From b9b72d22a9036fddbb34f70b85136f00cfe94b10 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 7 Feb 2012 01:40:14 -0400
Subject: refactor

Wow, triple monadic lift!
---
 Remote/S3.hs | 37 ++++++++++++++++++++-----------------
 1 file changed, 20 insertions(+), 17 deletions(-)

diff --git a/Remote/S3.hs b/Remote/S3.hs
index 1d23b7d6f..2ef96dbda 100644
--- a/Remote/S3.hs
+++ b/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
-- 
cgit v1.2.3