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

Fixes for ServantErr in servant-client

Browse source
This commit is contained in:
Julian K. Arni 2015-05-03 01:05:37 +02:00
parent 45f8c2c458
commit 1447221a16
3 changed files with 15 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
servant-client/src/Servant/Client.hs
View file

@ -37,8 +37,6 @@ import Network.HTTP.Media
import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types as H
import qualified Network.HTTP.Types.Header as HTTP import qualified Network.HTTP.Types.Header as HTTP
import Servant.API import Servant.API
import Servant.API.ResponseHeaders
import Servant.API.ContentTypes
import Servant.Common.BaseUrl import Servant.Common.BaseUrl
import Servant.Common.Req import Servant.Common.Req

13
servant-client/test/Servant/ClientSpec.hs
View file

@ -108,15 +108,14 @@ server = serve api (
:<|> return :<|> return
:<|> (\ name -> case name of :<|> (\ name -> case name of
Just "alice" -> return alice Just "alice" -> return alice
Just name -> left (400, name ++ " not found") Just name -> left $ ServantErr 400 (name ++ " not found") "" []
Nothing -> left $ ServantErr 400 "missing parameter" "" [])
Nothing -> left (400, "missing parameter"))
:<|> (\ names -> return (zipWith Person names [0..])) :<|> (\ names -> return (zipWith Person names [0..]))
:<|> return :<|> return
:<|> (\ name -> case name of :<|> (\ name -> case name of
Just "alice" -> return alice Just "alice" -> return alice
Just name -> left (400, name ++ " not found") Just name -> left $ ServantErr 400 (name ++ " not found") "" []
Nothing -> left (400, "missing parameter")) Nothing -> left $ ServantErr 400 "missing parameter" "" [])
:<|> (\ names -> return (zipWith Person names [0..])) :<|> (\ names -> return (zipWith Person names [0..]))
:<|> return :<|> return
:<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess") :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
@ -262,7 +261,7 @@ spec = do
let test :: (WrappedApi, String) -> Spec let test :: (WrappedApi, String) -> Spec
test (WrappedApi api, desc) = test (WrappedApi api, desc) =
it desc $ it desc $
withWaiDaemon (return (serve api (left (500, "error message")))) $ withWaiDaemon (return (serve api (left $ ServantErr 500 "error message" "" []))) $
\ host -> do \ host -> do
let getResponse :: BaseUrl -> EitherT ServantError IO () let getResponse :: BaseUrl -> EitherT ServantError IO ()
getResponse = client api getResponse = client api
@ -308,7 +307,7 @@ spec = do
_ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
data WrappedApi where data WrappedApi where
WrappedApi :: (HasServer (Canonicalize api), Server api ~ EitherT (Int, String) IO a, WrappedApi :: (HasServer (Canonicalize api), Server api ~ EitherT ServantErr IO a,
HasClient (Canonicalize api), Client api ~ (BaseUrl -> EitherT ServantError IO ())) => HasClient (Canonicalize api), Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>
Proxy api -> WrappedApi Proxy api -> WrappedApi

8
servant/src/Servant/API.hs
View file

@ -78,9 +78,11 @@ import Servant.API.QueryParam (QueryFlag, QueryParam,
QueryParams) QueryParams)
import Servant.API.Raw (Raw) import Servant.API.Raw (Raw)
import Servant.API.ReqBody (ReqBody) import Servant.API.ReqBody (ReqBody)
import Servant.API.ResponseHeaders (Headers, getHeaders, import Servant.API.ResponseHeaders (AddHeader (addHeader),
getHeadersHList, getResponse, BuildHeadersTo (buildHeadersTo),
buildHeadersTo, addHeader) GetHeaders (getHeaders),
HList (..), Headers (..),
getHeadersHList, getResponse)
import Servant.API.Sub ((:>)) import Servant.API.Sub ((:>))
import Servant.Common.Text (FromText (..), ToText (..)) import Servant.Common.Text (FromText (..), ToText (..))
import Servant.Utils.Links (HasLink (..), IsElem, IsElem', import Servant.Utils.Links (HasLink (..), IsElem, IsElem',