eff31f7 · typeable/servant

git.iko.soy/typeable/servant

implemented 'instance HasClient Raw'

commiteff31f748514a122fe31c3be5b9a542f700d1b43 authorSönke Hahn <soenke.hahn@zalora.com> dateThu 13 Nov 2014, 19:57 (12 years ago) parent9ee7373

7 files changed+55−19

compare with master

unifiedsplit

src/Servant/API/Delete.hs+1−1 src/Servant/API/Get.hs+1−1 src/Servant/API/Post.hs+1−1 src/Servant/API/Put.hs+1−1 src/Servant/API/Raw.hs+17−2 src/Servant/Common/Req.hs+22−12 test/Servant/ClientSpec.hs+12−1

src/Servant/API/Delete.hs+1−1

@@ -39,7 +39,7 @@ instance HasClient Delete where

3939 type Client Delete = BaseUrl -> EitherT String IO ()

4040

4141 clientWithRoute Proxy req host =

42− performRequest methodDelete req 204 host

42+ performRequestJSON methodDelete req 204 host

4343

4444instance HasDocs Delete where

4545 docsFor Proxy (endpoint, action) =

src/Servant/API/Get.hs+1−1

@@ -39,7 +39,7 @@ instance ToJSON result => HasServer (Get result) where

3939instance FromJSON result => HasClient (Get result) where

4040 type Client (Get result) = BaseUrl -> EitherT String IO result

4141 clientWithRoute Proxy req host =

42− performRequest methodGet req 200 host

42+ performRequestJSON methodGet req 200 host

4343

4444instance ToSample a => HasDocs (Get a) where

4545 docsFor Proxy (endpoint, action) =

src/Servant/API/Post.hs+1−1

@@ -42,7 +42,7 @@ instance FromJSON a => HasClient (Post a) where

4242 type Client (Post a) = BaseUrl -> EitherT String IO a

4343

4444 clientWithRoute Proxy req uri =

45− performRequest methodPost req 201 uri

45+ performRequestJSON methodPost req 201 uri

4646

4747instance ToSample a => HasDocs (Post a) where

4848 docsFor Proxy (endpoint, action) =

src/Servant/API/Put.hs+1−1

@@ -41,7 +41,7 @@ instance FromJSON a => HasClient (Put a) where

4141 type Client (Put a) = BaseUrl -> EitherT String IO a

4242

4343 clientWithRoute Proxy req host =

44− performRequest methodPut req 200 host

44+ performRequestJSON methodPut req 200 host

4545

4646instance ToSample a => HasDocs (Put a) where

4747 docsFor Proxy (endpoint, action) =

src/Servant/API/Raw.hs+17−2

@@ -1,10 +1,17 @@

