diff options
author | Baylac-Jacqué Félix <felix@alternativebit.fr> | 2017-08-17 16:11:33 +0200 |
---|---|---|
committer | Baylac-Jacqué Félix <felix@alternativebit.fr> | 2017-09-16 17:10:35 +0200 |
commit | e36a4cf345fede7f8b9f6a57ac842bf48fd9c068 (patch) | |
tree | 052c4f45baf7edd5e7e574da246b3740bdf85358 /src/Network/WireGuard/Internal/RpcParsers.hs | |
parent | Implement and test RPC show Peer feature. (diff) | |
download | wireguard-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.hs | 66 |
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') |