external-tests: trim the fat
Signed-off-by: Jason A. Donenfeld <Jason@zx2c4.com>
This commit is contained in:
Jason A. Donenfeld
parent
bdbb6298a0
commit
fbf715ea45
2
contrib/external-tests/haskell/.gitignore
vendored
2
contrib/external-tests/haskell/.gitignore
vendored
|
|
@ -1,2 +0,0 @@
|
|||
.cabal-sandbox/
|
||||
dist
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
Loading…
Reference in a new issue