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