1−{-# LANGUAGE TypeFamilies #-}

1+{-# LANGUAGE InstanceSigs #-}

22{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE TypeFamilies #-}

34module Servant.API.Raw where

6+import Control.Monad.Trans.Either

7+import Data.ByteString.Lazy

58import Data.Proxy

9+import Network.HTTP.Types

610import Network.Wai

7−import Servant.Docs

11+import Servant.Client

12+import Servant.Common.BaseUrl

13+import Servant.Common.Req

14+import Servant.Docs hiding (Method)

815import Servant.Server

916

1017-- | Endpoint for plugging in your own Wai 'Application's.

@@ -18,6 +25,14 @@ instance HasServer Raw where

1825 route Proxy rawApplication request respond =

1926 rawApplication request (respond . succeedWith)

2027

28+instance HasClient Raw where

29+ type Client Raw = Method -> BaseUrl -> EitherT String IO ByteString

30+

31+ clientWithRoute :: Proxy Raw -> Req -> Client Raw

32+ clientWithRoute Proxy req method host =

33+ performRequest method req (const True) host

34+

35+

2136instance HasDocs Raw where

2237 docsFor _proxy (endpoint, action) =

2338 single endpoint action

src/Servant/Common/Req.hs+22−12

@@ -77,9 +77,13 @@ __withGlobalManager action = modifyMVar __manager $ \ manager -> do

7777 result <- action manager

7878 return (manager, result)

7979

80−performRequest :: FromJSON result =>

81− Method -> Req -> Int -> BaseUrl -> EitherT String IO result

82−performRequest method req wantedStatus host = do

80+

81+displayHttpRequest :: Method -> String

82+displayHttpRequest method = "HTTP " ++ cs method ++ " request"

83+

84+

85+performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO ByteString

86+performRequest method req isWantedStatus host = do

8387 partialRequest <- liftIO $ reqToRequest req host

8488

8589 let request = partialRequest { Client.method = method

@@ -90,22 +94,28 @@ performRequest method req wantedStatus host = do

9094 Client.httpLbs request manager

9195 case eResponse of

9296 Left status ->

93− left (requestString ++ " failed with status: " ++ showStatus status)

97+ left (displayHttpRequest method ++ " failed with status: " ++ showStatus status)

9498

9599 Right response -> do

96100 let status = Client.responseStatus response

97− when (statusCode status /= wantedStatus) $

98− left (requestString ++ " failed with status: " ++ showStatus status)

99− result <- either

100− (\ message -> left (requestString ++ " returned invalid json: " ++ message))

101− return

102− (decodeLenient (Client.responseBody response))

103− return result

101+ unless (isWantedStatus (statusCode status)) $

102+ left (displayHttpRequest method ++ " failed with status: " ++ showStatus status)

103+ return $ Client.responseBody response

104104 where

105− requestString = "HTTP " ++ cs method ++ " request"

106105 showStatus (Status code message) =

107106 show code ++ " - " ++ cs message

108107

108+

109+performRequestJSON :: FromJSON result =>

110+ Method -> Req -> Int -> BaseUrl -> EitherT String IO result

111+performRequestJSON method req wantedStatus host = do

112+ responseBody <- performRequest method req (== wantedStatus) host

113+ either

114+ (\ message -> left (displayHttpRequest method ++ " returned invalid json: " ++ message))

115+ return

116+ (decodeLenient responseBody)

117+

118+

109119catchStatusCodeException :: IO a -> IO (Either Status a)

110120catchStatusCodeException action = catch (Right <$> action) $

111121 \ e -> case e of

test/Servant/ClientSpec.hs+12−1

@@ -1,6 +1,7 @@

11{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE TypeOperators #-}

32{-# LANGUAGE GADTs #-}

3+{-# LANGUAGE OverloadedStrings #-}

4+{-# LANGUAGE TypeOperators #-}

45{-# LANGUAGE ViewPatterns #-}

67module Servant.ClientSpec where

@@ -8,10 +9,12 @@ module Servant.ClientSpec where

89import Control.Concurrent

910import Control.Exception

1011import Control.Monad.Trans.Either

12+import Data.ByteString.Lazy (ByteString)

1113import Data.Char

1214import Data.Foldable (forM_)

1315import Data.Proxy

1416import Data.Typeable

17+import Network.HTTP.Types

1518import Network.Socket

1619import Network.Wai

1720import Network.Wai.Handler.Warp

@@ -33,6 +36,8 @@ type Api =

3336 :<|> "param" :> QueryParam "name" String :> Get Person

3437 :<|> "params" :> QueryParams "names" String :> Get [Person]

3538 :<|> "flag" :> QueryFlag "flag" :> Get Bool

39+ :<|> "rawSuccess" :> Raw

40+ :<|> "rawFailure" :> Raw

3641 :<|> "multiple" :>

3742 Capture "first" String :>

3843 QueryParam "second" Int :>

@@ -53,6 +58,8 @@ server = serve api (

5358 Nothing -> left (400, "missing parameter"))

5459 :<|> (\ names -> return (zipWith Person names [0..]))

5560 :<|> return

61+ :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")

62+ :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")

5663 :<|> \ a b c d -> return (a, b, c, d)

5764 )

5865

@@ -65,6 +72,8 @@ getBody :: Person -> BaseUrl -> EitherT String IO Person

6572getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person

6673getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]

6774getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool

75+getRawSuccess :: Method -> BaseUrl -> EitherT String IO ByteString

76+getRawFailure :: Method -> BaseUrl -> EitherT String IO ByteString

6877getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]

6978 -> BaseUrl

7079 -> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])])

@@ -74,6 +83,8 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]

7483 :<|> getQueryParam

7584 :<|> getQueryParams

7685 :<|> getQueryFlag

86+ :<|> getRawSuccess

87+ :<|> getRawFailure

7788 :<|> getMultiple)

7889 = client api

7990