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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses, DataKinds #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- 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 Data.Word
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.KEY256
cipher :: Raaz.AES 256 'Raaz.CBC
cipher = Raaz.aes256cbc
encrypt :: Tunables -> KeyEncryptionKey -> SecretKey -> EncryptedSecretKey
encrypt tunables kek (SecretKey secret) = EncryptedSecretKey b (keyBruteForceCalc kek)
where
-- Raaz does not seem to provide a high-level interface
-- for AES encryption, so use unsafeEncrypt. The use of
-- EncryptableBytes makes sure it's provided with a
-- multiple of the AES block size.
b = Raaz.unsafeEncrypt cipher (keyEncryptionKey kek, keyEncryptionIV kek) $
getEncryptableBytes $ toEncryptableBytes tunables secret
decrypt :: Candidates KeyEncryptionKey -> EncryptedSecretKey -> Maybe SecretKey
decrypt (Candidates l _ _) esk = go l
where
go [] = Nothing
go (kek:rest) = case decrypt' kek esk of
Just sk -> Just sk
Nothing -> go rest
decrypt' :: KeyEncryptionKey -> EncryptedSecretKey -> Maybe SecretKey
decrypt' kek (EncryptedSecretKey b _) = SecretKey <$> fromEncryptableBytes pbs
where
pbs = EncryptableBytes $ Raaz.unsafeDecrypt cipher (keyEncryptionKey kek, keyEncryptionIV kek) b
-- | An AES key, which is used to encrypt the secret key that is stored
-- in keysafe.
data KeyEncryptionKey = KeyEncryptionKey
{ keyEncryptionKey :: AesKey
, keyEncryptionIV :: Raaz.IV
, keyCreationCost :: Cost CreationOp
, keyDecryptionCost :: Cost DecryptionOp
, keyBruteForceCalc :: CostCalc BruteForceOp UnknownPassword
}
instance HasCreationCost KeyEncryptionKey where
getCreationCost = keyCreationCost
instance HasDecryptionCost KeyEncryptionKey where
getDecryptionCost = keyDecryptionCost
instance Bruteforceable KeyEncryptionKey UnknownPassword where
getBruteCostCalc = keyBruteForceCalc
data Candidates a = Candidates [a] (Cost CreationOp) (Cost DecryptionOp)
instance HasCreationCost (Candidates a) where
getCreationCost (Candidates _ c _) = c
instance HasDecryptionCost (Candidates a) where
getDecryptionCost (Candidates _ _ c) = c
-- | The ExpensiveHash of the Password used as the KeyEncryptionKey
--
-- Name is used as a salt, to prevent rainbow table attacks.
--
-- A random prefix is added to the salt, to force an attacker to
-- run the hash repeatedly.
genKeyEncryptionKey :: Tunables -> Name -> Password -> IO KeyEncryptionKey
genKeyEncryptionKey tunables name password = do
prg <- Raaz.newPRG () :: IO Raaz.SystemPRG
saltprefix <- genRandomSaltPrefix prg tunables
return $ head $
genKeyEncryptionKeys [saltprefix] tunables name password
-- | A stream of KeyEncryptionKeys, using the specified salt prefixes.
genKeyEncryptionKeys :: [SaltPrefix] -> Tunables -> Name -> Password -> [KeyEncryptionKey]
genKeyEncryptionKeys saltprefixes tunables (Name name) (Password password) =
map mk saltprefixes
where
iv = genIV (Password password)
-- To brute force data encrypted with a key,
-- an attacker needs to pay the decryptcost for
-- each password checked.
bruteforcecalc = bruteForceLinearSearch decryptcost
decryptcost = castCost $ randomSaltBytesBruteForceCost kektunables
kektunables = keyEncryptionKeyTunable tunables
mk saltprefix = KeyEncryptionKey (hashToAESKey hash) iv (getCreationCost hash) decryptcost bruteforcecalc
where
salt = Salt (saltprefix <> name)
hash = expensiveHash (keyEncryptionKeyHash kektunables) salt password
-- | A stream of all the key encryption keys that need to be tried to
-- decrypt.
candidateKeyEncryptionKeys :: Tunables -> Name -> Password -> Candidates KeyEncryptionKey
candidateKeyEncryptionKeys tunables name password =
let ks@(k:_) = genKeyEncryptionKeys saltprefixes tunables name password
in Candidates ks (getCreationCost k) (getDecryptionCost k)
where
saltprefixes = allByteStringsOfLength $
randomSaltBytes $ keyEncryptionKeyTunable tunables
allByteStringsOfLength :: Int -> [B.ByteString]
allByteStringsOfLength = go []
where
go ws n
| n == 0 = return (B.pack ws)
| otherwise = do
w <- [0..255]
go (w:ws) (n-1)
-- Use the sha256 of the password (truncated) as the IV.
genIV :: Password -> Raaz.IV
genIV (Password password) =
fromMaybe (error "genIV fromByteString failed") $
Raaz.fromByteString $ B.take ivlen $
Raaz.toByteString $ Raaz.sha256 password
where
ivlen = fromIntegral $ Raaz.byteSize (undefined :: Raaz.IV)
type SaltPrefix = B.ByteString
genRandomSaltPrefix :: Raaz.SystemPRG -> Tunables -> IO SaltPrefix
genRandomSaltPrefix prg tunables = go []
(randomSaltBytes $ keyEncryptionKeyTunable tunables)
where
go ws 0 = return (B.pack ws)
go ws n = do
b <- Raaz.random prg :: IO Word8
go (b:ws) (n-1)
instance Raaz.Random Word8
-- | 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 :: ExpensiveHash -> AesKey
hashToAESKey (ExpensiveHash _ t) =
fromMaybe (error "hashToAESKey fromByteString failed") $
Raaz.fromByteString b
where
b = B.take (fromIntegral $ Raaz.byteSize (undefined :: AesKey)) $
Raaz.toByteString $ Raaz.sha256 (E.encodeUtf8 t)
-- | A bytestring that can be AES enctypted. It includes a checksum,
-- and size, and is padded to the objectSize with NULs.
--
-- This is a multiple of the AES blocksize, as long as objectSize is,
-- which should always be the case.
newtype EncryptableBytes = EncryptableBytes { getEncryptableBytes :: B.ByteString }
deriving (Show)
toEncryptableBytes :: Tunables -> B.ByteString -> EncryptableBytes
toEncryptableBytes tunables b = EncryptableBytes $
padBytes (objectSize tunables) $
checksum <> sep <> len <> sep <> b
where
checksum = Raaz.toByteString $ Raaz.sha256 b
len = B8.pack (show (B.length b))
sep = B.singleton 0
padBytes :: Int -> B.ByteString -> B.ByteString
padBytes n b = b <> padding
where
len = B.length b
r = len `rem` n
padding
| r == 0 = B.empty
| otherwise = B.replicate (n - r) 0
fromEncryptableBytes :: EncryptableBytes -> Maybe B.ByteString
fromEncryptableBytes (EncryptableBytes b) = case B.break (== 0) b of
(checksum, rest)
| B.null checksum || B.null rest -> Nothing
| otherwise -> do
case B.break (== 0) (B.drop 1 rest) of
(lenb, rest')
| B.null lenb || B.null rest' -> Nothing
| otherwise -> do
len <- readMaybe (B8.unpack lenb)
let d = B.take len $ B.drop 1 rest'
if checksum == Raaz.toByteString (Raaz.sha256 d)
then Just d
else Nothing
|
