aboutsummaryrefslogtreecommitdiffstats
path: root/src/Network/WireGuard/Internal/RpcParsers.hs
diff options
context:
space:
mode:
authorBaylac-Jacqué Félix <felix@alternativebit.fr>2017-08-17 16:11:33 +0200
committerBaylac-Jacqué Félix <felix@alternativebit.fr>2017-09-16 17:10:35 +0200
commite36a4cf345fede7f8b9f6a57ac842bf48fd9c068 (patch)
tree052c4f45baf7edd5e7e574da246b3740bdf85358 /src/Network/WireGuard/Internal/RpcParsers.hs
parentImplement and test RPC show Peer feature. (diff)
downloadwireguard-hs-e36a4cf345fede7f8b9f6a57ac842bf48fd9c068.tar.xz
wireguard-hs-e36a4cf345fede7f8b9f6a57ac842bf48fd9c068.zip
Extracted RPC types to proper module.
Diffstat (limited to 'src/Network/WireGuard/Internal/RpcParsers.hs')
-rw-r--r--src/Network/WireGuard/Internal/RpcParsers.hs66
1 files changed, 66 insertions, 0 deletions
diff --git a/src/Network/WireGuard/Internal/RpcParsers.hs b/src/Network/WireGuard/Internal/RpcParsers.hs
new file mode 100644
index 0000000..b28b000
--- /dev/null
+++ b/src/Network/WireGuard/Internal/RpcParsers.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.WireGuard.Internal.RpcParsers(
+ RpcRequest(..),
+ OpType(..),
+ RpcSetPayload(..),
+ RpcDevicePayload(..),
+ RpcPeerPayload(..),
+ requestParser,
+ deviceParser
+) where
+
+import Control.Applicative ((*>), (<|>))
+import Control.Monad (liftM, join)
+import Crypto.Noise.DH (dhSecToBytes, dhBytesToPair)
+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)
+import Data.ByteString (ByteString)
+import Network.Socket.Internal (SockAddr)
+
+
+import Network.WireGuard.Internal.Data.RpcTypes (OpType(..),
+ RpcRequest(..),
+ RpcDevicePayload(..),
+ RpcPeerPayload(..),
+ RpcSetPayload(..))
+
+
+-- | Attoparsec parser used to parse a RPC request, both Set or Get.
+requestParser :: Parser RpcRequest
+requestParser = do
+ op <- requestTypeParser
+ let p = case op of
+ Set -> undefined
+ Get -> Nothing
+ _ <- string $ BC.pack "\n\n"
+ return $ RpcRequest op p
+
+requestTypeParser :: Parser OpType
+requestTypeParser = "get=1" *> return Get
+ <|> "set=1" *> return Set
+
+setPayloadParser :: Parser RpcSetPayload
+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
+
+keyParser :: ByteString -> Parser ByteString
+keyParser str = (string str *> "=") *> takeTill (=='\n')