Encryption works

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 @@ main = do
   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

@@ -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

@@ -59,7 +59,7 @@ test-suite rncryptor-tests
     , tasty-quickcheck
     , tasty-hunit
 
-executable rncryptor-stream
+executable rncryptor-decrypt
   build-depends:
       base
     , bytestring
@@ -72,5 +72,21 @@ executable rncryptor-stream
     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:
     -funbox-strict-fields

src/Crypto/RNCryptor/Padding.hs

@@ -15,5 +15,5 @@ pkcs7Padding :: Int
              -> ByteString
              -- ^ The resulting padding
 pkcs7Padding k l =
-  let octetsSize = k - (l `mod` k)
-  in  B.pack $ replicate octetsSize (fromInteger . toInteger $ octetsSize)
+  let octetsSize = k - (l `rem` k)
+  in  B.pack $ replicate octetsSize (fromIntegral octetsSize)

src/Crypto/RNCryptor/Types.hs

@@ -46,7 +46,7 @@ blockSize = 16
 
 --------------------------------------------------------------------------------
 randomSaltIO :: Int -> IO ByteString
-randomSaltIO sz = C8.pack <$> forM [0 .. sz] (const $ randomRIO ('\NUL', '\255'))
+randomSaltIO sz = C8.pack <$> forM [1 .. sz] (const $ randomRIO ('\NUL', '\255'))
 
 --------------------------------------------------------------------------------
 -- | Generates a new 'RNCryptorHeader', suitable for encryption.

src/Crypto/RNCryptor/V3/Decrypt.hs

@@ -174,8 +174,11 @@ decryptStream userKey inS outS = do
                       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
+                      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

src/Crypto/RNCryptor/V3/Encrypt.hs

@@ -3,13 +3,11 @@ module Crypto.RNCryptor.V3.Encrypt
   ( pkcs7Padding
   , encrypt
   , encryptBlock
-  -- , encryptStream
+  , encryptStream
   ) where
 
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as B
-import           Data.Word
-import           Control.Monad.State
 import           Crypto.RNCryptor.Types
 import           Crypto.RNCryptor.Padding
 import           Crypto.Cipher.AES
@@ -53,52 +51,56 @@ data EncryptionState =
   | 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
---                       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
+--------------------------------------------------------------------------------
+-- | 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