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
|
{-|
Encryption compatible with <https://crypto.stanford.edu/sjcl/ SJCL>
>>> import Web.ZeroBin.SJCL
>>> import Data.ByteString.Char8
>>> encrypt "secret-word" (pack "hello")
Content {iv = "VxyuJRVtKJqhG2iR/sPjAQ", salt = "AhnDuP1CkTCBlQTHgw", ct = "cqr7/pMRXrcROmcgwA"}
-}
{-# LANGUAGE DeriveGeneric #-}
module Web.ZeroBin.SJCL (
Content(..),
encrypt
) where
import Crypto.Cipher.AES (AES128)
import Crypto.Cipher.Types (ivAdd, blockSize, cipherInit, ecbEncrypt, ctrCombine, makeIV)
import Crypto.Error (throwCryptoErrorIO)
import Crypto.Hash.Algorithms (SHA256(..))
import Crypto.KDF.PBKDF2 (prfHMAC)
import Crypto.Number.Serialize (i2ospOf_)
import Crypto.Random.Entropy (getEntropy)
import Data.ByteString (ByteString)
import Data.Maybe (fromJust)
import Data.Word (Word8)
import GHC.Generics (Generic)
import Web.ZeroBin.Utils (toWeb)
import qualified Crypto.KDF.PBKDF2 as PBKDF2
import qualified Data.Aeson as JSON
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
-- | Encrypted content. Each field is a 'toWeb'-encoded byte-string
data Content = Content {
iv :: String -- ^ random initialization vector (IV)
, salt :: String -- ^ random salt
, ct :: String -- ^ encrypted data
} deriving (Generic, Show)
-- FIXME: http://stackoverflow.com/questions/33045350/unexpected-haskell-aeson-warning-no-explicit-implementation-for-tojson
instance JSON.ToJSON Content where
toJSON = JSON.genericToJSON JSON.defaultOptions
makeCipher :: ByteString -> IO AES128
makeCipher = throwCryptoErrorIO . cipherInit
-- https://github.com/bitwiseshiftleft/sjcl/blob/master/core/pbkdf2.js
-- TODO: this is default, we can specify it explicitly for forward compatibility
makeKey :: ByteString -> ByteString -> ByteString
makeKey = PBKDF2.generate (prfHMAC SHA256)
PBKDF2.Parameters {PBKDF2.iterCounts = 1000, PBKDF2.outputLength = 16}
chunks :: Int -> ByteString -> [ByteString]
chunks sz = split
where split b | cl <= sz = [b'] -- padded
| otherwise = b1 : split b2
where cl = BS.length b
(b1, b2) = BS.splitAt sz b
b' = BS.take sz $ BS.append b (BS.replicate sz 0)
lengthOf :: Int -> Word8
lengthOf = ceiling . (logBase 256 :: Float -> Float) . fromIntegral
-- | <https://crypto.stanford.edu/sjcl/ SJCL>-compatible encryption function.
-- Follows <https://tools.ietf.org/html/rfc3610 RFC3610> with a 8-bytes tag.
-- Uses 16-bytes cipher key generated from the password and a random 'salt'
-- by PBKDF2-HMAC-SHA256 with 1000 iterations.
encrypt :: String -- ^ the password
-> ByteString -- ^ the plain data to encrypt
-> IO Content
encrypt password plaintext = do
ivd <- getEntropy 16 -- XXX it is truncated to get the nonce below
slt <- getEntropy 13 -- arbitrary length
cipher <- makeCipher $ makeKey (C.pack password) slt
let tlen = 8 :: Word8
l = BS.length plaintext
eL = max 2 (lengthOf l)
nonce = BS.take (15 - fromIntegral eL) ivd
b0 = BS.concat [
BS.pack [8*((tlen-2) `div` 2) + (eL-1)],
nonce,
i2ospOf_ (fromIntegral eL) (fromIntegral l)
]
mac = foldl (\ a b -> ecbEncrypt cipher $ BA.xor a b)
(ecbEncrypt cipher b0)
(chunks (blockSize cipher) plaintext)
tag = BS.take (fromIntegral tlen) mac
a0 = BS.concat [
BS.pack [eL - 1],
nonce,
BS.replicate (fromIntegral eL) 0
]
a1iv = ivAdd (fromJust . makeIV $ a0) 1
ciphtext = BS.append
(ctrCombine cipher a1iv plaintext)
(BA.xor (ecbEncrypt cipher a0) tag)
return Content { iv = toWeb ivd, salt = toWeb slt, ct = toWeb ciphtext }
|
