rncryptor 0.0.2.0 → 0.0.2.1

raw patch · 8 files changed

+134/−97 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• rncryptor.cabal +3/−1
• src/Crypto/RNCryptor/Types.hs +26/−0
• src/Crypto/RNCryptor/V3.hs +2/−0
• src/Crypto/RNCryptor/V3/Decrypt.hs +2/−44
• src/Crypto/RNCryptor/V3/Encrypt.hs +5/−47
• src/Crypto/RNCryptor/V3/Stream.hs +72/−0
• test/Main.hs +3/−4
• test/Tests.hs +21/−1

@@ -1,5 +1,5 @@ name:                rncryptor-version:             0.0.2.0+version:             0.0.2.1 synopsis:            Haskell implementation of the RNCryptor file format description:         Pure Haskell implementation of the RNCrytor spec. license:             MIT@@ -23,6 +23,7 @@     Crypto.RNCryptor.V3.Decrypt     Crypto.RNCryptor.Types   other-modules:+    Crypto.RNCryptor.V3.Stream   build-depends:       base >=4.6 && < 5     , bytestring >= 0.9.0@@ -37,6 +38,7 @@   default-language:     Haskell2010   ghc-options:+    -O2     -funbox-strict-fields  test-suite rncryptor-tests

@@ -2,6 +2,7 @@ module Crypto.RNCryptor.Types       ( RNCryptorHeader(..)      , RNCryptorContext(ctxHeader, ctxCipher)+     , UserInput(..)      , newRNCryptorContext      , newRNCryptorHeader      , renderRNCryptorHeader@@ -17,6 +18,7 @@ import Control.Monad import Crypto.Cipher.AES import Crypto.PBKDF.ByteString+import Test.QuickCheck   data RNCryptorHeader = RNCryptorHeader {@@ -36,6 +38,25 @@       -- as the HMAC is at the end of the file.       } +instance Show RNCryptorHeader where+  show = C8.unpack . renderRNCryptorHeader++instance Arbitrary RNCryptorHeader where+  arbitrary = do+    let version = toEnum 3+    let options = toEnum 1+    eSalt    <- C8.pack <$> vector saltSize+    iv       <- C8.pack <$> vector blockSize+    hmacSalt <- C8.pack <$> vector saltSize+    return RNCryptorHeader {+          rncVersion = version+        , rncOptions = options+        , rncEncryptionSalt = eSalt+        , rncHMACSalt = hmacSalt+        , rncIV = iv+        , rncHMAC = \uKey -> sha1PBKDF2 uKey hmacSalt 10000 32+        }+ -------------------------------------------------------------------------------- saltSize :: Int saltSize = 8@@ -81,6 +102,11 @@         ctxHeader :: RNCryptorHeader       , ctxCipher :: AES       }++newtype UserInput = UI { unInput :: ByteString } deriving Show++instance Arbitrary UserInput where+  arbitrary = UI . C8.pack <$> arbitrary  -------------------------------------------------------------------------------- newRNCryptorContext :: ByteString -> RNCryptorHeader -> RNCryptorContext

@@ -2,7 +2,9 @@ module Crypto.RNCryptor.V3 (     module Crypto.RNCryptor.V3.Encrypt   , module Crypto.RNCryptor.V3.Decrypt+  , module Crypto.RNCryptor.Types   ) where  import Crypto.RNCryptor.V3.Encrypt import Crypto.RNCryptor.V3.Decrypt+import Crypto.RNCryptor.Types

@@ -11,6 +11,7 @@ import           Data.Word import           Control.Monad.State import           Crypto.RNCryptor.Types+import           Crypto.RNCryptor.V3.Stream import           Crypto.Cipher.AES import           Data.Monoid import qualified System.IO.Streams as S@@ -123,15 +124,6 @@   ----------------------------------------------------------------------------------- | 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)@@ -144,42 +136,8 @@   rawHdr <- S.readExactly 34 inS   let hdr = parseHeader rawHdr   let ctx = newRNCryptorContext userKey hdr-  go Continue mempty ctx+  processStream ctx inS outS decryptBlock finaliseDecryption   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

