Extracted RPC types to proper module.

10 files changed, 172 insertions, 64 deletions

diff --git a/src/Network/WireGuard/Core.hs b/src/Network/WireGuard/Core.hs
index 6d65e37..5bbf317 100644
--- a/src/Network/WireGuard/Core.hs
+++ b/src/Network/WireGuard/Core.hs
@@ -41,7 +41,7 @@ import           Network.WireGuard.Internal.Noise
 import           Network.WireGuard.Internal.Packet
 import           Network.WireGuard.Internal.PacketQueue
 import           Network.WireGuard.Internal.State
-import           Network.WireGuard.Internal.Types
+import           Network.WireGuard.Internal.Data.Types
 import           Network.WireGuard.Internal.Util
 
 runCore :: Device
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
diff --git a/src/Network/WireGuard/RPC.hs b/src/Network/WireGuard/RPC.hs
index 73d9e7a..ae9e552 100644
--- a/src/Network/WireGuard/RPC.hs
+++ b/src/Network/WireGuard/RPC.hs
@@ -13,67 +13,49 @@ module Network.WireGuard.RPC
 import           Control.Concurrent.STM                    (STM, atomically,
                                                             modifyTVar', readTVar,
                                                             writeTVar)
-import           Control.Monad                             (replicateM, sequence,
-                                                            when)
+import           Control.Monad                             (when)
 import           Control.Monad.IO.Class                    (liftIO)
 import qualified Crypto.Noise.DH                     as DH (dhPubToBytes, dhSecToBytes,
                                                             dhBytesToPair, dhBytesToPair,
                                                             dhBytesToPub)
 import qualified Data.ByteArray                      as BA (convert)
 import qualified Data.ByteString                     as BS (ByteString, concat,
-                                                            replicate, empty, pack)
-import qualified Data.ByteString.Lazy.Char8          as CL (unpack)
+                                                            replicate, empty)
 import qualified Data.ByteString.Char8               as BC (pack, singleton, map)
 import           Data.Char                                 (toLower)
-import qualified Data.Conduit.Binary                 as CB (sinkStorable, sinkLbs)
+import           Data.Conduit.Attoparsec                   (sinkParserEither) 
 import           Data.Conduit.Network.Unix                 (appSink, appSource,
                                                             runUnixServer,
                                                             serverSettings)
-import qualified Data.HashMap.Strict                 as HM (HashMap(..), size, delete,
-                                                            lookup, insert,
-                                                            empty, fromList,
-                                                            foldrWithKey, elems)
+import qualified Data.HashMap.Strict                 as HM ( delete, lookup, insert,
+                                                            empty, elems)
 import           Data.Hex                                  (hex)
 import           Data.Int                                  (Int32)
