make storage to use configurable on command line

1 files changed, 28 insertions, 38 deletions

diff --git a/keysafe.hs b/keysafe.hs
index fedc4c7..c88668e 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -17,7 +17,6 @@ import ExpensiveHash
 import Cost
 import Shard
 import Storage
-import Storage.LocalFiles
 import qualified Gpg
 import Data.Maybe
 import Data.Time.Clock
@@ -41,25 +40,30 @@ main = do
 				"Keysafe is running in test mode. This is not secure, and should not be used with real secret keys!"
 			return testModeTunables
 		else return defaultTunables
+	dispatch cmdline ui tunables
+
+dispatch :: CmdLine.CmdLine -> UI -> Tunables -> IO ()
+dispatch cmdline ui tunables = do
 	mode <- CmdLine.selectMode cmdline
-	go mode (CmdLine.secretkeysource cmdline) tunables ui
+	go mode (CmdLine.secretkeysource cmdline)
   where
-	go CmdLine.Backup (Just secretkeysource@(GpgKey kid)) tunables ui = do
+	storage = CmdLine.storage cmdline
+	go CmdLine.Backup (Just secretkeysource@(GpgKey kid)) = do
 		ok <- Gpg.knownByKeyServer kid
 		unless ok $
 			showError ui "Your gpg public key has to be stored on the keyservers before you can back it up by keyid. Either use gpg --send-key to store the public key on the keyservers, or omit the --gpgkeyid option"
-		backup ui tunables secretkeysource
+		backup storage ui tunables secretkeysource
 			=<< getSecretKey secretkeysource
-	go CmdLine.Backup (Just secretkeysource) tunables ui =
-		backup ui tunables secretkeysource
+	go CmdLine.Backup (Just secretkeysource) =
+		backup storage ui tunables secretkeysource
 			=<< getSecretKey secretkeysource
-	go CmdLine.Backup Nothing tunables ui =
-		backup ui tunables anyGpgKey =<< pickGpgKeyToBackup ui
-	go CmdLine.Restore (Just secretkeydest) _ ui =
-		restore ui secretkeydest
-	go CmdLine.Restore Nothing _ ui =
-		restore ui anyGpgKey
-	go CmdLine.Benchmark _ tunables _ =
+	go CmdLine.Backup Nothing =
+		backup storage ui tunables anyGpgKey =<< pickGpgKeyToBackup ui
+	go CmdLine.Restore (Just secretkeydest) =
+		restore storage ui secretkeydest
+	go CmdLine.Restore Nothing =
+		restore storage ui anyGpgKey
+	go CmdLine.Benchmark _ =
 		benchmarkTunables tunables
 
 getSecretKey :: SecretKeySource -> IO SecretKey
@@ -85,8 +89,8 @@ pickGpgKeyToBackup ui = go =<< Gpg.listSecretKeys
 anyGpgKey :: SecretKeySource
 anyGpgKey = GpgKey (KeyId "")
 
-backup :: UI -> Tunables -> SecretKeySource -> SecretKey -> IO ()
-backup ui tunables secretkeysource secretkey = do
+backup :: Storage -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO ()
+backup storage ui tunables secretkeysource secretkey = do
 	username <- userName
 	name <- fromMaybe (error "Aborting on no name") 
 		<$> promptName ui "Enter name"
@@ -102,7 +106,7 @@ backup ui tunables secretkeysource secretkey = do
 			_ <- sis `deepseq` setpercent 50
 			let step = 50 `div` length shards
 			let percentsteps = map setpercent [50+step, 50+step*2..100]
-			storeShards sis (zip percentsteps shards)
+			storeShards storage sis (zip percentsteps shards)
 	case r of
 		StoreSuccess -> showInfo ui "Success" "Your secret key successfully encrypted and backed up."
 		StoreFailure s -> showError ui ("There was a problem storing your encrypted secret key: " ++ s)
@@ -111,7 +115,7 @@ backup ui tunables secretkeysource secretkey = do
 				[ "Another secret key is already being stored under the name you entered."
 				, "Please try again with a different name."
 				]
-			backup ui tunables secretkeysource secretkey
+			backup storage ui tunables secretkeysource secretkey
   where
 	promptkek name = do
 		password <- fromMaybe (error "Aborting on no password") 
@@ -166,8 +170,8 @@ backup ui tunables secretkeysource secretkey = do
 		, "Please wait..."
 		]
 
-restore :: UI -> SecretKeySource -> IO ()
-restore ui secretkeydest = do
+restore :: Storage -> UI -> SecretKeySource -> IO ()
+restore storage ui secretkeydest = do
 	username <- userName
 	name <- fromMaybe (error "Aborting on no name") 
 		<$> promptName ui "Enter name"
@@ -176,7 +180,7 @@ restore ui secretkeydest = do
 		<$> promptPassword ui True "Enter password" passworddesc
 	
 	let sis = shardIdents tunables name secretkeydest
-	shards <- catMaybes <$> downloadShards ui sis
+	shards <- catMaybes <$> downloadShards storage ui sis
 	let candidatekeys = candidateKeyEncryptionKeys tunables name password
 	let cost = getCreationCost candidatekeys 
 		<> castCost (getDecryptionCost candidatekeys)
@@ -212,22 +216,8 @@ restore ui secretkeydest = do
 		, "Please wait..."
 		]
 
-storeShards :: ShardIdents -> [(IO (), Shard)] -> IO StoreResult
-storeShards sis shards = do
-	r <- go (zip (getIdents sis) shards)
-	_ <- obscureShards localFiles
-	return r
-  where
-	go [] = return StoreSuccess
-	go ((i,(showprogress, s)):rest) = do
-		r <- storeShard localFiles i s
-		_ <- showprogress
-		case r of
-			StoreSuccess -> go rest
-			_ -> return r
-
-downloadShards :: UI -> ShardIdents -> IO [Maybe Shard]
-downloadShards ui sis = bracket_ (return ()) cleanup
+downloadShards :: Storage -> UI -> ShardIdents -> IO [Maybe Shard]
+downloadShards storage ui sis = bracket_ (return ()) cleanup
 	(withProgress ui "Downloading encrypted data" message go)
   where
 	go setpercent = do
@@ -239,7 +229,7 @@ downloadShards ui sis = bracket_ (return ()) cleanup
 		let percentsteps = [50+step, 50+step*2..100]
 
 		forM (zip percentsteps l) $ \(pct, (n, i)) -> do
-			r <- retrieveShard localFiles n i
+			r <- retrieveShard storage n i
 			_ <- setpercent pct
 			case r of
 				RetrieveSuccess s -> do
@@ -248,7 +238,7 @@ downloadShards ui sis = bracket_ (return ()) cleanup
 					hPutStrLn stderr $
 						"warning: retrieval of shard " ++ show n ++ " failed: " ++ f
 					return Nothing
-	cleanup = obscureShards localFiles
+	cleanup = obscureShards storage
 	message = unlines
 		[ "This will probably take around "
 			++ showCostMinutes (getCreationCost sis)