aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/Network/WireGuard/Internal/Data/RpcTypes.hs60
-rw-r--r--src/Network/WireGuard/Internal/RpcParsers.hs167
-rw-r--r--src/Network/WireGuard/RPC.hs9
-rw-r--r--tests/spec/Network/WireGuard/RPCSpec.hs81
4 files changed, 246 insertions, 71 deletions
diff --git a/src/Network/WireGuard/Internal/Data/RpcTypes.hs b/src/Network/WireGuard/Internal/Data/RpcTypes.hs
index a3c148b..d45d38e 100644
--- a/src/Network/WireGuard/Internal/Data/RpcTypes.hs
+++ b/src/Network/WireGuard/Internal/Data/RpcTypes.hs
@@ -3,16 +3,17 @@ module Network.WireGuard.Internal.Data.RpcTypes(
RpcRequest(..),
RpcSetPayload(..),
RpcDevicePayload(..),
- RpcPeerPayload(..)
+ RpcPeerPayload(..),
+ RpcDeviceField(..),
+ RpcPeerField(..)
) where
-import Data.Word (Word64)
import Data.IP (IPRange(..))
-import Crypto.Noise.DH (dhSecToBytes)
+import Crypto.Noise.DH (dhSecToBytes, dhPubToBytes)
import Network.Socket.Internal (SockAddr)
import Network.WireGuard.Internal.Data.Types (PublicKey, KeyPair,
- Time)
+ PresharedKey)
-- | Kind of client operation.
--
-- See <https://www.wireguard.com/xplatform/#configuration-protocol> for more informations.
@@ -22,22 +23,22 @@ data OpType = Get | Set
--
-- See <https://www.wireguard.com/xplatform/#configuration-protocol> for more informations.
data RpcRequest = RpcRequest {
- opType :: OpType,
- payload :: Maybe RpcSetPayload
+ opType :: !OpType,
+ payload :: !(Maybe RpcSetPayload)
}
-- | Payload sent together with a set RPC operation.
data RpcSetPayload = RpcSetPayload {
- devicePayload :: RpcDevicePayload,
+ devicePayload :: !RpcDevicePayload,
peersPayload :: [RpcPeerPayload]
}
-- | Device related payload sent together with a set RPC operation.
data RpcDevicePayload = RpcDevicePayload {
- pk :: Maybe KeyPair,
- listenPort :: Int,
- fwMark :: Maybe Word,
- replacePeers :: Bool
+ pk :: !(Maybe KeyPair),
+ listenPort :: !Int,
+ fwMark :: !(Maybe Word),
+ replacePeers :: !Bool
}
instance Show RpcDevicePayload where
@@ -50,14 +51,35 @@ instance Eq RpcDevicePayload where
((dhSecToBytes . fst) <$> pk1) == ((dhSecToBytes . fst) <$> pk2) && (prt1 == prt2) &&
(rp1 == rp2) && (fw1 == fw2)
+data RpcDeviceField = RpcPk !(Maybe KeyPair)
+ | RpcPort !Int
+ | RpcFwMark !(Maybe Word)
+ | RpcReplacePeers
+
-- | Peer related payload sent together with a set RPC operation.
data RpcPeerPayload = RpcPeerPayload {
- pubK :: PublicKey,
- remove :: Bool,
- endpoint :: SockAddr,
- persistantKeepaliveInterval :: Int,
- allowedIp :: [IPRange],
- rxBytes :: Word64,
- txBytes :: Word64,
- lastHandshake :: Time
+ pubK :: !PublicKey,
+ remove :: !Bool,
+ presharedKey :: !(Maybe PresharedKey),
+ endpoint :: !SockAddr,
+ persistantKeepaliveInterval :: !Int,
+ replaceIps :: !Bool,
+ allowedIp :: ![IPRange]
}
+
+instance Eq RpcPeerPayload where
+ (==) (RpcPeerPayload pub1 rm1 psk1 e1 k1 rp1 aip1)(RpcPeerPayload pub2 rm2 psk2 e2 k2 rp2 aip2) =
+ (dhPubToBytes pub1 == dhPubToBytes pub2) && (rm1 == rm2) && (psk1 == psk2) && (e1 == e2) &&
+ (k1 == k2) && (rp1 == rp2) && (aip1 == aip2)
+
+instance Show RpcPeerPayload where
+ show (RpcPeerPayload pub1 rm1 psk1 e1 k1 rp1 aip1)
+ = show (dhPubToBytes pub1) ++ show rm1 ++ show psk1 ++ show e1 ++ show k1 ++
+ show rp1 ++ show aip1
+
+data RpcPeerField = RpcRmFlag !Bool
+ | RpcPsh !PresharedKey
+ | RpcEndp !SockAddr
+ | RpcKA !Int
+ | RpcDelIps !Bool
+ | RpcAllIp !IPRange
diff --git a/src/Network/WireGuard/Internal/RpcParsers.hs b/src/Network/WireGuard/Internal/RpcParsers.hs
index b28b000..c5179c8 100644
--- a/src/Network/WireGuard/Internal/RpcParsers.hs
+++ b/src/Network/WireGuard/Internal/RpcParsers.hs
@@ -1,39 +1,37 @@
{-# LANGUAGE OverloadedStrings #-}
module Network.WireGuard.Internal.RpcParsers(
- RpcRequest(..),
- OpType(..),
- RpcSetPayload(..),
- RpcDevicePayload(..),
- RpcPeerPayload(..),
requestParser,
- deviceParser
+ deviceParser,
+ peerParser
) where
-
import Control.Applicative ((*>), (<|>))
-import Control.Monad (liftM, join)
-import Crypto.Noise.DH (dhSecToBytes, dhBytesToPair)
+import Control.Monad (join)
+import Crypto.Noise.DH (dhBytesToPair, dhBytesToPub)
import Data.Attoparsec.ByteString.Char8 (Parser, string,
- takeTill, option)
-import Data.Attoparsec.Combinator ((<?>))
-import qualified Data.ByteArray as BA (convert)
-import qualified Data.ByteString as BS (head)
-import Data.ByteString.Conversion
-import qualified Data.ByteString.Char8 as BC (pack)
-import Data.Maybe (fromMaybe)
-import Data.IP (IPRange(..))
-import Data.Hex (unhex)
-import Data.Word (Word, Word64)
+ takeTill, option,
+ endOfLine, peekChar')
+import Data.Attoparsec.Text (isEndOfLine)
+import Data.Attoparsec.Combinator ((<?>), many')
+import qualified Data.ByteArray as BA (convert, )
import Data.ByteString (ByteString)
-import Network.Socket.Internal (SockAddr)
+import Data.ByteString.Conversion (fromByteString)
+import qualified Data.ByteString.Char8 as BC (pack, unpack)
+import Data.Maybe (fromMaybe, listToMaybe,
+ fromJust)
+import Data.IP (IPRange, toHostAddress6)
+import Data.Hex (unhex)
+import Network.Socket (SockAddr, tupleToHostAddress,
+ SockAddr(..))
import Network.WireGuard.Internal.Data.RpcTypes (OpType(..),
RpcRequest(..),
RpcDevicePayload(..),
RpcPeerPayload(..),
- RpcSetPayload(..))
-
+ RpcSetPayload(..),
+ RpcDeviceField(..),
+ RpcPeerField(..))
-- | Attoparsec parser used to parse a RPC request, both Set or Get.
requestParser :: Parser RpcRequest
@@ -54,13 +52,120 @@ setPayloadParser = undefined
deviceParser :: Parser RpcDevicePayload
deviceParser = do
- pkHex <- option Nothing (unhex <$> keyParser "private_key") <?> "Primary key parser"
- "\n"
- let pk = join $ (dhBytesToPair . BA.convert) <$> pkHex
- p <- (fromMaybe 0 . fromByteString) <$> keyParser "listen_port" <?> "Port parser"
- "\n"
- fwmark <- option Nothing (fromByteString <$> keyParser "fwmark") <?> "Fwmark parser"
- return $ RpcDevicePayload pk p fwmark False
+ fields <- deviceFieldsParser
+ let pk = join $ listToMaybe [ pkF | RpcPk pkF <- fields]
+ let p = head [ pF | RpcPort pF <- fields]
+ let fw = join $ listToMaybe [ fwF | RpcFwMark fwF <- fields]
+ let rmDev = not $ null [True | RpcReplacePeers <- fields]
+ return $ RpcDevicePayload pk p fw rmDev
+
+deviceFieldsParser :: Parser [RpcDeviceField]
+deviceFieldsParser = many' (deviceFieldParser <* endOfLine)
+
+deviceFieldParser :: Parser RpcDeviceField
+deviceFieldParser = do
+ key <- takeTill (=='=')
+ _ <- "="
+ case key of
+ "private_key" -> do
+ pkHex <- option Nothing (unhex <$> takeTill isEndOfLine) <?> "Primary Key parser"
+ return . RpcPk . join $ (dhBytesToPair . BA.convert) <$> pkHex
+ "listen_port" -> do
+ p <- (fromMaybe 0 . fromByteString) <$> takeTill isEndOfLine <?> "Listen Port parser"
+ return $ RpcPort p
+ "fwmark" -> do
+ fwmark <- option Nothing (fromByteString <$> takeTill isEndOfLine) <?> "fwmark parser"
+ return $ RpcFwMark fwmark
+ "replace_peers" -> do
+ _ <- "true"
+ return RpcReplacePeers
+ _ -> fail "Not a device key"
+
+peerParser :: Parser RpcPeerPayload
+peerParser = do
+ pubK <- parsePubKey
+ fields <- peerFieldsParser
+ let rm = not $ null [rmF | RpcRmFlag rmF <- fields]
+ let psh = listToMaybe [pshF | RpcPsh pshF <- fields]
+ let endPL = [endPF | RpcEndp endPF <- fields]
+ endP <- if null endPL
+ then fail "Cannot parse Peer endpoint"
+ else return $ head endPL
+ let ka = fromMaybe 0 $ listToMaybe [kaF | RpcKA kaF <- fields]
+ let rmIps = not $ null [rmIpsF | RpcDelIps rmIpsF <- fields]
+ let allIpR = [ipRF | RpcAllIp ipRF <- fields]
+ return $ RpcPeerPayload pubK rm psh endP ka rmIps allIpR
+ where
+ parsePubKey = do
+ _ <- "public_key=" <?> "Peer delimiter"
+ pubHex <- unhex <$> takeTill isEndOfLine :: Parser (Maybe ByteString)
+ _ <- "\n"
+ let pubMaybe = join $ (dhBytesToPub . BA.convert) <$> pubHex
+ maybe (fail "Cannot parse peer's public key") return pubMaybe
+
+peerFieldsParser :: Parser [RpcPeerField]
+peerFieldsParser = many' (peerFieldParser <* endOfLine)
+
+peerFieldParser :: Parser RpcPeerField
+peerFieldParser = do
+ key <- takeTill (=='=')
+ _ <- "="
+ case key of
+ "remove" -> (do
+ _ <- "true"
+ return $ RpcRmFlag True) <?> "Remove peer parser"
+ "preshared_key" -> (do
+ pshHex <- unhex <$> takeTill isEndOfLine
+ return . RpcPsh . BA.convert . fromJust $ pshHex) <?> "Psh key peer parser"
+ "endpoint" -> RpcEndp <$> parseIpAddress <?> "Endpoint peer parser"
+ "persistent_keepalive_interval" -> (RpcKA . read . BC.unpack) <$> takeTill isEndOfLine <?> "Persistant keepalive parser"
+ "replace_allowed_ips" -> (do
+ _ <- "true"
+ return $ RpcDelIps True) <?> "Replace allowed Ips parser"
+ "allowed_ip" -> RpcAllIp <$> parseIpRange <?> "Allowed ips parser"
+ _ -> fail "Not a peer key"
+
+parseIpAddress :: Parser SockAddr
+parseIpAddress = do
+ f <- peekChar'
+ if f == '['
+ then parseIpv6
+ else parseIpv4
+ where
+ parseIpv6 = do
+ _ <- "["
+ host1 <- (fromJust . fromByteString) <$> takeTill (=='%')
+ _ <- "%"
+ scope_id <- (fromJust . fromByteString) <$> takeTill (==']')
+ _ <- "]:"
+ port <- (read . fromJust . fromByteString) <$> takeTill isEndOfLine
+ let host = toHostAddress6 $ read host1
+ return $ SockAddrInet6 port 0 host scope_id
+ parseIpv4 = do
+ ip1 <- (fromJust . fromByteString) <$> takeTill (=='.')
+ _ <- "."
+ ip2 <- (fromJust . fromByteString) <$> takeTill (=='.')
+ _ <- "."
+ ip3 <- (fromJust . fromByteString) <$> takeTill (=='.')
+ _ <- "."
+ ip4 <- (fromJust . fromByteString) <$> takeTill (==':')
+ _ <- ":"
+ p <- (fromInteger . fromJust . fromByteString) <$> takeTill isEndOfLine
+ return . SockAddrInet p $ tupleToHostAddress (ip1,ip2,ip3,ip4)
-keyParser :: ByteString -> Parser ByteString
-keyParser str = (string str *> "=") *> takeTill (=='\n')
+parseIpRange :: Parser IPRange
+parseIpRange = do
+ f <- peekChar'
+ if f == '['
+ then parseIpv6Range
+ else parseIpv4Range
+ where
+ parseIpv4Range = do
+ line <- takeTill isEndOfLine
+ return . read . fromJust $ fromByteString line
+ parseIpv6Range = do
+ _ <- "["
+ rng <- takeTill (==']')
+ _ <- "]"
+ return . read . fromJust $ fromByteString rng
+
diff --git a/src/Network/WireGuard/RPC.hs b/src/Network/WireGuard/RPC.hs
index ae9e552..162b5b4 100644
--- a/src/Network/WireGuard/RPC.hs
+++ b/src/Network/WireGuard/RPC.hs
@@ -1,9 +1,7 @@
{-# LANGUAGE RecordWildCards #-}
module Network.WireGuard.RPC
- ( OpType(..),
- RpcRequest(..),
- runRPC,
+ ( runRPC,
serveConduit,
bytesToPair,
showDevice,
@@ -47,13 +45,14 @@ import Network.WireGuard.Foreign.UAPI (WgPeer(..), WgDevice
deviceFlagRemoveFwmark, deviceFlagReplacePeers,
deviceFlagRemovePrivateKey, deviceFlagRemovePresharedKey)
import Network.WireGuard.Internal.Constant (keyLength)
-import Network.WireGuard.Internal.RpcParsers (RpcRequest(..), RpcSetPayload(..),
- OpType(..), requestParser)
+import Network.WireGuard.Internal.RpcParsers (requestParser)
import Network.WireGuard.Internal.State (Device(..), Peer(..),
createPeer,
invalidateSessions)
import Network.WireGuard.Internal.Data.Types (PrivateKey, PublicKey,
PresharedKey, KeyPair)
+import Network.WireGuard.Internal.Data.RpcTypes (RpcRequest(..), RpcSetPayload(..),
+ OpType(..))
import Network.WireGuard.Internal.Util (catchIOExceptionAnd)
-- | Run RPC service over a unix socket
diff --git a/tests/spec/Network/WireGuard/RPCSpec.hs b/tests/spec/Network/WireGuard/RPCSpec.hs
index 100819d..18ba13d 100644
--- a/tests/spec/Network/WireGuard/RPCSpec.hs
+++ b/tests/spec/Network/WireGuard/RPCSpec.hs
@@ -2,17 +2,18 @@ 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 Data.Attoparsec.ByteString.Char8 (parse, eitherResult, feed)
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.Char8 as BC (pack, empty)
import qualified Data.ByteString.Lazy.Char8 as BCL (pack)
+import Data.Either (isLeft)
import Data.Maybe (fromJust)
import Data.HashMap.Strict as HM (fromList)
import Data.Hex (unhex)
import Data.IP (AddrRange, IPv4,
- IPRange(..),
+ IPv6, IPRange(..),
toHostAddress6)
import qualified Crypto.Noise.DH as DH (dhBytesToPair, dhBytesToPub)
import Data.Conduit (runConduit, yield, ( .|))
@@ -21,11 +22,13 @@ import Network.Socket (SockAddr(..), tupleToHostAdd
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)
+
+import Network.WireGuard.RPC (serveConduit, showPeer)
+import Network.WireGuard.Internal.RpcParsers (deviceParser, peerParser)
+import Network.WireGuard.Internal.State (Device(..), Peer(..),
+ createDevice, createPeer)
+import Network.WireGuard.Internal.Data.Types (PresharedKey, PeerId)
+import qualified Network.WireGuard.Internal.Data.RpcTypes as RPC (RpcDevicePayload(..), RpcPeerPayload(..))
spec :: Spec
spec = do
@@ -73,25 +76,71 @@ spec = 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"
+ let expectedDevice = RPC.RpcDevicePayload pk 777 (Just 0) False
+ let result = feed (parse deviceParser $ BC.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=0\n") BC.empty
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"
+ let expectedDevice = RPC.RpcDevicePayload Nothing 777 (Just 0) False
+ let result = feed (parse deviceParser $ BC.pack "private_key=\nlisten_port=777\nfwmark=0\n") BC.empty
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"
+ let expectedDevice = RPC.RpcDevicePayload pk 777 Nothing False
+ let result = feed (parse deviceParser $ BC.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=\n") BC.empty
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"
+ let expectedDevice = RPC.RpcDevicePayload pk 777 Nothing True
+ let result = feed (parse deviceParser $ BC.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=\nreplace_peers=true\n") BC.empty
+ eitherResult result `shouldBe` Right expectedDevice
+ it "must not be position sensitive" $ do
+ pkHex <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a"
+ let pk = DH.dhBytesToPair $ BA.convert pkHex
+ let expectedDevice = RPC.RpcDevicePayload pk 777 Nothing True
+ let result = feed (parse deviceParser $ BC.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nfwmark=\nreplace_peers=true\nlisten_port=777\n") BC.empty
eitherResult result `shouldBe` Right expectedDevice
+ describe "peerParser" $ do
+ it "must parse a standart add peer entry" $ do
+ pubHex <- unhex $ BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58"
+ let pubK = fromJust . DH.dhBytesToPub $ BA.convert pubHex
+ let expectedPeer = RPC.RpcPeerPayload pubK False Nothing (SockAddrInet 1337 $ tupleToHostAddress (192,168,1,1)) 0 False [IPv4Range (read "192.168.1.0/24" :: AddrRange IPv4)]
+ let result = feed (parse peerParser $ BC.pack "public_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=192.168.1.1:1337\nallowed_ip=192.168.1.0/24\n") BC.empty
+ eitherResult result `shouldBe` Right expectedPeer
+ it "must parse a remove peer entry" $ do
+ pubHex <- unhex $ BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58"
+ let pubK = fromJust . DH.dhBytesToPub $ BA.convert pubHex
+ let expectedPeer = RPC.RpcPeerPayload pubK True Nothing (SockAddrInet 1337 $ tupleToHostAddress (192,168,1,1)) 0 False [IPv4Range (read "192.168.1.0/24" :: AddrRange IPv4)]
+ let result = feed (parse peerParser $ BC.pack "public_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nremove=true\nendpoint=192.168.1.1:1337\nallowed_ip=192.168.1.0/24\n") BC.empty
+ eitherResult result `shouldBe` Right expectedPeer
+ it "must parse a peer entry containing a preshared key" $ do
+ pubHex <- unhex $ BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58"
+ pshHex <- unhex $ BC.pack "188515093e952f5f22e865cef3012e72f8b5f0b598ac0309d5dacce3b70fcf52"
+ let pubK = fromJust . DH.dhBytesToPub $ BA.convert pubHex
+ let pshK = Just $ BA.convert pshHex :: Maybe PresharedKey
+ let expectedPeer = RPC.RpcPeerPayload pubK False pshK (SockAddrInet 1337 $ tupleToHostAddress (192,168,1,1)) 0 False [IPv4Range (read "192.168.1.0/24" :: AddrRange IPv4)]
+ let result = feed (parse peerParser $ BC.pack "public_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\npreshared_key=188515093e952f5f22e865cef3012e72f8b5f0b598ac0309d5dacce3b70fcf52\nendpoint=192.168.1.1:1337\nallowed_ip=192.168.1.0/24\n") BC.empty
+ eitherResult result `shouldBe` Right expectedPeer
+ it "must parse a peer having an ipv6 endpoint" $ do
+ pubHex <- unhex $ BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58"
+ let pubK = fromJust . DH.dhBytesToPub $ BA.convert pubHex
+ let ipv6 = SockAddrInet6 51820 0 (toHostAddress6 $ read "abcd:23::33") 2
+ let expectedPeer = RPC.RpcPeerPayload pubK False Nothing ipv6 0 False [IPv4Range (read "192.168.1.0/24" :: AddrRange IPv4)]
+ let result = feed (parse peerParser $ BC.pack "public_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=[abcd:23::33%2]:51820\nallowed_ip=192.168.1.0/24\n") BC.empty
+ eitherResult result `shouldBe` Right expectedPeer
+ it "must parse a peer having several allowed ips " $ do
+ pubHex <- unhex $ BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58"
+ let pubK = fromJust . DH.dhBytesToPub $ BA.convert pubHex
+ let expectedPeer = RPC.RpcPeerPayload pubK False Nothing (SockAddrInet 1337 $ tupleToHostAddress (192,168,1,1)) 0 False [IPv4Range (read "192.168.1.0/24" :: AddrRange IPv4),IPv6Range (read "2001:7f8::/29" :: AddrRange IPv6)]
+ let result = feed (parse peerParser $ BC.pack "public_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=192.168.1.1:1337\nallowed_ip=192.168.1.0/24\nallowed_ip=[2001:7f8::/29]\n") BC.empty
+ eitherResult result `shouldBe` Right expectedPeer
+ it "must not parse a peer having an incorrect public key" $ do
+ let result = feed (parse peerParser $ BC.pack "public_key=2e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=192.168.1.1:1337\nallowed_ip=192.168.1.0/24\n") BC.empty
+ eitherResult result `shouldSatisfy` isLeft
+ it "must not parse a peer having an incorrect allowed ip" $ do
+ let result = feed (parse peerParser $ BC.pack "public_key=2e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=192.168.1.1:1337\nallowed_ip=192.168.1.0.2/24\n") BC.empty
+ eitherResult result `shouldSatisfy` isLeft
where
testDevice = do
pkH <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a"