diff --git a/contrib/external-tests/haskell/Setup.hs b/contrib/external-tests/haskell/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/contrib/external-tests/haskell/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/contrib/external-tests/haskell/package.yaml b/contrib/external-tests/haskell/package.yaml
new file mode 100644
index 0000000..3c8cc55
--- /dev/null
+++ b/contrib/external-tests/haskell/package.yaml
@@ -0,0 +1,36 @@
+name: cacophony-wg
+version: 0.1.0
+license: PublicDomain
+maintainer: John Galt <jgalt@centromere.net>
+category: Cryptography
+ghc-options: -Wall
+
+executables:
+ cacophony-wg:
+ main: Main.hs
+ source-dirs: src
+
+ dependencies:
+ - base
+ - base16-bytestring
+ - base64-bytestring
+ - blake2
+ - bytestring
+ - cacophony >= 0.10
+ - cereal
+ - cryptonite
+ - memory
+ - network
+ - time
+
+ ghc-options:
+ - -O2
+ - -rtsopts
+ - -threaded
+ - -with-rtsopts=-N
+
+ other-modules:
+ - Data.Time.TAI64
+
+ default-extensions:
+ - OverloadedStrings
diff --git a/contrib/external-tests/haskell/src/Data/Time/TAI64.hs b/contrib/external-tests/haskell/src/Data/Time/TAI64.hs
new file mode 100644
index 0000000..37a90e6
--- /dev/null
+++ b/contrib/external-tests/haskell/src/Data/Time/TAI64.hs
@@ -0,0 +1,86 @@
+module Data.Time.TAI64 (
+ TAI64(..)
+ , TAI64N(..)
+ , TAI64NA(..)
+ , posixToTAI64
+ , posixToTAI64N
+ , posixToTAI64NA
+ , getCurrentTAI64
+ , getCurrentTAI64N
+ , getCurrentTAI64NA
+ , tAI64ToPosix
+ , tAI64NToPosix
+ , tAI64NAToPosix
+) where
+
+import Data.Serialize
+import Control.Monad
+import Data.Word
+
+import Data.Time.Clock
+import Data.Time.Clock.POSIX
+
+import Numeric
+
+data TAI64 = TAI64
+ {-# UNPACK #-} !Word64
+ deriving (Eq, Ord)
+
+data TAI64N = TAI64N
+ {-# UNPACK #-} !TAI64
+ {-# UNPACK #-} !Word32
+ deriving (Eq, Ord, Show)
+
+data TAI64NA = TAI64NA
+ {-# UNPACK #-} !TAI64N
+ {-# UNPACK #-} !Word32
+ deriving (Eq, Ord, Show)
+
+instance Show TAI64 where
+ show (TAI64 t) = "TAI64 0x" ++ showHex t ""
+
+instance Serialize TAI64 where
+ put (TAI64 t) = putWord64be t
+ get = liftM TAI64 get
+
+instance Serialize TAI64N where
+ put (TAI64N t' nt) = put t' >> putWord32be nt
+ get = liftM2 TAI64N get get
+
+instance Serialize TAI64NA where
+ put (TAI64NA t' at) = put t' >> putWord32be at
+ get = liftM2 TAI64NA get get
+
+
+posixToTAI64 :: POSIXTime -> TAI64
+posixToTAI64 = TAI64 . (2^62 +) . truncate . realToFrac
+
+posixToTAI64N :: POSIXTime -> TAI64N
+posixToTAI64N pt = TAI64N t' ns where
+ t' = posixToTAI64 pt
+ ns = (`mod` 10^9) $ truncate (pts * 10**9)
+ pts = realToFrac pt
+
+posixToTAI64NA :: POSIXTime -> TAI64NA -- | PICOsecond precision
+posixToTAI64NA pt = TAI64NA t' as where
+ t' = posixToTAI64N pt
+ as = (`mod` 10^9) $ truncate (pts * 10**18)
+ pts = realToFrac pt
+
+getCurrentTAI64 :: IO TAI64
+getCurrentTAI64N :: IO TAI64N
+getCurrentTAI64NA :: IO TAI64NA
+getCurrentTAI64 = liftM posixToTAI64 getPOSIXTime
+getCurrentTAI64N = liftM posixToTAI64N getPOSIXTime
+getCurrentTAI64NA = liftM posixToTAI64NA getPOSIXTime
+
+tAI64ToPosix :: TAI64 -> POSIXTime
+tAI64ToPosix (TAI64 s) = fromRational . fromIntegral $ s - 2^62
+
+tAI64NToPosix :: TAI64N -> POSIXTime
+tAI64NToPosix (TAI64N t' n) = tAI64ToPosix t' + nanopart where
+ nanopart = fromRational $ (toRational $ 10**(-9)) * toRational n -- TODO: optimize?
+
+tAI64NAToPosix :: TAI64NA -> POSIXTime
+tAI64NAToPosix (TAI64NA t' a) = tAI64NToPosix t' + attopart where
+ attopart = fromRational $ (toRational $ 10**(-18)) * toRational a
diff --git a/contrib/external-tests/haskell/src/Main.hs b/contrib/external-tests/haskell/src/Main.hs
new file mode 100644
index 0000000..b0b7503
--- /dev/null
+++ b/contrib/external-tests/haskell/src/Main.hs
@@ -0,0 +1,138 @@
+module Main where
+
+import Control.Monad (void)
+import Crypto.Hash.BLAKE2.BLAKE2s (hash)
+import Data.ByteArray (ScrubbedBytes, convert)
+import Data.ByteString (ByteString, replicate, take, drop)
+import qualified Data.ByteString.Base16 as B16
+import qualified Data.ByteString.Base64 as B64
+import Data.Maybe (fromMaybe)
+import Data.Monoid ((<>))
+import qualified Data.Serialize as S
+import Network.Socket
+import qualified Network.Socket.ByteString as NBS
+import Prelude hiding (replicate, take, drop)
+
+import Crypto.Noise
+import Crypto.Noise.Cipher
+import Crypto.Noise.Cipher.ChaChaPoly1305
+import Crypto.Noise.DH
+import Crypto.Noise.DH.Curve25519
+import Crypto.Noise.HandshakePatterns (noiseIKpsk2)
+import Crypto.Noise.Hash hiding (hash)
+import Crypto.Noise.Hash.BLAKE2s
+
+import Data.Time.TAI64
+
+sampleICMPRequest :: ByteString
+sampleICMPRequest = fst . B16.decode $
+ "450000250000000014018f5b0abd81020abd810108001bfa039901b6576972654775617264"
+
+validateICMPResponse :: ByteString
+ -> Bool
+validateICMPResponse r =
+ -- Strip off part of IPv4 header because this is only a demo.
+ drop 12 sample == drop 12 r
+ where
+ sample = fst . B16.decode $ "45000025e3030000400180570abd81010abd8102000023fa039901b65769726547756172640000000000000000000000"
+
+unsafeMessage :: (Cipher c, DH d, Hash h)
+ => Bool
+ -> Maybe ScrubbedBytes
+ -> ScrubbedBytes
+ -> NoiseState c d h
+ -> (ScrubbedBytes, NoiseState c d h)
+unsafeMessage write mpsk msg ns = case operation msg ns of
+ NoiseResultMessage ct ns' -> (ct, ns')
+
+ NoiseResultNeedPSK ns' -> case mpsk of
+ Nothing -> error "psk required but not provided"
+ Just k -> case operation k ns' of
+ NoiseResultMessage ct ns'' -> (ct, ns'')
+ _ -> error "something terrible happened"
+
+ _ -> error "something terrible happened"
+ where
+ operation = if write then writeMessage else readMessage
+
+main :: IO ()
+main = do
+ let ip = "demo.wireguard.io"
+ port = "12913"
+ myKeyB64 = "WAmgVYXkbT2bCtdcDwolI88/iVi/aV3/PHcUBTQSYmo=" -- private key
+ serverKeyB64 = "qRCwZSKInrMAq5sepfCdaCsRJaoLe5jhtzfiw7CjbwM=" -- public key
+ pskB64 = "FpCyhws9cxwWoV4xELtfJvjJN+zQVRPISllRWgeopVE="
+
+ addrInfo <- head <$> getAddrInfo Nothing (Just ip) (Just port)
+ sock <- socket (addrFamily addrInfo) Datagram defaultProtocol
+
+ let addr = addrAddress addrInfo
+ myStaticKey = fromMaybe (error "invalid private key")
+ . dhBytesToPair
+ . convert
+ . either (error "error Base64 decoding my private key") id
+ . B64.decode
+ $ myKeyB64 :: KeyPair Curve25519
+
+ serverKey = fromMaybe (error "invalid public key")
+ . dhBytesToPub
+ . convert
+ . either (error "error Base64 decoding server public key") id
+ . B64.decode
+ $ serverKeyB64 :: PublicKey Curve25519
+
+ psk = convert
+ . either (error "error decoding PSK") id
+ . B64.decode
+ $ pskB64 :: ScrubbedBytes
+
+ myEphemeralKey <- dhGenKey
+
+ let dho = defaultHandshakeOpts InitiatorRole "WireGuard v1 zx2c4 Jason@zx2c4.com"
+ opts = setLocalEphemeral (Just myEphemeralKey)
+ . setLocalStatic (Just myStaticKey)
+ . setRemoteStatic (Just serverKey)
+ $ dho
+ ns0 = noiseState opts noiseIKpsk2 :: NoiseState ChaChaPoly1305 Curve25519 BLAKE2s
+
+ tai64n <- convert . S.encode <$> getCurrentTAI64N
+
+ -- Handshake: Initiator to responder -----------------------------------------
+
+ let (msg0, ns1) = unsafeMessage True Nothing tai64n ns0
+ macKey = hash 32 mempty $ "mac1----" `mappend` (convert . dhPubToBytes) serverKey
+ initiation = "\x01\x00\x00\x00\x1c\x00\x00\x00" <> convert msg0 -- sender index = 28 to match other examples
+ mac1 = hash 16 macKey initiation
+
+ void $ NBS.sendTo sock (initiation <> mac1 <> replicate 16 0) addr
+
+ -- Handshake: Responder to initiator -----------------------------------------
+
+ (response0, _) <- NBS.recvFrom sock 1024
+
+ let theirIndex = take 4 . drop 4 $ response0
+ (_, ns2) = unsafeMessage False (Just psk) (convert . take 48 . drop 12 $ response0) ns1
+
+ -- ICMP: Initiator to responder ----------------------------------------------
+
+ let (msg1, ns3) = unsafeMessage True Nothing (convert sampleICMPRequest) ns2
+ icmp = "\x04\x00\x00\x00" <> theirIndex <> replicate 8 0 <> convert msg1
+
+ void $ NBS.sendTo sock icmp addr
+
+ -- ICMP: Responder to initiator ----------------------------------------------
+
+ (response1, _) <- NBS.recvFrom sock 1024
+
+ let (icmpPayload, ns4) = unsafeMessage False Nothing (convert . drop 16 $ response1) ns3
+
+ -- KeepAlive: Initiator to responder -----------------------------------------
+
+ if validateICMPResponse . convert $ icmpPayload
+ then do
+ let (msg2, _) = unsafeMessage True Nothing mempty ns4
+ keepAlive = "\x04\x00\x00\x00" <> theirIndex <> "\x01" <> replicate 7 0 <> convert msg2
+
+ void $ NBS.sendTo sock keepAlive addr
+
+ else error "unexpected ICMP response from server!"
diff --git a/contrib/external-tests/haskell/stack.yaml b/contrib/external-tests/haskell/stack.yaml
new file mode 100644
index 0000000..f5612fc
--- /dev/null
+++ b/contrib/external-tests/haskell/stack.yaml
@@ -0,0 +1,6 @@
+resolver: lts-8.18
+packages:
+ - '.'
+extra-deps: []
+flags: {}
+extra-package-dbs: []