add test
This commit is contained in:
parent
966ebe0169
commit
a4e5707955
1 changed files with 36 additions and 7 deletions
|
@ -46,7 +46,7 @@ import Network.Wai.Test
|
||||||
simpleHeaders, simpleStatus)
|
simpleHeaders, simpleStatus)
|
||||||
import Servant.API
|
import Servant.API
|
||||||
((:<|>) (..), (:>), AuthProtect, BasicAuth,
|
((:<|>) (..), (:>), AuthProtect, BasicAuth,
|
||||||
BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete,
|
BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll, Lenient, Strict, Delete,
|
||||||
EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
|
EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
|
||||||
JSON, NoContent (..), NoFraming, OctetStream, Patch,
|
JSON, NoContent (..), NoFraming, OctetStream, Patch,
|
||||||
PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
|
PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
|
||||||
|
@ -54,7 +54,7 @@ import Servant.API
|
||||||
addHeader)
|
addHeader)
|
||||||
import Servant.Server
|
import Servant.Server
|
||||||
(Context ((:.), EmptyContext), Handler, Server, Tagged (..),
|
(Context ((:.), EmptyContext), Handler, Server, Tagged (..),
|
||||||
emptyServer, err401, err403, err404, serve, serveWithContext)
|
emptyServer, err400, err401, err403, err404, serve, serveWithContext)
|
||||||
import Servant.Test.ComprehensiveAPI
|
import Servant.Test.ComprehensiveAPI
|
||||||
import qualified Servant.Types.SourceT as S
|
import qualified Servant.Types.SourceT as S
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
@ -204,14 +204,28 @@ verbSpec = describe "Servant.API.Verb" $ do
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal
|
type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal
|
||||||
|
:<|> "ears" :> Capture' '[Lenient] "ears" Integer :> Get '[JSON] Animal
|
||||||
|
:<|> "eyes" :> Capture' '[Strict] "eyes" Integer :> Get '[JSON] Animal
|
||||||
captureApi :: Proxy CaptureApi
|
captureApi :: Proxy CaptureApi
|
||||||
captureApi = Proxy
|
captureApi = Proxy
|
||||||
captureServer :: Integer -> Handler Animal
|
|
||||||
captureServer legs = case legs of
|
captureServer :: Server CaptureApi
|
||||||
|
captureServer = getLegs :<|> getEars :<|> getEyes
|
||||||
|
where getLegs :: Integer -> Handler Animal
|
||||||
|
getLegs legs = case legs of
|
||||||
4 -> return jerry
|
4 -> return jerry
|
||||||
2 -> return tweety
|
2 -> return tweety
|
||||||
_ -> throwError err404
|
_ -> throwError err404
|
||||||
|
|
||||||
|
getEars :: Either String Integer -> Handler Animal
|
||||||
|
getEars (Left e) = return chimera -- ignore integer parse error, return weird animal
|
||||||
|
getEars (Right 2) = return jerry
|
||||||
|
getEars (Right _) = throwError err404
|
||||||
|
|
||||||
|
getEyes :: Integer -> Handler Animal
|
||||||
|
getEyes 2 = return jerry
|
||||||
|
getEyes _ = throwError err404
|
||||||
|
|
||||||
captureSpec :: Spec
|
captureSpec :: Spec
|
||||||
captureSpec = do
|
captureSpec = do
|
||||||
describe "Servant.API.Capture" $ do
|
describe "Servant.API.Capture" $ do
|
||||||
|
@ -224,6 +238,17 @@ captureSpec = do
|
||||||
it "returns 400 if the decoding fails" $ do
|
it "returns 400 if the decoding fails" $ do
|
||||||
get "/notAnInt" `shouldRespondWith` 400
|
get "/notAnInt" `shouldRespondWith` 400
|
||||||
|
|
||||||
|
it "returns an animal if eyes or ears are 2" $ do
|
||||||
|
get "/ears/2" `shouldRespondWith` 200
|
||||||
|
get "/eyes/2" `shouldRespondWith` 200
|
||||||
|
|
||||||
|
it "returns a weird animal on Lenient Capture" $ do
|
||||||
|
response <- get "/ears/bla"
|
||||||
|
liftIO $ decode' (simpleBody response) `shouldBe` Just chimera
|
||||||
|
|
||||||
|
it "returns 400 if parsing integer fails on Strict Capture" $ do
|
||||||
|
get "/eyes/bla" `shouldRespondWith` 400
|
||||||
|
|
||||||
with (return (serve
|
with (return (serve
|
||||||
(Proxy :: Proxy (Capture "captured" String :> Raw))
|
(Proxy :: Proxy (Capture "captured" String :> Raw))
|
||||||
(\ "captured" -> Tagged $ \request_ respond ->
|
(\ "captured" -> Tagged $ \request_ respond ->
|
||||||
|
@ -780,6 +805,10 @@ jerry = Animal "Mouse" 4
|
||||||
tweety :: Animal
|
tweety :: Animal
|
||||||
tweety = Animal "Bird" 2
|
tweety = Animal "Bird" 2
|
||||||
|
|
||||||
|
-- weird animal with non-integer amount of ears
|
||||||
|
chimera :: Animal
|
||||||
|
chimera = Animal "Chimera" (-1)
|
||||||
|
|
||||||
beholder :: Animal
|
beholder :: Animal
|
||||||
beholder = Animal "Beholder" 0
|
beholder = Animal "Beholder" 0
|
||||||
-- }}}
|
-- }}}
|
||||||
|
|
Loading…
Reference in a new issue