From c2eba63d11c748aeebdd3a4a3a5b015ac5e2f2c9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 16 Aug 2016 16:59:25 -0400 Subject: add cost estimates --- Cost.hs | 34 +++++++++++++++++++++++++++++++--- Types/Cost.hs | 4 ++-- Types/UI.hs | 3 ++- UI/Readline.hs | 7 ++++--- UI/Zenity.hs | 6 +++--- keysafe.hs | 31 +++++++++++++++++++++++-------- 6 files changed, 65 insertions(+), 20 deletions(-) diff --git a/Cost.hs b/Cost.hs index 31f00a3..5aa349c 100644 --- a/Cost.hs +++ b/Cost.hs @@ -56,8 +56,8 @@ spotAWS = DataCenterPrice -- which is unlikely to be the case; typically there will be many more -- cores than GPUs. So, this underestimates the price to brute force -- operations which run faster on GPUs. -estimateAttack :: DataCenterPrice -> Cost BruteForceOp -> Dollars -estimateAttack dc opcost = centsToDollars $ costcents +estimateAttackCost :: DataCenterPrice -> Cost BruteForceOp -> Dollars +estimateAttackCost dc opcost = centsToDollars $ costcents where (Seconds cpuseconds) = fst (totalCost opcost) cpuyears = cpuseconds `div` (60*60*24*365) @@ -70,7 +70,35 @@ newtype Cents = Cents Integer deriving (Num, Integral, Enum, Real, Ord, Eq, Show) newtype Dollars = Dollars Integer - deriving (Num, Integral, Enum, Real, Ord, Eq, Show) + deriving (Num, Integral, Enum, Real, Ord, Eq) + +instance Show Dollars where + show (Dollars n) = go + [ (1000000000000, "trillion") + , (1000000000, "billion") + , (1000000, "million") + , (1000, "thousand") + ] + where + go [] = "$" ++ show n + go ((d, u):us) + | n >= d = + let n' = n `div` d + in "$" ++ show n' ++ " " ++ u + | otherwise = go us centsToDollars :: Cents -> Dollars centsToDollars (Cents c) = Dollars (c `div` 100) + +type Year = Integer + +-- | Apply Moore's law to show how a cost might vary over time. +costOverTime :: Dollars -> Year -> [(Dollars, Year)] +costOverTime (Dollars currcost) thisyear = + (Dollars currcost, thisyear) : map calc otheryears + where + otheryears = [thisyear+1, thisyear+5, thisyear+10] + calc y = + let monthdelta = (fromIntegral ((y * 12) - (thisyear * 12))) :: Double + cost = floor $ fromIntegral currcost / 2 ** (monthdelta / 18) + in (Dollars cost, y) diff --git a/Types/Cost.hs b/Types/Cost.hs index 290fa25..2f181a2 100644 --- a/Types/Cost.hs +++ b/Types/Cost.hs @@ -12,13 +12,13 @@ import Utility.HumanTime -- | An estimated cost to perform an operation. data Cost op = CPUCost Seconds -- ^ using 1 CPU core - deriving (Show) + deriving (Show, Eq, Ord) unknownCost :: Cost op unknownCost = CPUCost (Seconds 0) newtype Seconds = Seconds Integer - deriving (Num) + deriving (Num, Eq, Ord) instance Show Seconds where show (Seconds n) = fromDuration (Duration n) diff --git a/Types/UI.hs b/Types/UI.hs index 67b4c5f..0a0c789 100644 --- a/Types/UI.hs +++ b/Types/UI.hs @@ -10,7 +10,7 @@ import Types data UI = UI { isAvailable :: IO Bool , showError :: Desc -> IO () - , promptQuestion :: Title -> Desc -> IO Bool + , promptQuestion :: Title -> Desc -> Question -> IO Bool , promptName :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name) , promptPassword :: Bool -> Title -> Desc -> IO (Maybe Password) , promptKeyId :: Title -> Desc -> [(Name, KeyId)] -> IO (Maybe KeyId) @@ -21,3 +21,4 @@ type Title = String type Desc = String type Percent = Int type Problem = String +type Question = String diff --git a/UI/Readline.hs b/UI/Readline.hs index ac962d2..8a3c4ee 100644 --- a/UI/Readline.hs +++ b/UI/Readline.hs @@ -32,15 +32,16 @@ readlineUI = UI myShowError :: Desc -> IO () myShowError desc = do hPutStrLn stderr $ "Error: " ++ desc + putStrLn "" -myPromptQuestion :: Title -> Desc -> IO Bool -myPromptQuestion title desc = do +myPromptQuestion :: Title -> Desc -> Question -> IO Bool +myPromptQuestion title desc question = do showTitle title go where go = do putStrLn desc - mresp <- readline "y/n? " + mresp <- readline $ question ++ " [y/n] " case mresp of Just s | "y" `isPrefixOf` (map toLower s) -> diff --git a/UI/Zenity.hs b/UI/Zenity.hs index 3c3f313..b74631f 100644 --- a/UI/Zenity.hs +++ b/UI/Zenity.hs @@ -42,12 +42,12 @@ myShowError desc = bracket go cleanup (\_ -> return ()) _ <- waitZenity h return () -myPromptQuestion :: Title -> Desc -> IO Bool -myPromptQuestion title desc = do +myPromptQuestion :: Title -> Desc -> Question -> IO Bool +myPromptQuestion title desc question = do h <- runZenity [ "--question" , "--title", title - , "--text", desc + , "--text", desc ++ "\n" ++ question ] (_, ok) <- waitZenity h return ok diff --git a/keysafe.hs b/keysafe.hs index 7068e22..103388b 100644 --- a/keysafe.hs +++ b/keysafe.hs @@ -20,6 +20,8 @@ import Storage import Storage.LocalFiles import qualified Gpg import Data.Maybe +import Data.Time.Clock +import Data.Time.Calendar import Control.Monad import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as BU8 @@ -82,27 +84,36 @@ backup ui tunables secretkeysource secretkey = do name <- fromMaybe (error "Aborting on no name") <$> promptName ui "Enter name" namedesc username validateName - kek <- getkek name + kek <- promptkek name let esk = encrypt tunables kek secretkey let sis = shardIdents tunables name secretkeysource shards <- genShards esk tunables print =<< mapM (uncurry (storeShard localFiles)) (zip (getIdents sis) shards) print =<< obscureShards localFiles where - getkek name = do + promptkek name = do password <- fromMaybe (error "Aborting on no password") <$> promptPassword ui True "Enter password" passworddesc kek <- genKeyEncryptionKey tunables name password username <- userName let badwords = concatMap namewords [name, username] - let crackcost = estimateAttack spotAWS $ + let crackcost = estimateAttackCost spotAWS $ estimateBruteforceOf kek $ passwordEntropy password badwords - ok <- promptQuestion ui "Password strength estimate" $ - show crackcost - if ok - then return kek - else getkek name + let mincost = Dollars 100000 + if crackcost < mincost + then do + showError ui $ "Weak password! It would cost less than " ++ show mincost ++ " to crack the password. Please think of a better one. More words would be good.." + promptkek name + else do + (thisyear, _, _) <- toGregorian . utctDay + <$> getCurrentTime + ok <- promptQuestion ui "Password strength estimate" + (crackdesc crackcost thisyear) + "Is your password strong enough?" + if ok + then return kek + else promptkek name namewords (Name nb) = words (BU8.toString nb) namedesc = unlines [ "To back up your secret key, you will need to enter a name and a password." @@ -121,6 +132,10 @@ backup ui tunables secretkeysource secretkey = do , "And, it needs to be one that you will be able to remember years from now" , "in order to restore your secret key." ] + crackdesc crackcost thisyear = unlines $ + "Rough estimate of the cost to crack your password: " : + map (\(c, y) -> " " ++ show y ++ ":\t" ++ show c) + (costOverTime crackcost thisyear) restore :: UI -> SecretKeySource -> IO () restore ui secretkeydest = do -- cgit v1.2.3