aboutsummaryrefslogtreecommitdiffstats
path: root/src/Network/WireGuard/Internal
diff options
context:
space:
mode:
authorBaylac-Jacqué Félix <felix@alternativebit.fr>2017-09-16 16:54:24 +0200
committerBaylac-Jacqué Félix <felix@alternativebit.fr>2017-09-16 17:11:53 +0200
commit4cc3292d6c59e48f22cbcaae0ee2773c22c2bad9 (patch)
treeacf8f8b90892625b423d2a7a62a80f09fde39edb /src/Network/WireGuard/Internal
parentFix GHC and HLINT warnings. (diff)
downloadwireguard-hs-master.tar.xz
wireguard-hs-master.zip
Document RPC-related modules.HEADmaster
Diffstat (limited to 'src/Network/WireGuard/Internal')
-rw-r--r--src/Network/WireGuard/Internal/Data/RpcTypes.hs14
-rw-r--r--src/Network/WireGuard/Internal/RpcParsers.hs76
2 files changed, 64 insertions, 26 deletions
diff --git a/src/Network/WireGuard/Internal/Data/RpcTypes.hs b/src/Network/WireGuard/Internal/Data/RpcTypes.hs
index 7e1c20e..d3ec964 100644
--- a/src/Network/WireGuard/Internal/Data/RpcTypes.hs
+++ b/src/Network/WireGuard/Internal/Data/RpcTypes.hs
@@ -1,3 +1,15 @@
+{-|
+Module : Network.WireGuard.Internal.Data.RpcTypes
+Description : Collection of types used to communicate with the wg CLI utility.
+Copyright : Félix Baylac-Jacqué, 2017
+License : GPL-3
+Maintainer : felix@alternativebit.fr
+Stability : experimental
+Portability : POSIX
+
+Collection of types used by to communicate with the wg CLI utility.
+|-}
+
module Network.WireGuard.Internal.Data.RpcTypes(
OpType(..),
RpcRequest(..),
@@ -51,6 +63,7 @@ instance Eq RpcDevicePayload where
((dhSecToBytes . fst) <$> pk1) == ((dhSecToBytes . fst) <$> pk2) && (prt1 == prt2) &&
(rp1 == rp2) && (fw1 == fw2)
+-- | Key/Value couple of set device operations.
data RpcDeviceField = RpcPk !(Maybe KeyPair)
| RpcPort !Int
| RpcFwMark !(Maybe Word)
@@ -77,6 +90,7 @@ instance Show RpcPeerPayload where
= show (dhPubToBytes pub1) ++ show rm1 ++ show psk1 ++ show e1 ++ show k1 ++
show rp1 ++ show aip1
+-- | Key/Value couple of set peer operations.
data RpcPeerField = RpcRmFlag !Bool
| RpcPsh !PresharedKey
| RpcEndp !SockAddr
diff --git a/src/Network/WireGuard/Internal/RpcParsers.hs b/src/Network/WireGuard/Internal/RpcParsers.hs
index 654cf4e..6e23635 100644
--- a/src/Network/WireGuard/Internal/RpcParsers.hs
+++ b/src/Network/WireGuard/Internal/RpcParsers.hs
@@ -1,5 +1,17 @@
{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Network.WireGuard.Internal.RpcParsers
+Description : Collection of parsers related to the communication with the wg CLI utility.
+Copyright : Félix Baylac-Jacqué, 2017
+License : GPL-3
+Maintainer : felix@alternativebit.fr
+Stability : experimental
+Portability : POSIX
+
+Collection of attoparsec parsers related to the communication with the wg CLI utility.
+|-}
+
module Network.WireGuard.Internal.RpcParsers(
requestParser,
deviceParser,
@@ -34,7 +46,9 @@ import Network.WireGuard.Internal.Data.RpcTypes (OpType(..),
RpcDeviceField(..),
RpcPeerField(..))
--- | Attoparsec parser used to parse a RPC request, both Set or Get.
+-- | Parses a RPC operation coming from the wg CLI.
+--
+-- See <https://www.wireguard.com/xplatform/> for more informations about the RPC set operation.
requestParser :: Parser RpcRequest
requestParser = do
op <- requestTypeParser
@@ -44,16 +58,18 @@ requestParser = do
_ <- string $ BC.pack "\n"
return $ RpcRequest op p
-requestTypeParser :: Parser OpType
-requestTypeParser = "get=1\n" *> return Get
- <|> "set=1\n" *> return Set
-
+-- | Parses a set operation.
+--
+-- See <https://www.wireguard.com/xplatform/> for more informations about the RPC set operation.
setPayloadParser :: Parser RpcSetPayload
setPayloadParser = do
dev <- deviceParser
peers <- many' peerParser
return $ RpcSetPayload dev peers
+-- | Parses a device entry during a RPC set operation.
+--
+-- See <https://www.wireguard.com/xplatform/> for more informations about the RPC set operation.
deviceParser :: Parser RpcDevicePayload
deviceParser = do
fields <- deviceFieldsParser
@@ -63,6 +79,35 @@ deviceParser = do
let rmDev = not $ null [True | RpcReplacePeers <- fields]
return $ RpcDevicePayload devPk p fw rmDev
+-- | Parses a peer entry during a RPC set operation.
+--
+-- See <https://www.wireguard.com/xplatform/> for more informations about the RPC set operation.
+peerParser :: Parser RpcPeerPayload
+peerParser = do
+ peerPubK <- 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 peerPubK 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
+
+requestTypeParser :: Parser OpType
+requestTypeParser = "get=1\n" *> return Get
+ <|> "set=1\n" *> return Set
+
deviceFieldsParser :: Parser [RpcDeviceField]
deviceFieldsParser = many' (deviceFieldParser <* endOfLine)
@@ -85,27 +130,6 @@ deviceFieldParser = do
return RpcReplacePeers
_ -> fail "Not a device key"
-peerParser :: Parser RpcPeerPayload
-peerParser = do
- peerPubK <- 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 peerPubK 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)