packages feed

rncryptor 0.0.1.0 → 0.0.2.0

raw patch · 8 files changed

+402/−203 lines, 8 filesdep +randomdep −base64-bytestringdep ~basedep ~bytestringdep ~cipher-aesnew-component:exe:rncryptor-decryptnew-component:exe:rncryptor-encryptPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: random

Dependencies removed: base64-bytestring

Dependency ranges changed: base, bytestring, cipher-aes, io-streams

API changes (from Hackage documentation)

- Crypto.RNCryptor.V3: decrypt :: ByteString -> ByteString -> ByteString
- Crypto.RNCryptor.V3: decryptBlock :: RNCryptorContext -> ByteString -> (RNCryptorContext, ByteString)
- Crypto.RNCryptor.V3: decryptStream :: ByteString -> InputStream ByteString -> OutputStream ByteString -> IO ()
- Crypto.RNCryptor.V3: instance Eq DecryptionState
- Crypto.RNCryptor.V3: instance Show DecryptionState
- Crypto.RNCryptor.V3: parseHeader :: ByteString -> RNCryptorHeader
- Crypto.RNCryptor.V3: pkcs7Padding :: Int -> Int -> ByteString
+ Crypto.RNCryptor.Padding: pkcs7Padding :: Int -> Int -> ByteString
+ Crypto.RNCryptor.Types: blockSize :: Int
+ Crypto.RNCryptor.Types: newRNCryptorHeader :: ByteString -> IO RNCryptorHeader
+ Crypto.RNCryptor.Types: renderRNCryptorHeader :: RNCryptorHeader -> ByteString
+ Crypto.RNCryptor.V3.Decrypt: decrypt :: ByteString -> ByteString -> ByteString
+ Crypto.RNCryptor.V3.Decrypt: decryptBlock :: RNCryptorContext -> ByteString -> (RNCryptorContext, ByteString)
+ Crypto.RNCryptor.V3.Decrypt: decryptStream :: ByteString -> InputStream ByteString -> OutputStream ByteString -> IO ()
+ Crypto.RNCryptor.V3.Decrypt: instance Eq DecryptionState
+ Crypto.RNCryptor.V3.Decrypt: instance Show DecryptionState
+ Crypto.RNCryptor.V3.Decrypt: parseHeader :: ByteString -> RNCryptorHeader
+ Crypto.RNCryptor.V3.Encrypt: encrypt :: RNCryptorContext -> ByteString -> ByteString
+ Crypto.RNCryptor.V3.Encrypt: encryptBlock :: RNCryptorContext -> ByteString -> (RNCryptorContext, ByteString)
+ Crypto.RNCryptor.V3.Encrypt: encryptStream :: ByteString -> InputStream ByteString -> OutputStream ByteString -> IO ()
+ Crypto.RNCryptor.V3.Encrypt: instance Eq EncryptionState
+ Crypto.RNCryptor.V3.Encrypt: instance Show EncryptionState
+ Crypto.RNCryptor.V3.Encrypt: pkcs7Padding :: Int -> Int -> ByteString
- Crypto.RNCryptor.Types: RNCryptorHeader :: !Word8 -> !Word8 -> !ByteString -> !ByteString -> !AESIV -> (ByteString -> ByteString) -> RNCryptorHeader
+ Crypto.RNCryptor.Types: RNCryptorHeader :: !Word8 -> !Word8 -> !ByteString -> !ByteString -> !ByteString -> (ByteString -> ByteString) -> RNCryptorHeader
- Crypto.RNCryptor.Types: rncIV :: RNCryptorHeader -> !AESIV
+ Crypto.RNCryptor.Types: rncIV :: RNCryptorHeader -> !ByteString

Files

example/StreamingDecrypter.hs view
@@ -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 <key>"+    _ -> putStrLn "usage: rncryptor-decrypt <key>"
+ example/StreamingEncrypter.hs view
@@ -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 <key>"
rncryptor.cabal view
@@ -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:
+ src/Crypto/RNCryptor/Padding.hs view
@@ -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: <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 `rem` k)+  in  B.pack $ replicate octetsSize (fromIntegral octetsSize)
src/Crypto/RNCryptor/Types.hs view
@@ -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,
src/Crypto/RNCryptor/V3.hs view
@@ -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
+ src/Crypto/RNCryptor/V3/Decrypt.hs view
@@ -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
+ src/Crypto/RNCryptor/V3/Encrypt.hs view
@@ -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