add headers test

package.yaml

@@ -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

roboservant.cabal

@@ -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

test/Headers.hs

@@ -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

test/Spec.hs

@@ -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