diff --git a/example/StreamingDecrypter.hs b/example/StreamingDecrypter.hs --- a/example/StreamingDecrypter.hs +++ b/example/StreamingDecrypter.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Crypto.RNCryptor.V3 +import Crypto.RNCryptor.V3.Decrypt import qualified System.IO.Streams as S import System.Environment import qualified Data.ByteString.Char8 as B @@ -11,4 +11,4 @@ args <- getArgs case args of key:_ -> decryptStream (B.pack key) S.stdin S.stdout - _ -> putStrLn "usage: rncryptor-stream " + _ -> putStrLn "usage: rncryptor-decrypt " diff --git a/example/StreamingEncrypter.hs b/example/StreamingEncrypter.hs new file mode 100644 --- /dev/null +++ b/example/StreamingEncrypter.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Crypto.RNCryptor.V3.Encrypt +import qualified System.IO.Streams as S +import System.Environment +import qualified Data.ByteString.Char8 as B + +main :: IO () +main = do + args <- getArgs + case args of + key:_ -> encryptStream (B.pack key) S.stdin S.stdout + _ -> putStrLn "usage: rncryptor-encrypt " diff --git a/rncryptor.cabal b/rncryptor.cabal --- a/rncryptor.cabal +++ b/rncryptor.cabal @@ -1,5 +1,5 @@ name: rncryptor -version: 0.0.1.0 +version: 0.0.2.0 synopsis: Haskell implementation of the RNCryptor file format description: Pure Haskell implementation of the RNCrytor spec. license: MIT @@ -17,14 +17,17 @@ library exposed-modules: + Crypto.RNCryptor.Padding Crypto.RNCryptor.V3 + Crypto.RNCryptor.V3.Encrypt + Crypto.RNCryptor.V3.Decrypt Crypto.RNCryptor.Types other-modules: build-depends: base >=4.6 && < 5 , bytestring >= 0.9.0 , mtl >= 2.1 - , base64-bytestring >= 1.0.0.1 + , random >= 1.0.0.1 , QuickCheck >= 2.6 && < 2.8 , io-streams >= 1.2.0.0 , cipher-aes >= 0.2.0 @@ -56,18 +59,33 @@ , tasty-quickcheck , tasty-hunit -executable rncryptor-stream +executable rncryptor-decrypt build-depends: base , bytestring , io-streams - , base64-bytestring , cipher-aes , rncryptor -any hs-source-dirs: example main-is: StreamingDecrypter.hs + default-language: + Haskell2010 + ghc-options: + -funbox-strict-fields + +executable rncryptor-encrypt + build-depends: + base + , bytestring + , io-streams + , cipher-aes + , rncryptor -any + hs-source-dirs: + example + main-is: + StreamingEncrypter.hs default-language: Haskell2010 ghc-options: diff --git a/src/Crypto/RNCryptor/Padding.hs b/src/Crypto/RNCryptor/Padding.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/RNCryptor/Padding.hs @@ -0,0 +1,19 @@ +module Crypto.RNCryptor.Padding + ( pkcs7Padding ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B + + +-------------------------------------------------------------------------------- +-- | Computes the padding as per PKCS#7. The specification can be found +-- here: +pkcs7Padding :: Int + -- ^ The block size (e.g. 16 bytes) + -> Int + -- ^ The input size + -> ByteString + -- ^ The resulting padding +pkcs7Padding k l = + let octetsSize = k - (l `rem` k) + in B.pack $ replicate octetsSize (fromIntegral octetsSize) diff --git a/src/Crypto/RNCryptor/Types.hs b/src/Crypto/RNCryptor/Types.hs --- a/src/Crypto/RNCryptor/Types.hs +++ b/src/Crypto/RNCryptor/Types.hs @@ -1,12 +1,20 @@ - +{-# LANGUAGE RecordWildCards #-} module Crypto.RNCryptor.Types ( RNCryptorHeader(..) , RNCryptorContext(ctxHeader, ctxCipher) , newRNCryptorContext + , newRNCryptorHeader + , renderRNCryptorHeader + , blockSize ) where -import Data.ByteString (ByteString) +import Data.ByteString (cons, ByteString) +import qualified Data.ByteString.Char8 as C8 import Data.Word +import Data.Monoid +import System.Random +import Control.Applicative +import Control.Monad import Crypto.Cipher.AES import Crypto.PBKDF.ByteString @@ -20,7 +28,7 @@ -- ^ iff option includes "uses password" , rncHMACSalt :: !ByteString -- ^ iff options includes "uses password" - , rncIV :: !AESIV + , rncIV :: !ByteString -- ^ The initialisation vector -- The ciphertext is variable and encrypted in CBC mode , rncHMAC :: (ByteString -> ByteString) @@ -28,6 +36,43 @@ -- as the HMAC is at the end of the file. } +-------------------------------------------------------------------------------- +saltSize :: Int +saltSize = 8 + +-------------------------------------------------------------------------------- +blockSize :: Int +blockSize = 16 + +-------------------------------------------------------------------------------- +randomSaltIO :: Int -> IO ByteString +randomSaltIO sz = C8.pack <$> forM [1 .. sz] (const $ randomRIO ('\NUL', '\255')) + +-------------------------------------------------------------------------------- +-- | Generates a new 'RNCryptorHeader', suitable for encryption. +newRNCryptorHeader :: ByteString -> IO RNCryptorHeader +newRNCryptorHeader userKey = do + let version = toEnum 3 + let options = toEnum 1 + eSalt <- randomSaltIO saltSize + iv <- randomSaltIO blockSize + hmacSalt <- randomSaltIO saltSize + return RNCryptorHeader { + rncVersion = version + , rncOptions = options + , rncEncryptionSalt = eSalt + , rncHMACSalt = hmacSalt + , rncIV = iv + , rncHMAC = const $ sha1PBKDF2 userKey hmacSalt 10000 32 + } + +-------------------------------------------------------------------------------- +-- | Concatenates this 'RNCryptorHeader' into a raw sequence of bytes, up to the +-- IV. This means you need to append the ciphertext plus the HMAC to finalise +-- the encrypted file. +renderRNCryptorHeader :: RNCryptorHeader -> ByteString +renderRNCryptorHeader RNCryptorHeader{..} = + rncVersion `cons` rncOptions `cons` (rncEncryptionSalt <> rncHMACSalt <> rncIV) -------------------------------------------------------------------------------- -- A convenient datatype to avoid carrying around the AES cypher, diff --git a/src/Crypto/RNCryptor/V3.hs b/src/Crypto/RNCryptor/V3.hs --- a/src/Crypto/RNCryptor/V3.hs +++ b/src/Crypto/RNCryptor/V3.hs @@ -1,196 +1,8 @@ -{-# LANGUAGE BangPatterns #-} -module Crypto.RNCryptor.V3 - ( pkcs7Padding - , parseHeader - , decrypt - , decryptBlock - , decryptStream +{-# OPTIONS_GHC -fno-warn-unused-imports #-} +module Crypto.RNCryptor.V3 ( + module Crypto.RNCryptor.V3.Encrypt + , module Crypto.RNCryptor.V3.Decrypt ) where -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Word -import Control.Monad.State -import Crypto.RNCryptor.Types -import Crypto.Cipher.AES -import Data.Monoid -import qualified System.IO.Streams as S - - --------------------------------------------------------------------------------- --- | Computes the padding as per PKCS#7. The specification can be found --- here: http://tools.ietf.org/html/rfc5652#section-6.3 -pkcs7Padding :: Int - -- ^ The block size (e.g. 16 bytes) - -> Int - -- ^ The input size - -> ByteString - -- ^ The resulting padding -pkcs7Padding k l = - let octetsSize = k - (l `mod` k) - in B.pack $ replicate octetsSize (fromInteger . toInteger $ octetsSize) - --------------------------------------------------------------------------------- --- | Parse the input 'ByteString' to extract the 'RNCryptorHeader', as --- defined in the V3 spec. The incoming 'ByteString' is expected to have --- at least 34 bytes available. As the HMAC can be found only at the very --- end of an encrypted file, 'RNCryptorHeader' provides by default a function --- to parse the HMAC, callable at the right time during streaming/parsing. -parseHeader :: ByteString -> RNCryptorHeader -parseHeader input = flip evalState input $ do - v <- parseVersion - o <- parseOptions - eSalt <- parseEncryptionSalt - hmacSalt <- parseHMACSalt - iv <- parseIV - return RNCryptorHeader { - rncVersion = v - , rncOptions = o - , rncEncryptionSalt = eSalt - , rncHMACSalt = hmacSalt - , rncIV = iv - , rncHMAC = parseHMAC - } - --------------------------------------------------------------------------------- -parseSingleWord8 :: String -> State ByteString Word8 -parseSingleWord8 err = do - bs <- get - let (v,vs) = B.splitAt 1 bs - put vs - case B.unpack v of - x:[] -> return x - _ -> fail err - --------------------------------------------------------------------------------- -parseBSOfSize :: Int -> String -> State ByteString ByteString -parseBSOfSize sz err = do - bs <- get - let (v,vs) = B.splitAt sz bs - put vs - case B.unpack v of - [] -> fail err - _ -> return v - --------------------------------------------------------------------------------- -parseVersion :: State ByteString Word8 -parseVersion = parseSingleWord8 "parseVersion: not enough bytes." - --------------------------------------------------------------------------------- -parseOptions :: State ByteString Word8 -parseOptions = parseSingleWord8 "parseOptions: not enough bytes." - --------------------------------------------------------------------------------- -parseEncryptionSalt :: State ByteString ByteString -parseEncryptionSalt = parseBSOfSize 8 "parseEncryptionSalt: not enough bytes." - --------------------------------------------------------------------------------- -parseHMACSalt :: State ByteString ByteString -parseHMACSalt = parseBSOfSize 8 "parseHMACSalt: not enough bytes." - --------------------------------------------------------------------------------- -parseIV :: State ByteString AESIV -parseIV = fmap aesIV_ (parseBSOfSize 16 "parseIV: not enough bytes.") - --------------------------------------------------------------------------------- -parseHMAC :: ByteString -> ByteString -parseHMAC leftover = flip evalState leftover $ parseBSOfSize 32 "parseHMAC: not enough bytes." - --------------------------------------------------------------------------------- -blockSize :: Int -blockSize = 16 - --------------------------------------------------------------------------------- --- | This was taken directly from the Python implementation, see "post_decrypt_data", --- even though it doesn't seem to be a usual PKCS#7 removal: --- data = data[:-bord(data[-1])] --- https://github.com/RNCryptor/RNCryptor-python/blob/master/RNCryptor.py#L69 -removePaddingSymbols :: ByteString -> ByteString -removePaddingSymbols input = - let lastWord = B.last input - in B.take (B.length input - fromEnum lastWord) input - --------------------------------------------------------------------------------- --- | Decrypt a raw Bytestring block. The function returns the clear text block --- plus a new 'RNCryptorContext', which is needed because the IV needs to be --- set to the last 16 bytes of the previous cipher text. (Thanks to Rob Napier --- for the insight). -decryptBlock :: RNCryptorContext - -> ByteString - -> (RNCryptorContext, ByteString) -decryptBlock ctx cipherText = - let clearText = decryptCBC (ctxCipher ctx) (rncIV . ctxHeader $ ctx) cipherText - !sz = B.length cipherText - !newHeader = (ctxHeader ctx) { rncIV = aesIV_ (B.drop (sz - 16) cipherText) } - in (ctx { ctxHeader = newHeader }, clearText) - --------------------------------------------------------------------------------- --- | Decrypt an encrypted message. Please be aware that this is a user-friendly --- but dangerous function, in the sense that it will load the *ENTIRE* input in --- memory. It's mostly suitable for small inputs like passwords. For large --- inputs, where size exceeds the available memory, please use 'decryptStream'. -decrypt :: ByteString -> ByteString -> ByteString -decrypt input pwd = - let (rawHdr, rest) = B.splitAt 34 input - -- remove the hmac at the end of the file - (toDecrypt, _) = B.splitAt (B.length rest - 32) rest - hdr = parseHeader rawHdr - ctx = newRNCryptorContext pwd hdr - clearText = decryptCBC (ctxCipher ctx) (rncIV . ctxHeader $ ctx) toDecrypt - in removePaddingSymbols clearText - - --------------------------------------------------------------------------------- --- | The 'DecryptionState' the streamer can be at. This is needed to drive the --- computation as well as reading leftovers unread back in case we need to --- chop the buffer read, if not multiple of the 'blockSize'. -data DecryptionState = - Continue - | FetchLeftOver !Int - | DrainSource deriving (Show, Eq) - --------------------------------------------------------------------------------- -decryptStream :: ByteString - -> S.InputStream ByteString - -> S.OutputStream ByteString - -> IO () -decryptStream userKey inS outS = do - rawHdr <- S.readExactly 34 inS - let hdr = parseHeader rawHdr - let ctx = newRNCryptorContext userKey hdr - go Continue mempty ctx - where - slack input = let bsL = B.length input in (bsL, bsL `mod` blockSize) - - go :: DecryptionState -> ByteString -> RNCryptorContext -> IO () - go dc !iBuffer ctx = do - nextChunk <- case dc of - FetchLeftOver size -> do - lo <- S.readExactly size inS - p <- S.read inS - return $ fmap (mappend lo) p - _ -> S.read inS - case nextChunk of - Nothing -> finaliseDecryption iBuffer ctx - (Just v) -> do - let (sz, sl) = slack v - case dc of - DrainSource -> go DrainSource (iBuffer <> v) ctx - _ -> do - whatsNext <- S.peek inS - case whatsNext of - Nothing -> finaliseDecryption (iBuffer <> v) ctx - Just nt -> - case sz + B.length nt < 4096 of - True -> go DrainSource (iBuffer <> v) ctx - False -> do - -- If I'm here, it means I can safely decrypt this chunk - let (toDecrypt, rest) = B.splitAt (sz - sl) v - let (newCtx, clearT) = decryptBlock ctx toDecrypt - S.write (Just $ clearT) outS - S.unRead rest inS - go (FetchLeftOver sl) iBuffer newCtx - - finaliseDecryption lastBlock ctx = do - let (rest, _) = B.splitAt (B.length lastBlock - 32) lastBlock --strip the hmac - S.write (Just $ removePaddingSymbols (snd $ decryptBlock ctx rest)) outS +import Crypto.RNCryptor.V3.Encrypt +import Crypto.RNCryptor.V3.Decrypt diff --git a/src/Crypto/RNCryptor/V3/Decrypt.hs b/src/Crypto/RNCryptor/V3/Decrypt.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/RNCryptor/V3/Decrypt.hs @@ -0,0 +1,185 @@ +{-# LANGUAGE BangPatterns #-} +module Crypto.RNCryptor.V3.Decrypt + ( parseHeader + , decrypt + , decryptBlock + , decryptStream + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Word +import Control.Monad.State +import Crypto.RNCryptor.Types +import Crypto.Cipher.AES +import Data.Monoid +import qualified System.IO.Streams as S + + +-------------------------------------------------------------------------------- +-- | Parse the input 'ByteString' to extract the 'RNCryptorHeader', as +-- defined in the V3 spec. The incoming 'ByteString' is expected to have +-- at least 34 bytes available. As the HMAC can be found only at the very +-- end of an encrypted file, 'RNCryptorHeader' provides by default a function +-- to parse the HMAC, callable at the right time during streaming/parsing. +parseHeader :: ByteString -> RNCryptorHeader +parseHeader input = flip evalState input $ do + v <- parseVersion + o <- parseOptions + eSalt <- parseEncryptionSalt + hmacSalt <- parseHMACSalt + iv <- parseIV + return RNCryptorHeader { + rncVersion = v + , rncOptions = o + , rncEncryptionSalt = eSalt + , rncHMACSalt = hmacSalt + , rncIV = iv + , rncHMAC = parseHMAC + } + +-------------------------------------------------------------------------------- +parseSingleWord8 :: String -> State ByteString Word8 +parseSingleWord8 err = do + bs <- get + let (v,vs) = B.splitAt 1 bs + put vs + case B.unpack v of + x:[] -> return x + _ -> fail err + +-------------------------------------------------------------------------------- +parseBSOfSize :: Int -> String -> State ByteString ByteString +parseBSOfSize sz err = do + bs <- get + let (v,vs) = B.splitAt sz bs + put vs + case B.unpack v of + [] -> fail err + _ -> return v + +-------------------------------------------------------------------------------- +parseVersion :: State ByteString Word8 +parseVersion = parseSingleWord8 "parseVersion: not enough bytes." + +-------------------------------------------------------------------------------- +parseOptions :: State ByteString Word8 +parseOptions = parseSingleWord8 "parseOptions: not enough bytes." + +-------------------------------------------------------------------------------- +parseEncryptionSalt :: State ByteString ByteString +parseEncryptionSalt = parseBSOfSize 8 "parseEncryptionSalt: not enough bytes." + +-------------------------------------------------------------------------------- +parseHMACSalt :: State ByteString ByteString +parseHMACSalt = parseBSOfSize 8 "parseHMACSalt: not enough bytes." + +-------------------------------------------------------------------------------- +parseIV :: State ByteString ByteString +parseIV = parseBSOfSize 16 "parseIV: not enough bytes." + +-------------------------------------------------------------------------------- +parseHMAC :: ByteString -> ByteString +parseHMAC leftover = flip evalState leftover $ parseBSOfSize 32 "parseHMAC: not enough bytes." + +-------------------------------------------------------------------------------- +-- | This was taken directly from the Python implementation, see "post_decrypt_data", +-- even though it doesn't seem to be a usual PKCS#7 removal: +-- data = data[:-bord(data[-1])] +-- https://github.com/RNCryptor/RNCryptor-python/blob/master/RNCryptor.py#L69 +removePaddingSymbols :: ByteString -> ByteString +removePaddingSymbols input = + let lastWord = B.last input + in B.take (B.length input - fromEnum lastWord) input + +-------------------------------------------------------------------------------- +-- | Decrypt a raw Bytestring block. The function returns the clear text block +-- plus a new 'RNCryptorContext', which is needed because the IV needs to be +-- set to the last 16 bytes of the previous cipher text. (Thanks to Rob Napier +-- for the insight). +decryptBlock :: RNCryptorContext + -> ByteString + -> (RNCryptorContext, ByteString) +decryptBlock ctx cipherText = + let clearText = decryptCBC (ctxCipher ctx) (aesIV_ . rncIV . ctxHeader $ ctx) cipherText + !sz = B.length cipherText + !newHeader = (ctxHeader ctx) { rncIV = (B.drop (sz - 16) cipherText) } + in (ctx { ctxHeader = newHeader }, clearText) + +-------------------------------------------------------------------------------- +-- | Decrypt an encrypted message. Please be aware that this is a user-friendly +-- but dangerous function, in the sense that it will load the *ENTIRE* input in +-- memory. It's mostly suitable for small inputs like passwords. For large +-- inputs, where size exceeds the available memory, please use 'decryptStream'. +decrypt :: ByteString -> ByteString -> ByteString +decrypt input pwd = + let (rawHdr, rest) = B.splitAt 34 input + -- remove the hmac at the end of the file + (toDecrypt, _) = B.splitAt (B.length rest - 32) rest + hdr = parseHeader rawHdr + ctx = newRNCryptorContext pwd hdr + clearText = decryptCBC (ctxCipher ctx) (aesIV_ . rncIV . ctxHeader $ ctx) toDecrypt + in removePaddingSymbols clearText + + +-------------------------------------------------------------------------------- +-- | The 'DecryptionState' the streamer can be at. This is needed to drive the +-- computation as well as reading leftovers unread back in case we need to +-- chop the buffer read, if not multiple of the 'blockSize'. +data DecryptionState = + Continue + | FetchLeftOver !Int + | DrainSource deriving (Show, Eq) + +-------------------------------------------------------------------------------- +-- | Efficiently decrypts an incoming stream of bytes. +decryptStream :: ByteString + -- ^ The user key (e.g. password) + -> S.InputStream ByteString + -- ^ The input source (mostly likely stdin) + -> S.OutputStream ByteString + -- ^ The output source (mostly likely stdout) + -> IO () +decryptStream userKey inS outS = do + rawHdr <- S.readExactly 34 inS + let hdr = parseHeader rawHdr + let ctx = newRNCryptorContext userKey hdr + go Continue mempty ctx + where + slack input = let bsL = B.length input in (bsL, bsL `mod` blockSize) + + go :: DecryptionState -> ByteString -> RNCryptorContext -> IO () + go dc !iBuffer ctx = do + nextChunk <- case dc of + FetchLeftOver size -> do + lo <- S.readExactly size inS + p <- S.read inS + return $ fmap (mappend lo) p + _ -> S.read inS + case nextChunk of + Nothing -> finaliseDecryption iBuffer ctx + (Just v) -> do + let (sz, sl) = slack v + case dc of + DrainSource -> go DrainSource (iBuffer <> v) ctx + _ -> do + whatsNext <- S.peek inS + case whatsNext of + Nothing -> finaliseDecryption (iBuffer <> v) ctx + Just nt -> + case sz + B.length nt < 4096 of + True -> go DrainSource (iBuffer <> v) ctx + False -> do + -- If I'm here, it means I can safely decrypt this chunk + let (toDecrypt, rest) = B.splitAt (sz - sl) v + let (newCtx, clearT) = decryptBlock ctx toDecrypt + S.write (Just clearT) outS + case sl == 0 of + False -> do + S.unRead rest inS + go (FetchLeftOver sl) iBuffer newCtx + True -> go Continue iBuffer newCtx + + finaliseDecryption lastBlock ctx = do + let (rest, _) = B.splitAt (B.length lastBlock - 32) lastBlock --strip the hmac + S.write (Just $ removePaddingSymbols (snd $ decryptBlock ctx rest)) outS diff --git a/src/Crypto/RNCryptor/V3/Encrypt.hs b/src/Crypto/RNCryptor/V3/Encrypt.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/RNCryptor/V3/Encrypt.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE BangPatterns #-} +module Crypto.RNCryptor.V3.Encrypt + ( pkcs7Padding + , encrypt + , encryptBlock + , encryptStream + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Crypto.RNCryptor.Types +import Crypto.RNCryptor.Padding +import Crypto.Cipher.AES +import Data.Monoid +import qualified System.IO.Streams as S + + +-------------------------------------------------------------------------------- +-- | Encrypt a raw Bytestring block. The function returns the encrypt text block +-- plus a new 'RNCryptorContext', which is needed because the IV needs to be +-- set to the last 16 bytes of the previous cipher text. (Thanks to Rob Napier +-- for the insight). +encryptBlock :: RNCryptorContext + -> ByteString + -> (RNCryptorContext, ByteString) +encryptBlock ctx clearText = + let cipherText = encryptCBC (ctxCipher ctx) (rncIV . ctxHeader $ ctx) clearText + !sz = B.length clearText + !newHeader = (ctxHeader ctx) { rncIV = (B.drop (sz - 16) clearText) } + in (ctx { ctxHeader = newHeader }, cipherText) + +-------------------------------------------------------------------------------- +-- | Encrypt a message. Please be aware that this is a user-friendly +-- but dangerous function, in the sense that it will load the *ENTIRE* input in +-- memory. It's mostly suitable for small inputs like passwords. For large +-- inputs, where size exceeds the available memory, please use 'encryptStream'. +encrypt :: RNCryptorContext -> ByteString -> ByteString +encrypt ctx input = + let hdr = ctxHeader ctx + inSz = B.length input + (_, clearText) = encryptBlock ctx (input <> pkcs7Padding blockSize inSz) + in renderRNCryptorHeader hdr <> clearText <> (rncHMAC hdr $ mempty) + + +-------------------------------------------------------------------------------- +-- | The 'EncryptionState' the streamer can be at. This is needed to drive the +-- computation as well as reading leftovers unread back in case we need to +-- chop the buffer read, if not multiple of the 'blockSize'. +data EncryptionState = + Continue + | FetchLeftOver !Int + | DrainSource deriving (Show, Eq) + +-------------------------------------------------------------------------------- +-- | Efficiently encrypt an incoming stream of bytes. +encryptStream :: ByteString + -- ^ The user key (e.g. password) + -> S.InputStream ByteString + -- ^ The input source (mostly likely stdin) + -> S.OutputStream ByteString + -- ^ The output source (mostly likely stdout) + -> IO () +encryptStream userKey inS outS = do + hdr <- newRNCryptorHeader userKey + let ctx = newRNCryptorContext userKey hdr + S.write (Just $ renderRNCryptorHeader hdr) outS + go Continue mempty ctx + where + slack input = let bsL = B.length input in (bsL, bsL `mod` blockSize) + + go :: EncryptionState -> ByteString -> RNCryptorContext -> IO () + go dc !iBuffer ctx = do + nextChunk <- case dc of + FetchLeftOver size -> do + lo <- S.readExactly size inS + p <- S.read inS + return $ fmap (mappend lo) p + _ -> S.read inS + case nextChunk of + Nothing -> finaliseEncryption iBuffer ctx + (Just v) -> do + let (sz, sl) = slack v + case dc of + DrainSource -> go DrainSource (iBuffer <> v) ctx + _ -> do + whatsNext <- S.peek inS + case whatsNext of + Nothing -> finaliseEncryption (iBuffer <> v) ctx + Just nt -> + case sz + B.length nt < 4096 of + True -> go DrainSource (iBuffer <> v) ctx + False -> do + -- If I'm here, it means I can safely decrypt this chunk + let (toEncrypt, rest) = B.splitAt (sz - sl) v + let (newCtx, cryptoB) = encryptBlock ctx toEncrypt + S.write (Just cryptoB) outS + case sl == 0 of + False -> do + S.unRead rest inS + go (FetchLeftOver sl) iBuffer newCtx + True -> go Continue iBuffer newCtx + + finaliseEncryption lastBlock ctx = do + let inSz = B.length lastBlock + padding = pkcs7Padding blockSize inSz + S.write (Just (snd $ encryptBlock ctx (lastBlock <> padding))) outS