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

Error retry tests

Browse source 
Mime[Un]Render instances for PlainText String
        pragmas and formatting
This commit is contained in:
Julian K. Arni 2015-09-09 14:17:17 -07:00
parent 9c62a3b150
commit 153de01a62
3 changed files with 121 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1,15 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.Server.ErrorSpec (spec) where
import Test.Hspec
import Data.Proxy
import Test.Hspec.Wai (request, with, shouldRespondWith)
import Network.HTTP.Types (methodGet, methodPost)
import Data.Aeson (encode)
import Data.Aeson (encode)
import qualified Data.ByteString.Lazy.Char8 as BC
import Control.Monad.Trans.Either (left)
import Data.Proxy
import Network.HTTP.Types (methodGet, methodPost)
import Test.Hspec
import Test.Hspec.Wai
import Servant
import Servant
-- 1) Check whether one or more endpoints have the right path. Otherwise return 404.
@ -26,9 +30,12 @@ import Servant
-- 9) Call the handler. Whatever it returns, we return.
spec :: Spec
spec = do
spec = describe "HTTP Errors" $ do
errorOrder
errorRetry
------------------------------------------------------------------------------
-- * Error Order {{{
type ErrorOrderApi = "home"
:> ReqBody '[JSON] Int
@ -39,40 +46,108 @@ errorOrderApi :: Proxy ErrorOrderApi
errorOrderApi = Proxy
errorOrderServer :: Server ErrorOrderApi
errorOrderServer = \_ _ -> return 10
errorOrderServer = \_ _ -> left err402
errorOrder :: Spec
errorOrder = describe "HTTP error order"
$ with (return $ serve errorOrderApi errorOrderServer) $ do
let badContentType = ("Content-Type", "text/plain")
badAccept = ("Accept", "text/plain")
badMethod = methodGet
badUrl = "home/nonexistent"
badBody = "nonsense"
goodContentType = ("Content-Type", "application/json")
goodAccept = ("Accept", "application/json")
goodMethod = methodPost
goodUrl = "home/5"
goodBody = encode (5 :: Int)
let badContentType = ("Content-Type", "text/plain")
badAccept = ("Accept", "text/plain")
badMethod = methodGet
badUrl = "home/nonexistent"
badBody = "nonsense"
goodContentType = ("Content-Type", "application/json")
goodAccept = ("Accept", "application/json")
goodMethod = methodPost
goodUrl = "home/5"
goodBody = encode (5 :: Int)
it "has 404 as its highest priority error" $ do
request badMethod badUrl [badContentType, badAccept] badBody
`shouldRespondWith` 404
it "has 404 as its highest priority error" $ do
request badMethod badUrl [badContentType, badAccept] badBody
`shouldRespondWith` 404
it "has 405 as its second highest priority error" $ do
request badMethod goodUrl [badContentType, badAccept] badBody
`shouldRespondWith` 405
it "has 405 as its second highest priority error" $ do
request badMethod goodUrl [badContentType, badAccept] badBody
`shouldRespondWith` 405
it "has 415 as its third highest priority error" $ do
request goodMethod goodUrl [badContentType, badAccept] badBody
`shouldRespondWith` 415
it "has 415 as its third highest priority error" $ do
request goodMethod goodUrl [badContentType, badAccept] badBody
`shouldRespondWith` 415
it "has 400 as its fourth highest priority error" $ do
request goodMethod goodUrl [goodContentType, badAccept] badBody
`shouldRespondWith` 400
it "has 400 as its fourth highest priority error" $ do
request goodMethod goodUrl [goodContentType, badAccept] badBody
`shouldRespondWith` 400
it "has 406 as its fifth highest priority error" $ do
request goodMethod goodUrl [goodContentType, badAccept] goodBody
`shouldRespondWith` 406
it "has 406 as its fifth highest priority error" $ do
request goodMethod goodUrl [goodContentType, badAccept] goodBody
`shouldRespondWith` 406
it "returns handler errors as its lower priority errors" $ do
request goodMethod goodUrl [goodContentType, goodAccept] goodBody
`shouldRespondWith` 402
-- }}}
------------------------------------------------------------------------------
-- * Error Retry {{{
type ErrorRetryApi
= "a" :> ReqBody '[JSON] Int :> Post '[JSON] Int -- 0
:<|> "a" :> ReqBody '[PlainText] Int :> Post '[JSON] Int -- 1
:<|> "a" :> ReqBody '[JSON] Int :> Post '[PlainText] Int -- 2
:<|> "a" :> ReqBody '[JSON] String :> Post '[JSON] Int -- 3
:<|> "a" :> ReqBody '[JSON] Int :> Get '[PlainText] Int -- 4
:<|> ReqBody '[JSON] Int :> Get '[JSON] Int -- 5
:<|> ReqBody '[JSON] Int :> Get '[JSON] Int -- 6
errorRetryApi :: Proxy ErrorRetryApi
errorRetryApi = Proxy
errorRetryServer :: Server ErrorRetryApi
errorRetryServer
= (\_ -> return 0)
:<|> (\_ -> return 1)
:<|> (\_ -> return 2)
:<|> (\_ -> return 3)
:<|> (\_ -> return 4)
:<|> (\_ -> return 5)
:<|> (\_ -> return 6)
errorRetry :: Spec
errorRetry = describe "Handler search"
$ with (return $ serve errorRetryApi errorRetryServer) $ do
let plainCT = ("Content-Type", "text/plain")
plainAccept = ("Accept", "text/plain")
jsonCT = ("Content-Type", "application/json")
jsonAccept = ("Accept", "application/json")
jsonBody = encode (1797 :: Int)
it "should continue when URLs don't match" $ do
request methodPost "" [jsonCT, jsonAccept] jsonBody
`shouldRespondWith` 201 { matchBody = Just $ encode (5 :: Int) }
it "should continue when methods don't match" $ do
request methodGet "a" [jsonCT, jsonAccept] jsonBody
`shouldRespondWith` 200 { matchBody = Just $ encode (4 :: Int) }
it "should not continue when Content-Types don't match" $ do
request methodPost "a" [plainCT, jsonAccept] jsonBody
`shouldRespondWith` 415
it "should not continue when body can't be deserialized" $ do
request methodPost "a" [jsonCT, jsonAccept] (encode ("nonsense" :: String))
`shouldRespondWith` 400
it "should not continue when Accepts don't match" $ do
request methodPost "a" [jsonCT, plainAccept] jsonBody
`shouldRespondWith` 406
-- }}}
------------------------------------------------------------------------------
-- * Instances {{{
instance MimeUnrender PlainText Int where
mimeUnrender _ = Right . read . BC.unpack
instance MimeRender PlainText Int where
mimeRender _ = BC.pack . show
-- }}}

