diff options
| -rw-r--r-- | Encryption.hs | 123 | ||||
| -rw-r--r-- | ExpensiveHash.hs | 32 | ||||
| -rw-r--r-- | INSTALL | 3 | ||||
| -rw-r--r-- | Serialization.hs | 37 | ||||
| -rw-r--r-- | Shard.hs | 56 | ||||
| -rw-r--r-- | Tunables.hs (renamed from Versions.hs) | 24 | ||||
| -rw-r--r-- | Types.hs | 25 | ||||
| -rw-r--r-- | Types/Cost.hs | 3 | ||||
| -rw-r--r-- | keysafe.cabal | 6 | ||||
| -rw-r--r-- | keysafe.hs | 20 |
10 files changed, 229 insertions, 100 deletions
diff --git a/Encryption.hs b/Encryption.hs index 4a5abd8..8040f5f 100644 --- a/Encryption.hs +++ b/Encryption.hs @@ -1,22 +1,28 @@ -{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses, DataKinds #-} module Encryption where import Types -import Versions +import Tunables import Cost import ExpensiveHash import Data.Bits import Data.Monoid import Data.Maybe +import qualified Raaz +import qualified Raaz.Cipher.AES as Raaz +import qualified Raaz.Cipher.Internal as Raaz +import qualified Data.Text.Encoding as E import qualified Data.ByteString as B -import Raaz -import qualified Raaz.Cipher.AES as AES +import qualified Data.ByteString.Char8 as B8 +import Text.Read + +type AesKey = Raaz.Key (Raaz.AES 256 'Raaz.CBC) -- | An AES key, which is used to encrypt the key that is stored -- in keysafe. data KeyEncryptionKey = KeyEncryptionKey - { keyEncryptionKey :: AES.KEY256 + { keyEncryptionKey :: AesKey , keyDecryptionCost :: Cost DecryptionOp , keyBruteForceCalc :: CostCalc BruteForceOp UnknownPassword } @@ -24,16 +30,36 @@ data KeyEncryptionKey = KeyEncryptionKey instance Bruteforceable KeyEncryptionKey UnknownPassword where getBruteCostCalc = keyBruteForceCalc +cipher :: Raaz.AES 256 'Raaz.CBC +cipher = Raaz.aes256cbc + +blocksize :: Int +blocksize = fromIntegral $ Raaz.blockSize cipher + +encrypt :: KeyEncryptionKey -> SecretKey -> EncryptedSecretKey +encrypt kek (SecretKey secret) = EncryptedSecretKey b (keyBruteForceCalc kek) + where + -- Raaz does not seem to provide a high-level interface + -- for AES encryption, so use unsafeEncrypt, doing our own padding + -- of the secret key, with NULLs, so that it is a multiple of + -- the block size. + b = Raaz.unsafeEncrypt cipher (keyEncryptionKey kek) $ getPaddedBytes $ + toPaddedBytes blocksize secret + +decrypt :: KeyEncryptionKey -> EncryptedSecretKey -> Maybe SecretKey +decrypt kek (EncryptedSecretKey b _) = SecretKey <$> fromPaddedBytes pbs + where + pbs = PaddedBytes $ Raaz.unsafeDecrypt cipher (keyEncryptionKey kek) b + -- | 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 = case decryptionPuzzleTunable tunables of +-- +-- Name is used as a salt, to prevent rainbow table attacks. +genKeyEncryptionKey :: Tunables -> Name -> Password -> IO KeyEncryptionKey +genKeyEncryptionKey tunables name (Password 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 k = hashToAESKey ok hash let strongk = mixinRandomObstacle ob k let decryptcost = CombinedCost puzzlecost (castCost hashcost) -- To brute force data encrypted with this key, @@ -42,15 +68,31 @@ genKeyEncryptionKey tunables keyident password = case decryptionPuzzleTunable tu let bruteforcecalc = bruteForceLinearSearch decryptcost return $ KeyEncryptionKey strongk decryptcost bruteforcecalc where - (ExpensiveHash hashcost hashb) = expensiveHash tunables salt password - salt = Salt keyident + hash@(ExpensiveHash hashcost _) = expensiveHash tunables salt password + salt = Salt name + +-- | Make an AES key out of a hash value. +-- +-- Since the ExpensiveHash value is ascii encoded, and has a common prefix, +-- it does not have a high entropy in every byte, and its length is longer +-- than the AES key length. To deal with this, use the SHA256 of +-- the ExpensiveHash, as a bytestring. +hashToAESKey :: AesKey -> ExpensiveHash -> Raaz.KEY256 +hashToAESKey (samplekey, _iv) (ExpensiveHash _ t) = + fromMaybe (error "hashToAESKey fromByteString failed") $ + Raaz.fromByteString b + where + b = B.take (B.length (Raaz.toByteString samplekey)) $ + Raaz.toByteString $ Raaz.sha256 (E.encodeUtf8 t) -- | A random value which can be mixed into an AES key to -- require decrypting it to perform some brute-force work. -- --- The random value is right-padded with NULL bytes, so ORing it with an AES +-- The random value is left-padded with NULL bytes, so ORing it with an AES -- key varies the initial bytes of the key. -data RandomObstacle = RandomObstacle AES.KEY256 +-- +-- The AesKey also includes a random IV. +data RandomObstacle = RandomObstacle AesKey -- | Length of the random obstacle, in bytes, that will satisfy the -- decryptionPuzzleCost. @@ -76,26 +118,51 @@ sizeRandomObstacle tunables = ceiling $ nbits / 8 nbits :: Double nbits = logBase 2 (fromIntegral $ targetseconds * triespersecond) + 1 -mkRandomObstacle :: AES.KEY256 -> Int -> AES.KEY256 -mkRandomObstacle k nbytes = - fromMaybe (error "mkRandomObstacle fromByteString failed") $ - fromByteString ob +mkRandomObstacle :: AesKey -> Int -> AesKey +mkRandomObstacle (k, iv) nbytes = (k', iv) where - kb = toByteString k - rightnulls = B.replicate (B.length kb - nbytes) 0 - ob = B.take nbytes kb <> rightnulls + k' = fromMaybe (error "mkRandomObstacle fromByteString failed") $ + Raaz.fromByteString ob + kb = Raaz.toByteString k + padding = B.replicate (B.length kb - nbytes) 0 + ob = padding <> B.take nbytes kb genRandomObstacle :: Tunables -> IO RandomObstacle genRandomObstacle tunables = do - prg <- newPRG () :: IO SystemPRG - randomkey <- random prg :: IO AES.KEY256 + prg <- Raaz.newPRG () :: IO Raaz.SystemPRG + randomkey <- Raaz.random prg :: IO AesKey let size = sizeRandomObstacle tunables return $ RandomObstacle $ mkRandomObstacle randomkey size -mixinRandomObstacle :: RandomObstacle -> AES.KEY256 -> AES.KEY256 -mixinRandomObstacle (RandomObstacle r) k = - fromMaybe (error "mixinRandomObstacle fromByteString failed") $ - fromByteString $ toByteString r `orBytes` toByteString k +mixinRandomObstacle :: RandomObstacle -> Raaz.KEY256 -> AesKey +mixinRandomObstacle (RandomObstacle (r, iv)) k = (k', iv) + where + k' = fromMaybe (error "mixinRandomObstacle fromByteString failed") $ + Raaz.fromByteString $ + Raaz.toByteString r `orBytes` Raaz.toByteString k orBytes :: B.ByteString -> B.ByteString -> B.ByteString orBytes a b = B.pack $ map (uncurry (.|.)) $ zip (B.unpack a) (B.unpack b) + +newtype PaddedBytes = PaddedBytes { getPaddedBytes :: B.ByteString } + deriving (Show) + +-- Pad with NULs. Since the bytestring can itself include NULs, prefix +-- with the length. +toPaddedBytes :: Int -> B.ByteString -> PaddedBytes +toPaddedBytes n b = PaddedBytes $ + B8.pack (show len) <> B.singleton 0 <> b <> padding + where + len = B.length b + r = len `rem` n + padding + | r == 0 = B.empty + | otherwise = B.replicate (n - r) 0 + +fromPaddedBytes :: PaddedBytes -> Maybe B.ByteString +fromPaddedBytes (PaddedBytes b) = case B.break (== 0) b of + (header, rest) + | B.null header || B.null rest -> Nothing + | otherwise -> do + len <- readMaybe (B8.unpack header) + return $ B.take len $ B.drop 1 rest diff --git a/ExpensiveHash.hs b/ExpensiveHash.hs index e089957..48acba2 100644 --- a/ExpensiveHash.hs +++ b/ExpensiveHash.hs @@ -3,38 +3,50 @@ module ExpensiveHash where import Types -import Versions +import Tunables import Cost import Serialization () +import qualified Data.Text as T import qualified Data.ByteString as B -import Raaz.Core.Encode import qualified Crypto.Argon2 as Argon2 +import Raaz.Core.Encode import Data.Time.Clock import Control.DeepSeq +import Data.Monoid -- | A hash that is expensive to calculate. -- -- This is a lynchpin of keysafe's security, because using this hash -- as an encryption key forces brute force attackers to generate -- hashes over and over again, taking a very long time. -data ExpensiveHash = ExpensiveHash (Cost CreationOp) B.ByteString +data ExpensiveHash = ExpensiveHash (Cost CreationOp) T.Text deriving (Show) data Salt t = Salt t -expensiveHash :: Encodable t => Tunables -> Salt t -> Password -> ExpensiveHash -expensiveHash tunables (Salt s) (Password password) = +-- | Would rather use haskell argon2 library, but it doesn't build +-- from source, and is buggy. https://github.com/ocharles/argon2/issues/3 +expensiveHash :: Encodable t => Tunables -> Salt t -> B.ByteString -> ExpensiveHash +expensiveHash tunables (Salt s) b = case expensiveHashTunable tunables of UseArgon2 opts cost -> ExpensiveHash cost $ - Argon2.hash opts password (toByteString s) + -- Using hashEncoded here and not hash, + -- because of this bug: + -- https://github.com/ocharles/argon2/issues/3 + Argon2.hashEncoded opts b argonsalt + where + -- argon salt cannot be shorter than 8 bytes, so pad with spaces. + argonsalt = + let sb = toByteString s + in sb <> B.replicate (8 - B.length sb ) 32 benchmarkExpensiveHash :: Tunables -> IO (Benchmark (Cost CreationOp)) benchmarkExpensiveHash tunables = do start <- getCurrentTime - let ExpensiveHash expected b = expensiveHash tunables - (Salt (KeyIdent gpgKey (Name ("benchmark" :: B.ByteString)))) - (Password ("himom" :: B.ByteString)) - end <- b `deepseq` getCurrentTime + let ExpensiveHash expected t = expensiveHash tunables + (Salt (KeyId gpgKey ("benchmark" :: B.ByteString))) + ("himom" :: B.ByteString) + end <- t `deepseq` getCurrentTime let diff = floor $ end `diffUTCTime` start let actual = CPUCost $ Seconds diff return $ Benchmark @@ -0,0 +1,3 @@ +keysafe is a haskell program, and can be built using ghc and cabal: + + cabal install keysafe diff --git a/Serialization.hs b/Serialization.hs index 6a283ff..224d67a 100644 --- a/Serialization.hs +++ b/Serialization.hs @@ -6,42 +6,23 @@ 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 sepChar <> n +-- | A KeyId is serialized in the form "keytype value". +-- For example "gpg C910D9222512E3C7" +instance Encodable KeyId where + toByteString (KeyId (KeyType t) i) = + t <> B.singleton sepChar <> i fromByteString b = case B.break (== sepChar) b of (t, n) | B.null n -> Nothing | otherwise -> Just $ - KeyIdent (KeyType t) (Name (B.drop 1 n)) + KeyId (KeyType t) (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 sepChar <> toByteString keyident - fromByteString b = case B.break (== sepChar) 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 +instance Encodable Name where + toByteString (Name n) = n + fromByteString = Just . Name sepChar :: Word8 sepChar = 32 @@ -1,22 +1,60 @@ +{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-} + module Shard where import Types -import Serialization +import Tunables +import ExpensiveHash import Cost import qualified Crypto.SecretSharing as SS +import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL -import Raaz.Core.Encode (toByteString, fromByteString) +import qualified Raaz.Core.Encode as Raaz +import qualified Raaz.Hash.Sha256 as Raaz +import qualified Data.Text as T +import qualified Data.Text.Encoding as E import Data.Binary +import Data.Monoid + +data ShardIdents = ShardIdents + { getIdents :: [StorableObjectIdent] + , identsCreationCost :: Cost CreationOp + , identsBruteForceCalc :: CostCalc BruteForceOp UnknownName + } + +instance Bruteforceable ShardIdents UnknownName where + getBruteCostCalc = identsBruteForceCalc + +-- | Generates identifiers to use for storing shards. +-- +-- This is an expensive operation, to make it difficult for an attacker +-- to brute force known/guessed names and find matching shards. +-- The keyid is used as a salt, both to avoid collisions when the same +-- name is chosen for multiple keys, and to prevent the attacker +-- from using a rainbow table from names to expensivehashes. +shardIdents :: Tunables -> Name -> KeyId -> ShardIdents +shardIdents tunables (Name name) keyid = + ShardIdents idents creationcost bruteforcecalc + where + (ExpensiveHash creationcost basename) = + expensiveHash tunables (Salt keyid) name + mk n = StorableObjectIdent $ Raaz.toByteString $ mksha $ + 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))] + bruteforcecalc = bruteForceLinearSearch creationcost -genShards :: EncryptedSecretKey -> ShardParams -> IO [StorableObject] -genShards esk ps = +genShards :: EncryptedSecretKey -> Tunables -> IO [StorableObject] +genShards (EncryptedSecretKey esk _) tunables = map (StorableObject . encode) <$> SS.encode - (neededObjects ps) - (totalObjects ps) - (BL.fromStrict (toByteString esk)) + (neededObjects $ head $ shardParams tunables) + (totalObjects $ head $ shardParams tunables) + (BL.fromStrict esk) -- Throws AssertionFailed if the number of shares is too small. -combineShards :: [StorableObject] -> Maybe EncryptedSecretKey -combineShards = fromByteString . BL.toStrict . SS.decode . map conv +combineShards :: [StorableObject] -> EncryptedSecretKey +combineShards = mk . BL.toStrict . SS.decode . map conv where conv = decode . fromStorableObject + mk b = EncryptedSecretKey b unknownCostCalc diff --git a/Versions.hs b/Tunables.hs index a807d02..7a646d3 100644 --- a/Versions.hs +++ b/Tunables.hs @@ -1,23 +1,23 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} -module Versions where +module Tunables where import Cost import qualified Crypto.Argon2 as Argon2 --- | To determine the version used for a key name the expensive hash of the +-- | To determine the tunables used for a key name the expensive hash of the -- name is calculated, using a particular configuration, and if the --- object names it generates are available, we know the version. +-- object names it generates are available, we know the tunables. -- -- Since this process is expensive, it's important that the most commonly --- used items come first, so that the expensive hash does not have to be +-- used tunables come first, so that the expensive hash does not have to be -- calculated repatedly. -- --- The reason for using this expensive method of encoding the version --- information is that it prevents attacks where related objects are --- correlated based on using an unusual version. -knownVersions :: [(ExpensiveHashTunable, Tunables)] -knownVersions = map (\t -> (expensiveHashTunable t, t)) +-- The reason for using this expensive method of encoding the tunables +-- is that it prevents attacks where related objects are correlated based +-- on their tunables. +knownTunings :: [(ExpensiveHashTunable, Tunables)] +knownTunings = map (\t -> (expensiveHashTunable t, t)) [ defaultTunables ] @@ -88,8 +88,10 @@ testModeTunables :: Tunables testModeTunables = Tunables { shardParams = [ShardParams { totalObjects = 3, neededObjects = 2 }] , objectSize = 1024*64 - , expensiveHashTunable = UseArgon2 Argon2.defaultHashOptions (CPUCost (Seconds (2*600))) + , expensiveHashTunable = UseArgon2 weakargonoptions argoncost , encryptionTunable = UseAES256 , decryptionPuzzleTunable = KeyBlindingLeftSide (GPUCost (Seconds 60)) } - + where + UseArgon2 argonoptions argoncost = expensiveHashTunable defaultTunables + weakargonoptions = argonoptions { Argon2.hashIterations = 1 } @@ -20,6 +20,11 @@ instance Bruteforceable EncryptedSecretKey UnknownPassword where -- | Objects stored on a keysafe server are (probably) a shard of an -- encrypted secret key. newtype StorableObject = StorableObject { fromStorableObject :: BL.ByteString } + deriving (Show) + +-- | An identifier for a StorableObject +newtype StorableObjectIdent = StorableObjectIdent B.ByteString + deriving (Show) -- | A password used to encrypt a key stored in keysafe. newtype Password = Password B.ByteString @@ -36,6 +41,11 @@ passwordEntropy (Password p) = Entropy $ floor $ totalEntropy p newtype Name = Name B.ByteString deriving (Show) +-- | Very naive calculation of the entropy of a name. +-- Assumes that the attacker is not targeting a particular list of names. +nameEntropy :: Name -> Entropy UnknownName +nameEntropy (Name n) = Entropy $ floor $ totalEntropy n + -- | The type of the key that is stored in keysafe. newtype KeyType = KeyType B.ByteString deriving (Show) @@ -43,16 +53,11 @@ newtype KeyType = KeyType B.ByteString gpgKey :: KeyType gpgKey = KeyType "gpg" --- | Enough information to uniquely identify a key stored in keysafe. -data KeyIdent = KeyIdent KeyType Name - deriving (Show) - -newtype ShardNum = ShardNum Int - deriving (Show) - --- | Enough information to uniquely identify an object stored on a keysafe --- server for a key. -data ObjectIdent = ObjectIdent ShardNum KeyIdent +-- | The keyid is any value that is unique to a private key, and can be +-- looked up somehow without knowing the private key. +-- +-- A gpg keyid is the obvious example. +data KeyId = KeyId KeyType B.ByteString deriving (Show) data Benchmark t = Benchmark { expectedBenchmark :: t, actualBenchmark :: t } diff --git a/Types/Cost.hs b/Types/Cost.hs index f880bfe..45cf813 100644 --- a/Types/Cost.hs +++ b/Types/Cost.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, EmptyDataDecls #-} module Types.Cost where @@ -56,3 +56,4 @@ class Bruteforceable t a where -- | Things that can have entropy data UnknownPassword +data UnknownName diff --git a/keysafe.cabal b/keysafe.cabal index 1e586f7..084f682 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -25,6 +25,12 @@ Executable keysafe , secret-sharing == 1.0.* , raaz == 0.0.2 , argon2 == 1.1.* + , QuickCheck == 2.8.* + , time == 1.5.* + , containers == 0.5.* + , binary == 0.7.* + , text == 1.2.* + , utf8-string == 1.0.* source-repository head type: git @@ -1,8 +1,22 @@ -module Main where - {-# LANGUAGE OverloadedStrings #-} +module Main where + import Types +import Tunables import Encryption +import Shard -main = print $ genKeyEncryptionKey (Password "foo") (Name "bar") +main :: IO () +main = do + kek <- genKeyEncryptionKey tunables name password + let esk = encrypt kek secretkey + let sis = shardIdents tunables name keyid + shards <- genShards esk tunables + print $ zip (getIdents sis) shards + where + password = Password "foo" + name = Name "bar" + tunables = testModeTunables -- defaultTunables + keyid = KeyId gpgKey "foobar" + secretkey = SecretKey "this is a gpg private key" |