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. --- .travis.yml | 23 +++++++++++++++++++++++ README.md | 1 + nara.cabal | 6 +++++- src/Network/WireGuard/RPC.hs | 19 ++++++++++++------- tests/spec/Network/WireGuard/RPCSpec.hs | 33 ++++++++++++++++++++++++++++----- 5 files changed, 69 insertions(+), 13 deletions(-) create mode 100644 .travis.yml 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 -- cgit v1.2.3-59-g8ed1b