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
|
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI #-}
-- |Asymmetric cipher decryption using encrypted symmetric key. This
-- is an opposite of "OpenSSL.EVP.Open".
module OpenSSL.EVP.Seal
( seal
, sealBS
, sealLBS
)
where
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as L8
import Foreign
import Foreign.C
import OpenSSL.EVP.Cipher hiding (cipher)
import OpenSSL.EVP.PKey
import OpenSSL.EVP.Internal
import OpenSSL.Utils
foreign import capi unsafe "openssl/evp.h EVP_SealInit"
_SealInit :: Ptr EVP_CIPHER_CTX
-> Cipher
-> Ptr (Ptr CChar)
-> Ptr CInt
-> Ptr CChar
-> Ptr (Ptr EVP_PKEY)
-> CInt
-> IO CInt
sealInit :: Cipher
-> [SomePublicKey]
-> IO (CipherCtx, [B8.ByteString], B8.ByteString)
sealInit _ []
= fail "sealInit: at least one public key is required"
sealInit cipher pubKeys
= do ctx <- newCipherCtx
-- Allocate a list of buffers to write encrypted symmetric
-- keys. Each keys will be at most pkeySize bytes long.
encKeyBufs <- mapM mallocEncKeyBuf pubKeys
-- encKeyBufs is [Ptr a] but we want Ptr (Ptr CChar).
encKeyBufsPtr <- newArray encKeyBufs
-- Allocate a buffer to write lengths of each encrypted
-- symmetric keys.
encKeyBufsLenPtr <- mallocArray nKeys
-- Allocate a buffer to write IV.
ivPtr <- mallocArray (cipherIvLength cipher)
-- Create Ptr (Ptr EVP_PKEY) from [PKey]. Don't forget to
-- apply touchForeignPtr to each PKey's later.
pkeys <- mapM toPKey pubKeys
pubKeysPtr <- newArray $ map unsafePKeyToPtr pkeys
-- Prepare an IO action to free buffers we allocated above.
let cleanup = do mapM_ free encKeyBufs
free encKeyBufsPtr
free encKeyBufsLenPtr
free ivPtr
free pubKeysPtr
mapM_ touchPKey pkeys
-- Call EVP_SealInit finally.
ret <- withCipherCtxPtr ctx $ \ ctxPtr ->
_SealInit ctxPtr cipher encKeyBufsPtr encKeyBufsLenPtr ivPtr pubKeysPtr (fromIntegral nKeys)
if ret == 0 then
cleanup >> raiseOpenSSLError
else
do encKeysLen <- peekArray nKeys encKeyBufsLenPtr
encKeys <- mapM B8.packCStringLen $ zip encKeyBufs (fromIntegral `fmap` encKeysLen)
iv <- B8.packCStringLen (ivPtr, cipherIvLength cipher)
cleanup
return (ctx, encKeys, iv)
where
nKeys :: Int
nKeys = length pubKeys
mallocEncKeyBuf :: (PKey k, Storable a) => k -> IO (Ptr a)
mallocEncKeyBuf = mallocArray . pkeySize
-- |@'seal'@ lazilly encrypts a stream of data. The input string
-- doesn't necessarily have to be finite.
seal :: Cipher -- ^ symmetric cipher algorithm to use
-> [SomePublicKey] -- ^ A list of public keys to encrypt a
-- symmetric key. At least one public key
-- must be supplied. If two or more keys are
-- given, the symmetric key are encrypted by
-- each public keys so that any of the
-- corresponding private keys can decrypt
-- the message.
-> String -- ^ input string to encrypt
-> IO ( String
, [String]
, String
) -- ^ (encrypted string, list of encrypted asymmetric
-- keys, IV)
{-# DEPRECATED seal "Use sealBS or sealLBS instead." #-}
seal cipher pubKeys input
= do (output, encKeys, iv) <- sealLBS cipher pubKeys $ L8.pack input
return ( L8.unpack output
, B8.unpack `fmap` encKeys
, B8.unpack iv
)
-- |@'sealBS'@ strictly encrypts a chunk of data.
sealBS :: Cipher -- ^ symmetric cipher algorithm to use
-> [SomePublicKey] -- ^ list of public keys to encrypt a
-- symmetric key
-> B8.ByteString -- ^ input string to encrypt
-> IO ( B8.ByteString
, [B8.ByteString]
, B8.ByteString
) -- ^ (encrypted string, list of encrypted asymmetric
-- keys, IV)
sealBS cipher pubKeys input
= do (ctx, encKeys, iv) <- sealInit cipher pubKeys
output <- cipherStrictly ctx input
return (output, encKeys, iv)
-- |@'sealLBS'@ lazilly encrypts a stream of data. The input string
-- doesn't necessarily have to be finite.
sealLBS :: Cipher -- ^ symmetric cipher algorithm to use
-> [SomePublicKey] -- ^ list of public keys to encrypt a
-- symmetric key
-> L8.ByteString -- ^ input string to encrypt
-> IO ( L8.ByteString
, [B8.ByteString]
, B8.ByteString
) -- ^ (encrypted string, list of encrypted asymmetric
-- keys, IV)
sealLBS cipher pubKeys input
= do (ctx, encKeys, iv) <- sealInit cipher pubKeys
output <- cipherLazily ctx input
return (output, encKeys, iv)
|
