6c8754e · gogol · git.iko.soy

git.iko.soy/gogol

Adding headers support to GoogleClient instances

commit6c8754ea2179d41926b6765b71158df8a06c5790 authorBrendan Hay <brendan.g.hay@gmail.com> dateSun 11 Oct 2015, 13:13 (11 years ago) parent8234724

5 files changed+38−6

compare with develop

unifiedsplit

core/gogol-core.cabal+1 core/src/Network/Google/Data/JSON.hs+6 core/src/Network/Google/Prelude.hs+1 core/src/Network/Google/Types.hs+29−5 gen/src/Gen/Syntax.hs+1−1

core/gogol-core.cabal+1

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

5959 , scientific >= 0.3

6060 , servant >= 0.4.4

6161 , text >= 1.1

62+ , unordered-containers

6263

6364 if !impl(ghc>=7.9)

6465 build-depends:

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

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

1212--

1313module Network.Google.Data.JSON

1414 ( JSONValue

15+ , parseJSONObject

1516 , parseJSONText

1617 , toJSONText

1718

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

3132

3233import Data.Aeson

3334import Data.Aeson.Types

35+import Data.HashMap.Strict (HashMap)

36+import Data.Text (Text)

3437import Servant.API

3538

3639type JSONValue = Value

3740

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

42+parseJSONObject = parseJSON . Object

43+

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

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

4046

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

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

1515 (^.), _Just)

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

1717import Data.Hashable as Export

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

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

1920import Data.Maybe as Export

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

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

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

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

5050import qualified Network.HTTP.Client as Client

5151import Network.HTTP.Media hiding (Accept)

52−import Network.HTTP.Types

53−import Servant.API hiding (Header)

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

53+import qualified Network.HTTP.Types as HTTP

54+import Servant.API

5455import Servant.Utils.Links

5556

5657data AltJSON = AltJSON

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

6667 toText = const "media"

6768

6869newtype AuthKey = AuthKey Text

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

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

7071

7172newtype 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

7377

7478class GoogleAuth a where

7579 _AuthKey :: Traversal' a AuthKey

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

118122 -- , _serializeMessage :: String

119123 } deriving (Eq, Show, Typeable)

120124

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

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

122126 -- _serviceAbbrev :: !Abbrev

123127 -- , _serviceStatus :: !Status

124128 -- , _serviceHeaders :: [Header]

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

166170 , _rqBasePath :: ByteString

167171 , _rqPath :: Builder

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

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

169174 , _rqBody :: Maybe (MediaType, Stream)

170175 }

171176

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

179184 , _rqBasePath = p

180185 , _rqPath = mempty

181186 , _rqQuery = mempty

187+ , _rqHeaders = mempty

182188 , _rqBody = Nothing

183189 }

184190

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

191197appendQuery :: RequestBuilder -> Text -> Maybe Text -> RequestBuilder

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

193199

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+

194204setStream :: RequestBuilder -> MediaType -> Stream -> RequestBuilder

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

196206

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

396406

397407 k = textSymbol (Proxy :: Proxy s)

398408

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+

399423instance ( ToStream c a

400424 , GoogleClient fn

401425 ) => 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]

263263 ]

264264

265265 decode (l, s)

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

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

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

268268 | required s = reqJS l

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