on develop help sign in
Reordering significant parameters
commitf1cbd0dc1afc5ca054bd13166cbdfc3fa6745297 authorBrendan Hay <brendan.g.hay@gmail.com> dateThu 22 Oct 2015, 10:34 (11 years ago) parent9b63381
3 files changed+58−54
gogol/src/Network/Google/Auth.hs+30−27 gogol/src/Network/Google/Compute/Metadata.hs+27−26 gogol/src/Network/Google/Env.hs+1−1
gogol/src/Network/Google/Auth.hs+30−27
@@ -198,22 +198,22 @@ data Credentials
198198--
199199-- Throws 'AuthError' when environment variables or service account information
200200-- cannot be read, and credentials files are invalid or cannot be found.
201−getAuth :: (MonadIO m, MonadCatch m) => Manager -> Credentials -> m Auth
202−getAuth m = \case
201+getAuth :: (MonadIO m, MonadCatch m) => Credentials -> Manager -> m Auth
202+getAuth c m = case c of
203203 FromToken t -> pure (AuthToken t)
204− FromFile f -> fromFilePath m f
205− FromAccount s -> fromMetadata m s
204+ FromFile f -> fromFilePath f m
205+ FromAccount s -> fromMetadata s m
206206 Discover ->
207207 catching _MissingFileError (fromFile m) $ \f -> do
208208 p <- isGCE m
209209 unless p $
210210 throwingM _MissingFileError f
211− fromMetadata m "default"
211+ fromMetadata "default" m
212212
213213-- | Refresh a token from the local GCE metadata endpoint for the specified
214214-- 'ServiceId'.
215−fromMetadata :: (MonadIO m, MonadCatch m) => Manager -> ServiceId -> m Auth
216−fromMetadata m = refresh m >=> fmap AuthMeta . liftIO . newMVar
215+fromMetadata :: (MonadIO m, MonadCatch m) => ServiceId -> Manager -> m Auth
216+fromMetadata s = refresh s >=> fmap AuthMeta . liftIO . newMVar
217217
218218-- | Attempt to load either a @service_account@ or @authorized_user@ formatted
219219-- file to obtain the credentials neccessary to perform a token refresh.
@@ -221,22 +221,24 @@ fromFile :: (MonadIO m, MonadCatch m) => Manager -> m Auth
221221fromFile m = do
222222 f <- defaultCredentialsPath
223223 case f of
224− Just x -> fromFilePath m x
225− Nothing -> cloudSDKConfigPath >>= fromFilePath m
224+ Just x -> fromFilePath x m
225+ Nothing -> do
226+ x <- cloudSDKConfigPath
227+ fromFilePath x m
226228
227229-- | Attempt to load either a @service_account@ or @authorized_user@ formatted
228230-- file to obtain the credentials neccessary to perform a token refresh from
229231-- the specified file.
230−fromFilePath :: (MonadIO m, MonadCatch m) => Manager -> FilePath -> m Auth
231−fromFilePath m f = do
232+fromFilePath :: (MonadIO m, MonadCatch m) => FilePath -> Manager -> m Auth
233+fromFilePath f m = do
232234 p <- liftIO (doesFileExist f)
233235 unless p $
234236 throwM (MissingFileError f)
235237 e <- liftIO (LBS.readFile f) >>=
236238 either (throwM . InvalidFileError f) pure . parseLBS
237239 case e of
238− Left a -> refresh m a >>= fmap AuthSign . liftIO . newMVar
239− Right u -> refresh m u >>= fmap AuthUser . liftIO . newMVar
240+ Left a -> refresh a m >>= fmap AuthSign . liftIO . newMVar
241+ Right u -> refresh u m >>= fmap AuthUser . liftIO . newMVar
240242
241243-- | Lookup the @GOOGLE_APPLICATION_CREDENTIALS@ environment variable for the
242244-- default application credentials filepath.
@@ -324,7 +326,7 @@ refreshToken m r = do
324326 if yv
325327 then pure (y, _token y)
326328 else do
327− z <- refresh m (_details y)
329+ z <- refresh (_details y) m
328330 pure (z, _token z)
329331
330332-- {
@@ -398,17 +400,18 @@ instance FromJSON AuthorisedUser where
398400 <*> o .: "refresh_token"
399401
400402class Refresh a where
401− refresh :: (MonadIO m, MonadCatch m) => Manager -> a -> m (Expires a)
403+ refresh :: (MonadIO m, MonadCatch m) => a -> Manager -> m (Expires a)
402404
403405instance Refresh ServiceAccount where
404− refresh m s = do
406+ refresh s m = do
405407 b <- jwtEncode s
406− refreshRequest m s $ accountsRequest
407− { Client.requestBody = RequestBodyBS $
408− "grant_type=urn:ietf:params:oauth:grant-type:jwt-bearer"
409− <> "&assertion="
410− <> b
411− }
408+ let rq = accountsRequest
409+ { Client.requestBody = RequestBodyBS $
410+ "grant_type=urn:ietf:params:oauth:grant-type:jwt-bearer"
411+ <> "&assertion="
412+ <> b
413+ }
414+ refreshRequest s rq m
412415
413416jwtEncode :: (MonadIO m, MonadThrow m) => ServiceAccount -> m ByteString
414417jwtEncode s = liftIO $ do
@@ -443,7 +446,7 @@ jwtEncode s = liftIO $ do
443446 ]
444447
445448instance Refresh AuthorisedUser where
446− refresh m u@AuthorisedUser{..} = refreshRequest m u $
449+ refresh u@AuthorisedUser{..} = refreshRequest u $
447450 accountsRequest
448451 { Client.requestBody = RequestBodyBS . Text.encodeUtf8 $
449452 "grant_type=refresh_token"
@@ -453,7 +456,7 @@ instance Refresh AuthorisedUser where
453456 }
454457
455458instance Refresh ServiceId where
456− refresh m sid = refreshRequest m sid $
459+ refresh sid = refreshRequest sid $
457460 metadataRequest
458461 { Client.path = "instance/service-accounts/"
459462 <> Text.encodeUtf8 (serviceIdToText sid)
@@ -472,11 +475,11 @@ accountsRequest = def
472475 }
473476
474477refreshRequest :: (MonadIO m, MonadCatch m)
475− => Manager
476− -> a
478+ => a
477479 -> Client.Request
480+ -> Manager
478481 -> m (Expires a)
479−refreshRequest m r rq = do
482+refreshRequest r rq m = do
480483 rs <- liftIO (httpLbs rq m) `catch` (throwM . RetrievalError)
481484 let bs = responseBody rs
482485 s = responseStatus rs
gogol/src/Network/Google/Compute/Metadata.hs+27−26
@@ -105,16 +105,16 @@ isGCE m = liftIO $ do
105105 }
106106
107107-- | A directory of custom metadata values that have been set for this project.
108−getProjectAttribute :: MonadIO m => Manager -> Text -> m (Maybe LBS.ByteString)
109−getProjectAttribute m k =
110− metadataMaybe m ("project/attributes/" <> Text.encodeUtf8 k)
108+getProjectAttribute :: MonadIO m => Text -> Manager -> m (Maybe LBS.ByteString)
109+getProjectAttribute k =
110+ metadataMaybe ("project/attributes/" <> Text.encodeUtf8 k)
111111
112112-- | SSH keys that can connect to instances in the project. SSH keys for Compute
113113-- Engine use a specialized format where the keys are prepended with a username,
114114-- like so: @user1:ssh-rsa my-public-ssh-key user1@host.com@
115115getSSHKeys :: MonadIO m => Manager -> m [Text]
116116getSSHKeys m = do
117− mx <- metadataMaybe m "project/attributes/sshKeys"
117+ mx <- metadataMaybe "project/attributes/sshKeys" m
118118 case mx of
119119 Nothing -> pure []
120120 Just x -> pure
@@ -127,48 +127,48 @@ getSSHKeys m = do
127127-- the project-id metadata entry value. The project-id value is required for all
128128-- requests to the Compute Engine service.
129129getNumericProjectId :: MonadIO m => Manager -> m Text
130−getNumericProjectId m = metadataText m "project/numeric-project-id"
130+getNumericProjectId = metadataText "project/numeric-project-id"
131131
132132-- | The project ID.
133133getProjectId :: MonadIO m => Manager -> m Text
134−getProjectId m = metadataText m "project/project-id"
134+getProjectId = metadataText "project/project-id"
135135
136136-- | A directory of custom metadata values passed to the instance during startup
137137-- or shutdown.
138−getInstanceAttribute :: MonadIO m => Manager -> Text -> m (Maybe LBS.ByteString)
139−getInstanceAttribute m k =
140− metadataMaybe m ("instance/attributes/" <> Text.encodeUtf8 k)
138+getInstanceAttribute :: MonadIO m => Text -> Manager -> m (Maybe LBS.ByteString)
139+getInstanceAttribute k =
140+ metadataMaybe ("instance/attributes/" <> Text.encodeUtf8 k)
141141
142142-- | The free-text description of an instance, assigned using the
143143-- @--description@ flag, or set in the API.
144144getDescription :: MonadIO m => Manager -> m Text
145−getDescription m = metadataText m "instance/description"
145+getDescription = metadataText "instance/description"
146146
147147-- | The host name of the instance.
148148getHostname :: MonadIO m => Manager -> m Text
149−getHostname m = metadataText m "instance/hostname"
149+getHostname = metadataText "instance/hostname"
150150
151151-- | The ID of the instance. This is a unique, numerical ID that is generated by
152152-- Google Compute Engine. This is useful for identifying instances if you do not
153153-- want to use instance names.
154154getInstanceId :: MonadIO m => Manager -> m Text
155−getInstanceId m = metadataText m "instance/id"
155+getInstanceId = metadataText "instance/id"
156156
157157-- | The fully-qualified machine type name of the instance's host machine.
158158getMachineType :: MonadIO m => Manager -> m Text
159−getMachineType m = metadataText m "instance/machine-type"
159+getMachineType = metadataText "instance/machine-type"
160160
161161-- | Any tags associated with the instance.
162162getTags :: MonadIO m => Manager -> m [Text]
163163getTags m = do
164− rs <- metadata m "instance/tags" []
164+ rs <- metadata "instance/tags" [] m
165165 case eitherDecode' (responseBody rs) of
166166 Left _ -> pure []
167167 Right xs -> pure xs
168168
169169-- | The instance's zone.
170170getZone :: MonadIO m => Manager -> m Text
171−getZone m = metadataText m "instance/zone"
171+getZone = metadataText "instance/zone"
172172
173173-- -- | A directory of disks attached to this instance.
174174-- getDisk ::
@@ -212,28 +212,28 @@ getZone m = metadataText m "instance/zone"
212212-- curl "http://metadata.google.internal/computeMetadata/v1/instance/tags?wait_for_change=true"
213213
214214metadataMaybe :: MonadIO m
215− => Manager
216− -> ByteString
215+ => ByteString
216+ -> Manager
217217 -> m (Maybe LBS.ByteString)
218−metadataMaybe m path = do
219− rs <- metadata m path [404]
218+metadataMaybe path m = do
219+ rs <- metadata path [404] m
220220 if fromEnum (responseStatus rs) == 404
221221 then pure Nothing
222222 else pure $ Just (responseBody rs)
223223
224224metadataText :: MonadIO m
225− => Manager
226− -> ByteString
225+ => ByteString
226+ -> Manager
227227 -> m Text
228−metadataText m path = LText.toStrict . LText.decodeUtf8 . responseBody
229− <$> metadata m path []
228+metadataText path m = LText.toStrict . LText.decodeUtf8 . responseBody
229+ <$> metadata path [] m
230230
231231metadata :: MonadIO m
232− => Manager
233− -> ByteString
232+ => ByteString
234233 -> [Int]
234+ -> Manager
235235 -> m (Client.Response LBS.ByteString)
236−metadata m path ss =
236+metadata path ss m =
237237 liftIO . flip httpLbs m $ metadataRequest
238238 { Client.path = "/computeMetadata/v1/" <> path
239239 , Client.checkStatus = \s hs cj ->
@@ -242,3 +242,4 @@ metadata m path ss =
242242 then Nothing
243243 else Just . toException $ StatusCodeException s hs cj
244244 }
245+
gogol/src/Network/Google/Env.hs+1−1
@@ -105,4 +105,4 @@ newEnv c = liftIO (newManager tlsManagerSettings) >>= newEnvWith c
105105
106106-- | /See:/ 'newEnv'
107107newEnvWith :: (MonadIO m, MonadCatch m) => Credentials -> Manager -> m Env
108−newEnvWith c m = Env mempty m <$> getAuth m c
108+newEnvWith c m = Env mempty m <$> getAuth c m