6c8754e · gogol · git.iko.soy

git.iko.soy/gogol

on develop help sign in

Adding headers support to GoogleClient instances

6c8754eBrendan Hay11 years ago

core/gogol-core.cabal+1

compare with develop

unifiedsplit

@@ -59,6 +59,7 @@ library

59 , scientific >= 0.3

60 , servant >= 0.4.4

61 , text >= 1.1

62+ , unordered-containers

63 if !impl(ghc>=7.9)

64 if !impl(ghc>=7.9)

64 build-depends:

65 build-depends:

core/src/Network/Google/Data/JSON.hs+6

@@ -12,6 +12,7 @@

12--

13module Network.Google.Data.JSON

14 ( JSONValue

15+ , parseJSONObject

15 , parseJSONText

16 , parseJSONText

16 , toJSONText

17 , toJSONText

@@ -31,10 +32,15 @@ module Network.Google.Data.JSON

32import Data.Aeson

33import Data.Aeson

33import Data.Aeson.Types

34import Data.Aeson.Types

35+import Data.HashMap.Strict (HashMap)

36+import Data.Text (Text)

34import Servant.API

37import Servant.API

36type JSONValue = Value

39type JSONValue = Value

41+parseJSONObject :: FromJSON a => HashMap Text Value -> Parser a

42+parseJSONObject = parseJSON . Object

43+

38parseJSONText :: FromText a => String -> Value -> Parser a

44parseJSONText :: FromText a => String -> Value -> Parser a

39parseJSONText n = withText n (maybe (fail n) pure . fromText)

45parseJSONText n = withText n (maybe (fail n) pure . fromText)

core/src/Network/Google/Prelude.hs+1

@@ -15,6 +15,7 @@ import Control.Lens as Export (Lens', lens, mapping,

15 (^.), _Just)

16import Data.Data as Export (Data, Typeable)

17import Data.Hashable as Export

18+import Data.HashMap.Strict as Export (HashMap)

18import Data.Int as Export (Int32, Int64)

19import Data.Int as Export (Int32, Int64)

19import Data.Maybe as Export

20import Data.Maybe as Export

20import Data.Monoid as Export (mempty, (<>))

21import Data.Monoid as Export (mempty, (<>))

core/src/Network/Google/Types.hs+29−5

@@ -49,8 +49,9 @@ import GHC.TypeLits

49import Network.HTTP.Client (HttpException, RequestBody (..))

50import qualified Network.HTTP.Client as Client

51import Network.HTTP.Media hiding (Accept)

52−import Network.HTTP.Types

52+import Network.HTTP.Types hiding (Header)

53−import Servant.API hiding (Header)

53+import qualified Network.HTTP.Types as HTTP

54+import Servant.API

54import Servant.Utils.Links

55import Servant.Utils.Links

56data AltJSON = AltJSON

57data AltJSON = AltJSON

@@ -66,10 +67,13 @@ instance ToText AltMedia where

66 toText = const "media"

67 toText = const "media"

68newtype AuthKey = AuthKey Text

69newtype AuthKey = AuthKey Text

69− deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, ToText, FromText)

70+ deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, ToText)

71newtype OAuthToken = OAuthToken Text

72newtype OAuthToken = OAuthToken Text

72− deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, ToText, FromText)

73+ deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)

74+

75+instance ToText OAuthToken where

76+ toText (OAuthToken t) = "Bearer " <> t

74class GoogleAuth a where

78class GoogleAuth a where

75 _AuthKey :: Traversal' a AuthKey

79 _AuthKey :: Traversal' a AuthKey

@@ -118,7 +122,7 @@ data SerializeError = SerializeError'

118 -- , _serializeMessage :: String

122 -- , _serializeMessage :: String

119 } deriving (Eq, Show, Typeable)

123 } deriving (Eq, Show, Typeable)

120

124

121−data ServiceError = ServiceError' !Status !MediaType [Header] LBS.ByteString

125+data ServiceError = ServiceError' !Status !MediaType [HTTP.Header] LBS.ByteString

