aboutsummaryrefslogtreecommitdiffstats
path: root/src/Network/WireGuard/Internal
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/WireGuard/Internal')
-rw-r--r--src/Network/WireGuard/Internal/Data/RpcTypes.hs63
-rw-r--r--src/Network/WireGuard/Internal/Data/Types.hs (renamed from src/Network/WireGuard/Internal/Types.hs)2
-rw-r--r--src/Network/WireGuard/Internal/Noise.hs2
-rw-r--r--src/Network/WireGuard/Internal/Packet.hs2
-rw-r--r--src/Network/WireGuard/Internal/RpcParsers.hs66
-rw-r--r--src/Network/WireGuard/Internal/State.hs2
6 files changed, 133 insertions, 4 deletions
diff --git a/src/Network/WireGuard/Internal/Data/RpcTypes.hs b/src/Network/WireGuard/Internal/Data/RpcTypes.hs
new file mode 100644
index 0000000..a3c148b
--- /dev/null
+++ b/src/Network/WireGuard/Internal/Data/RpcTypes.hs
@@ -0,0 +1,63 @@
+module Network.WireGuard.Internal.Data.RpcTypes(
+ OpType(..),
+ RpcRequest(..),
+ RpcSetPayload(..),
+ RpcDevicePayload(..),
+ RpcPeerPayload(..)
+) where
+
+import Data.Word (Word64)
+import Data.IP (IPRange(..))
+import Crypto.Noise.DH (dhSecToBytes)
+import Network.Socket.Internal (SockAddr)
+
+import Network.WireGuard.Internal.Data.Types (PublicKey, KeyPair,
+ Time)
+-- | Kind of client operation.
+--
+-- See <https://www.wireguard.com/xplatform/#configuration-protocol> for more informations.
+data OpType = Get | Set
+
+-- | Request wrapper. The payload is set only for Set operations.
+--
+-- See <https://www.wireguard.com/xplatform/#configuration-protocol> for more informations.
+data RpcRequest = RpcRequest {
+ opType :: OpType,
+ payload :: Maybe RpcSetPayload
+}
+
+-- | Payload sent together with a set RPC operation.
+data RpcSetPayload = RpcSetPayload {
+ 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
+}
+
+instance Show RpcDevicePayload where
+ show (RpcDevicePayload kp lp fwM rpp) = show (showKeyPair <$> kp) ++ show lp ++ show fwM ++ show rpp
+ where
+ showKeyPair (pk, _) = show $ dhSecToBytes pk
+
+instance Eq RpcDevicePayload where
+ (==) (RpcDevicePayload pk1 prt1 fw1 rp1) (RpcDevicePayload pk2 prt2 fw2 rp2) =
+ ((dhSecToBytes . fst) <$> pk1) == ((dhSecToBytes . fst) <$> pk2) && (prt1 == prt2) &&
+ (rp1 == rp2) && (fw1 == fw2)
+
+-- | 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
+}
diff --git a/src/Network/WireGuard/Internal/Types.hs b/src/Network/WireGuard/Internal/Data/Types.hs
index 3409e2a..53c3cea 100644
--- a/src/Network/WireGuard/Internal/Types.hs
+++ b/src/Network/WireGuard/Internal/Data/Types.hs
@@ -1,4 +1,4 @@
-module Network.WireGuard.Internal.Types
+module Network.WireGuard.Internal.Data.Types
( Index
, Counter
, PeerId
diff --git a/src/Network/WireGuard/Internal/Noise.hs b/src/Network/WireGuard/Internal/Noise.hs
index 842e002..4084f42 100644
--- a/src/Network/WireGuard/Internal/Noise.hs
+++ b/src/Network/WireGuard/Internal/Noise.hs
@@ -31,7 +31,7 @@ import Data.Serialize (putWord64le, runPut)
import Crypto.Noise
-import Network.WireGuard.Internal.Types
+import Network.WireGuard.Internal.Data.Types
type NoiseStateWG = NoiseState ChaChaPoly1305 Curve25519 BLAKE2s
diff --git a/src/Network/WireGuard/Internal/Packet.hs b/src/Network/WireGuard/Internal/Packet.hs
index ebc24fc..f89c160 100644
--- a/src/Network/WireGuard/Internal/Packet.hs
+++ b/src/Network/WireGuard/Internal/Packet.hs
@@ -13,7 +13,7 @@ import Foreign.Storable (sizeOf)
import Data.Serialize
import Network.WireGuard.Internal.Constant
-import Network.WireGuard.Internal.Types
+import Network.WireGuard.Internal.Data.Types
data Packet = HandshakeInitiation
{ senderIndex :: !Index
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')
diff --git a/src/Network/WireGuard/Internal/State.hs b/src/Network/WireGuard/Internal/State.hs
index f7b1ca0..ea8ce1b 100644
--- a/src/Network/WireGuard/Internal/State.hs
+++ b/src/Network/WireGuard/Internal/State.hs
@@ -42,7 +42,7 @@ import Network.Socket.Internal (SockAddr)
import Control.Concurrent.STM
import Network.WireGuard.Internal.Constant
-import Network.WireGuard.Internal.Types
+import Network.WireGuard.Internal.Data.Types
data Device = Device
{ intfName :: String