From 07bd29a80ed36c63296214af34689d0cce14751f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 7 Aug 2016 18:49:15 -0400 Subject: reorg, and working on serialization --- .ghci | 1 + Cost.hs | 56 +++------------------------- Encryption.hs | 37 +++++++++--------- ExpensiveHash.hs | 7 ++-- Serialization.hs | 46 +++++++++++++++++++++++ Shard.hs | 22 ++++++----- Tunables.hs | 50 ------------------------- Types.hs | 112 +++++++++++++++++++++++++++++++++++++------------------ Types/Cost.hs | 55 +++++++++++++++++++++++++++ 9 files changed, 218 insertions(+), 168 deletions(-) create mode 100644 Serialization.hs delete mode 100644 Tunables.hs create mode 100644 Types/Cost.hs diff --git a/.ghci b/.ghci index 0c4c042..c459af9 100644 --- a/.ghci +++ b/.ghci @@ -1,2 +1,3 @@ +:set -Wall :set -fno-warn-tabs :set -XOverloadedStrings diff --git a/Cost.hs b/Cost.hs index 8a47fcc..4a90310 100644 --- a/Cost.hs +++ b/Cost.hs @@ -1,23 +1,11 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} -module Cost where +module Cost ( + module Cost, + module Types.Cost +) where -import Entropy -import Utility.HumanTime -import Data.Monoid - --- | An estimated cost to perform an operation. -data Cost op - = CPUCost Seconds -- ^ using 1 CPU core - | GPUCost Seconds - | CombinedCost (Cost op) (Cost op) - deriving (Show) - -newtype Seconds = Seconds Integer - deriving (Num) - -instance Show Seconds where - show (Seconds n) = fromDuration (Duration n) +import Types.Cost -- | Cost in seconds, with the type of hardware needed. totalCost :: Cost op -> (Seconds, [UsingHardware]) @@ -28,9 +16,6 @@ totalCost (CombinedCost a b) = (s2, h2) = totalCost b in (s1+s2, h1++h2) -data UsingHardware = UsingCPU | UsingGPU | UsingASIC - deriving (Show) - raiseCostPower :: Cost c -> Entropy e -> Cost c raiseCostPower c (Entropy e) = adjustCost c (* 2^e) @@ -44,33 +29,6 @@ castCost (CPUCost s) = CPUCost s castCost (GPUCost s) = GPUCost s castCost (CombinedCost a b) = CombinedCost (castCost a) (castCost b) -instance Monoid (Cost t) where - mempty = CPUCost (Seconds 0) - CPUCost (Seconds a) `mappend` CPUCost (Seconds b) = - CPUCost (Seconds (a+b)) - GPUCost (Seconds a) `mappend` GPUCost (Seconds b) = - GPUCost (Seconds (a+b)) - a `mappend` b = CombinedCost a b - --- | Operations whose cost can be measured. -data DecryptionOp -data CreationOp -data BruteForceOp - --- | Calculation of a cost that depends on some amount of entropy. -type CostCalc op t = Entropy t -> Cost op - --- | Number of bits of entropy -newtype Entropy t = Entropy Int - deriving (Num, Show) - --- | Entropy can never go negative when subtracting bits from it. -reduceEntropy :: Entropy t -> Int -> Entropy t -reduceEntropy (Entropy a) b = Entropy (max 0 (a - b)) - --- | Things that can have entropy -data UnknownPassword - -- | CostCalc for a brute force linear search through an entropy space -- in which each step entails paying a cost. -- @@ -80,10 +38,6 @@ bruteForceLinearSearch :: Cost step -> CostCalc BruteForceOp t bruteForceLinearSearch stepcost e = castCost stepcost `raiseCostPower` reduceEntropy e 1 --- | Things that can be brute-forced track their CostCalc. -class Bruteforceable t a where - getBruteCostCalc :: t -> CostCalc BruteForceOp a - -- | Estimate of cost of a brute force attack. estimateBruteforceOf :: Bruteforceable t a => t -> Entropy a -> Cost BruteForceOp estimateBruteforceOf t e = getBruteCostCalc t e diff --git a/Encryption.hs b/Encryption.hs index 50fa0fb..be0a234 100644 --- a/Encryption.hs +++ b/Encryption.hs @@ -4,9 +4,7 @@ module Encryption where import Types import Cost -import Tunables import ExpensiveHash -import Data.Word import Data.Bits import Data.Monoid import Data.Maybe @@ -28,22 +26,23 @@ instance Bruteforceable KeyEncryptionKey UnknownPassword where -- | The ExpensiveHash of the Password is combined with a -- RandomObstacle to form the AES key. Combination method is logical OR. genKeyEncryptionKey :: Tunables -> KeyIdent -> Password -> IO KeyEncryptionKey -genKeyEncryptionKey tunables keyident password = do - ob@(RandomObstacle ok) <- genRandomObstacle tunables - -- Truncate the hash to the AES key length. - let truncatedhashb = B.take (B.length (toByteString ok)) hashb - let k = fromMaybe (error "genKeyEncryptionKey fromByteString failed") $ - fromByteString truncatedhashb - let strongk = mixinRandomObstacle ob k - return $ KeyEncryptionKey strongk decryptcost bruteforcecalc +genKeyEncryptionKey tunables keyident password = case decryptionPuzzleTunable tunables of + KeyBlindingLeftSide puzzlecost -> do + ob@(RandomObstacle ok) <- genRandomObstacle tunables + -- Truncate the hash to the AES key length. + let truncatedhashb = B.take (B.length (toByteString ok)) hashb + let k = fromMaybe (error "genKeyEncryptionKey fromByteString failed") $ + fromByteString truncatedhashb + let strongk = mixinRandomObstacle ob k + let decryptcost = CombinedCost puzzlecost (castCost hashcost) + -- To brute force data encrypted with this key, + -- an attacker needs to pay the decryptcost for + -- each password checked. + let bruteforcecalc = bruteForceLinearSearch decryptcost + return $ KeyEncryptionKey strongk decryptcost bruteforcecalc where (ExpensiveHash hashcost hashb) = expensiveHash tunables salt password salt = Salt keyident - decryptcost = CombinedCost (decryptionPuzzleCost tunables) (castCost hashcost) - -- To brute force data encrypted with this key, - -- an attacker needs to pay the decryptcost for each password - -- checked. - bruteforcecalc = bruteForceLinearSearch decryptcost -- | A random value which can be mixed into an AES key to -- require decrypting it to perform some brute-force work. @@ -67,11 +66,13 @@ sizeRandomObstacle tunables = ceiling $ nbits / 8 -- in 2016, a GPU can run AES at 10 GB/s. bytespersecond = 10*1024*1024*1024 triespersecond = bytespersecond `div` fromIntegral (objectSize tunables) - targetseconds = case decryptionPuzzleCost tunables of - GPUCost (Seconds n) -> n - _ -> error "decryptionPuzzleCost must be a GPUCost" + targetseconds = case decryptionPuzzleTunable tunables of + KeyBlindingLeftSide cost -> case cost of + GPUCost (Seconds n) -> n + _ -> error "decryptionPuzzleCost must be a GPUCost" -- Add one bit of entropy, because a brute-force attack will -- on average succeed half-way through the search space. + nbits :: Double nbits = logBase 2 (fromIntegral $ targetseconds * triespersecond) + 1 mkRandomObstacle :: AES.KEY256 -> Int -> AES.KEY256 diff --git a/ExpensiveHash.hs b/ExpensiveHash.hs index ca357bc..c27f703 100644 --- a/ExpensiveHash.hs +++ b/ExpensiveHash.hs @@ -3,8 +3,8 @@ module ExpensiveHash where import Types +import Serialization import Cost -import Tunables import qualified Data.ByteString as B import Raaz.Core.Encode import qualified Crypto.Argon2 as Argon2 @@ -23,8 +23,9 @@ data Salt t = Salt t expensiveHash :: Encodable t => Tunables -> Salt t -> Password -> ExpensiveHash expensiveHash tunables (Salt s) (Password password) = - ExpensiveHash (argonCost tunables) $ - Argon2.hash (argonOptions tunables) password (toByteString s) + case expensiveHashTunable tunables of + UseArgon2 opts cost -> ExpensiveHash cost $ + Argon2.hash opts password (toByteString s) benchmarkExpensiveHash :: Tunables -> IO (Benchmark (Cost CreationOp)) benchmarkExpensiveHash tunables = do diff --git a/Serialization.hs b/Serialization.hs new file mode 100644 index 0000000..3c23137 --- /dev/null +++ b/Serialization.hs @@ -0,0 +1,46 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Serialization where + +import Types +import Raaz.Core.Encode +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import Data.Monoid +import Data.Word +import Text.Read + +-- TODO +-- | An EncryptedSecretKey is serialized as first a md5sum of the rest +-- of the content, and then a SelfDescription EncryptedSecretKey, +-- and finally the +--instance Encodable EncryptedSecretKey where +-- toByteString (EncryptedSecretKey b _) = b +-- fromByteString b = + +-- | A KeyIdent is serialized in the form "keytype name". +-- For example "gpg Joey Hess" +instance Encodable KeyIdent where + toByteString (KeyIdent (KeyType t) (Name n)) = + t <> B.singleton identSepChar <> n + fromByteString b = case B.break (== identSepChar) b of + (t, n) + | B.null n -> Nothing + | otherwise -> Just $ + KeyIdent (KeyType t) (Name (B.drop 1 n)) + +-- | An ObjectIdent is serialied in the form "shardnum keytype name" +-- For example "1 gpg Joey Hess" +instance Encodable ObjectIdent where + toByteString (ObjectIdent (ShardNum n) keyident) = + B8.pack (show n) <> B.singleton identSepChar <> toByteString keyident + fromByteString b = case B.break (== identSepChar) b of + (ns, rest) + | B.null ns -> Nothing + | otherwise -> do + keyident <- fromByteString (B.drop 1 rest) + n <- readMaybe (B8.unpack ns) + return $ ObjectIdent (ShardNum n) keyident + +identSepChar :: Word8 +identSepChar = 32 diff --git a/Shard.hs b/Shard.hs index cd510cd..14ebbf5 100644 --- a/Shard.hs +++ b/Shard.hs @@ -1,18 +1,22 @@ module Shard where import Types +import Serialization +import Cost import qualified Crypto.SecretSharing as SS import qualified Data.ByteString.Lazy as BL +import Raaz.Core.Encode (toByteString, fromByteString) import Data.Binary --- | Parameters for sharding. The secret is split into --- N objects, such that only M are needed to reconstruct it. -data ShardParams = ShardParams - { totalObjects :: Int -- ^ N - , neededObjects :: Int -- ^ M - } - genShards :: EncryptedSecretKey -> ShardParams -> IO [StorableObject] -genShards (EncryptedSecretKey esk _) ps = +genShards esk ps = map (StorableObject . encode) <$> SS.encode - (neededObjects ps) (totalObjects ps) (BL.fromStrict esk) + (neededObjects ps) + (totalObjects ps) + (BL.fromStrict (toByteString esk)) + +-- Throws AssertionFailed if the number of shares is too small. +combineShards :: [StorableObject] -> Maybe EncryptedSecretKey +combineShards = fromByteString . BL.toStrict . SS.decode . map conv + where + conv = decode . fromStorableObject diff --git a/Tunables.hs b/Tunables.hs deleted file mode 100644 index 1806703..0000000 --- a/Tunables.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Tunables where - -import Types -import Shard -import Cost -import qualified Crypto.Argon2 as Argon2 - -data Tunables = Tunables - { objectSize :: Int - , shardParams :: shardParams - -- ^ size of objects stored in keysafe, in bytes - , argonOptions :: Argon2.HashOptions - , argonCost :: Cost CreationOp - -- ^ should correspond to the argonOptions - , decryptionPuzzleCost :: Cost DecryptionOp - -- ^ cost of decryption puzzle - } - -defaultTunables :: Tunables -defaultTunables = Tunables - { shardParams = ShardParams { totalObjects = 3, neededObjects = 2 } - , objectSize = 1024*64 -- 64 kb - , argonOptions = Argon2.HashOptions - { Argon2.hashIterations = 10000 - , Argon2.hashMemory = 131072 -- 128 mebibtyes per thread - , Argon2.hashParallelism = 4 -- 4 threads - , Argon2.hashVariant = Argon2.Argon2i - } - -- argon2 is GPU and ASIC resistent, so it uses CPU time. - -- The above HashOptions were benchmarked at 661 seconds CPU time - -- on a 2 core Intel(R) Core(TM) i5-4210Y CPU @ 1.50GHz. - -- Since cost is measured per core, we double that. - , argonCost = CPUCost (Seconds (2*600)) - -- AES can be calculated more efficiently by a GPU, so this - -- cost is a GPU cost. - -- This is set to only 1 minute because GPUs are quite a lot - -- faster than CPUs at AES, and so setting it higher would make - -- clients too slow at key recovery. - , decryptionPuzzleCost = GPUCost (Seconds 60) - } - --- | Dials back cryptographic difficulty, not for production use. -testModeTunables :: Tunables -testModeTunables = Tunables - { shardParams = shardParams { totalObjects = 3, neededObjects = 2 } - , objectSize = 1024*64 - , argonOptions = Argon2.defaultHashOptions - , argonCost = CPUCost (Seconds (2*600)) - , decryptionPuzzleCost = GPUCost (Seconds 60) - } diff --git a/Types.hs b/Types.hs index b4d68f4..7873175 100644 --- a/Types.hs +++ b/Types.hs @@ -2,30 +2,95 @@ module Types where -import Cost +import Types.Cost import Entropy import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL -import Raaz.Core.Encode -import Data.Monoid -import Data.Word -import Data.Time.Clock +import qualified Crypto.Argon2 as Argon2 import Data.String -import Text.Read -- | keysafe stores secret keys. newtype SecretKey = SecretKey B.ByteString +-- | Objects stored on a keysafe server are (probably) a shard of an +-- encrypted secret key. +newtype StorableObject = StorableObject { fromStorableObject :: BL.ByteString } + +-- | Parameters for sharding. The secret is split into +-- N objects, such that only M are needed to reconstruct it. +data ShardParams = ShardParams + { totalObjects :: Int -- ^ N + , neededObjects :: Int -- ^ M + } + +-- | keysafe stores data for a long time, and needs to be able to process +-- data from a long time ago when restoring a key. We don't want to be +-- locked into old choices of crypto primitives etc forever. +-- +-- So, every parameter that can be tuned is configured in this data +-- structure. Carefully chosen parts of this are exposed at various points +-- in the data stored for a key, to allow future versions of keysafe to +-- make the right decisions when processing it. +data Tunables = Tunables + { shardParams :: ShardParams + , objectSize :: Int + -- ^ a StorableObject is exactly this many bytes in size + , expensiveHashTunable :: ExpensiveHashTunable + , encryptionTunable :: EncryptionTunable + , decryptionPuzzleTunable :: DecryptionPuzzleTunable + } + +-- | An expensive hash, used to make it hard to crack an encrypted secret key. +data ExpensiveHashTunable = UseArgon2 Argon2.HashOptions (Cost CreationOp) + +-- | What encryption to use. +data EncryptionTunable = UseAES256 + +-- | An additional puzzle that makes decryption more expensive. +data DecryptionPuzzleTunable = KeyBlindingLeftSide (Cost DecryptionOp) + +defaultTunables :: Tunables +defaultTunables = Tunables + { shardParams = ShardParams { totalObjects = 3, neededObjects = 2 } + , objectSize = 1024*64 -- 64 kb + , expensiveHashTunable = UseArgon2 argonoptions argoncost + , encryptionTunable = UseAES256 + -- AES can be calculated more efficiently by a GPU, so the + -- cost is a GPU cost. + -- This is set to only 1 minute because GPUs are quite a lot + -- faster than CPUs at AES, and so setting it higher would make + -- clients too slow at key recovery. + , decryptionPuzzleTunable = KeyBlindingLeftSide (GPUCost (Seconds 60)) + } + where + argonoptions = Argon2.HashOptions + { Argon2.hashIterations = 10000 + , Argon2.hashMemory = 131072 -- 128 mebibtyes per thread + , Argon2.hashParallelism = 4 -- 4 threads + , Argon2.hashVariant = Argon2.Argon2i + } + -- argon2 is GPU and ASIC resistent, so it uses CPU time. + -- The above HashOptions were benchmarked at 661 seconds CPU time + -- on a 2 core Intel(R) Core(TM) i5-4210Y CPU @ 1.50GHz. + -- Since cost is measured per core, we double that. + argoncost = CPUCost (Seconds (2*600)) + +-- | Dials back cryptographic difficulty, not for production use. +testModeTunables :: Tunables +testModeTunables = Tunables + { shardParams = ShardParams { totalObjects = 3, neededObjects = 2 } + , objectSize = 1024*64 + , expensiveHashTunable = UseArgon2 Argon2.defaultHashOptions (CPUCost (Seconds (2*600))) + , encryptionTunable = UseAES256 + , decryptionPuzzleTunable = KeyBlindingLeftSide (GPUCost (Seconds 60)) + } + -- | The secret key, encrypted with a password. data EncryptedSecretKey = EncryptedSecretKey B.ByteString (CostCalc BruteForceOp UnknownPassword) instance Bruteforceable EncryptedSecretKey UnknownPassword where getBruteCostCalc (EncryptedSecretKey _ cc) = cc --- | An object that can be stored on a keysafe server. -data StorableObject = StorableObject BL.ByteString - -- | A password used to encrypt a key stored in keysafe. newtype Password = Password B.ByteString deriving (IsString) @@ -52,20 +117,6 @@ gpgKey = KeyType "gpg" data KeyIdent = KeyIdent KeyType Name deriving (Show) --- | A KeyIdent is serialized in the form "keytype name". --- For example "gpg Joey Hess" -instance Encodable KeyIdent where - toByteString (KeyIdent (KeyType t) (Name n)) = - t <> B.singleton identSepChar <> n - fromByteString b = case B.break (== identSepChar) b of - (t, n) - | B.null n -> Nothing - | otherwise -> Just $ - KeyIdent (KeyType t) (Name (B.drop 1 n)) - -identSepChar :: Word8 -identSepChar = 32 - newtype ShardNum = ShardNum Int deriving (Show) @@ -74,18 +125,5 @@ newtype ShardNum = ShardNum Int data ObjectIdent = ObjectIdent ShardNum KeyIdent deriving (Show) --- | An ObjectIdent is serialied in the form "shardnum keytype name" --- For example "1 gpg Joey Hess" -instance Encodable ObjectIdent where - toByteString (ObjectIdent (ShardNum n) keyident) = - B8.pack (show n) <> B.singleton identSepChar <> toByteString keyident - fromByteString b = case B.break (== identSepChar) b of - (ns, rest) - | B.null ns -> Nothing - | otherwise -> do - keyident <- fromByteString (B.drop 1 rest) - n <- readMaybe (B8.unpack ns) - return $ ObjectIdent (ShardNum n) keyident - data Benchmark t = Benchmark { expectedBenchmark :: t, actualBenchmark :: t } deriving (Show) diff --git a/Types/Cost.hs b/Types/Cost.hs new file mode 100644 index 0000000..c742848 --- /dev/null +++ b/Types/Cost.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} + +module Types.Cost where + +import Utility.HumanTime + +-- | An estimated cost to perform an operation. +data Cost op + = CPUCost Seconds -- ^ using 1 CPU core + | GPUCost Seconds + | CombinedCost (Cost op) (Cost op) + deriving (Show) + +newtype Seconds = Seconds Integer + deriving (Num) + +instance Show Seconds where + show (Seconds n) = fromDuration (Duration n) + +data UsingHardware = UsingCPU | UsingGPU | UsingASIC + deriving (Show) + +instance Monoid (Cost t) where + mempty = CPUCost (Seconds 0) + CPUCost (Seconds a) `mappend` CPUCost (Seconds b) = + CPUCost (Seconds (a+b)) + GPUCost (Seconds a) `mappend` GPUCost (Seconds b) = + GPUCost (Seconds (a+b)) + a `mappend` b = CombinedCost a b + +-- | Operations whose cost can be measured. +data DecryptionOp +data CreationOp +data BruteForceOp + +-- | Calculation of a cost that depends on some amount of entropy. +type CostCalc op t = Entropy t -> Cost op + +unknownCostCalc :: CostCalc op t +unknownCostCalc = \_e -> error "No cost calculation available" + +-- | Number of bits of entropy +newtype Entropy t = Entropy Int + deriving (Num, Show) + +-- | Entropy can never go negative when subtracting bits from it. +reduceEntropy :: Entropy t -> Int -> Entropy t +reduceEntropy (Entropy a) b = Entropy (max 0 (a - b)) + +-- | Things that can be brute-forced track their CostCalc. +class Bruteforceable t a where + getBruteCostCalc :: t -> CostCalc BruteForceOp a + +-- | Things that can have entropy +data UnknownPassword -- cgit v1.2.3