Skip to content

Commit

Permalink
Merge pull request #446 from haskell-servant/gen-auth-test-for-raw
Browse files Browse the repository at this point in the history
Add test: Gen Auth properly supports Raw endpoints
  • Loading branch information
aaronlevin committed Apr 6, 2016
2 parents 6df3429 + 8a0c3a9 commit 56c13ee
Showing 1 changed file with 10 additions and 5 deletions.
15 changes: 10 additions & 5 deletions servant-server/test/Servant/ServerSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -593,12 +593,14 @@ basicAuthSpec = do
------------------------------------------------------------------------------

type GenAuthAPI = AuthProtect "auth" :> "auth" :> Get '[JSON] Animal
:<|> Raw

authApi :: Proxy GenAuthAPI
authApi = Proxy
genAuthApi :: Proxy GenAuthAPI
genAuthApi = Proxy

authServer :: Server GenAuthAPI
authServer = const (return tweety)
genAuthServer :: Server GenAuthAPI
genAuthServer = const (return tweety)
:<|> (\ _ respond -> respond $ responseLBS imATeaPot418 [] "")

type instance AuthServerData (AuthProtect "auth") = ()

Expand All @@ -614,7 +616,7 @@ genAuthContext =
genAuthSpec :: Spec
genAuthSpec = do
describe "Servant.API.Auth" $ do
with (return (serveWithContext authApi genAuthContext authServer)) $ do
with (return (serveWithContext genAuthApi genAuthContext genAuthServer)) $ do

context "Custom Auth Protection" $ do
it "returns 401 when missing headers" $ do
Expand All @@ -623,6 +625,9 @@ genAuthSpec = do
it "returns 200 with the right header" $ do
THW.request methodGet "/auth" [("Auth","secret")] "" `shouldRespondWith` 200

it "plays nice with subsequent Raw endpoints" $ do
get "/foo" `shouldRespondWith` 418

-- }}}
------------------------------------------------------------------------------
-- * Test data types {{{
Expand Down

0 comments on commit 56c13ee

Please sign in to comment.