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

remove 'hspec' call in servant-client tests

This commit is contained in:
Julian K. Arni 2015-10-07 17:50:29 +02:00
parent fce1c8d2a4
commit 59d8824888
2 changed files with 106 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

235
servant-client/test/Servant/ClientSpec.hs
View File

@ -1,12 +1,19 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fcontext-stack=100 #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
@ -20,20 +27,20 @@ import Control.Concurrent
import Control.Exception
import Control.Monad.Trans.Except
import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import Data.Char
import Data.Foldable (forM_)
import Data.Monoid
import Data.Proxy
import qualified Data.Text as T
import GHC.Generics
import GHC.TypeLits
import qualified Network.HTTP.Client as C
import Network.HTTP.Media
import Network.HTTP.Types hiding (Header)
import qualified Network.HTTP.Types as HTTP
import Network.Socket
import Network.Wai hiding (Response)
import Network.Wai.Handler.Warp
import System.IO.Unsafe (unsafePerformIO)
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.HUnit
@ -43,6 +50,12 @@ import Servant.API
import Servant.Client
import Servant.Server
spec :: Spec
spec = describe "Servant.Client" $ do
sucessSpec
failSpec
wrappedApiSpec
-- * test data types
data Person = Person {
@ -122,8 +135,6 @@ server = serve api (
:<|> return ()
)
withServer :: (BaseUrl -> IO a) -> IO a
withServer action = withWaiDaemon (return server) action
type FailApi =
"get" :> Raw
@ -139,93 +150,72 @@ failServer = serve failApi (
:<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
)
withFailServer :: (BaseUrl -> IO a) -> IO a
withFailServer action = withWaiDaemon (return failServer) action
{-# NOINLINE manager #-}
manager :: C.Manager
manager = unsafePerformIO $ C.newManager C.defaultManagerSettings
spec :: IO ()
spec = withServer $ \ baseUrl -> do
manager <- C.newManager C.defaultManagerSettings
let getGet :: ExceptT ServantError IO Person
getDeleteEmpty :: ExceptT ServantError IO ()
getCapture :: String -> ExceptT ServantError IO Person
getBody :: Person -> ExceptT ServantError IO Person
getQueryParam :: Maybe String -> ExceptT ServantError IO Person
getQueryParams :: [String] -> ExceptT ServantError IO [Person]
getQueryFlag :: Bool -> ExceptT ServantError IO Bool
getMatrixParam :: Maybe String -> ExceptT ServantError IO Person
getMatrixParams :: [String] -> ExceptT ServantError IO [Person]
getMatrixFlag :: Bool -> ExceptT ServantError IO Bool
getRawSuccess :: Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
getRawFailure :: Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> ExceptT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
getRespHeaders :: ExceptT ServantError IO (Headers TestHeaders Bool)
getDeleteContentType :: ExceptT ServantError IO ()
( getGet
:<|> getDeleteEmpty
:<|> getCapture
:<|> getBody
:<|> getQueryParam
:<|> getQueryParams
:<|> getQueryFlag
:<|> getMatrixParam
:<|> getMatrixParams
:<|> getMatrixFlag
:<|> getRawSuccess
:<|> getRawFailure
:<|> getMultiple
:<|> getRespHeaders
:<|> getDeleteContentType)
= client api baseUrl manager
sucessSpec :: Spec
sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
hspec $ do
it "Servant.API.Get" $ do
it "Servant.API.Get" $ \(_, baseUrl) -> do
let getGet = getNth (Proxy :: Proxy 0) $ client api baseUrl manager
(left show <$> runExceptT getGet) `shouldReturn` Right alice
describe "Servant.API.Delete" $ do
it "allows empty content type" $ do
it "allows empty content type" $ \(_, baseUrl) -> do
let getDeleteEmpty = getNth (Proxy :: Proxy 1) $ client api baseUrl manager
(left show <$> runExceptT getDeleteEmpty) `shouldReturn` Right ()
it "allows content type" $ do
(left show <$> runExceptT getDeleteContentType) `shouldReturn` Right ()
{-it "allows content type" $ \(_, baseUrl) -> do-}
{-let getDeleteContentType = getNth (Proxy :: Proxy 14) $ client api baseUrl manager-}
{-(left show <$> runExceptT getDeleteContentType) `shouldReturn` Right ()-}
it "Servant.API.Capture" $ do
it "Servant.API.Capture" $ \(_, baseUrl) -> do
let getCapture = getNth (Proxy :: Proxy 2) $ client api baseUrl manager
(left show <$> runExceptT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0)
it "Servant.API.ReqBody" $ do
it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
let p = Person "Clara" 42
getBody = getNth (Proxy :: Proxy 3) $ client api baseUrl manager
(left show <$> runExceptT (getBody p)) `shouldReturn` Right p
it "Servant.API.QueryParam" $ do
it "Servant.API.QueryParam" $ \(_, baseUrl) -> do
let getQueryParam = getNth (Proxy :: Proxy 4) $ client api baseUrl manager
left show <$> runExceptT (getQueryParam (Just "alice")) `shouldReturn` Right alice
Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob"))
responseStatus `shouldBe` Status 400 "bob not found"
it "Servant.API.QueryParam.QueryParams" $ do
it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do
let getQueryParams = getNth (Proxy :: Proxy 5) $ client api baseUrl manager
(left show <$> runExceptT (getQueryParams [])) `shouldReturn` Right []
(left show <$> runExceptT (getQueryParams ["alice", "bob"]))
`shouldReturn` Right [Person "alice" 0, Person "bob" 1]
context "Servant.API.QueryParam.QueryFlag" $
forM_ [False, True] $ \ flag ->
it (show flag) $ do
forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do
let getQueryFlag = getNth (Proxy :: Proxy 6) $ client api baseUrl manager
(left show <$> runExceptT (getQueryFlag flag)) `shouldReturn` Right flag
it "Servant.API.MatrixParam" $ do
it "Servant.API.MatrixParam" $ \(_, baseUrl) -> do
let getMatrixParam = getNth (Proxy :: Proxy 7) $ client api baseUrl manager
left show <$> runExceptT (getMatrixParam (Just "alice")) `shouldReturn` Right alice
Left FailureResponse{..} <- runExceptT (getMatrixParam (Just "bob"))
responseStatus `shouldBe` Status 400 "bob not found"
it "Servant.API.MatrixParam.MatrixParams" $ do
it "Servant.API.MatrixParam.MatrixParams" $ \(_, baseUrl) -> do
let getMatrixParams = getNth (Proxy :: Proxy 8) $ client api baseUrl manager
left show <$> runExceptT (getMatrixParams []) `shouldReturn` Right []
left show <$> runExceptT (getMatrixParams ["alice", "bob"])
`shouldReturn` Right [Person "alice" 0, Person "bob" 1]
context "Servant.API.MatrixParam.MatrixFlag" $
forM_ [False, True] $ \ flag ->
it (show flag) $ do
it (show flag) $ \(_, baseUrl) -> do
let getMatrixFlag = getNth (Proxy :: Proxy 9) $ client api baseUrl manager
left show <$> runExceptT (getMatrixFlag flag) `shouldReturn` Right flag
it "Servant.API.Raw on success" $ do
it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
let getRawSuccess = getNth (Proxy :: Proxy 10) $ client api baseUrl manager
res <- runExceptT (getRawSuccess methodGet)
case res of
Left e -> assertFailure $ show e
@ -234,7 +224,8 @@ spec = withServer $ \ baseUrl -> do
C.responseBody response `shouldBe` body
C.responseStatus response `shouldBe` ok200
it "Servant.API.Raw on failure" $ do
it "Servant.API.Raw on failure" $ \(_, baseUrl) -> do
let getRawFailure = getNth (Proxy :: Proxy 11) $ client api baseUrl manager
res <- runExceptT (getRawFailure methodGet)
case res of
Left e -> assertFailure $ show e
@ -243,81 +234,75 @@ spec = withServer $ \ baseUrl -> do
C.responseBody response `shouldBe` body
C.responseStatus response `shouldBe` badRequest400
it "Returns headers appropriately" $ withServer $ \ _ -> do
it "Returns headers appropriately" $ \(_, baseUrl) -> do
let getRespHeaders = getNth (Proxy :: Proxy 13) $ client api baseUrl manager
res <- runExceptT getRespHeaders
case res of
Left e -> assertFailure $ show e
Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
modifyMaxSuccess (const 20) $ do
it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
let getMultiple = getNth (Proxy :: Proxy 12) $ client api baseUrl manager
in property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
ioProperty $ do
result <- left show <$> runExceptT (getMultiple cap num flag body)
return $
result === Right (cap, num, flag, body)
context "client correctly handles error status codes" $ do
let test :: (WrappedApi, String) -> Spec
test (WrappedApi api, desc) =
it desc $
withWaiDaemon (return (serve api (throwE $ ServantErr 500 "error message" "" []))) $
\ host -> do
let getResponse :: ExceptT ServantError IO ()
getResponse = client api host manager
Left FailureResponse{..} <- runExceptT getResponse
responseStatus `shouldBe` (Status 500 "error message")
mapM_ test $
wrappedApiSpec :: Spec
wrappedApiSpec = describe "error status codes" $ do
let serveW api = serve api $ throwE $ ServantErr 500 "error message" "" []
context "are correctly handled by the client" $
let test :: (WrappedApi, String) -> Spec
test (WrappedApi api, desc) =
it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do
let getResponse :: ExceptT ServantError IO ()
getResponse = client api baseUrl manager
Left FailureResponse{..} <- runExceptT getResponse
responseStatus `shouldBe` (Status 500 "error message")
in mapM_ test $
(WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
(WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
(WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") :
(WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") :
[]
failSpec :: IO ()
failSpec = withFailServer $ \ baseUrl -> do
manager <- C.newManager C.defaultManagerSettings
let getGet :: ExceptT ServantError IO Person
getDeleteEmpty :: ExceptT ServantError IO ()
getCapture :: String -> ExceptT ServantError IO Person
getBody :: Person -> ExceptT ServantError IO Person
( getGet
:<|> getDeleteEmpty
:<|> getCapture
:<|> getBody
:<|> _ )
= client api baseUrl manager
getGetWrongHost :: ExceptT ServantError IO Person
(getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "") manager
failSpec :: Spec
failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
hspec $ do
context "client returns errors appropriately" $ do
it "reports FailureResponse" $ do
it "reports FailureResponse" $ \(_, baseUrl) -> do
let (_ :<|> getDeleteEmpty :<|> _) = client api baseUrl manager
Left res <- runExceptT getDeleteEmpty
case res of
FailureResponse (Status 404 "Not Found") _ _ -> return ()
_ -> fail $ "expected 404 response, but got " <> show res
it "reports DecodeFailure" $ do
it "reports DecodeFailure" $ \(_, baseUrl) -> do
let (_ :<|> _ :<|> getCapture :<|> _) = client api baseUrl manager
Left res <- runExceptT (getCapture "foo")
case res of
DecodeFailure _ ("application/json") _ -> return ()
_ -> fail $ "expected DecodeFailure, but got " <> show res
it "reports ConnectionError" $ do
it "reports ConnectionError" $ \_ -> do
let (getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "") manager
Left res <- runExceptT getGetWrongHost
case res of
ConnectionError _ -> return ()
_ -> fail $ "expected ConnectionError, but got " <> show res
it "reports UnsupportedContentType" $ do
it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
let (getGet :<|> _ ) = client api baseUrl manager
Left res <- runExceptT getGet
case res of
UnsupportedContentType ("application/octet-stream") _ -> return ()
_ -> fail $ "expected UnsupportedContentType, but got " <> show res
it "reports InvalidContentTypeHeader" $ do
it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api baseUrl manager
Left res <- runExceptT (getBody alice)
case res of
InvalidContentTypeHeader "fooooo" _ -> return ()
@ -331,36 +316,16 @@ data WrappedApi where
-- * utils
withWaiDaemon :: IO Application -> (BaseUrl -> IO a) -> IO a
withWaiDaemon mkApplication action = do
application <- mkApplication
bracket (acquire application) free (\ (_, _, baseUrl) -> action baseUrl)
where
acquire application = do
(notifyStart, waitForStart) <- lvar
(notifyKilled, waitForKilled) <- lvar
thread <- forkIO $ (do
(krakenPort, socket) <- openTestSocket
let settings =
setPort krakenPort $ -- set here just for consistency, shouldn't be
-- used (it's set in the socket)
setBeforeMainLoop (notifyStart krakenPort)
defaultSettings
runSettingsSocket settings socket application)
`finally` notifyKilled ()
krakenPort <- waitForStart
let baseUrl = (BaseUrl Http "localhost" 80 ""){baseUrlPort = krakenPort}
return (thread, waitForKilled, baseUrl)
free (thread, waitForKilled, _) = do
killThread thread
waitForKilled
startWaiApp :: Application -> IO (ThreadId, BaseUrl)
startWaiApp app = do
(port, socket) <- openTestSocket
let settings = setPort port $ defaultSettings
thread <- forkIO $ runSettingsSocket settings socket app
return (thread, BaseUrl Http "localhost" port "")
lvar :: IO (a -> IO (), IO a)
lvar = do
mvar <- newEmptyMVar
let put = putMVar mvar
wait = readMVar mvar
return (put, wait)
endWaiApp :: (ThreadId, BaseUrl) -> IO ()
endWaiApp (thread, _) = killThread thread
openTestSocket :: IO (Port, Socket)
openTestSocket = do
@ -378,3 +343,15 @@ pathGen = fmap NonEmpty path
filter (not . (`elem` ("?%[]/#;" :: String))) $
filter isPrint $
map chr [0..127]
class GetNth (n :: Nat) a b | n a -> b where
getNth :: Proxy n -> a -> b
instance GetNth 0 (x :<|> y) x where
getNth _ (x :<|> _) = x
{-instance GetNth 0 x x where-}
{-getNth _ = id-}
instance (GetNth (n - 1) x y) => GetNth n (a :<|> x) y where
getNth _ (_ :<|> x) = getNth (Proxy :: Proxy (n - 1)) x

1
servant-client/test/Spec.hs
View File

@ -1,2 +1 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}