From 5decbad3eb779b1bbe11245cbde84701909e9c68 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 11 Aug 2016 15:52:50 -0400 Subject: nearly able to generate shards now --- Encryption.hs | 123 +++++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 95 insertions(+), 28 deletions(-) (limited to 'Encryption.hs') 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 -- cgit v1.2.3