diff options
Diffstat (limited to 'tests/spec')
-rw-r--r-- | tests/spec/Network/WireGuard/RPCSpec.hs | 106 |
1 files changed, 88 insertions, 18 deletions
diff --git a/tests/spec/Network/WireGuard/RPCSpec.hs b/tests/spec/Network/WireGuard/RPCSpec.hs index 5a33d80..6d40e18 100644 --- a/tests/spec/Network/WireGuard/RPCSpec.hs +++ b/tests/spec/Network/WireGuard/RPCSpec.hs @@ -1,35 +1,105 @@ module Network.WireGuard.RPCSpec (spec) where import Control.Monad.STM (atomically, STM) +import Control.Concurrent.STM.TVar (writeTVar) +import qualified Data.ByteArray as BA (convert) import qualified Data.ByteString as BS (ByteString) -import qualified Data.ByteString.Lazy as BSL (ByteString) +import qualified Data.ByteString.Lazy as BSL (ByteString, isSuffixOf) import qualified Data.ByteString.Char8 as BC (pack) import qualified Data.ByteString.Lazy.Char8 as BCL (pack) +import Data.Maybe (fromJust) +import Data.Hex (unhex) +import Data.IP (AddrRange, IPv4, IPRange(..)) +import qualified Crypto.Noise.DH as DH (dhBytesToPair, dhBytesToPub) import Data.Conduit (runConduit, yield, ( .|)) import Data.Conduit.Binary (sinkLbs) +import Network.Socket (SockAddr(..), tupleToHostAddress) import Test.Hspec (Spec, describe, it, shouldBe, - shouldNotBe) + shouldSatisfy) +import Network.WireGuard.RPC (serveConduit, showPeer) +import Network.WireGuard.Internal.State (Device(..), Peer(..), + createDevice, createPeer) +import Network.WireGuard.Internal.Types (PresharedKey) -import Network.WireGuard.RPC (serveConduit) -import Network.WireGuard.Internal.State (Device, createDevice) +spec :: Spec +spec = do + describe "serveConduit" $ do + it "must correctly respond to a malformed request" $ do + devStm <- testDevice + device <- atomically devStm + res <- runConduit (yield (BC.pack "") .| serveConduit device .| sinkLbs) + res `shouldBe` BCL.pack "" + it "must correctly respond to an empty request" $ do + devStm <- testDevice + device <- atomically devStm + res <- runConduit (yield (BC.pack "\n\n") .| serveConduit device .| sinkLbs) + res `shouldBe` BCL.pack "" + it "must respond to a correctly formed get v1 request" $ do + devStm <- testDevice + device <- atomically devStm + res <- runConduit (yield (BC.pack "get=1\n\n") .| serveConduit device .| sinkLbs) + res `shouldBe` bsTestDevice + chkCorrectEnd res + describe "showPeer" $ do + it "must correctly generate a complete peer bytestring containing one ip range" $ do + peerPub <- unhex $ BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58" + peer <- atomically $ getTestPeerOneRange peerPub + res <- atomically $ showPeer peer + res `shouldBe` BC.pack "public_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=192.168.1.1:1337\npersistant_keepalive_interval=0\nrx_bytes=777\ntx_bytes=778\nlast_handshake_time=1502895867\nallowed_ip=192.168.1.0/24\n" + it "must correctly generate a complete peer bytestring containing several ip ranges" $ do + peerPub <- unhex $ BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58" + peer <- atomically $ getTestPeerTwoRanges peerPub + res <- atomically $ showPeer peer + res `shouldBe` BC.pack "public_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=192.168.1.1:1337\npersistant_keepalive_interval=0\nrx_bytes=777\ntx_bytes=778\nlast_handshake_time=1502895867\nallowed_ip=192.168.1.0/24\nallowed_ip=192.168.2.0/24\n" + where + testDevice = do + pkH <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" + pshH <- unhex $ BC.pack "188515093e952f5f22e865cef3012e72f8b5f0b598ac0309d5dacce3b70fcf52" + return $ getTestDevice pkH pshH + chkCorrectEnd bs = shouldSatisfy bs (BSL.isSuffixOf (BCL.pack "\n\n") ) +getGenericPeer :: BS.ByteString -> STM Peer +getGenericPeer pub = do + peer <- createPeer pubKey + writeTVar (endPoint peer) $ Just $ SockAddrInet 1337 $ tupleToHostAddress (192,168,1,1) + writeTVar (receivedBytes peer) 777 + writeTVar (transferredBytes peer) 778 + writeTVar (lastHandshakeTime peer) (Just 1502895867) + return peer + where + pubKey = fromJust . DH.dhBytesToPub $ BA.convert pub -getCommand :: BS.ByteString -getCommand = BC.pack "get=1\n\n" +getTestPeerOneRange :: BS.ByteString -> STM Peer +getTestPeerOneRange publicKeyHexBytes = do + p <- getGenericPeer publicKeyHexBytes + writeTVar (ipmasks p) ipmask + return p + where + ipmask = [IPv4Range (read "192.168.1.0/24" :: AddrRange IPv4)] -deviceS :: STM Device -deviceS = createDevice "wg0" +getTestPeerTwoRanges :: BS.ByteString -> STM Peer +getTestPeerTwoRanges publicKeyHexBytes = do + peer <- getGenericPeer publicKeyHexBytes + writeTVar (ipmasks peer) ipmask + return peer + where + ipmask = [IPv4Range (read "192.168.1.0/24" :: AddrRange IPv4), IPv4Range (read "192.168.2.0/24" :: AddrRange IPv4)] -bsDeviceStrict :: BS.ByteString -bsDeviceStrict = BC.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\npublic_key=b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33\npreshared_key=188515093e952f5f22e865cef3012e72f8b5f0b598ac0309d5dacce3b70fcf52\nallowed_ip=192.168.4.4/32\nendpoint=[abcd:23::33%2]:51820\n\n" +getTestDevice :: BS.ByteString -> BS.ByteString -> STM Device +getTestDevice pkHex pshHex = do + dev <- createDevice "wg0" + let keyPair = DH.dhBytesToPair $ BA.convert pkHex + let psh = Just $ BA.convert pshHex :: Maybe PresharedKey + writeTVar (localKey dev) keyPair + writeTVar (presharedKey dev) psh + writeTVar (port dev) 12912 + return dev -bsDevice :: BSL.ByteString -bsDevice = BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\npublic_key=b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33\npreshared_key=188515093e952f5f22e865cef3012e72f8b5f0b598ac0309d5dacce3b70fcf52\nallowed_ip=192.168.4.4/32\nendpoint=[abcd:23::33%2]:51820\npublic_key=58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376\ntx_bytes=38333\nrx_bytes=2224\nallowed_ip=192.168.4.6/32\npersistent_keepalive_interval=111\nendpoint=182.122.22.19:3233\npublic_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=5.152.198.39:51820\nallowed_ip=192.168.4.10/32\nallowed_ip=192.168.4.11/32\ntx_bytes=1212111\nrx_bytes=1929999999\nerrno=0\n\n" +bsTestDevice :: BSL.ByteString +bsTestDevice = BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\nfwmark=0\n\n" + + +--bsTestDeviceWithPairs :: BSL.ByteString +--bsTestDeviceWithPairs = BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\npublic_key=b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33\npreshared_key=188515093e952f5f22e865cef3012e72f8b5f0b598ac0309d5dacce3b70fcf52\nallowed_ip=192.168.4.4/32\nendpoint=[abcd:23::33%2]:51820\npublic_key=58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376\ntx_bytes=38333\nrx_bytes=2224\nallowed_ip=192.168.4.6/32\npersistent_keepalive_interval=111\nendpoint=182.122.22.19:3233\npublic_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=5.152.198.39:51820\nallowed_ip=192.168.4.10/32\nallowed_ip=192.168.4.11/32\ntx_bytes=1212111\nrx_bytes=1929999999\nerrno=0\n\n" -spec :: Spec -spec = describe "serveConduit" $ - it "must respond to a get v1 request" $ do - device <- atomically deviceS - res <- runConduit (yield getCommand .| serveConduit device .| sinkLbs) - res `shouldNotBe` BCL.pack "" |