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

fix servant-client tests

Browse source
This commit is contained in:
Alp Mestanogullari 2015-07-31 14:22:52 +02:00 committed by Brandon Martin
parent 8cded479d8
commit 7a6f7dad5a
2 changed files with 9 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -31,7 +31,7 @@ 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.Socket hiding (Raw)
import Network.Wai hiding (Response)
import Network.Wai.Handler.Warp
import Test.Hspec
@ -115,8 +115,8 @@ server = serve api (
Nothing -> throwE $ ServantErr 400 "missing parameter" "" [])
:<|> (\ names -> return (zipWith Person names [0..]))
:<|> return
:<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
:<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
:<|> Raw (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
:<|> Raw (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
:<|> (\ a b c d -> return (a, b, c, d))
:<|> (return $ addHeader 1729 $ addHeader "eg2" True)
:<|> return ()
@ -134,9 +134,9 @@ failApi = Proxy
failServer :: Application
failServer = serve failApi (
(\ _request respond -> respond $ responseLBS ok200 [] "")
:<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
:<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
Raw (\ _request respond -> respond $ responseLBS ok200 [] "")
:<|> (\ _capture -> Raw (\ _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] ""))
:<|> Raw (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
)
withFailServer :: (BaseUrl -> IO a) -> IO a

3
servant-server/src/Servant/Server/Internal.hs
View file

@ -674,6 +674,9 @@ instance (KnownSymbol sym, HasServer sublayout)
class ToRawApplication a where
toRawApplication :: a -> Application
instance ToRawApplication Application where
toRawApplication = id
instance ToRawApplication a => HasServer (Raw m a) where
type ServerT (Raw m a) n = Raw n a