122 -- _serviceAbbrev :: !Abbrev

126 -- _serviceAbbrev :: !Abbrev

123 -- , _serviceStatus :: !Status

127 -- , _serviceStatus :: !Status

124 -- , _serviceHeaders :: [Header]

128 -- , _serviceHeaders :: [Header]

@@ -166,6 +170,7 @@ data RequestBuilder = RequestBuilder

166 , _rqBasePath :: ByteString

170 , _rqBasePath :: ByteString

167 , _rqPath :: Builder

171 , _rqPath :: Builder

168 , _rqQuery :: DList (Text, Maybe Text)

172 , _rqQuery :: DList (Text, Maybe Text)

173+ , _rqHeaders :: DList (Text, Text)

169 , _rqBody :: Maybe (MediaType, Stream)

174 , _rqBody :: Maybe (MediaType, Stream)

170 }

175 }

171

176

@@ -179,6 +184,7 @@ defaultRequest h p = RequestBuilder

179 , _rqBasePath = p

184 , _rqBasePath = p

180 , _rqPath = mempty

185 , _rqPath = mempty

181 , _rqQuery = mempty

186 , _rqQuery = mempty

187+ , _rqHeaders = mempty

182 , _rqBody = Nothing

188 , _rqBody = Nothing

183 }

189 }

184

190

@@ -191,6 +197,10 @@ appendPaths rq = appendPath rq . foldMap (mappend "/" . buildText)

191appendQuery :: RequestBuilder -> Text -> Maybe Text -> RequestBuilder

197appendQuery :: RequestBuilder -> Text -> Maybe Text -> RequestBuilder

192appendQuery rq k v = rq { _rqQuery = DList.snoc (_rqQuery rq) (k, v) }

198appendQuery rq k v = rq { _rqQuery = DList.snoc (_rqQuery rq) (k, v) }

193

199

200+appendHeader :: RequestBuilder -> Text -> Maybe Text -> RequestBuilder

201+appendHeader rq _ Nothing = rq

202+appendHeader rq k (Just v) = rq { _rqHeaders = DList.snoc (_rqHeaders rq) (k, v) }

203+

194setStream :: RequestBuilder -> MediaType -> Stream -> RequestBuilder

204setStream :: RequestBuilder -> MediaType -> Stream -> RequestBuilder

195setStream rq c x = rq { _rqBody = Just (c, x) }

205setStream rq c x = rq { _rqBody = Just (c, x) }

196

206

@@ -396,6 +406,20 @@ instance ( KnownSymbol s

396

406

397 k = textSymbol (Proxy :: Proxy s)

407 k = textSymbol (Proxy :: Proxy s)

398

408

409+instance ( KnownSymbol s

410+ , ToText a

411+ , GoogleClient fn

412+ ) => GoogleClient (Header s a :> fn) where

413+ type Fn (Header s a :> fn) = Maybe a -> Fn fn

414+

415+ clientBuild Proxy rq mx = clientBuild (Proxy :: Proxy fn) $

416+ case mx of

417+ Nothing -> rq

418+ Just x -> appendHeader rq k v

419+ where

420+ k = textSymbol (Proxy :: Proxy s)

421+ v = Just (toText x)

422+

399instance ( ToStream c a

423instance ( ToStream c a

400 , GoogleClient fn

424 , GoogleClient fn

401 ) => GoogleClient (ReqBody (c ': cs) a :> fn) where

425 ) => GoogleClient (ReqBody (c ': cs) a :> fn) where

gen/src/Gen/Syntax.hs+1−1

@@ -263,7 +263,7 @@ jsonDecls g p (Map.toList -> rs) = [from, to]

263 ]

264

265 decode (l, s)

266− | _additional s = app (var "parseJSON") (app (var "Object") (var "o"))

266+ | _additional s = app (var "parseJSONObject") (var "o")

267 | Just x <- def s = defJS l x

268 | required s = reqJS l

269 | monoid s = defJS l (var "mempty")