refactor
Wow, triple monadic lift!
This commit is contained in:
parent
0ad5d8168f
commit
b9b72d22a9
1 changed files with 20 additions and 17 deletions
37
Remote/S3.hs
37
Remote/S3.hs
|
@ -272,26 +272,29 @@ s3Connection c = do
|
|||
{- S3 creds come from the environment if set.
|
||||
- Otherwise, might be stored encrypted in the remote's config. -}
|
||||
s3GetCreds :: RemoteConfig -> Annex (Maybe (String, String))
|
||||
s3GetCreds c = do
|
||||
ak <- getEnvKey s3AccessKey
|
||||
sk <- getEnvKey s3SecretKey
|
||||
if null ak || null sk
|
||||
then do
|
||||
s3GetCreds c = maybe fromconfig (return . Just) =<< liftIO getenv
|
||||
where
|
||||
getenv = liftM2 (,)
|
||||
<$> get s3AccessKey
|
||||
<*> get s3SecretKey
|
||||
where
|
||||
get = catchMaybeIO . getEnv
|
||||
setenv (ak, sk) = do
|
||||
setEnv s3AccessKey ak True
|
||||
setEnv s3SecretKey sk True
|
||||
fromconfig = do
|
||||
mcipher <- remoteCipher c
|
||||
case (M.lookup "s3creds" c, mcipher) of
|
||||
(Just encrypted, Just cipher) -> do
|
||||
s <- liftIO $ withDecryptedContent cipher
|
||||
(return $ L.pack $ fromB64 encrypted)
|
||||
(return . L.unpack)
|
||||
let [ak', sk', _rest] = lines s
|
||||
liftIO $ do
|
||||
setEnv s3AccessKey ak True
|
||||
setEnv s3SecretKey sk True
|
||||
return $ Just (ak', sk')
|
||||
(Just s3creds, Just cipher) ->
|
||||
liftIO $ decrypt s3creds cipher
|
||||
_ -> return Nothing
|
||||
else return $ Just (ak, sk)
|
||||
where
|
||||
getEnvKey s = liftIO $ catchDefaultIO (getEnv s) ""
|
||||
decrypt s3creds cipher = do
|
||||
[ak, sk, _rest] <- lines <$>
|
||||
withDecryptedContent cipher
|
||||
(return $ L.pack $ fromB64 s3creds)
|
||||
(return . L.unpack)
|
||||
setenv (ak, sk)
|
||||
return $ Just (ak, sk)
|
||||
|
||||
{- Stores S3 creds encrypted in the remote's config if possible. -}
|
||||
s3SetCreds :: RemoteConfig -> Annex RemoteConfig
|
||||
|
|
Loading…
Add table
Reference in a new issue