@@ -22,6 +22,7 @@
2222--
2323module Network.Google.Types where
2424
25+import Control.Applicative
2526import Control.Exception.Lens (exception)
2627import Control.Lens hiding (coerce)
2728import Control.Monad
@@ -38,13 +39,9 @@ import qualified Data.Conduit.List as CL
3839import Data.Data
3940import Data.DList (DList)
4041import qualified Data.DList as DList
41−import Data.Foldable (foldMap, foldl')
42−import Data.List (intersperse)
43−import Data.Maybe
42+import Data.Foldable (foldl')
4443import Data.Monoid
45−import Data.Proxy
4644import Data.Text (Text)
47−import qualified Data.Text as Text
4845import qualified Data.Text.Encoding as Text
4946import Data.Text.Lazy.Builder (Builder)
5047import qualified Data.Text.Lazy.Builder as Build
@@ -55,38 +52,41 @@ import Network.HTTP.Media hiding (Accept)
5552import Network.HTTP.Types hiding (Header)
5653import qualified Network.HTTP.Types as HTTP
5754import Servant.API
58−import Servant.Utils.Links
5955
6056data AltJSON = AltJSON
61− deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)
57+ deriving (Eq, Ord, Show, Read, Generic, Typeable)
6258
6359instance ToText AltJSON where
6460 toText = const "json"
6561
6662data AltMedia = AltMedia
67− deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)
63+ deriving (Eq, Ord, Show, Read, Generic, Typeable)
6864
6965instance ToText AltMedia where
7066 toText = const "media"
7167
7268newtype AuthKey = AuthKey Text
73− deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, ToText)
69+ deriving (Eq, Ord, Show, Read, Generic, Typeable, ToText)
7470
7571newtype OAuthToken = OAuthToken Text
76− deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)
72+ deriving (Eq, Ord, Show, Read, Generic, Typeable)
7773
7874instance ToText OAuthToken where
79− toText (OAuthToken t) = "Bearer " <> t
75+ toText (OAuthToken t) = t
76+
77+newtype OAuthScope = OAuthScope Text
78+ deriving (Eq, Ord, Show, Read, Generic, Typeable, ToText)
79+
80+newtype Bearer a = Bearer a
81+
82+instance ToText a => ToText (Bearer a) where
83+ toText = mappend "Bearer " . toText
8084
8185newtype MediaDownload a = MediaDownload a
8286
8387_MediaDownload :: Iso' (MediaDownload a) a
8488_MediaDownload = iso (\(MediaDownload x) -> x) MediaDownload
8589
86−instance GoogleAuth a => GoogleAuth (MediaDownload a) where
87− _AuthKey = _MediaDownload . _AuthKey
88− _AuthToken = _MediaDownload . _AuthToken
89−
9090_Coerce :: (Coercible a b, Coercible b a) => Iso' a b
9191_Coerce = iso coerce coerce
9292
@@ -101,7 +101,7 @@ _Default = iso f Just
101101type Stream = ResumableSource (ResourceT IO) ByteString
102102
103103newtype ServiceId = ServiceId Text
104− deriving (Eq, Show, Data, Typeable)
104+ deriving (Eq, Show, Typeable)
105105
106106data Error
107107 = TransportError HttpException
@@ -168,6 +168,18 @@ data Service = Service
168168 , _svcPort :: !Int
169169 , _svcSecure :: !Bool
170170 , _svcTimeout :: !(Maybe Seconds)
171+ , _svcScopes :: ![OAuthScope]
172+ }
173+
174+defaultService :: ServiceId -> ByteString -> Builder -> Service
175+defaultService i h p = Service
176+ { _svcId = i
177+ , _svcHost = h
178+ , _svcPath = p
179+ , _svcPort = 443
180+ , _svcSecure = True
181+ , _svcTimeout = Just 70
182+ , _svcScopes = []
171183 }
172184
173185-- | An intermediary request builder.
@@ -178,6 +190,14 @@ data Request = Request
178190 , _rqBody :: Maybe (MediaType, RequestBody)
179191 }
180192
193+instance Monoid Request where
194+ mempty = Request mempty mempty mempty Nothing
195+ mappend a b = Request
196+ (_rqPath a <> "/" <> _rqPath b)
197+ (_rqQuery a <> _rqQuery b)
198+ (_rqHeaders a <> _rqHeaders b)
199+ (_rqBody b <|> _rqBody a)
200+
181201appendPath :: Request -> Builder -> Request
182202appendPath rq x = rq { _rqPath = _rqPath rq <> "/" <> x }
183203
@@ -256,11 +276,7 @@ instance FromStream OctetStream Stream where
256276instance FromJSON a => FromStream JSON a where
257277 fromStream Proxy = sinkLBS >=> pure . eitherDecode
258278
259−class GoogleAuth a where
260− _AuthKey :: Traversal' a AuthKey
261− _AuthToken :: Traversal' a OAuthToken
262−
263−class GoogleAuth a => GoogleRequest a where
279+class GoogleRequest a where
264280 type Rs a :: *
265281
266282 requestClient :: a -> Client (Rs a)