1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses, DataKinds #-}
{- Copyright 2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Encryption where
import Types
import Tunables
import Cost
import ExpensiveHash
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 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 :: AesKey
, keyDecryptionCost :: Cost DecryptionOp
, keyBruteForceCalc :: CostCalc BruteForceOp UnknownPassword
}
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 used as the AES key.
-- Name is used as a salt, to prevent rainbow table attacks.
--
-- The DecryptionPuzzleTunable is used to alter the AES key
-- in some way that requires significant work to determine at
-- decryption time.
genKeyEncryptionKey :: Tunables -> Name -> Password -> IO KeyEncryptionKey
genKeyEncryptionKey tunables name (Password password) = case decryptionPuzzleTunable tunables of
UsePuzzleIV puzzlecost -> do
prg <- Raaz.newPRG () :: IO Raaz.SystemPRG
samplekey <- Raaz.random prg :: IO AesKey
let basek = hashToAESKey samplekey hash
(PuzzleIV iv) <- genPuzzleIV tunables
let strongk = (basek, iv)
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
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 puzzle IV starts with some number of random bytes of IV data,
-- and is right-padded with NULL bytes.
data PuzzleIV = PuzzleIV Raaz.IV
-- | Length of the puzzle IV, in bytes, that will satisfy the
-- decryptionPuzzleCost.
--
-- AES can be calculated more efficiently by a GPU, so the cost must be
-- a GPU cost.
--
-- This depends on the objectSize, because to brute force the
-- RandomIV, AES decryptions must be done repeatedly, and the
-- time needed for an AES decryption depends on the amount of data.
sizePuzzleIV :: Tunables -> Int
sizePuzzleIV tunables = ceiling $ nbits / 8
where
-- in 2016, a GPU can run AES at 10 GB/s.
bytespersecond = 10*1024*1024*1024
triespersecond = bytespersecond `div` fromIntegral (objectSize tunables)
targetseconds = case decryptionPuzzleTunable tunables of
UsePuzzleIV cost -> case cost of
GPUCost (Seconds n) -> n
_ -> error "decryptionPuzzleTunable 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
mkPuzzleIV :: Raaz.IV -> Int -> PuzzleIV
mkPuzzleIV randomiv nbytes = PuzzleIV $
fromMaybe (error "mkRandomIV fromByteString failed") $
Raaz.fromByteString $ B.take nbytes b <> padding
where
b = Raaz.toByteString randomiv
padding = B.replicate (B.length b - nbytes) 0
genPuzzleIV :: Tunables -> IO PuzzleIV
genPuzzleIV tunables = do
prg <- Raaz.newPRG () :: IO Raaz.SystemPRG
randomiv <- Raaz.random prg :: IO Raaz.IV
let size = sizePuzzleIV tunables
return $ mkPuzzleIV randomiv size
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
|