@@ -1,7 +1,6 @@ {-# LANGUAGE BangPatterns #-} module Crypto.RNCryptor.V3.Encrypt-  ( pkcs7Padding-  , encrypt+  ( encrypt   , encryptBlock   , encryptStream   ) where@@ -9,6 +8,7 @@ import           Data.ByteString (ByteString) import qualified Data.ByteString as B import           Crypto.RNCryptor.Types+import           Crypto.RNCryptor.V3.Stream import           Crypto.RNCryptor.Padding import           Crypto.Cipher.AES import           Data.Monoid@@ -41,17 +41,7 @@       (_, 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)@@ -64,43 +54,11 @@   hdr <- newRNCryptorHeader userKey   let ctx = newRNCryptorContext userKey hdr   S.write (Just $ renderRNCryptorHeader hdr) outS-  go Continue mempty ctx+  processStream ctx inS outS encryptBlock finaliseEncryption   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+      -- Finalise the block with the HMAC+      S.write (Just ((rncHMAC . ctxHeader $ ctx) mempty)) outS

@@ -0,0 +1,72 @@+{-# LANGUAGE BangPatterns #-}+module Crypto.RNCryptor.V3.Stream+  ( processStream+  , StreamingState(..)+  ) 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++--------------------------------------------------------------------------------+-- | The 'StreamingState' 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 StreamingState =+    Continue+  | FetchLeftOver !Int+  | DrainSource deriving (Show, Eq)++--------------------------------------------------------------------------------+-- | Efficiently transform an incoming stream of bytes.+processStream :: RNCryptorContext+              -- ^ The RNCryptor context for this operation+              -> S.InputStream ByteString+              -- ^ The input source (mostly likely stdin)+              -> S.OutputStream ByteString+              -- ^ The output source (mostly likely stdout)+              -> (RNCryptorContext -> ByteString -> (RNCryptorContext, ByteString))+              -- ^ The action to perform over the block+              -> (ByteString -> RNCryptorContext -> IO ())+              -- ^ The finaliser+              -> IO ()+processStream context inS outS blockFn finaliser = go Continue mempty context+  where+    slack input = let bsL = B.length input in (bsL, bsL `mod` blockSize)++    go :: StreamingState -> 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 -> finaliser 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 -> finaliser (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 process this chunk+                      let (toProcess, rest) = B.splitAt (sz - sl) v+                      let (newCtx, res) = blockFn ctx toProcess+                      S.write (Just res) outS+                      case sl == 0 of+                        False -> do+                          S.unRead rest inS+                          go (FetchLeftOver sl) iBuffer newCtx+                        True -> go Continue iBuffer newCtx

@@ -1,11 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import           System.Environment-import           Data.Monoid import           Tests import           Test.Tasty-import           Test.Tasty.HUnit import           Test.Tasty.QuickCheck  ----------------------------------------------------------------------@@ -18,5 +15,7 @@ main = do   defaultMainWithIngredients defaultIngredients $     testGroup "RNCryptor tests" $ [-         testGroup "RNCryptor properties" []+         withQuickCheckDepth "RNCryptor properties" 100 [+           testProperty "encrypt/decrypt roundtrip" testEncryptDecryptRoundtrip+         ]      ]

@@ -1,3 +1,23 @@+{-# LANGUAGE ScopedTypeVariables #-} module Tests where -import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import Crypto.RNCryptor.V3+import Control.Applicative+import qualified Data.ByteString as B+++newtype TestVector = TV (UserInput, UserInput, RNCryptorHeader) deriving Show++instance Arbitrary TestVector where+  arbitrary = TV <$> ((,,) <$> arbitrary <*> arbitrary <*> arbitrary)+++testEncryptDecryptRoundtrip :: Property+testEncryptDecryptRoundtrip =+  forAll arbitrary $ \(TV (input,pwd,hdr)) ->+    B.length (unInput input) > 0 &&+    B.length (unInput pwd) > 0 ==>+    let ctx = newRNCryptorContext (unInput pwd) hdr+        encrypted = encrypt ctx (unInput input)+    in decrypt encrypted (unInput pwd) == unInput input