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