2ecc612 · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

add HasClient instance for Header

2ecc612Alp Mestanogullari12 years ago

src/Servant/Client.hs+43−6

compare with master

unifiedsplit

@@ -21,7 +21,7 @@ import Data.Proxy

21import Data.String.Conversions

22import Data.Text (unpack)

23import GHC.TypeLits

24−import Network.HTTP.Types

24+import qualified Network.HTTP.Types as H

25import Servant.API

26import Servant.Common.BaseUrl

27import Servant.Common.Req

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

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

109

110 clientWithRoute Proxy req host =

111− performRequestJSON methodDelete req 204 host

111+ performRequestJSON H.methodDelete req 204 host

112

113-- | If you have a 'Get' endpoint in your API, the client

114-- side querying function that is created when calling 'client'

@@ -117,7 +117,44 @@ instance HasClient Delete where

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

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

119 clientWithRoute Proxy req host =

120− performRequestJSON methodGet req 200 host

120+ performRequestJSON H.methodGet req 200 host

121+

122+-- | If you use a 'Header' in one of your endpoints in your API,

123+-- the corresponding querying function will automatically take

124+-- an additional argument of the type specified by your 'Header',

125+-- wrapped in Maybe.

126+--

127+-- That function will take care of encoding this argument as Text

128+-- in the request headers.

129+--

130+-- All you need is for your type to have a 'ToText' instance.

131+--

132+-- Example:

133+--

134+-- > newtype Referer = Referer Text

135+-- > deriving (Eq, Show, FromText, ToText)

136+-- >

137+-- > -- GET /view-my-referer

138+-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get Referer

139+-- >

140+-- > myApi :: Proxy MyApi

141+-- > myApi = Proxy

142+-- >

143+-- > viewReferer :: Maybe Referer -> BaseUrl -> EitherT String IO Book

144+-- > viewReferer = client myApi

145+-- > -- then you can just use "viewRefer" to query that endpoint

146+-- > -- specifying Nothing or Just "http://haskell.org/" as arguments

147+instance (KnownSymbol sym, ToText a, HasClient sublayout)

148+ => HasClient (Header sym a :> sublayout) where

149+

150+ type Client (Header sym a :> sublayout) =

151+ Maybe a -> Client sublayout

152+

153+ clientWithRoute Proxy req mval =

154+ clientWithRoute (Proxy :: Proxy sublayout) $

155+ maybe req (\value -> addHeader hname value req) mval

156+

157+ where hname = symbolVal (Proxy :: Proxy sym)

121

158

122-- | If you have a 'Post' endpoint in your API, the client

159-- | If you have a 'Post' endpoint in your API, the client

123-- side querying function that is created when calling 'client'

160-- side querying function that is created when calling 'client'

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

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

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

128

165

129 clientWithRoute Proxy req uri =

166 clientWithRoute Proxy req uri =

130− performRequestJSON methodPost req 201 uri

167+ performRequestJSON H.methodPost req 201 uri

131

168

132-- | If you have a 'Put' endpoint in your API, the client

169-- | If you have a 'Put' endpoint in your API, the client

133-- side querying function that is created when calling 'client'

170-- side querying function that is created when calling 'client'

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

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

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

138

175

139 clientWithRoute Proxy req host =

176 clientWithRoute Proxy req host =

140− performRequestJSON methodPut req 200 host

177+ performRequestJSON H.methodPut req 200 host

141

178

142-- | If you use a 'QueryParam' in one of your endpoints in your API,

179-- | If you use a 'QueryParam' in one of your endpoints in your API,

143-- the corresponding querying function will automatically take

180-- the corresponding querying function will automatically take

@@ -258,7 +295,7 @@ instance (KnownSymbol sym, HasClient sublayout)

258-- | Pick a 'Method' and specify where the server you want to query is. You get

295-- | Pick a 'Method' and specify where the server you want to query is. You get

