{-# LANGUAGE BangPatterns #-}
module Crypto.RNCryptor.V3.Encrypt
( encrypt
, encryptBlock
, encryptStream
, encryptStreamWithContext
) where
import Crypto.Cipher.AES (AES256)
import Crypto.Cipher.Types (makeIV, IV, BlockCipher, cbcEncrypt)
import Crypto.MAC.HMAC (update, finalize)
import Crypto.RNCryptor.Padding
import Crypto.RNCryptor.Types
import Crypto.RNCryptor.V3.Stream
import Data.ByteArray (convert)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Maybe (fromMaybe)
import Data.Monoid
import qualified System.IO.Streams as S
encryptBytes :: AES256 -> ByteString -> ByteString -> ByteString
encryptBytes a iv = cbcEncrypt a iv'
where
iv' = fromMaybe (error $ "encryptBytes: makeIV failed (iv was: " <> show (B.unpack iv) <> ")") $ makeIV iv
encryptBlock :: RNCryptorContext
-> ByteString
-> (RNCryptorContext, ByteString)
encryptBlock ctx clearText =
let cipherText = encryptBytes (ctxCipher ctx) (rncIV . ctxHeader $ ctx) clearText
!newHmacCtx = update (ctxHMACCtx ctx) cipherText
!sz = B.length clearText
!newHeader = (ctxHeader ctx) { rncIV = B.drop (sz - 16) cipherText }
in (ctx { ctxHeader = newHeader, ctxHMACCtx = newHmacCtx }, cipherText)
encrypt :: RNCryptorContext -> ByteString -> ByteString
encrypt ctx input =
let msgHdr = renderRNCryptorHeader $ ctxHeader ctx
ctx' = ctx { ctxHMACCtx = update (ctxHMACCtx ctx) msgHdr }
(ctx'', cipherText) = encryptBlock ctx' (input <> pkcs7Padding blockSize (B.length input))
msgHMAC = convert $ finalize (ctxHMACCtx ctx'')
in msgHdr <> cipherText <> msgHMAC
encryptStreamWithContext :: RNCryptorContext
-> S.InputStream ByteString
-> S.OutputStream ByteString
-> IO ()
encryptStreamWithContext ctx inS outS = do
S.write (Just (renderRNCryptorHeader $ ctxHeader ctx)) outS
processStream ctx inS outS encryptBlock finaliseEncryption
where
finaliseEncryption lastBlock lastCtx = do
let (ctx', cipherText) = encryptBlock lastCtx (lastBlock <> pkcs7Padding blockSize (B.length lastBlock))
S.write (Just cipherText) outS
S.write (Just (convert $ finalize (ctxHMACCtx ctx'))) outS
encryptStream :: Password
-> S.InputStream ByteString
-> S.OutputStream ByteString
-> IO ()
encryptStream userKey inS outS = do
hdr <- newRNCryptorHeader
let ctx = newRNCryptorContext userKey hdr
msgHdr = renderRNCryptorHeader hdr
ctx' = ctx { ctxHMACCtx = update (ctxHMACCtx ctx) msgHdr }
encryptStreamWithContext ctx' inS outS