From 4441702b47ddfb0e862ccc3fa5caa00c5acc8aaf Mon Sep 17 00:00:00 2001 From: Baylac-Jacqué Félix Date: Thu, 10 Aug 2017 16:51:07 +0200 Subject: Setup travis CI. --- src/Network/WireGuard/RPC.hs | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) (limited to 'src/Network/WireGuard') diff --git a/src/Network/WireGuard/RPC.hs b/src/Network/WireGuard/RPC.hs index 7ecb8de..3aa4e44 100644 --- a/src/Network/WireGuard/RPC.hs +++ b/src/Network/WireGuard/RPC.hs @@ -1,7 +1,8 @@ {-# LANGUAGE RecordWildCards #-} module Network.WireGuard.RPC - ( runRPC + ( runRPC, + serveConduit ) where import Control.Concurrent.STM (STM, atomically, @@ -31,16 +32,20 @@ import Network.WireGuard.Foreign.UAPI import Network.WireGuard.Internal.Constant import Network.WireGuard.Internal.State import Network.WireGuard.Internal.Types -import Network.WireGuard.Internal.Util +import Network.WireGuard.Internal.Util (catchIOExceptionAnd, + catchSomeExceptionAnd) +import Debug.Trace -- | Run RPC service over a unix socket runRPC :: FilePath -> Device -> IO () runRPC sockPath device = runUnixServer (serverSettings sockPath) $ \app -> - catchIOExceptionAnd (return ()) $ runConduit (appSource app =$= serveConduit =$= appSink app) - where - -- TODO: ensure that all bytestring over sockets will be erased - serveConduit = do + catchIOExceptionAnd (return ()) $ runConduit (appSource app .| serveConduit device .| appSink app) + +-- TODO: ensure that all bytestring over sockets will be erased +serveConduit :: Device -> ConduitM BS.ByteString BS.ByteString IO () +serveConduit device = do h <- CB.head + traceM $ "Received " ++ show h case h of Just 0 -> showDevice device Just byte -> do @@ -50,7 +55,7 @@ runRPC sockPath device = runUnixServer (serverSettings sockPath) $ \app -> Just wgdev -> catchSomeExceptionAnd returnError (updateDevice wgdev) Nothing -> mempty Nothing -> mempty - + where returnError = yield $ writeConfig (-invalidValueError) showDevice Device{..} = do -- cgit v1.2.3-59-g8ed1b