Return complete response in Raw endpoint

This commit is contained in:
Timo von Holtz 2015-03-16 11:12:11 +11:00
parent c08baabfdf
commit ecb8627433
4 changed files with 29 additions and 16 deletions

View file

@ -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

View file

@ -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,

View file

@ -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

View file

@ -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