-import           Data.List                                 (foldl', genericLength)
-import           Foreign.C.Types                           (CTime (..))
-
+import           Data.List                                 (foldl')
 import           Data.Bits                                 (Bits(..))
 import           Data.Conduit                              (ConduitM, (.|),
-                                                            yield, runConduit,
-                                                            toConsumer)
+                                                            yield, runConduit)
 import           Data.IP                                   (IPRange(..), addrRangePair,
                                                             toHostAddress, toHostAddress6,
                                                             fromHostAddress, makeAddrRange,
                                                             fromHostAddress6)
-import           Data.Maybe                                (fromMaybe, fromJust, isJust)
+import           Data.Maybe                                (fromJust, isJust)
 
 import           Network.WireGuard.Foreign.UAPI            (WgPeer(..), WgDevice(..),
-                                                            WgIpmask(..), writeConfig,
+                                                            WgIpmask(..),
                                                             peerFlagRemoveMe, peerFlagReplaceIpmasks,
                                                             deviceFlagRemoveFwmark, deviceFlagReplacePeers,
                                                             deviceFlagRemovePrivateKey, deviceFlagRemovePresharedKey)
 import           Network.WireGuard.Internal.Constant       (keyLength)
+import           Network.WireGuard.Internal.RpcParsers     (RpcRequest(..), RpcSetPayload(..), 
+                                                            OpType(..), requestParser)
 import           Network.WireGuard.Internal.State          (Device(..), Peer(..),
-                                                            buildRouteTables, createPeer,
+                                                            createPeer,
                                                             invalidateSessions)
-import           Network.WireGuard.Internal.Types          (PrivateKey, PublicKey,
+import           Network.WireGuard.Internal.Data.Types     (PrivateKey, PublicKey,
                                                             PresharedKey, KeyPair)
 import           Network.WireGuard.Internal.Util           (catchIOExceptionAnd)
 
--- | 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 ::  BS.ByteString
-}
-
 -- | Run RPC service over a unix socket
 runRPC :: FilePath -> Device -> IO ()
 runRPC sockPath device = runUnixServer (serverSettings sockPath) $ \app ->
@@ -83,34 +65,30 @@ runRPC sockPath device = runUnixServer (serverSettings sockPath) $ \app ->
 -- TODO: ensure that all bytestring over sockets will be erased
 serveConduit :: Device -> ConduitM BS.ByteString BS.ByteString IO ()
 serveConduit device = do
-        request <- CL.unpack <$> toConsumer CB.sinkLbs 
-        if request /= "" 
-          then routeRequest request
-          else yield mempty
+  request <- sinkParserEither requestParser
+  routeRequest request
   where
     --returnError = yield $ writeConfig (-invalidValueError)
-    isGet = (== "get=1")
-    isSet = (== "set=1")
-    routeRequest req = do
-        let line = head $ lines req
-        case () of _
-                    | isGet line  -> do 
-                        deviceBstr <- liftIO . atomically $ showDevice device
-                        yield deviceBstr                    
-                    | otherwise   -> yield mempty
+    routeRequest (Left _) = yield mempty
+    routeRequest (Right req) = 
+      case opType req of
+        Set -> undefined
+        Get -> do
+          deviceBstr <- liftIO . atomically $ showDevice device
+          yield $ BS.concat [deviceBstr, BC.pack "errno=0\n\n"]
 
 showDevice :: Device -> STM BS.ByteString
 showDevice device@Device{..} = do
   listen_port   <- BC.pack . show <$> readTVar port
-  fwmark        <- BC.pack . show <$> readTVar fwmark
+  fwm           <- BC.pack . show <$> readTVar fwmark
   private_key   <- fmap (toLowerBs . hex . privToBytes . fst) <$> readTVar localKey
   let devHm     = [("private_key", private_key),
                    ("listen_port", Just listen_port),
-                   ("fwmark", Just fwmark)]
+                   ("fwmark", Just fwm)]
   let devBs     = serializeRpcKeyValue devHm
-  peers         <- readTVar peers 
-  peersBstrList <-  mapM showPeer $ HM.elems peers
-  return . BS.concat $ (devBs : peersBstrList ++ [BC.singleton '\n'])
+  prs           <- readTVar peers 
+  peersBstrList <-  mapM showPeer $ HM.elems prs
+  return . BS.concat $ (devBs : peersBstrList)
 
 showPeer :: Peer -> STM BS.ByteString
 showPeer Peer{..} = do
@@ -124,9 +102,9 @@ showPeer Peer{..} = do
   last_handshake_time           <- readTVar lastHandshakeTime
   let peer = [("public_key", Just public_key),
               ("endpoint", BC.pack . show <$> endpoint),
-              ("persistant_keepalive_interval", Just . BC.pack . show $ persistant_keepalive_interval),
-              ("rx_bytes", Just . BC.pack . show $ rx_bytes),
+              ("persistent_keepalive_interval", Just . BC.pack . show $ persistant_keepalive_interval),
               ("tx_bytes", Just . BC.pack . show $ tx_bytes),
+              ("rx_bytes", Just . BC.pack . show $ rx_bytes),
               ("last_handshake_time", BC.pack . show <$> last_handshake_time)
               ] ++ expandAllowedIps (Just . BC.pack . show <$> allowed_ip)
   return $ serializeRpcKeyValue peer
