eff31f7 · typeable/servant

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

compare with master

unifiedsplit

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

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

40

41 clientWithRoute Proxy req host =

42− performRequest methodDelete req 204 host

42+ performRequestJSON methodDelete req 204 host

43

44instance HasDocs Delete where

45 docsFor Proxy (endpoint, action) =

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

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

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

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

41 clientWithRoute Proxy req host =

42− performRequest methodGet req 200 host

42+ performRequestJSON methodGet req 200 host

43

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

45 docsFor Proxy (endpoint, action) =

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

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

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

43

44 clientWithRoute Proxy req uri =

45− performRequest methodPost req 201 uri

45+ performRequestJSON methodPost req 201 uri

46

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

48 docsFor Proxy (endpoint, action) =

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

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

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

42

43 clientWithRoute Proxy req host =

44− performRequest methodPut req 200 host

44+ performRequestJSON methodPut req 200 host

45

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

47 docsFor Proxy (endpoint, action) =

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

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

1−{-# LANGUAGE TypeFamilies #-}

1+{-# LANGUAGE InstanceSigs #-}

2{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE TypeFamilies #-}

3module Servant.API.Raw where

4module Servant.API.Raw where

4

5

6+import Control.Monad.Trans.Either

7+import Data.ByteString.Lazy

5import Data.Proxy

8import Data.Proxy

9+import Network.HTTP.Types

6import Network.Wai

10import 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)

8import Servant.Server

15import Servant.Server

9

16

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

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

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

18 route Proxy rawApplication request respond =

25 route Proxy rawApplication request respond =

19 rawApplication request (respond . succeedWith)

26 rawApplication request (respond . succeedWith)

20

27

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+

21instance HasDocs Raw where

36instance HasDocs Raw where

22 docsFor _proxy (endpoint, action) =

37 docsFor _proxy (endpoint, action) =

23 single endpoint action

38 single endpoint action

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

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

77 result <- action manager

78 return (manager, result)

79

80−performRequest :: FromJSON result =>

80+

81+displayHttpRequest :: Method -> String

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

83+

84+

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

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

82−performRequest method req wantedStatus host = do

86+performRequest method req isWantedStatus host = do

83 partialRequest <- liftIO $ reqToRequest req host

87 partialRequest <- liftIO $ reqToRequest req host

84

88

85 let request = partialRequest { Client.method = method

89 let request = partialRequest { Client.method = method

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

90 Client.httpLbs request manager

94 Client.httpLbs request manager

91 case eResponse of

95 case eResponse of

92 Left status ->

96 Left status ->

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

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

94

98

95 Right response -> do

99 Right response -> do

96 let status = Client.responseStatus response

100 let status = Client.responseStatus response

97− when (statusCode status /= wantedStatus) $

101+ unless (isWantedStatus (statusCode status)) $

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

102+ left (displayHttpRequest method ++ " 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 $ Client.responseBody response

103− return result

104 where

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

106 showStatus (Status code message) =

105 showStatus (Status code message) =

107 show code ++ " - " ++ cs message

106 show code ++ " - " ++ cs message

108

107

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+

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

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

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

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

111 \ e -> case e of

121 \ e -> case e of

test/Servant/ClientSpec.hs+12−1

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

1{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE TypeOperators #-}

3{-# LANGUAGE GADTs #-}

2{-# LANGUAGE GADTs #-}

3+{-# LANGUAGE OverloadedStrings #-}

4+{-# LANGUAGE TypeOperators #-}

4{-# LANGUAGE ViewPatterns #-}

5{-# LANGUAGE ViewPatterns #-}

5

6

6module Servant.ClientSpec where

7module Servant.ClientSpec where

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

8import Control.Concurrent

9import Control.Concurrent

9import Control.Exception

10import Control.Exception

10import Control.Monad.Trans.Either

11import Control.Monad.Trans.Either

12+import Data.ByteString.Lazy (ByteString)

11import Data.Char

13import Data.Char

12import Data.Foldable (forM_)

14import Data.Foldable (forM_)

13import Data.Proxy

15import Data.Proxy

14import Data.Typeable

16import Data.Typeable

17+import Network.HTTP.Types

15import Network.Socket

18import Network.Socket

16import Network.Wai

19import Network.Wai

17import Network.Wai.Handler.Warp

20import Network.Wai.Handler.Warp

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

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

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

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

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

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

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

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

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

36 :<|> "multiple" :>

41 :<|> "multiple" :>

37 Capture "first" String :>

42 Capture "first" String :>

38 QueryParam "second" Int :>

43 QueryParam "second" Int :>

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

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

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

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

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

55 :<|> return

60 :<|> return

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

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

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

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

57 )

64 )

58

65

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

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

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

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

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

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

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

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

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

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

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

69 -> BaseUrl

78 -> BaseUrl

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

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

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

74 :<|> getQueryParam

83 :<|> getQueryParam

75 :<|> getQueryParams

84 :<|> getQueryParams

76 :<|> getQueryFlag

85 :<|> getQueryFlag

86+ :<|> getRawSuccess

87+ :<|> getRawFailure

77 :<|> getMultiple)

88 :<|> getMultiple)

78 = client api

89 = client api

79

90