1
servant/CHANGELOG.md
View file

@ -6,6 +6,7 @@ HEAD
* Add more instances for (:<|>)
* Use `http-api-data` instead of `Servant.Common.Text`
* Remove matrix params.
* Add PlainText String MimeRender and MimeUnrender instances.
0.4.2
-----

9
servant/src/Servant/API/ContentTypes.hs
View file

@ -80,6 +80,7 @@ import qualified Data.ByteString as BS
import Data.ByteString.Lazy (ByteString, fromStrict,
toStrict)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as BC
import Data.Monoid
import Data.String.Conversions (cs)
import qualified Data.Text as TextS
@ -279,6 +280,10 @@ instance MimeRender PlainText TextL.Text where
instance MimeRender PlainText TextS.Text where
mimeRender _ = fromStrict . TextS.encodeUtf8
-- | @BC.pack@
instance MimeRender PlainText String where
mimeRender _ = BC.pack
-- | @id@
instance MimeRender OctetStream ByteString where
mimeRender _ = id
@ -328,6 +333,10 @@ instance MimeUnrender PlainText TextL.Text where
instance MimeUnrender PlainText TextS.Text where
mimeUnrender _ = left show . TextS.decodeUtf8' . toStrict
-- | @Right . BC.unpack@
instance MimeUnrender PlainText String where
mimeUnrender _ = Right . BC.unpack
-- | @Right . id@
instance MimeUnrender OctetStream ByteString where
mimeUnrender _ = Right . id