git.iko.soy/gogol
on develop help sign in
Renaming and adding placeholder notes
76c10c0Brendan Hay
gogol/src/Network/Google.hs+17−4
compare with develop
unifiedsplit
@@ -28,6 +28,9 @@
28-- application stack.
28-- application stack.
29module Network.Google
29module Network.Google
30 (
30 (
31+ -- * Usage
32+ -- $usage
33+
31 -- * Running Google Actions
34 -- * Running Google Actions
32 Google (..)
35 Google (..)
33 , MonadGoogle (..)
36 , MonadGoogle (..)
@@ -44,12 +47,14 @@ module Network.Google
44 , getApplicationDefault
47 , getApplicationDefault
45
48
46 -- ** Authorization
49 -- ** Authorization
50+ -- $auth
51+
47 , allow
52 , allow
48 , forbid
53 , forbid
49 , (!)
54 , (!)
50
55
56+ , AllowScopes
51 , type HasScope
57 , type HasScope
52− , type HasScope'
53
58
54 -- * Sending Requests
59 -- * Sending Requests
55 , send
60 , send
@@ -152,17 +157,17 @@ runGoogle :: (MonadResource m, HasEnv s r) => r -> Google s a -> m a
152runGoogle e m = liftResourceT $ runReaderT (unGoogle m) (e ^. environment)
157runGoogle e m = liftResourceT $ runReaderT (unGoogle m) (e ^. environment)
153
158
154-- | Monads in which 'Google' actions may be embedded.
159-- | Monads in which 'Google' actions may be embedded.
155−class ( Allow s
156− , Functor m
160+class ( Functor m
157 , Applicative m
161 , Applicative m
158 , Monad m
162 , Monad m
159 , MonadIO m
163 , MonadIO m
160 , MonadCatch m
164 , MonadCatch m
165+ , AllowScopes s
161 ) => MonadGoogle s m | m -> s where
166 ) => MonadGoogle s m | m -> s where
162 -- | Lift a computation to the 'Google' monad.
167 -- | Lift a computation to the 'Google' monad.
163 liftGoogle :: Google s a -> m a
168 liftGoogle :: Google s a -> m a
164
169
165−instance Allow s => MonadGoogle s (Google s) where
170+instance AllowScopes s => MonadGoogle s (Google s) where
166 liftGoogle = id
171 liftGoogle = id
167
172
168instance MonadBaseControl IO (Google s) where
173instance MonadBaseControl IO (Google s) where
@@ -243,6 +248,14 @@ upload x = send . MediaUpload x
243hoistError :: MonadThrow m => Either Error a -> m a
248hoistError :: MonadThrow m => Either Error a -> m a
244hoistError = either (throwingM _Error) return
249hoistError = either (throwingM _Error) return
245
250
251+{- $usage
252+Usage explanation and example placeholder.
253+-}
254+
255+{- $auth
256+Authorization explanation and example placeholder.
257+-}
258+
246{- $async
259{- $async
247Requests can be sent asynchronously, but due to guarantees about resource closure
260Requests can be sent asynchronously, but due to guarantees about resource closure
248require the use of <http://hackage.haskell.org/package/lifted-async lifted-async>.
261require the use of <http://hackage.haskell.org/package/lifted-async lifted-async>.
gogol/src/Network/Google/Auth/Scope.hs+5−4
@@ -65,6 +65,7 @@ type family HasScope (s :: [Symbol]) a :: Constraint where
65 HasScope s a = (s `HasScope'` Scopes a) ~ 'True
65 HasScope s a = (s `HasScope'` Scopes a) ~ 'True
66
66
67-- | Check if any of actual supplied scopes 's' exist in the required set 'a'.
67-- | Check if any of actual supplied scopes 's' exist in the required set 'a'.
68+-- If the required set 'a' is empty, then succeed.
68type family HasScope' s a where
69type family HasScope' s a where
69 HasScope' s '[] = 'True -- No scopes are required.
70 HasScope' s '[] = 'True -- No scopes are required.
70 HasScope' (x ': xs) a = x ∈ a || HasScope' xs a
71 HasScope' (x ': xs) a = x ∈ a || HasScope' xs a
@@ -80,19 +81,19 @@ type family (++) xs ys where
80 (++) '[] b = b
81 (++) '[] b = b
81 (++) (a ': as) bs = a ': (as ++ bs)
82 (++) (a ': as) bs = a ': (as ++ bs)
82
83
83−class Allow a where
84+class AllowScopes a where
84 -- | Obtain a list of supported 'OAuthScope' values from a proxy.
85 -- | Obtain a list of supported 'OAuthScope' values from a proxy.
85 allowScopes :: proxy a -> [OAuthScope]
86 allowScopes :: proxy a -> [OAuthScope]
86
87
87−instance Allow '[] where
88+instance AllowScopes '[] where
88 allowScopes _ = []
89 allowScopes _ = []
89
90
90−instance (KnownSymbol x, Allow xs) => Allow (x ': xs) where
91+instance (KnownSymbol x, AllowScopes xs) => AllowScopes (x ': xs) where
91 allowScopes _ = scope (Proxy :: Proxy x) : allowScopes (Proxy :: Proxy xs)
92 allowScopes _ = scope (Proxy :: Proxy x) : allowScopes (Proxy :: Proxy xs)
92 where
93 where
93 scope = OAuthScope . Text.pack . symbolVal
94 scope = OAuthScope . Text.pack . symbolVal
94
95
95−instance Allow s => Allow (Credentials s) where
96+instance AllowScopes s => AllowScopes (Credentials s) where
96 allowScopes _ = allowScopes (Proxy :: Proxy s)
97 allowScopes _ = allowScopes (Proxy :: Proxy s)
97
98
98concatScopes :: [OAuthScope] -> Text
99concatScopes :: [OAuthScope] -> Text
gogol/src/Network/Google/Env.hs+2−2
@@ -121,14 +121,14 @@ timeout s = local (override (serviceTimeout ?~ s))
121-- Lenses from 'HasEnv' can be used to further configure the resulting 'Env'.
121-- Lenses from 'HasEnv' can be used to further configure the resulting 'Env'.
122--
122--
123-- /See:/ 'newEnvWith', 'getApplicationDefault'.
123-- /See:/ 'newEnvWith', 'getApplicationDefault'.
124−newEnv :: (MonadIO m, MonadCatch m, Allow s) => m (Env s)
124+newEnv :: (MonadIO m, MonadCatch m, AllowScopes s) => m (Env s)
125newEnv = do
125newEnv = do
126 m <- liftIO (newManager tlsManagerSettings)
126 m <- liftIO (newManager tlsManagerSettings)
127 c <- getApplicationDefault m
127 c <- getApplicationDefault m
128 newEnvWith c (\_ _ -> pure ()) m
128 newEnvWith c (\_ _ -> pure ()) m
129
129
130-- /See:/ 'newEnv'.
130-- /See:/ 'newEnv'.
131−newEnvWith :: (MonadIO m, MonadCatch m, Allow s)
131+newEnvWith :: (MonadIO m, MonadCatch m, AllowScopes s)
132 => Credentials s
132 => Credentials s
133 -> Logger
133 -> Logger
134 -> Manager
134 -> Manager