Setup travis CI.

5 files changed, 69 insertions, 13 deletions

diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 0000000..9ad9d09
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,23 @@
+sudo: required
+dist: "trusty"
+os: "linux"
+
+
+language: generic
+
+# Caching so the next build will be fast too.
+cache:
+  directories:
+    - $HOME/.stack
+
+before_install:
+- "mkdir -p $HOME/.local/bin",
+- travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
+
+install:
+# Build dependencies
+- stack --no-terminal --install-ghc test --only-dependencies
+
+script:
+# Build the package, its tests, and its docs and run the tests
+- stack --no-terminal test 
diff --git a/README.md b/README.md
index cc8d1e5..83187a3 100644
--- a/README.md
+++ b/README.md
@@ -1,3 +1,4 @@
+[![Travis Status](https://travis-ci.org/NinjaTrappeur/wireguard-hs.svg?branch=RPC-Refactoring)](https://travis-ci.org/NinjaTrappeur/wireguard-hs)
 ### Do not use this Haskell code.
 
 This is not a complete implementation of WireGuard. If you're interested in using WireGuard, use the implementation for Linux [found here](https://git.zx2c4.com/WireGuard/) and described on the [main wireguard website](https://www.wireguard.io/). There is no group of users that should be using the code in this repository here under any circumstances at the moment, not even beta testers or dare devils. It simply isn't complete. However, if you're interested in assisting with the Haskell development of WireGuard and contributing to this repository, by all means dig in and help out. But users: stay far away, at least for now.
diff --git a/nara.cabal b/nara.cabal
index 323f635..1000dae 100644
--- a/nara.cabal
+++ b/nara.cabal
@@ -19,7 +19,7 @@ flag static
   default:
     False
 
-executable nara-exe
+executable nara
   hs-source-dirs:      app
   main-is:             Main.hs
   ghc-options:
@@ -115,6 +115,10 @@ test-suite nara-test
       base == 4.9.*
     , hspec
     , nara
+    , bytestring
+    , conduit-extra
+    , conduit
+    , stm
   other-modules:
     Network.WireGuard.RPCSpec
   default-language: Haskell2010
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
diff --git a/tests/spec/Network/WireGuard/RPCSpec.hs b/tests/spec/Network/WireGuard/RPCSpec.hs
index b0422a3..286443e 100644
--- a/tests/spec/Network/WireGuard/RPCSpec.hs
+++ b/tests/spec/Network/WireGuard/RPCSpec.hs
@@ -1,11 +1,34 @@
 module Network.WireGuard.RPCSpec (spec) where
 
-import Test.Hspec (Spec, describe, it, shouldBe)
+import Control.Monad.STM                     (atomically, STM)
+import qualified Data.ByteString      as BS  (ByteString)
+import qualified Data.ByteString.Lazy as BSL (ByteString)
+import qualified Data.ByteString.Char8          as BC  (pack)
+import qualified Data.ByteString.Lazy.Char8     as BCL (pack)
+import Data.Conduit                          (runConduit, yield, ( .|))
+import Data.Conduit.Binary                   (sinkLbs)
+import Test.Hspec                            (Spec, describe,
+                                              it, shouldBe)
 
-import Network.WireGuard.RPC (runRPC)
+import Network.WireGuard.RPC            (serveConduit)
+import Network.WireGuard.Internal.State (Device, createDevice)
 
 
+getCommand :: BS.ByteString
+getCommand = BC.pack "\n\nget=1\n\n"
+
+deviceS :: STM Device
+deviceS = createDevice "wg0"
+
+bsDeviceStrict :: BS.ByteString
+bsDeviceStrict = BC.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\npublic_key=b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33\npreshared_key=188515093e952f5f22e865cef3012e72f8b5f0b598ac0309d5dacce3b70fcf52\nallowed_ip=192.168.4.4/32\nendpoint=[abcd:23::33%2]:51820\n\n"
+
+bsDevice :: BSL.ByteString
+bsDevice = BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\npublic_key=b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33\npreshared_key=188515093e952f5f22e865cef3012e72f8b5f0b598ac0309d5dacce3b70fcf52\nallowed_ip=192.168.4.4/32\nendpoint=[abcd:23::33%2]:51820\npublic_key=58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376\ntx_bytes=38333\nrx_bytes=2224\nallowed_ip=192.168.4.6/32\npersistent_keepalive_interval=111\nendpoint=182.122.22.19:3233\npublic_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=5.152.198.39:51820\nallowed_ip=192.168.4.10/32\nallowed_ip=192.168.4.11/32\ntx_bytes=1212111\nrx_bytes=1929999999\nerrno=0"
+
 spec :: Spec
-spec = describe "test" $ 
-        it "should fail" $ 
-          True `shouldBe` False
+spec = describe "serveConduit" $ 
+        it "must respond to a get v1 request" $ do
+          device <- atomically deviceS
+          res <- runConduit (yield getCommand .| serveConduit device .| sinkLbs)
+          res `shouldBe` bsDevice