259-- back the status code and the response body as a 'ByteString'.

296-- back the status code and the response body as a 'ByteString'.

260instance HasClient Raw where

297instance HasClient Raw where

261− type Client Raw = Method -> BaseUrl -> EitherT String IO (Int, ByteString)

298+ type Client Raw = H.Method -> BaseUrl -> EitherT String IO (Int, ByteString)

262

299

263 clientWithRoute :: Proxy Raw -> Req -> Client Raw

300 clientWithRoute :: Proxy Raw -> Req -> Client Raw

264 clientWithRoute Proxy req httpMethod host =

301 clientWithRoute Proxy req httpMethod host =

src/Servant/Common/Req.hs+17−3

@@ -13,13 +13,16 @@ import Data.Aeson

13import Data.Aeson.Parser

14import Data.Aeson.Types

15import Data.Attoparsec.ByteString

16−import Data.ByteString.Lazy

16+import Data.ByteString.Lazy hiding (pack)

17+import Data.String

17import Data.String.Conversions

18import Data.String.Conversions

18import Data.Text

19import Data.Text

20+import Data.Text.Encoding

19import Network.HTTP.Client

21import Network.HTTP.Client

20import Network.HTTP.Types

22import Network.HTTP.Types

21import Network.URI

23import Network.URI

22import Servant.Common.BaseUrl

24import Servant.Common.BaseUrl

25+import Servant.Common.Text

23import System.IO.Unsafe

26import System.IO.Unsafe

25import qualified Network.HTTP.Client as Client

28import qualified Network.HTTP.Client as Client

@@ -28,10 +31,11 @@ data Req = Req

28 { reqPath :: String

31 { reqPath :: String

29 , qs :: QueryText

32 , qs :: QueryText

30 , reqBody :: ByteString

33 , reqBody :: ByteString

34+ , headers :: [(String, Text)]

31 }

35 }

33defReq :: Req

37defReq :: Req

34−defReq = Req "" [] ""

38+defReq = Req "" [] "" []

36appendToPath :: String -> Req -> Req

40appendToPath :: String -> Req -> Req

37appendToPath p req =

41appendToPath p req =

@@ -45,11 +49,17 @@ appendToQueryString pname pvalue req =

45 req { qs = qs req ++ [(pname, pvalue)]

49 req { qs = qs req ++ [(pname, pvalue)]

46 }

50 }

52+addHeader :: ToText a => String -> a -> Req -> Req

53+addHeader name val req = req { headers = headers req

54+ ++ [(name, toText val)]

55+ }

56+

48setRQBody :: ByteString -> Req -> Req

57setRQBody :: ByteString -> Req -> Req

49setRQBody b req = req { reqBody = b }

58setRQBody b req = req { reqBody = b }

51reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request

60reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request

52−reqToRequest req (BaseUrl reqScheme reqHost reqPort) = fmap (setrqb . setQS ) $ parseUrl url

61+reqToRequest req (BaseUrl reqScheme reqHost reqPort) =

62+ fmap (setheaders . setrqb . setQS ) $ parseUrl url

54 where url = show $ nullURI { uriScheme = case reqScheme of

64 where url = show $ nullURI { uriScheme = case reqScheme of

55 Http -> "http:"

65 Http -> "http:"

@@ -64,6 +74,10 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort) = fmap (setrqb . setQS ) $

65 setrqb r = r { requestBody = RequestBodyLBS (reqBody req) }

75 setrqb r = r { requestBody = RequestBodyLBS (reqBody req) }

66 setQS = setQueryString $ queryTextToQuery (qs req)

76 setQS = setQueryString $ queryTextToQuery (qs req)

77+ setheaders r = r { requestHeaders = Prelude.map toProperHeader (headers req) }

78+

79+ toProperHeader (name, val) =

80+ (fromString name, encodeUtf8 val)

69-- * performing requests

83-- * performing requests