mirror of
https://github.com/ilyakooo0/roboservant.git
synced 2024-09-11 08:05:47 +03:00
add headers test
This commit is contained in:
parent
73ebfe0094
commit
84e3e65fe8
@ -20,10 +20,10 @@ dependencies:
|
||||
- containers
|
||||
- hedgehog
|
||||
- mtl
|
||||
- servant >= 0.17
|
||||
- servant-client >= 0.17
|
||||
- servant # >= 0.17
|
||||
- servant-client # >= 0.17
|
||||
- servant-flatten
|
||||
- servant-server >= 0.17
|
||||
- servant-server # >= 0.17
|
||||
- string-conversions
|
||||
|
||||
ghc-options: -Wall
|
||||
|
@ -1,10 +1,10 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.31.2.
|
||||
-- This file has been generated from package.yaml by hpack version 0.33.0.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 179b83962de30f5bcf8b13d2f0648b301a753367094171f21a68e60b5cb4e4d5
|
||||
-- hash: 0bfe1c9487789846b43d871520e7e546842a8ff9acb003e426d5282dac1e6aa1
|
||||
|
||||
name: roboservant
|
||||
version: 0.1.0.2
|
||||
@ -42,10 +42,10 @@ library
|
||||
, containers
|
||||
, hedgehog
|
||||
, mtl
|
||||
, servant >=0.17
|
||||
, servant-client >=0.17
|
||||
, servant
|
||||
, servant-client
|
||||
, servant-flatten
|
||||
, servant-server >=0.17
|
||||
, servant-server
|
||||
, string-conversions
|
||||
default-language: Haskell2010
|
||||
|
||||
@ -54,6 +54,7 @@ test-suite roboservant-test
|
||||
main-is: Spec.hs
|
||||
other-modules:
|
||||
Foo
|
||||
Headers
|
||||
UnsafeIO
|
||||
Paths_roboservant
|
||||
hs-source-dirs:
|
||||
@ -67,9 +68,9 @@ test-suite roboservant-test
|
||||
, hedgehog
|
||||
, mtl
|
||||
, roboservant
|
||||
, servant >=0.17
|
||||
, servant-client >=0.17
|
||||
, servant
|
||||
, servant-client
|
||||
, servant-flatten
|
||||
, servant-server >=0.17
|
||||
, servant-server
|
||||
, string-conversions
|
||||
default-language: Haskell2010
|
||||
|
47
test/Headers.hs
Normal file
47
test/Headers.hs
Normal file
@ -0,0 +1,47 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Headers where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Typeable (Typeable)
|
||||
import GHC.Generics (Generic)
|
||||
import Servant
|
||||
|
||||
newtype Foo = Foo Int
|
||||
deriving (Generic, Eq, Show, Typeable)
|
||||
deriving newtype (FromHttpApiData, ToHttpApiData)
|
||||
|
||||
instance ToJSON Foo
|
||||
|
||||
instance FromJSON Foo
|
||||
|
||||
type Api =
|
||||
"item" :> Get '[JSON] Foo
|
||||
:<|> "itemAdd" :> Header "one" Foo :> Header "two" Foo :> Get '[JSON] Foo
|
||||
:<|> "item" :> Capture "itemId" Foo :> Get '[JSON] ()
|
||||
|
||||
intro :: Handler Foo
|
||||
intro = pure (Foo 1)
|
||||
|
||||
combine :: Maybe Foo -> Maybe Foo -> Handler Foo
|
||||
combine (Just (Foo a)) (Just (Foo b)) = pure (Foo (a + b))
|
||||
combine (Just a) Nothing = pure a
|
||||
combine Nothing (Just a) = pure a
|
||||
combine Nothing Nothing = pure (Foo 1)
|
||||
|
||||
|
||||
eliminate :: Foo -> Handler ()
|
||||
eliminate (Foo a)
|
||||
| a > 10 = throwError $ err500 {errBody = "eliminate blew up, oh no!"}
|
||||
| otherwise = pure ()
|
||||
|
||||
server :: Server Api
|
||||
server =
|
||||
intro
|
||||
:<|> combine
|
||||
:<|> eliminate
|
@ -2,6 +2,7 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
import qualified Foo
|
||||
import qualified Headers
|
||||
import Hedgehog (Group (..), checkSequential, withTests)
|
||||
import qualified Roboservant as RS
|
||||
import qualified UnsafeIO
|
||||
@ -17,6 +18,10 @@ main :: IO ()
|
||||
main = do
|
||||
assert "should find an error in Foo" . not
|
||||
=<< checkSequential (Group "Foo" [("Foo", withTests 100000 $ RS.prop_sequential @Foo.FooApi Foo.fooServer)])
|
||||
|
||||
assert "should find an error in Headers" . not
|
||||
=<< checkSequential (Group "Headers" [("Headers", withTests 10000 $ RS.prop_sequential @Headers.Api Headers.server)])
|
||||
|
||||
-- The UnsafeIO checker does not actually really use the contextually aware stuff, though it
|
||||
-- could: it's mostly here to show how to test for concurrency problems.
|
||||
unsafeServer <- UnsafeIO.makeServer
|
||||
|
Loading…
Reference in New Issue
Block a user