Return complete response in Raw endpoint
This commit is contained in:
parent
c08baabfdf
commit
ecb8627433
4 changed files with 29 additions and 16 deletions
|
@ -74,6 +74,7 @@ test-suite spec
|
||||||
, http-client
|
, http-client
|
||||||
, http-media
|
, http-media
|
||||||
, http-types
|
, http-types
|
||||||
|
, HUnit
|
||||||
, network >= 2.6
|
, network >= 2.6
|
||||||
, QuickCheck >= 2.7
|
, QuickCheck >= 2.7
|
||||||
, servant >= 0.2.1
|
, servant >= 0.2.1
|
||||||
|
|
|
@ -23,6 +23,7 @@ import Data.Proxy
|
||||||
import Data.String.Conversions
|
import Data.String.Conversions
|
||||||
import Data.Text (unpack)
|
import Data.Text (unpack)
|
||||||
import GHC.TypeLits
|
import GHC.TypeLits
|
||||||
|
import Network.HTTP.Client (Response)
|
||||||
import Network.HTTP.Media
|
import Network.HTTP.Media
|
||||||
import qualified Network.HTTP.Types as H
|
import qualified Network.HTTP.Types as H
|
||||||
import Servant.API
|
import Servant.API
|
||||||
|
@ -411,12 +412,12 @@ instance (KnownSymbol sym, HasClient sublayout)
|
||||||
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
|
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
|
||||||
|
|
||||||
-- | Pick a 'Method' and specify where the server you want to query is. You get
|
-- | Pick a 'Method' and specify where the server you want to query is. You get
|
||||||
-- back the status code and the response body as a 'ByteString'.
|
-- back the full `Response`.
|
||||||
instance HasClient Raw where
|
instance HasClient Raw where
|
||||||
type Client Raw = H.Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
|
type Client Raw = H.Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, Response ByteString)
|
||||||
|
|
||||||
clientWithRoute :: Proxy Raw -> Req -> Client Raw
|
clientWithRoute :: Proxy Raw -> Req -> Client Raw
|
||||||
clientWithRoute Proxy req httpMethod host =
|
clientWithRoute Proxy req httpMethod host = do
|
||||||
performRequest httpMethod req (const True) host
|
performRequest httpMethod req (const True) host
|
||||||
|
|
||||||
-- | If you use a 'ReqBody' in one of your endpoints in your API,
|
-- | If you use a 'ReqBody' in one of your endpoints in your API,
|
||||||
|
|
|
@ -133,7 +133,7 @@ displayHttpRequest :: Method -> String
|
||||||
displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
|
displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
|
||||||
|
|
||||||
|
|
||||||
performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
|
performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, Response ByteString)
|
||||||
performRequest reqMethod req isWantedStatus reqHost = do
|
performRequest reqMethod req isWantedStatus reqHost = do
|
||||||
partialRequest <- liftIO $ reqToRequest req reqHost
|
partialRequest <- liftIO $ reqToRequest req reqHost
|
||||||
|
|
||||||
|
@ -159,13 +159,13 @@ performRequest reqMethod req isWantedStatus reqHost = do
|
||||||
Just t' -> pure t'
|
Just t' -> pure t'
|
||||||
unless (isWantedStatus status_code) $
|
unless (isWantedStatus status_code) $
|
||||||
left $ FailureResponse status ct body
|
left $ FailureResponse status ct body
|
||||||
return (status_code, body, ct)
|
return (status_code, body, ct, response)
|
||||||
|
|
||||||
performRequestCT :: MimeUnrender ct result =>
|
performRequestCT :: MimeUnrender ct result =>
|
||||||
Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO result
|
Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO result
|
||||||
performRequestCT ct reqMethod req wantedStatus reqHost = do
|
performRequestCT ct reqMethod req wantedStatus reqHost = do
|
||||||
let acceptCT = contentType ct
|
let acceptCT = contentType ct
|
||||||
(_status, respBody, respCT) <-
|
(_status, respBody, respCT, _response) <-
|
||||||
performRequest reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost
|
performRequest reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost
|
||||||
unless (matches respCT (acceptCT)) $
|
unless (matches respCT (acceptCT)) $
|
||||||
left $ UnsupportedContentType respCT respBody
|
left $ UnsupportedContentType respCT respBody
|
||||||
|
|
|
@ -23,14 +23,15 @@ import Data.Monoid
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
import Network.HTTP.Client (HttpException(..))
|
import qualified Network.HTTP.Client as C
|
||||||
import Network.HTTP.Media
|
import Network.HTTP.Media
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
import Network.Socket
|
import Network.Socket
|
||||||
import Network.Wai
|
import Network.Wai hiding (Response)
|
||||||
import Network.Wai.Handler.Warp
|
import Network.Wai.Handler.Warp
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import Test.Hspec.QuickCheck
|
import Test.Hspec.QuickCheck
|
||||||
|
import Test.HUnit
|
||||||
import Test.QuickCheck
|
import Test.QuickCheck
|
||||||
|
|
||||||
import Servant.API
|
import Servant.API
|
||||||
|
@ -64,7 +65,7 @@ instance FromFormUrlEncoded Person where
|
||||||
|
|
||||||
deriving instance Eq ServantError
|
deriving instance Eq ServantError
|
||||||
|
|
||||||
instance Eq HttpException where
|
instance Eq C.HttpException where
|
||||||
a == b = show a == show b
|
a == b = show a == show b
|
||||||
|
|
||||||
alice :: Person
|
alice :: Person
|
||||||
|
@ -128,8 +129,8 @@ getQueryFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
|
||||||
getMatrixParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
|
getMatrixParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
|
||||||
getMatrixParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
|
getMatrixParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
|
||||||
getMatrixFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
|
getMatrixFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
|
||||||
getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
|
getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, C.Response ByteString)
|
||||||
getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
|
getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, C.Response ByteString)
|
||||||
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
|
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
|
||||||
-> BaseUrl
|
-> BaseUrl
|
||||||
-> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
|
-> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
|
||||||
|
@ -211,12 +212,22 @@ spec = do
|
||||||
Arrow.left show <$> runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag
|
Arrow.left show <$> runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag
|
||||||
|
|
||||||
it "Servant.API.Raw on success" $ withServer $ \ host -> do
|
it "Servant.API.Raw on success" $ withServer $ \ host -> do
|
||||||
(Arrow.left show <$> runEitherT (getRawSuccess methodGet host))
|
res <- runEitherT (getRawSuccess methodGet host)
|
||||||
`shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream")
|
case res of
|
||||||
|
Left e -> assertFailure $ show e
|
||||||
|
Right (code, body, ct, response) -> do
|
||||||
|
(code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")
|
||||||
|
C.responseBody response `shouldBe` body
|
||||||
|
C.responseStatus response `shouldBe` ok200
|
||||||
|
|
||||||
it "Servant.API.Raw on failure" $ withServer $ \ host -> do
|
it "Servant.API.Raw on failure" $ withServer $ \ host -> do
|
||||||
(Arrow.left show <$> runEitherT (getRawFailure methodGet host))
|
res <- runEitherT (getRawFailure methodGet host)
|
||||||
`shouldReturn` Right (400, "rawFailure", "application"//"octet-stream")
|
case res of
|
||||||
|
Left e -> assertFailure $ show e
|
||||||
|
Right (code, body, ct, response) -> do
|
||||||
|
(code, body, ct) `shouldBe` (400, "rawFailure", "application"//"octet-stream")
|
||||||
|
C.responseBody response `shouldBe` body
|
||||||
|
C.responseStatus response `shouldBe` badRequest400
|
||||||
|
|
||||||
modifyMaxSuccess (const 20) $ do
|
modifyMaxSuccess (const 20) $ do
|
||||||
it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
|
it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
|
||||||
|
@ -262,7 +273,7 @@ spec = do
|
||||||
Right host <- return $ parseBaseUrl "127.0.0.1:987654"
|
Right host <- return $ parseBaseUrl "127.0.0.1:987654"
|
||||||
Left res <- runEitherT (getGet host)
|
Left res <- runEitherT (getGet host)
|
||||||
case res of
|
case res of
|
||||||
ConnectionError (FailedConnectionException2 "127.0.0.1" 987654 False _) -> return ()
|
ConnectionError (C.FailedConnectionException2 "127.0.0.1" 987654 False _) -> return ()
|
||||||
_ -> fail $ "expected ConnectionError, but got " <> show res
|
_ -> fail $ "expected ConnectionError, but got " <> show res
|
||||||
|
|
||||||
it "reports UnsupportedContentType" $ withFailServer $ \ host -> do
|
it "reports UnsupportedContentType" $ withFailServer $ \ host -> do
|
||||||
|
|
Loading…
Reference in a new issue