allow configuring N and M

User has to remember they did this and use the same configuration on
restore.

5 files changed, 41 insertions, 24 deletions

diff --git a/CmdLine.hs b/CmdLine.hs
index 910aa81..1c0abd2 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -3,9 +3,10 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-module CmdLine (CmdLine(..), Mode(..), get, parse, selectMode) where
+module CmdLine where
 
 import Types
+import Tunables
 import qualified Gpg
 import Options.Applicative
 import qualified Data.ByteString.UTF8 as BU8
@@ -20,6 +21,7 @@ data CmdLine = CmdLine
 	, storage :: Storage
 	, gui :: Bool
 	, testMode :: Bool
+	, customShardParams :: Maybe ShardParams
 	}
 
 data Mode = Backup | Restore | Benchmark
@@ -32,6 +34,7 @@ parse = CmdLine
 	<*> localstorageflag
 	<*> guiswitch
 	<*> testmodeswitch
+	<*> optional (ShardParams <$> totalobjects <*> neededobjects)
   where
 	backup = flag' Backup
 		( long "backup"
@@ -47,10 +50,12 @@ parse = CmdLine
 		)
 	gpgswitch = GpgKey . KeyId . BU8.fromString <$> strOption
 		( long "gpgkeyid"
+		<> metavar "KEYID"
 		<> help "Specify keyid of gpg key to back up or restore. (When this option is used to back up a key, it must also be used at restore time.)"
 		)
 	fileswitch = KeyFile <$> strOption
 		( long "keyfile"
+		<> metavar "FILE"
 		<> help "Specify secret key file to back up or restore. (The same filename must be used to restore a key as was used to back it up.)"
 		)
 	localstorageflag = flag networkStorage localStorage
@@ -65,6 +70,16 @@ parse = CmdLine
 		( long "gui"
 		<> help "Use GUI interface for interaction. Default is to use readline interface when run in a terminal, and GUI otherwise."
 		)
+	totalobjects = option auto 
+		( long "totalshards"
+		<> metavar "M"
+		<> help ("Configure the number of shards to split encrypted secret key into. Default: " ++ show (totalObjects (shardParams defaultTunables)) ++ " (When this option is used to back up a key, it must also be provided at restore time.)")
+		)
+	neededobjects = option auto 
+		( long "neededshards"
+		<> metavar "N"
+		<> help ("Configure the number of shards needed to restore. Default: " ++ show (neededObjects (shardParams defaultTunables)) ++ " (When this option is used to back up a key, it must also be provided at restore time.)")
+		)
 
 get :: IO CmdLine
 get = execParser opts
@@ -85,3 +100,8 @@ selectMode cmdline = case mode cmdline of
   where
 	present True = Backup
 	present False = Restore
+
+customizeShardParams :: CmdLine -> Tunables -> Tunables
+customizeShardParams cmdline t = case customShardParams cmdline of
+	Nothing -> t
+	Just ps -> t { shardParams = ps }
diff --git a/Shard.hs b/Shard.hs
index da09188..75db802 100644
--- a/Shard.hs
+++ b/Shard.hs
@@ -53,15 +53,15 @@ shardIdents tunables (Name name) keyid =
 		E.encodeUtf8 $ basename <> T.pack (show n)
 	mksha :: B.ByteString -> Raaz.Base16
 	mksha = Raaz.encode . Raaz.sha256
-	idents = map mk [1..totalObjects (head (shardParams tunables))]
+	idents = map mk [1..totalObjects (shardParams tunables)]
 	bruteforcecalc = bruteForceLinearSearch creationcost
 	hashtunables = nameGenerationHash $ nameGenerationTunable tunables
 
 genShards :: EncryptedSecretKey -> Tunables -> IO [Shard]
 genShards (EncryptedSecretKey esk _) tunables = do 
 	shares <- SS.encode
-		(neededObjects $ head $ shardParams tunables)
-		(totalObjects $ head $ shardParams tunables)
+		(neededObjects $ shardParams tunables)
+		(totalObjects $ shardParams tunables)
 		(BL.fromStrict esk)
 	return $ map (\(n, share) -> Shard n (StorableObject $ encodeShare share))
 		(zip [1..] shares)
@@ -70,14 +70,14 @@ combineShards :: Tunables -> [Shard] -> Either String EncryptedSecretKey
 combineShards tunables shards
 	| null shards =
 		Left "No shards could be downloaded. Perhaps you entered the wrong name or password?"
-	| length shards < minimum (map neededObjects (shardParams tunables)) = 
+	| length shards < neededObjects (shardParams tunables) = 
 		Left "Not enough are shards currently available to reconstruct your data."
 	| otherwise = Right $ mk $ SS.decode $ map decodeshard shards
   where
 	mk b = EncryptedSecretKey (BL.toStrict b) unknownCostCalc
 	decodeshard (Shard sharenum so) = decodeShare sharenum sharesneeded $
 		fromStorableObject so
-	sharesneeded = neededObjects $ head $ shardParams tunables
+	sharesneeded = neededObjects $ shardParams tunables
 
 -- | This efficient encoding relies on the share using a finite field of
 -- size 256, so it maps directly to bytes.
