sydtest-servant (empty) → 0.0.0.0

raw patch · 6 files changed

+175/−0 lines, 6 filesdep +basedep +http-clientdep +servant

Dependencies added: base, http-client, servant, servant-client, servant-server, stm, sydtest, sydtest-servant, sydtest-wai

Files

LICENSE.md +5/−0
src/Test/Syd/Servant.hs +52/−0
sydtest-servant.cabal +61/−0
test/Spec.hs +1/−0
test/Test/Syd/Servant/Example.hs +33/−0
test/Test/Syd/ServantSpec.hs +23/−0

+ LICENSE.md view

@@ -0,0 +1,5 @@+# Sydtest License++Copyright (c) 2020-2021 Tom Sydney Kerckhove++See the Sydtest License at https://github.com/NorfairKing/sydtest/blob/master/sydtest/LICENSE.md for the full license text.

+ src/Test/Syd/Servant.hs view

@@ -0,0 +1,52 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Servant+  ( servantSpec,+    servantSpecWithSetupFunc,+    clientEnvSetupFunc,+    testClient,+    testClientOrError,+  )+where++import Network.HTTP.Client as HTTP+import Servant+import Servant.Client+import Test.Syd+import Test.Syd.Wai++type ServantSpec = TestDef '[HTTP.Manager] ClientEnv++-- | Run a given servant server around every test+servantSpec :: forall api. HasServer api '[] => Servant.Proxy api -> ServerT api Handler -> ServantSpec -> Spec+servantSpec py server = servantSpecWithSetupFunc py (pure server)++-- | Run a servant server around every test, based around the given 'SetupFunc'+servantSpecWithSetupFunc :: forall api a. HasServer api '[] => Servant.Proxy api -> SetupFunc a (ServerT api Handler) -> ServantSpec -> SpecWith a+servantSpecWithSetupFunc py serverSetupFunc =+  beforeAll (newManager defaultManagerSettings)+    . setupAroundWith' (\man -> serverSetupFunc `connectSetupFunc` clientEnvSetupFunc py man)++clientEnvSetupFunc :: forall api. HasServer api '[] => Servant.Proxy api -> HTTP.Manager -> SetupFunc (ServerT api Handler) ClientEnv+clientEnvSetupFunc py man = wrapSetupFunc $ \server -> do+  let application = serve py server+  p <- unwrapSetupFunc applicationSetupFunc application+  pure $ mkClientEnv man (BaseUrl Http "127.0.0.1" p "")++testClient :: ClientEnv -> ClientM a -> IO a+testClient cenv func = do+  errOrRes <- testClientOrError cenv func+  case errOrRes of+    Left err -> expectationFailure $ show err+    Right r -> pure r++#if MIN_VERSION_servant_client(0,16,0)+testClientOrError :: ClientEnv -> ClientM a -> IO (Either ClientError a)+testClientOrError = flip runClientM+#else+testClientOrError :: ClientEnv -> ClientM a -> IO (Either ServantError a)+testClientOrError = flip runClientM+#endif

+ sydtest-servant.cabal view

@@ -0,0 +1,61 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           sydtest-servant+version:        0.0.0.0+synopsis:       A servant companion library for sydtest+category:       Testing+homepage:       https://github.com/NorfairKing/sydtest#readme+bug-reports:    https://github.com/NorfairKing/sydtest/issues+author:         Tom Sydney Kerckhove+maintainer:     syd@cs-syd.eu+copyright:      Copyright (c) 2020 Tom Sydney Kerckhove+license:        OtherLicense+license-file:   LICENSE.md+build-type:     Simple++source-repository head+  type: git+  location: https://github.com/NorfairKing/sydtest++library+  exposed-modules:+      Test.Syd.Servant+  other-modules:+      Paths_sydtest_servant+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , http-client+    , servant+    , servant-client+    , servant-server+    , sydtest+    , sydtest-wai+  default-language: Haskell2010++test-suite sydtest-servant-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Test.Syd.Servant.Example+      Test.Syd.ServantSpec+      Paths_sydtest_servant+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-tool-depends:+      sydtest-discover:sydtest-discover+  build-depends:+      base >=4.7 && <5+    , servant+    , servant-client+    , servant-server+    , stm+    , sydtest+    , sydtest-servant+  default-language: Haskell2010

+ test/Spec.hs view

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF sydtest-discover #-}

+ test/Test/Syd/Servant/Example.hs view

@@ -0,0 +1,33 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++module Test.Syd.Servant.Example where++import Control.Concurrent.STM+import Control.Monad.IO.Class+import Servant+import Servant.Client++exampleAPI :: Proxy ExampleAPI+exampleAPI = Proxy++type ExampleAPI =+  "get" :> Get '[JSON] Int+    :<|> "add" :> ReqBody '[JSON] Int :> PostNoContent '[JSON] NoContent++exampleServer :: TVar Int -> Server ExampleAPI+exampleServer var = serveGet :<|> serveAdd+  where+    serveGet :: Handler Int+    serveGet = liftIO $ readTVarIO var+    serveAdd :: Int -> Handler NoContent+    serveAdd i = do+      liftIO $ atomically $ modifyTVar var (+ i)+      pure NoContent++exampleApplication :: TVar Int -> Application+exampleApplication var = serve exampleAPI (exampleServer var)++clientGet :: ClientM Int+clientAdd :: Int -> ClientM NoContent+clientGet :<|> clientAdd = client exampleAPI

+ test/Test/Syd/ServantSpec.hs view

@@ -0,0 +1,23 @@+module Test.Syd.ServantSpec (spec) where++import Control.Concurrent.STM+import Servant+import Test.Syd+import Test.Syd.Servant+import Test.Syd.Servant.Example++exampleSetupFunc :: SetupFunc () (Server ExampleAPI)+exampleSetupFunc = SetupFunc $ \func () -> do+  var <- newTVarIO 0+  func $ exampleServer var++spec :: Spec+spec = servantSpecWithSetupFunc exampleAPI exampleSetupFunc $ do+  it "gets zero at the start" $ \cenv -> do+    r <- testClient cenv clientGet+    r `shouldBe` 0+  it "can add 1 to get 1" $ \cenv -> do+    r <- testClient cenv $ do+      NoContent <- clientAdd 1+      clientGet+    r `shouldBe` 1