summaryrefslogtreecommitdiffhomepage
path: root/Encryption.hs
blob: be0a23433739fd0b18b44557090514c39c1713ef (plain)
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
{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-}

module Encryption where

import Types
import Cost
import ExpensiveHash
import Data.Bits
import Data.Monoid
import Data.Maybe
import qualified Data.ByteString as B
import Raaz
import qualified Raaz.Cipher.AES as AES

-- | An AES key, which is used to encrypt the key that is stored
-- in keysafe.
data KeyEncryptionKey = KeyEncryptionKey
	{ keyEncryptionKey :: AES.KEY256
	, keyDecryptionCost :: Cost DecryptionOp
	, keyBruteForceCalc :: CostCalc BruteForceOp UnknownPassword
	}

instance Bruteforceable KeyEncryptionKey UnknownPassword where
	getBruteCostCalc = keyBruteForceCalc

-- | 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
	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

-- | 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
-- key varies the initial bytes of the key.
data RandomObstacle = RandomObstacle AES.KEY256

-- | Length of the random obstacle, 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
-- RandomObstable, AES decryptions must be done repeatedly, and the
-- time needed for an AES decryption depends on the amount of data.
sizeRandomObstacle :: Tunables -> Int
sizeRandomObstacle 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
		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
mkRandomObstacle k nbytes = 
	fromMaybe (error "mkRandomObstacle fromByteString failed") $
		fromByteString ob
  where
	kb = toByteString k
	rightnulls = B.replicate (B.length kb - nbytes) 0
	ob = B.take nbytes kb <> rightnulls

genRandomObstacle :: Tunables -> IO RandomObstacle
genRandomObstacle tunables = do
	prg <- newPRG () :: IO SystemPRG
	randomkey <- random prg :: IO AES.KEY256
	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

orBytes :: B.ByteString -> B.ByteString -> B.ByteString
orBytes a b = B.pack $ map (uncurry (.|.)) $ zip (B.unpack a) (B.unpack b)