diff --git a/TODO b/TODO
index f0bd7f7..cb45e6a 100644
--- a/TODO
+++ b/TODO
@@ -2,3 +2,4 @@
 * prompt for name that is less obviously connected to user
 * tune hashes on more powerful hardware than thermal throttling laptop
 * store to servers
+* improve restore progress bar points (10m, 5m, 50m)
diff --git a/Tunables.hs b/Tunables.hs
index f4f74a4..2e8d43b 100644
--- a/Tunables.hs
+++ b/Tunables.hs
@@ -33,9 +33,7 @@ knownTunings = map (\t -> (nameGenerationHash (nameGenerationTunable t), t))
 -- So, every parameter that can be tuned is configured in this data
 -- structure.
 data Tunables = Tunables
-	{ shardParams :: [ShardParams]
-	-- ^ multiple ShardParams may be supported, with the user
-	-- allowed to choose between them
+	{ shardParams :: ShardParams
 	, objectSize :: Int
 	-- ^ a StorableObject is exactly this many bytes in size
 	-- (must be a multiple of AES block size 16)
@@ -82,7 +80,7 @@ data EncryptionTunable = UseAES256
 
 defaultTunables :: Tunables
 defaultTunables = Tunables
-	{ shardParams = [ShardParams { totalObjects = 3, neededObjects = 2 }]
+	{ shardParams = ShardParams { totalObjects = 3, neededObjects = 2 }
 	, objectSize = 1024*64 -- 64 kb
 	-- The nameGenerationHash was benchmarked at 661 seconds CPU time
 	-- on a 2 core Intel(R) Core(TM) i5-4210Y CPU @ 1.50GHz.
@@ -114,7 +112,7 @@ defaultTunables = Tunables
 -- Not for production use!
 testModeTunables :: Tunables
 testModeTunables = Tunables
-	{ shardParams = [ShardParams { totalObjects = 3, neededObjects = 2 }]
+	{ shardParams = ShardParams { totalObjects = 3, neededObjects = 2 }
 	, objectSize = 1024*64
 	, nameGenerationTunable = NameGenerationTunable
 		{ nameGenerationHash = weakargon2 (CPUCost (Seconds (2*600)))
diff --git a/keysafe.hs b/keysafe.hs
index 3551cb4..bb6d766 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -35,16 +35,17 @@ main :: IO ()
 main = do
 	cmdline <- CmdLine.get
 	ui <- selectUI (CmdLine.gui cmdline)
-	tunables <- if CmdLine.testMode cmdline
+	let mkt = CmdLine.customizeShardParams cmdline
+	(tunables, possibletunables) <- if CmdLine.testMode cmdline
 		then do
 			showInfo ui "Test mode"
 				"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
+			return (mkt testModeTunables, [mkt testModeTunables])
+		else return (mkt defaultTunables, map (mkt . snd) knownTunings)
+	dispatch cmdline ui tunables possibletunables
 
-dispatch :: CmdLine.CmdLine -> UI -> Tunables -> IO ()
-dispatch cmdline ui tunables = do
+dispatch :: CmdLine.CmdLine -> UI -> Tunables -> [Tunables] -> IO ()
+dispatch cmdline ui tunables possibletunables = do
 	mode <- CmdLine.selectMode cmdline
 	go mode (CmdLine.secretkeysource cmdline)
   where
@@ -53,12 +54,12 @@ dispatch cmdline ui tunables = do
 		backup storage ui tunables secretkeysource
 			=<< getSecretKey secretkeysource
 	go CmdLine.Restore (Just secretkeydest) =
-		restore storage ui (CmdLine.testMode cmdline) secretkeydest
+		restore storage ui possibletunables secretkeydest
 	go CmdLine.Backup Nothing =
 		backup storage ui tunables Gpg.anyKey
 			=<< Gpg.getKeyToBackup ui
 	go CmdLine.Restore Nothing =
-		restore storage ui (CmdLine.testMode cmdline) Gpg.anyKey
+		restore storage ui possibletunables Gpg.anyKey
 	go CmdLine.Benchmark _ =
 		benchmarkTunables tunables
 
@@ -143,8 +144,8 @@ backup storage ui tunables secretkeysource secretkey = do
 		, "Please wait..."
 		]
 
-restore :: Storage -> UI -> Bool -> SecretKeySource -> IO ()
-restore storage ui testmode secretkeydest = do
+restore :: Storage -> UI -> [Tunables] -> SecretKeySource -> IO ()
+restore storage ui possibletunables secretkeydest = do
 	username <- userName
 	name <- fromMaybe (error "Aborting on no name") 
 		<$> promptName ui "Enter name"
@@ -169,9 +170,6 @@ restore storage ui testmode secretkeydest = do
 						writeSecretKey secretkeydest secretkey
 						showInfo ui "Success" "Your secret key successfully restored!"
   where
-	possibletunables
-		| testmode = [testModeTunables]
-		| otherwise = map snd knownTunings
 	namedesc = unlines
 		[ "When you backed up your secret key, you entered a name and a password."
 		, "Now it's time to remember what you entered back then."