Wow, triple monadic lift!
This commit is contained in:
Joey Hess 2012-02-07 01:40:14 -04:00
parent 0ad5d8168f
commit b9b72d22a9

View file

@ -272,26 +272,29 @@ s3Connection c = do
{- S3 creds come from the environment if set. {- S3 creds come from the environment if set.
- Otherwise, might be stored encrypted in the remote's config. -} - Otherwise, might be stored encrypted in the remote's config. -}
s3GetCreds :: RemoteConfig -> Annex (Maybe (String, String)) s3GetCreds :: RemoteConfig -> Annex (Maybe (String, String))
s3GetCreds c = do s3GetCreds c = maybe fromconfig (return . Just) =<< liftIO getenv
ak <- getEnvKey s3AccessKey where
sk <- getEnvKey s3SecretKey getenv = liftM2 (,)
if null ak || null sk <$> get s3AccessKey
then do <*> get s3SecretKey
mcipher <- remoteCipher c where
case (M.lookup "s3creds" c, mcipher) of get = catchMaybeIO . getEnv
(Just encrypted, Just cipher) -> do setenv (ak, sk) = 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 s3AccessKey ak True
setEnv s3SecretKey sk True setEnv s3SecretKey sk True
return $ Just (ak', sk') fromconfig = do
mcipher <- remoteCipher c
case (M.lookup "s3creds" c, mcipher) of
(Just s3creds, Just cipher) ->
liftIO $ decrypt s3creds cipher
_ -> return Nothing _ -> return Nothing
else return $ Just (ak, sk) decrypt s3creds cipher = do
where [ak, sk, _rest] <- lines <$>
getEnvKey s = liftIO $ catchDefaultIO (getEnv s) "" 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. -} {- Stores S3 creds encrypted in the remote's config if possible. -}
s3SetCreds :: RemoteConfig -> Annex RemoteConfig s3SetCreds :: RemoteConfig -> Annex RemoteConfig