From e36a4cf345fede7f8b9f6a57ac842bf48fd9c068 Mon Sep 17 00:00:00 2001 From: Baylac-Jacqué Félix Date: Thu, 17 Aug 2017 16:11:33 +0200 Subject: Extracted RPC types to proper module. --- src/Network/WireGuard/Internal/Data/RpcTypes.hs | 63 ++++++++++++++++++++ src/Network/WireGuard/Internal/Data/Types.hs | 78 +++++++++++++++++++++++++ src/Network/WireGuard/Internal/Noise.hs | 2 +- src/Network/WireGuard/Internal/Packet.hs | 2 +- src/Network/WireGuard/Internal/RpcParsers.hs | 66 +++++++++++++++++++++ src/Network/WireGuard/Internal/State.hs | 2 +- src/Network/WireGuard/Internal/Types.hs | 78 ------------------------- 7 files changed, 210 insertions(+), 81 deletions(-) create mode 100644 src/Network/WireGuard/Internal/Data/RpcTypes.hs create mode 100644 src/Network/WireGuard/Internal/Data/Types.hs create mode 100644 src/Network/WireGuard/Internal/RpcParsers.hs delete mode 100644 src/Network/WireGuard/Internal/Types.hs (limited to 'src/Network/WireGuard/Internal') 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 for more informations. +data OpType = Get | Set + +-- | Request wrapper. The payload is set only for Set operations. +-- +-- See 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/Data/Types.hs b/src/Network/WireGuard/Internal/Data/Types.hs new file mode 100644 index 0000000..53c3cea --- /dev/null +++ b/src/Network/WireGuard/Internal/Data/Types.hs @@ -0,0 +1,78 @@ +module Network.WireGuard.Internal.Data.Types + ( Index + , Counter + , PeerId + , PublicKey + , PrivateKey + , KeyPair + , PresharedKey + , Time + , UdpPacket + , TunPacket + , EncryptedPayload + , AuthTag + , TAI64n + , SessionKey(..) + , WireGuardError(..) + , getPeerId + , farFuture + ) where + +import Control.Exception (Exception, SomeException) +import qualified Crypto.Noise.DH as DH +import Crypto.Noise.DH.Curve25519 (Curve25519) +import Data.ByteArray (ScrubbedBytes) +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS +import Foreign.C.Types (CTime (..)) +import Network.Socket (SockAddr) +import System.Posix.Types (EpochTime) + +import Data.Word + +type Index = Word32 +type Counter = Word64 +type PeerId = BS.ByteString + +type PublicKey = DH.PublicKey Curve25519 +type PrivateKey = DH.SecretKey Curve25519 +type KeyPair = DH.KeyPair Curve25519 +type PresharedKey = ScrubbedBytes + +type Time = EpochTime + +type UdpPacket = (BS.ByteString, SockAddr) +type TunPacket = ScrubbedBytes + +type EncryptedPayload = BS.ByteString +type AuthTag = BS.ByteString +type TAI64n = BS.ByteString + +data SessionKey = SessionKey + { sendKey :: !ScrubbedBytes + , recvKey :: !ScrubbedBytes + } + +data WireGuardError + = DecryptFailureError + | DestinationNotReachableError + | DeviceNotReadyError + | EndPointUnknownError + | HandshakeInitiationReplayError + | InvalidIPPacketError + | InvalidWGPacketError String + | NoiseError SomeException + | NonceReuseError + | OutdatedPacketError + | RemotePeerNotFoundError + | SourceAddrBlockedError + | UnknownIndexError + deriving (Show) + +instance Exception WireGuardError + +getPeerId :: PublicKey -> PeerId +getPeerId = BA.convert . DH.dhPubToBytes + +farFuture :: Time +farFuture = CTime maxBound 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 diff --git a/src/Network/WireGuard/Internal/Types.hs b/src/Network/WireGuard/Internal/Types.hs deleted file mode 100644 index 3409e2a..0000000 --- a/src/Network/WireGuard/Internal/Types.hs +++ /dev/null @@ -1,78 +0,0 @@ -module Network.WireGuard.Internal.Types - ( Index - , Counter - , PeerId - , PublicKey - , PrivateKey - , KeyPair - , PresharedKey - , Time - , UdpPacket - , TunPacket - , EncryptedPayload - , AuthTag - , TAI64n - , SessionKey(..) - , WireGuardError(..) - , getPeerId - , farFuture - ) where - -import Control.Exception (Exception, SomeException) -import qualified Crypto.Noise.DH as DH -import Crypto.Noise.DH.Curve25519 (Curve25519) -import Data.ByteArray (ScrubbedBytes) -import qualified Data.ByteArray as BA -import qualified Data.ByteString as BS -import Foreign.C.Types (CTime (..)) -import Network.Socket (SockAddr) -import System.Posix.Types (EpochTime) - -import Data.Word - -type Index = Word32 -type Counter = Word64 -type PeerId = BS.ByteString - -type PublicKey = DH.PublicKey Curve25519 -type PrivateKey = DH.SecretKey Curve25519 -type KeyPair = DH.KeyPair Curve25519 -type PresharedKey = ScrubbedBytes - -type Time = EpochTime - -type UdpPacket = (BS.ByteString, SockAddr) -type TunPacket = ScrubbedBytes - -type EncryptedPayload = BS.ByteString -type AuthTag = BS.ByteString -type TAI64n = BS.ByteString - -data SessionKey = SessionKey - { sendKey :: !ScrubbedBytes - , recvKey :: !ScrubbedBytes - } - -data WireGuardError - = DecryptFailureError - | DestinationNotReachableError - | DeviceNotReadyError - | EndPointUnknownError - | HandshakeInitiationReplayError - | InvalidIPPacketError - | InvalidWGPacketError String - | NoiseError SomeException - | NonceReuseError - | OutdatedPacketError - | RemotePeerNotFoundError - | SourceAddrBlockedError - | UnknownIndexError - deriving (Show) - -instance Exception WireGuardError - -getPeerId :: PublicKey -> PeerId -getPeerId = BA.convert . DH.dhPubToBytes - -farFuture :: Time -farFuture = CTime maxBound -- cgit v1.2.3-59-g8ed1b