Error retry tests
Mime[Un]Render instances for PlainText String pragmas and formatting
This commit is contained in:
parent
9c62a3b150
commit
153de01a62
3 changed files with 121 additions and 36 deletions
|
@ -1,13 +1,17 @@
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
module Servant.Server.ErrorSpec (spec) where
|
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
|
||||||
|
|
||||||
|
@ -26,9 +30,12 @@ import Servant
|
||||||
-- 9) Call the handler. Whatever it returns, we return.
|
-- 9) Call the handler. Whatever it returns, we return.
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec = describe "HTTP Errors" $ do
|
||||||
errorOrder
|
errorOrder
|
||||||
|
errorRetry
|
||||||
|
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
-- * Error Order {{{
|
||||||
|
|
||||||
type ErrorOrderApi = "home"
|
type ErrorOrderApi = "home"
|
||||||
:> ReqBody '[JSON] Int
|
:> ReqBody '[JSON] Int
|
||||||
|
@ -39,7 +46,7 @@ errorOrderApi :: Proxy ErrorOrderApi
|
||||||
errorOrderApi = Proxy
|
errorOrderApi = Proxy
|
||||||
|
|
||||||
errorOrderServer :: Server ErrorOrderApi
|
errorOrderServer :: Server ErrorOrderApi
|
||||||
errorOrderServer = \_ _ -> return 10
|
errorOrderServer = \_ _ -> left err402
|
||||||
|
|
||||||
errorOrder :: Spec
|
errorOrder :: Spec
|
||||||
errorOrder = describe "HTTP error order"
|
errorOrder = describe "HTTP error order"
|
||||||
|
@ -75,4 +82,72 @@ errorOrder = describe "HTTP error order"
|
||||||
request goodMethod goodUrl [goodContentType, badAccept] goodBody
|
request goodMethod goodUrl [goodContentType, badAccept] goodBody
|
||||||
`shouldRespondWith` 406
|
`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
|
||||||
|
-- }}}
|
||||||
|
|
|
@ -6,6 +6,7 @@ HEAD
|
||||||
* Add more instances for (:<|>)
|
* Add more instances for (:<|>)
|
||||||
* Use `http-api-data` instead of `Servant.Common.Text`
|
* Use `http-api-data` instead of `Servant.Common.Text`
|
||||||
* Remove matrix params.
|
* Remove matrix params.
|
||||||
|
* Add PlainText String MimeRender and MimeUnrender instances.
|
||||||
|
|
||||||
0.4.2
|
0.4.2
|
||||||
-----
|
-----
|
||||||
|
|
|
@ -80,6 +80,7 @@ import qualified Data.ByteString as BS
|
||||||
import Data.ByteString.Lazy (ByteString, fromStrict,
|
import Data.ByteString.Lazy (ByteString, fromStrict,
|
||||||
toStrict)
|
toStrict)
|
||||||
import qualified Data.ByteString.Lazy as B
|
import qualified Data.ByteString.Lazy as B
|
||||||
|
import qualified Data.ByteString.Lazy.Char8 as BC
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
import Data.String.Conversions (cs)
|
import Data.String.Conversions (cs)
|
||||||
import qualified Data.Text as TextS
|
import qualified Data.Text as TextS
|
||||||
|
@ -279,6 +280,10 @@ instance MimeRender PlainText TextL.Text where
|
||||||
instance MimeRender PlainText TextS.Text where
|
instance MimeRender PlainText TextS.Text where
|
||||||
mimeRender _ = fromStrict . TextS.encodeUtf8
|
mimeRender _ = fromStrict . TextS.encodeUtf8
|
||||||
|
|
||||||
|
-- | @BC.pack@
|
||||||
|
instance MimeRender PlainText String where
|
||||||
|
mimeRender _ = BC.pack
|
||||||
|
|
||||||
-- | @id@
|
-- | @id@
|
||||||
instance MimeRender OctetStream ByteString where
|
instance MimeRender OctetStream ByteString where
|
||||||
mimeRender _ = id
|
mimeRender _ = id
|
||||||
|
@ -328,6 +333,10 @@ instance MimeUnrender PlainText TextL.Text where
|
||||||
instance MimeUnrender PlainText TextS.Text where
|
instance MimeUnrender PlainText TextS.Text where
|
||||||
mimeUnrender _ = left show . TextS.decodeUtf8' . toStrict
|
mimeUnrender _ = left show . TextS.decodeUtf8' . toStrict
|
||||||
|
|
||||||
|
-- | @Right . BC.unpack@
|
||||||
|
instance MimeUnrender PlainText String where
|
||||||
|
mimeUnrender _ = Right . BC.unpack
|
||||||
|
|
||||||
-- | @Right . id@
|
-- | @Right . id@
|
||||||
instance MimeUnrender OctetStream ByteString where
|
instance MimeUnrender OctetStream ByteString where
|
||||||
mimeUnrender _ = Right . id
|
mimeUnrender _ = Right . id
|
||||||
|
|
Loading…
Add table
Reference in a new issue