@@ -136,8 +114,10 @@ showPeer Peer{..} = do
 serializeRpcKeyValue :: [(String, Maybe BS.ByteString)] -> BS.ByteString
 serializeRpcKeyValue = foldl' showKeyValueLine BS.empty
   where
-    showKeyValueLine acc (key, Just val) = BS.concat [acc, BC.pack key, BC.singleton '=', val, BC.singleton '\n']
-    showKeyValueLine acc (_, Nothing)    = acc
+    showKeyValueLine acc (key, Just val) 
+      | val == BC.pack "0" = acc
+      | otherwise          = BS.concat [acc, BC.pack key, BC.singleton '=', val, BC.singleton '\n']
+    showKeyValueLine acc (_, Nothing) = acc
 
 
 -- | implementation of config.c::set_peer()
@@ -181,7 +161,6 @@ setDevice device@Device{..} WgDevice{..} = do
         changePSK = removePSK || devicePSK /= emptyKey
         changePSKTo = if removePSK then Nothing else Just (bytesToPSK devicePSK)
     when changePSK $ writeTVar presharedKey changePSKTo
-
     when (changeLocalKey || changePSK) $ invalidateSessions device
 
 ipRangeToWgIpmask :: IPRange -> WgIpmask
@@ -201,9 +180,6 @@ invalidValueError = 22  -- TODO: report back actual error
 emptyKey :: BS.ByteString
 emptyKey = BS.replicate keyLength 0
 
-testFlag :: Bits a => a -> a -> Bool
-testFlag a flag = (a .&. flag) /= zeroBits
-
 pubToBytes :: PublicKey -> BS.ByteString
 pubToBytes = BA.convert . DH.dhPubToBytes
 
@@ -224,3 +200,6 @@ bytesToPSK = BA.convert
 
 toLowerBs :: BS.ByteString -> BS.ByteString
 toLowerBs = BC.map toLower 
+
+testFlag :: Bits a => a -> a -> Bool
+testFlag a flag = (a .&. flag) /= zeroBits
diff --git a/src/Network/WireGuard/TunListener.hs b/src/Network/WireGuard/TunListener.hs
index f5628e5..34b961b 100644
--- a/src/Network/WireGuard/TunListener.hs
+++ b/src/Network/WireGuard/TunListener.hs
@@ -14,7 +14,7 @@ import           System.Posix.Types                     (Fd)
 import           Network.WireGuard.Foreign.Tun
 import           Network.WireGuard.Internal.Constant
 import           Network.WireGuard.Internal.PacketQueue
-import           Network.WireGuard.Internal.Types
+import           Network.WireGuard.Internal.Data.Types
 import           Network.WireGuard.Internal.Util
 
 runTunListener :: [Fd] -> PacketQueue (Time, TunPacket) -> PacketQueue TunPacket -> IO ()
diff --git a/src/Network/WireGuard/UdpListener.hs b/src/Network/WireGuard/UdpListener.hs
index 93369f4..81743f7 100644
--- a/src/Network/WireGuard/UdpListener.hs
+++ b/src/Network/WireGuard/UdpListener.hs
@@ -19,7 +19,7 @@ import           Network.WireGuard.Internal.State       (Device (..))
 
 import           Network.WireGuard.Internal.Constant
 import           Network.WireGuard.Internal.PacketQueue
-import           Network.WireGuard.Internal.Types
+import           Network.WireGuard.Internal.Data.Types
 import           Network.WireGuard.Internal.Util
 
 runUdpListener :: Device -> PacketQueue UdpPacket -> PacketQueue UdpPacket -> IO ()