aboutsummaryrefslogtreecommitdiffstats
path: root/tests/spec/Network/WireGuard/RPCSpec.hs
blob: 100819d3bcf604a5821ac93167ef08af6851b145 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
module Network.WireGuard.RPCSpec (spec) where

import Control.Monad.STM                           (atomically, STM)
import Control.Concurrent.STM.TVar                 (writeTVar)
import           Data.Attoparsec.ByteString.Char8  (parse, eitherResult)
import qualified Data.ByteArray             as BA  (convert)
import qualified Data.ByteString            as BS  (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.HashMap.Strict        as HM  (fromList)
import           Data.Hex                          (unhex)
import           Data.IP                           (AddrRange, IPv4, 
                                                    IPRange(..),
                                                    toHostAddress6)
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,
                                                    shouldSatisfy)
import Network.WireGuard.RPC                       (serveConduit, showPeer)
import Network.WireGuard.Internal.RpcParsers       (RpcDevicePayload(..), deviceParser)            
import Network.WireGuard.Internal.State            (Device(..), Peer(..),
                                                    createDevice, createPeer)
import Network.WireGuard.Internal.Data.Types       (PresharedKey, PeerId)

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 not connected to any peer" $ do
          devStm <- testDevice
          device <- atomically devStm
          res <- runConduit (yield (BC.pack "get=1\n\n") .| serveConduit device .| sinkLbs)
          res `shouldBe` bsTestDevice
          chkCorrectEnd res
        it "must respond to a correctly formed get v1 request connected to several peers" $ do
          pubKey1 <- unhex $ BC.pack "b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33"
          pubKey2 <- unhex $ BC.pack "58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376"
          pubKey3 <- unhex $ BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58"
          peer1 <- atomically $ getPeer1 pubKey1
          peer2 <- atomically $ getPeer2 pubKey2
          peer3 <- atomically $ getPeer3 pubKey3
          devStm <- testDeviceWithPeers [(BC.pack "peer1", peer1), (BC.pack "peer2", peer2), (BC.pack "peer3", peer3)]
          device <- atomically $ devStm
          res <- runConduit (yield (BC.pack "get=1\n\n") .| serveConduit device .| sinkLbs)
          res `shouldBe` bsTestDeviceWithPairs
          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\ntx_bytes=778\nrx_bytes=777\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\ntx_bytes=778\nrx_bytes=777\nlast_handshake_time=1502895867\nallowed_ip=192.168.1.0/24\nallowed_ip=192.168.2.0/24\n"
      describe "deviceParser" $ do
        it "must parse a add device entry" $ do
          pkHex <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a"
          let pk = DH.dhBytesToPair $ BA.convert pkHex
          let expectedDevice = RpcDevicePayload pk 777 (Just 0) False
          let result = parse deviceParser $ BC.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=0\n"
          eitherResult result `shouldBe` Right expectedDevice
        it "must parse a remove pk device entry" $ do
          let expectedDevice = RpcDevicePayload Nothing 777 (Just 0) False
          let result = parse deviceParser $ BC.pack "private_key=\nlisten_port=777\nfwmark=0\n"
          eitherResult result `shouldBe` Right expectedDevice
        it "must parse a remove fwmark device entry" $ do
          pkHex <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a"
          let pk = DH.dhBytesToPair $ BA.convert pkHex
          let expectedDevice = RpcDevicePayload pk 777 Nothing False
          let result = parse deviceParser $ BC.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=\n"
          eitherResult result `shouldBe` Right expectedDevice
        it "must handle remove device flag" $ do
          pkHex <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a"
          let pk = DH.dhBytesToPair $ BA.convert pkHex
          let expectedDevice = RpcDevicePayload pk 777 Nothing True
          let result = parse deviceParser $ BC.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=\nreplace_peers=true\n"
          eitherResult result `shouldBe` Right expectedDevice
        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") )
          testDeviceWithPeers prs = do
            pkH <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" 
            pshH <- unhex $ BC.pack "188515093e952f5f22e865cef3012e72f8b5f0b598ac0309d5dacce3b70fcf52" 
            return $ getTestDeviceWithPeers pkH pshH prs
            

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

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)]

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)]

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

getTestDeviceWithPeers :: BS.ByteString -> BS.ByteString -> [(PeerId, Peer)] -> STM Device
getTestDeviceWithPeers pkHex pshHex prs = 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
  writeTVar (peers dev) $ HM.fromList prs
  return dev
  
getPeer1 :: BS.ByteString -> STM Peer
getPeer1 pubHex = do
  peer <- createPeer pubKey
  writeTVar (endPoint peer) . Just $ SockAddrInet6 51820 0 (toHostAddress6 $ read "abcd:23::33") 2
  writeTVar (ipmasks peer) ipRange 
  return peer
  where
    pubKey = fromJust . DH.dhBytesToPub $ BA.convert pubHex
    ipRange = [IPv4Range (read "192.168.4.4/32" :: AddrRange IPv4)]
getPeer2 :: BS.ByteString -> STM Peer
getPeer2 pubHex = do
  peer <- createPeer pubKey
  writeTVar (endPoint peer) $ Just $ SockAddrInet 3233 $ tupleToHostAddress (182,122,22,19)
  writeTVar (receivedBytes peer) 2224
  writeTVar (transferredBytes peer) 38333
  writeTVar (keepaliveInterval peer) 111
  writeTVar (ipmasks peer) ipRange 
  return peer
  where
    pubKey = fromJust . DH.dhBytesToPub $ BA.convert pubHex
    ipRange = [IPv4Range (read "192.168.4.6/32" :: AddrRange IPv4)]

getPeer3 :: BS.ByteString -> STM Peer
getPeer3 pubHex = do
  peer <- createPeer pubKey
  writeTVar (endPoint peer) $ Just $ SockAddrInet 51820 $ tupleToHostAddress (5, 152, 198, 39)
  writeTVar (receivedBytes peer) 1929999999 
  writeTVar (transferredBytes peer) 1212111
  writeTVar (ipmasks peer) ipRange 
  return peer
  where
    pubKey = fromJust . DH.dhBytesToPub $ BA.convert pubHex
    ipRange = [IPv4Range (read "192.168.4.10/32" :: AddrRange IPv4),
               IPv4Range (read "192.168.4.11/32" :: AddrRange IPv4)]
bsTestDevice :: BSL.ByteString
bsTestDevice = BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\nerrno=0\n\n"


bsTestDeviceWithPairs :: BSL.ByteString
bsTestDeviceWithPairs = BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\npublic_key=b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33\nendpoint=[abcd:23::33%2]:51820\nallowed_ip=192.168.4.4/32\npublic_key=58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376\nendpoint=182.122.22.19:3233\npersistent_keepalive_interval=111\ntx_bytes=38333\nrx_bytes=2224\nallowed_ip=192.168.4.6/32\npublic_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=5.152.198.39:51820\ntx_bytes=1212111\nrx_bytes=1929999999\nallowed_ip=192.168.4.10/32\nallowed_ip=192.168.4.11/32\nerrno=0\n\n"