eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Add ordering check for auth in ErrorSpec

Browse source
This commit is contained in:
aaron levin 2016-01-27 20:55:23 +01:00
parent 364d5dafe9
commit d91a47e1f5
1 changed files with 26 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
servant-server/test/Servant/Server/ErrorSpec.hs
View file

@ -28,16 +28,10 @@ spec = describe "HTTP Errors" $ do
errorRetrySpec
errorChoiceSpec
------------------------------------------------------------------------------
-- * Error Order {{{
type ErrorOrderApi = "home"
:> BasicAuth "error-realm"
:> ReqBody '[JSON] Int
:> Capture "t" Int
:> Post '[JSON] Int
-- * Auth machinery (reused throughout)
type instance AuthReturnType (BasicAuth "error-realm") = ()
type instance AuthReturnType (BasicAuth "bar-realm") = ()
-- | 'BasicAuthCheck' holds the handler we'll use to verify a username and password.
errorOrderAuthCheck :: BasicAuthCheck ()
@ -48,6 +42,15 @@ errorOrderAuthCheck =
else return Unauthorized
in BasicAuthCheck check
------------------------------------------------------------------------------
-- * Error Order {{{
type ErrorOrderApi = "home"
:> BasicAuth "error-realm"
:> ReqBody '[JSON] Int
:> Capture "t" Int
:> Post '[JSON] Int
errorOrderApi :: Proxy ErrorOrderApi
errorOrderApi = Proxy
@ -159,9 +162,12 @@ type ErrorRetryApi
:<|> "a" :> ReqBody '[JSON] Int :> Post '[PlainText] Int -- 2
:<|> "a" :> ReqBody '[JSON] String :> Post '[JSON] Int -- 3
:<|> "a" :> ReqBody '[JSON] Int :> Get '[JSON] Int -- 4
:<|> "a" :> ReqBody '[JSON] Int :> Get '[PlainText] Int -- 5
:<|> ReqBody '[JSON] Int :> Get '[JSON] Int -- 6
:<|> ReqBody '[JSON] Int :> Post '[JSON] Int -- 7
:<|> "a" :> BasicAuth "bar-realm"
:> ReqBody '[JSON] Int :> Get '[PlainText] Int -- 5
:<|> "a" :> ReqBody '[JSON] Int :> Get '[PlainText] Int -- 6
:<|> ReqBody '[JSON] Int :> Get '[JSON] Int -- 7
:<|> ReqBody '[JSON] Int :> Post '[JSON] Int -- 8
errorRetryApi :: Proxy ErrorRetryApi
errorRetryApi = Proxy
@ -173,13 +179,18 @@ errorRetryServer
:<|> (\_ -> return 2)
:<|> (\_ -> return 3)
:<|> (\_ -> return 4)
:<|> (\_ -> return 5)
:<|> (\_ _ -> return 5)
:<|> (\_ -> return 6)
:<|> (\_ -> return 7)
:<|> (\_ -> return 8)
errorRetrySpec :: Spec
errorRetrySpec = describe "Handler search"
$ with (return $ serve errorRetryApi EmptyConfig errorRetryServer) $ do
errorRetrySpec =
describe "Handler search" $
with (return $ serve errorRetryApi
(errorOrderAuthCheck :. EmptyConfig)
errorRetryServer
) $ do
let jsonCT = (hContentType, "application/json")
jsonAccept = (hAccept, "application/json")
@ -187,7 +198,7 @@ errorRetrySpec = describe "Handler search"
it "should continue when URLs don't match" $ do
request methodPost "" [jsonCT, jsonAccept] jsonBody
`shouldRespondWith` 200 { matchBody = Just $ encode (7 :: Int) }
`shouldRespondWith` 200 { matchBody = Just $ encode (8 :: Int) }
it "should continue when methods don't match" $ do
request methodGet "a" [jsonCT, jsonAccept] jsonBody