From fbf715ea45fae7028e726f80e4d5bef7174677d0 Mon Sep 17 00:00:00 2001 From: "Jason A. Donenfeld" Date: Fri, 9 Jun 2017 02:56:08 +0200 Subject: [PATCH] external-tests: trim the fat Signed-off-by: Jason A. Donenfeld --- contrib/external-tests/haskell/.gitignore | 2 - contrib/external-tests/haskell/Setup.hs | 2 - .../external-tests/haskell/cacophony-wg.cabal | 34 -------- .../haskell/src/Data/Time/TAI64.hs | 86 ------------------- contrib/external-tests/haskell/src/Main.hs | 81 ----------------- 5 files changed, 205 deletions(-) delete mode 100644 contrib/external-tests/haskell/.gitignore delete mode 100644 contrib/external-tests/haskell/Setup.hs delete mode 100644 contrib/external-tests/haskell/cacophony-wg.cabal delete mode 100644 contrib/external-tests/haskell/src/Data/Time/TAI64.hs delete mode 100644 contrib/external-tests/haskell/src/Main.hs diff --git a/contrib/external-tests/haskell/.gitignore b/contrib/external-tests/haskell/.gitignore deleted file mode 100644 index 1159ea5..0000000 --- a/contrib/external-tests/haskell/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -.cabal-sandbox/ -dist diff --git a/contrib/external-tests/haskell/Setup.hs b/contrib/external-tests/haskell/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/contrib/external-tests/haskell/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/contrib/external-tests/haskell/cacophony-wg.cabal b/contrib/external-tests/haskell/cacophony-wg.cabal deleted file mode 100644 index 90f519d..0000000 --- a/contrib/external-tests/haskell/cacophony-wg.cabal +++ /dev/null @@ -1,34 +0,0 @@ --- Initial cacophony-wg.cabal generated by cabal init. For further --- documentation, see https://www.haskell.org/cabal/users-guide/ - -name: cacophony-wg -version: 0.1.0 --- synopsis: --- description: -license: PublicDomain -license-file: LICENSE -author: John Galt -maintainer: centromere@users.noreply.github.com --- copyright: --- category: -build-type: Simple --- extra-source-files: -cabal-version: >=1.10 - -executable cacophony-wg - main-is: Main.hs - other-modules: - Data.Time.TAI64 - build-depends: - base >=4.8 && <4.9, - base16-bytestring, - base64-bytestring, - blake2, - bytestring, - cacophony, - cereal, - cryptonite, - network, - time - hs-source-dirs: src - default-language: Haskell2010 diff --git a/contrib/external-tests/haskell/src/Data/Time/TAI64.hs b/contrib/external-tests/haskell/src/Data/Time/TAI64.hs deleted file mode 100644 index 37a90e6..0000000 --- a/contrib/external-tests/haskell/src/Data/Time/TAI64.hs +++ /dev/null @@ -1,86 +0,0 @@ -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 deleted file mode 100644 index 8983e6c..0000000 --- a/contrib/external-tests/haskell/src/Main.hs +++ /dev/null @@ -1,81 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Main where - -import Control.Applicative ((<$>)) -import Control.Concurrent.MVar -import Control.Monad (void) -import Data.ByteString.Char8 (pack, unpack, take, drop, replicate) -import Data.ByteString (ByteString) -import qualified Data.ByteString.Base16 as Hex -import qualified Data.ByteString.Base64 as B64 -import qualified Data.Serialize as S -import Prelude hiding (take, drop, replicate) -import System.Environment -import Network.Socket -import qualified Network.Socket.ByteString as NBS - -import Crypto.Hash.BLAKE2.BLAKE2s -import Crypto.Noise.Cipher -import Crypto.Noise.Cipher.ChaChaPoly1305 -import Crypto.Noise.Curve -import Crypto.Noise.Curve.Curve25519 -import Crypto.Noise.Handshake -import Crypto.Noise.HandshakePatterns -import Crypto.Noise.Hash.BLAKE2s -import Crypto.Noise.Types - -import Data.Time.TAI64 - -w :: PublicKey Curve25519 - -> Plaintext - -> Socket - -> SockAddr - -> ByteString - -> IO () -w theirPub (Plaintext myPSK) sock addr msg = do - let x = "\x01\x00\x00\x00\x00\x00" `mappend` msg - mac = hash 16 myPSK (sbToBS' (curvePubToBytes theirPub) `mappend` sbToBS' x) -- TODO: this should actually be blake2s(key=blake2s("mac1----" || theirPub), payload=blah) - void $ NBS.sendTo sock (x `mappend` mac `mappend` replicate 16 '\0') addr - -r :: MVar ByteString -> Socket -> IO ByteString -r smv sock = do - (r, _) <- NBS.recvFrom sock 1024 - putMVar smv $ (take 2 . drop 1) r - return . take 48 . drop 8 $ r - -payload :: IO Plaintext -payload = do - tai64n <- getCurrentTAI64N - return . Plaintext . bsToSB' $ S.encode tai64n - -main :: IO () -main = do - let ip = "demo.wireguard.io" - let port = "12913" - let mykey = "WAmgVYXkbT2bCtdcDwolI88/iVi/aV3/PHcUBTQSYmo=" - let serverkey = "qRCwZSKInrMAq5sepfCdaCsRJaoLe5jhtzfiw7CjbwM=" - let psk = "FpCyhws9cxwWoV4xELtfJvjJN+zQVRPISllRWgeopVE=" - addrInfo <- head <$> getAddrInfo Nothing (Just ip) (Just port) - sock <- socket (addrFamily addrInfo) Datagram defaultProtocol - - let addr = addrAddress addrInfo - mykey' = curveBytesToPair . bsToSB' . either undefined id . B64.decode . pack $ mykey :: KeyPair Curve25519 - serverkey' = curveBytesToPub . bsToSB' . either undefined id . B64.decode . pack $ serverkey :: PublicKey Curve25519 - psk' = Plaintext . bsToSB' . either undefined id . B64.decode . pack $ psk - hs = handshakeState $ HandshakeStateParams - noiseIK -- TODO: specify psk2 mode - "WireGuard v1 zx2c4 Jason@zx2c4.com" - (Just psk') - (Just mykey') - Nothing - (Just serverkey') - Nothing - True :: HandshakeState ChaChaPoly1305 Curve25519 BLAKE2s - - senderindexmv <- newEmptyMVar - let hc = HandshakeCallbacks (w serverkey' psk' sock addr) (r senderindexmv sock) (\_ -> return ()) payload - (encryption, decryption) <- runHandshake hs hc - - let (keepAlive, encryption') = encryptPayload "" encryption - senderindex <- takeMVar senderindexmv - void $ NBS.sendTo sock ("\x04\x00\x00\x00" `mappend` senderindex `mappend` replicate 8 '\0' `mappend` keepAlive) addr