diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Criterion.Main +import Crypto.RNCryptor.Types +import Crypto.RNCryptor.V3.Encrypt +import Data.ByteString as B + +encryptBench :: ByteString -> ByteString +encryptBench input = + let eSalt = B.pack [0,1,2,3,4,5,6,7] + hSalt = B.pack [1,2,3,4,5,6,7,8] + iv = B.pack [2,3,4,5,6,7,8,9,10,11,12,13,14,15,0,1] + header = newRNCryptorHeaderFrom eSalt hSalt iv + ctx = newRNCryptorContext "password" header + in encrypt ctx input + +main :: IO () +main = defaultMain [ + bgroup "encryption" [ bench "simple encryption" $ nf encryptBench "bench" + , bench "long encryption" $ nf encryptBench (B.pack $ Prelude.replicate 1000000 0x0) + ] + ] diff --git a/rncryptor.cabal b/rncryptor.cabal --- a/rncryptor.cabal +++ b/rncryptor.cabal @@ -1,5 +1,5 @@ name: rncryptor -version: 0.0.2.3 +version: 0.3.0.0 synopsis: Haskell implementation of the RNCryptor file format description: Pure Haskell implementation of the RNCrytor spec. license: MIT @@ -11,6 +11,10 @@ tested-with: GHC == 7.6, GHC == 7.8 cabal-version: >=1.10 +flag fastpbkdf2 + description: Use fastpbkdf2 instead of cryptonite for PBKDF2. + default: True + source-repository head type: git location: https://github.com/adinapoli/rncryptor-hs @@ -31,8 +35,11 @@ , random >= 1.0.0.1 , QuickCheck >= 2.6 && < 2.9 , io-streams >= 1.2.0.0 - , cipher-aes >= 0.2.9 - , pbkdf >= 1.1.1.1 + , cryptonite >= 0.15 + , memory + if flag(fastpbkdf2) + build-depends: fastpbkdf2 + cpp-options: -DFASTPBKDF2 hs-source-dirs: src default-language: @@ -45,8 +52,8 @@ exitcode-stdio-1.0 main-is: Main.hs - other-modules: - Tests + other-modules: Tests + PasswordBasedVectors hs-source-dirs: test default-language: @@ -59,13 +66,18 @@ , tasty >= 0.9.0.1 , tasty-quickcheck , tasty-hunit + , io-streams + , base16-bytestring + , cryptonite + , text + , bytestring-arbitrary >= 0.1.0 executable rncryptor-decrypt build-depends: base , bytestring + , cryptonite >= 0.15 , io-streams - , cipher-aes , rncryptor -any hs-source-dirs: example @@ -81,7 +93,7 @@ base , bytestring , io-streams - , cipher-aes + , cryptonite >= 0.15 , rncryptor -any hs-source-dirs: example @@ -91,3 +103,16 @@ Haskell2010 ghc-options: -funbox-strict-fields + +benchmark store-bench + type: exitcode-stdio-1.0 + main-is: Bench.hs + hs-source-dirs: + bench + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -O2 -threaded -rtsopts -with-rtsopts=-N1 -with-rtsopts=-s -with-rtsopts=-qg + build-depends: + base >=4.6 && <5 + , bytestring >= 0.10.4.0 + , criterion + , rncryptor + default-language: Haskell2010 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,41 +1,86 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} -module Crypto.RNCryptor.Types - ( RNCryptorHeader(..) - , RNCryptorContext(ctxHeader, ctxCipher) - , UserInput(..) +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE DeriveDataTypeable #-} +module Crypto.RNCryptor.Types + ( RNCryptorException(..) + , RNCryptorHeader(..) + , RNCryptorContext(ctxHeader, ctxHMACCtx, ctxCipher) , newRNCryptorContext , newRNCryptorHeader + , newRNCryptorHeaderFrom , renderRNCryptorHeader + , makeHMAC , blockSize + -- * Type synonyms to make the API more descriptive + , Password + , HMAC + , Salt + , EncryptionKey + , EncryptionSalt + , HMACSalt + , IV ) where -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 -import Test.QuickCheck +import Control.Applicative +import Control.Exception (Exception) +import Control.Monad +import Crypto.Cipher.AES (AES256) +import Crypto.Cipher.Types (Cipher(..)) +import Crypto.Error (CryptoFailable(..)) +import Crypto.Hash (Digest(..)) +import Crypto.Hash.Algorithms (SHA1(..), SHA256(..)) +import Crypto.Hash.IO (HashAlgorithm(..)) +#if FASTPBKDF2 +import "fastpbkdf2" Crypto.KDF.PBKDF2 (fastpbkdf2_hmac_sha1) +#else +import "cryptonite" Crypto.KDF.PBKDF2 +#endif +import Crypto.MAC.HMAC (Context, initialize, hmac) +import qualified Crypto.MAC.HMAC as Crypto +import Data.ByteArray (ByteArray, convert) +import Data.ByteString (cons, ByteString, unpack) +import qualified Data.ByteString.Char8 as C8 +import Data.Monoid +import Data.Typeable +import Data.Word +import System.Random +import Test.QuickCheck (Arbitrary(..), vector) +data RNCryptorException = + InvalidHMACException !ByteString !ByteString + -- ^ HMAC validation failed. First parameter is the untrusted hmac, the + -- second the computed one. + deriving (Typeable, Eq) + +instance Show RNCryptorException where + show (InvalidHMACException untrusted computed) = + "InvalidHMACException: Untrusted HMAC was " <> show (unpack untrusted) + <> ", but the computed one is " <> show (unpack computed) <> "." + +instance Exception RNCryptorException + +type Password = ByteString +type HMAC = ByteString +type EncryptionKey = ByteString +type Salt = ByteString +type EncryptionSalt = Salt +type HMACSalt = Salt +type IV = ByteString + data RNCryptorHeader = RNCryptorHeader { rncVersion :: !Word8 -- ^ Data format version. Currently 3. , rncOptions :: !Word8 -- ^ bit 0 - uses password - , rncEncryptionSalt :: !ByteString + , rncEncryptionSalt :: !EncryptionSalt -- ^ iff option includes "uses password" - , rncHMACSalt :: !ByteString + , rncHMACSalt :: !HMACSalt -- ^ iff options includes "uses password" - , rncIV :: !ByteString + , rncIV :: !IV -- ^ The initialisation vector -- The ciphertext is variable and encrypted in CBC mode - , rncHMAC :: (ByteString -> ByteString) - -- ^ The HMAC (32 bytes). This field is a continuation - -- as the HMAC is at the end of the file. } instance Show RNCryptorHeader where @@ -54,7 +99,6 @@ , rncEncryptionSalt = eSalt , rncHMACSalt = hmacSalt , rncIV = iv - , rncHMAC = \uKey -> sha1PBKDF2 uKey hmacSalt 10000 32 } -------------------------------------------------------------------------------- @@ -70,9 +114,25 @@ randomSaltIO sz = C8.pack <$> forM [1 .. sz] (const $ randomRIO ('\NUL', '\255')) -------------------------------------------------------------------------------- +makeKey :: ByteString -> ByteString -> ByteString +#if FASTPBKDF2 +makeKey input salt = fastpbkdf2_hmac_sha1 input salt 10000 32 +#else +makeKey = generate (prfHMAC SHA1) (Parameters 10000 32) +#endif + +-------------------------------------------------------------------------------- +makeHMAC :: ByteString -> Password -> ByteString -> HMAC +makeHMAC hmacSalt userKey secret = + let key = makeKey userKey hmacSalt + hmacSha256 = hmac key secret + in + convert (hmacSha256 :: Crypto.HMAC SHA256) + +-------------------------------------------------------------------------------- -- | Generates a new 'RNCryptorHeader', suitable for encryption. -newRNCryptorHeader :: ByteString -> IO RNCryptorHeader -newRNCryptorHeader userKey = do +newRNCryptorHeader :: IO RNCryptorHeader +newRNCryptorHeader = do let version = toEnum 3 let options = toEnum 1 eSalt <- randomSaltIO saltSize @@ -84,12 +144,24 @@ , rncEncryptionSalt = eSalt , rncHMACSalt = hmacSalt , rncIV = iv - , rncHMAC = const $ sha1PBKDF2 userKey hmacSalt 10000 32 } -------------------------------------------------------------------------------- +newRNCryptorHeaderFrom :: EncryptionSalt -> HMACSalt -> IV -> RNCryptorHeader +newRNCryptorHeaderFrom eSalt hmacSalt iv = do + let version = toEnum 3 + let options = toEnum 1 + RNCryptorHeader { + rncVersion = version + , rncOptions = options + , rncEncryptionSalt = eSalt + , rncHMACSalt = hmacSalt + , rncIV = iv + } + +-------------------------------------------------------------------------------- -- | 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 +-- IV. This means you need to append the ciphertext plus the HMAC to finalise -- the encrypted file. renderRNCryptorHeader :: RNCryptorHeader -> ByteString renderRNCryptorHeader RNCryptorHeader{..} = @@ -99,18 +171,23 @@ -- A convenient datatype to avoid carrying around the AES cypher, -- the encrypted key and so on and so forth. data RNCryptorContext = RNCryptorContext { - ctxHeader :: RNCryptorHeader - , ctxCipher :: AES + ctxHeader :: RNCryptorHeader + , ctxCipher :: AES256 + , ctxHMACCtx :: Context SHA256 } -newtype UserInput = UI { unInput :: ByteString } deriving Show - -instance Arbitrary UserInput where - arbitrary = UI . C8.pack <$> arbitrary +-------------------------------------------------------------------------------- +cipherInitNoError :: ByteString -> AES256 +cipherInitNoError k = case cipherInit k of + CryptoPassed a -> a + CryptoFailed e -> error ("cipherInitNoError: " <> show e) -------------------------------------------------------------------------------- -newRNCryptorContext :: ByteString -> RNCryptorHeader -> RNCryptorContext +newRNCryptorContext :: Password -> RNCryptorHeader -> RNCryptorContext newRNCryptorContext userKey hdr = - let eKey = sha1PBKDF2 userKey (rncEncryptionSalt hdr) 10000 32 - cipher = initAES eKey - in RNCryptorContext hdr cipher + let hmacSalt = rncHMACSalt hdr + hmacKey = makeKey userKey hmacSalt + hmacCtx = initialize hmacKey + encKey = makeKey userKey $ rncEncryptionSalt hdr + cipher = cipherInitNoError encKey + in RNCryptorContext hdr cipher (hmacCtx :: Context SHA256) diff --git a/src/Crypto/RNCryptor/V3/Decrypt.hs b/src/Crypto/RNCryptor/V3/Decrypt.hs --- a/src/Crypto/RNCryptor/V3/Decrypt.hs +++ b/src/Crypto/RNCryptor/V3/Decrypt.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} module Crypto.RNCryptor.V3.Decrypt ( parseHeader , decrypt @@ -6,19 +7,25 @@ , decryptStream ) where -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Word import Control.Monad.State +import Control.Exception (throwIO) +import Crypto.Cipher.AES (AES256) +import Crypto.Cipher.Types (IV, makeIV, BlockCipher, cbcDecrypt) +import Crypto.MAC.HMAC (update, finalize) import Crypto.RNCryptor.Types import Crypto.RNCryptor.V3.Stream -import Crypto.Cipher.AES +import Data.Bits (xor, (.|.)) +import Data.ByteArray (convert) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Foldable +import Data.Maybe (fromMaybe) import Data.Monoid +import Data.Word import qualified System.IO.Streams as S - -------------------------------------------------------------------------------- --- | Parse the input 'ByteString' to extract the 'RNCryptorHeader', as +-- | 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 @@ -36,7 +43,6 @@ , rncEncryptionSalt = eSalt , rncHMACSalt = hmacSalt , rncIV = iv - , rncHMAC = parseHMAC } -------------------------------------------------------------------------------- @@ -46,8 +52,8 @@ let (v,vs) = B.splitAt 1 bs put vs case B.unpack v of - x:[] -> return x - _ -> fail err + [x] -> return x + _ -> fail err -------------------------------------------------------------------------------- parseBSOfSize :: Int -> String -> State ByteString ByteString @@ -80,20 +86,22 @@ 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 = +removePaddingSymbols input = let lastWord = B.last input in B.take (B.length input - fromEnum lastWord) input -------------------------------------------------------------------------------- +decryptBytes :: AES256 -> ByteString -> ByteString -> ByteString +decryptBytes a iv = cbcDecrypt a iv' + where + iv' = fromMaybe (error "decryptBytes: makeIV failed.") $ makeIV iv + +-------------------------------------------------------------------------------- -- | 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 @@ -101,27 +109,46 @@ 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) +decryptBlock ctx cipherText = + let clearText = decryptBytes (ctxCipher ctx) (rncIV . ctxHeader $ ctx) cipherText + !newHMACCtx = update (ctxHMACCtx ctx) cipherText + !sz = B.length cipherText + !newHeader = (ctxHeader ctx) { rncIV = B.drop (sz - 16) cipherText } + in (ctx { ctxHeader = newHeader, ctxHMACCtx = newHMACCtx }, clearText) -------------------------------------------------------------------------------- +-- "A consistent time function needs to be clear on which parameter is secret and +-- which one is untrusted. Your complexity must always be proportional to the length +-- of the untrusted data, not the secret." +-- +-- Below, untrusted == arrived in the message, secret == computed +-- +consistentTimeEqual :: ByteString -> ByteString -> Bool +consistentTimeEqual untrusted secret = + let (initialResult :: Word8) = if B.length secret == B.length untrusted then 0 else 1 + secretCycle = cycle (B.unpack secret) + xorResults = zipWith xor (B.unpack untrusted) secretCycle + in 0 == foldl' (.|.) initialResult xorResults + +-------------------------------------------------------------------------------- -- | 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 +-- +-- Returns either the reason for failure, or the successfully decrypted message. +decrypt :: ByteString -> ByteString -> Either RNCryptorException 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 + (cipherText, msgHMAC) = 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 - + clearText = decryptBytes (ctxCipher ctx) (rncIV . ctxHeader $ ctx) cipherText + hmac = makeHMAC (rncHMACSalt . ctxHeader $ ctx) pwd $ rawHdr <> cipherText + in case consistentTimeEqual msgHMAC hmac of + True -> Right (removePaddingSymbols clearText) + False -> Left (InvalidHMACException msgHMAC hmac) -------------------------------------------------------------------------------- -- | Efficiently decrypts an incoming stream of bytes. @@ -135,9 +162,13 @@ decryptStream userKey inS outS = do rawHdr <- S.readExactly 34 inS let hdr = parseHeader rawHdr - let ctx = newRNCryptorContext userKey hdr - processStream ctx inS outS decryptBlock finaliseDecryption + ctx = newRNCryptorContext userKey hdr + ctx' = ctx { ctxHMACCtx = update (ctxHMACCtx ctx) rawHdr } + processStream ctx' inS outS decryptBlock finaliseDecryption where 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 + let (cipherText, msgHMAC) = B.splitAt (B.length lastBlock - 32) lastBlock + (ctx', clearText) = decryptBlock ctx cipherText + hmac = convert $ finalize (ctxHMACCtx ctx') + unless (consistentTimeEqual msgHMAC hmac) (throwIO $ InvalidHMACException msgHMAC hmac) + S.write (Just $ removePaddingSymbols clearText) outS diff --git a/src/Crypto/RNCryptor/V3/Encrypt.hs b/src/Crypto/RNCryptor/V3/Encrypt.hs --- a/src/Crypto/RNCryptor/V3/Encrypt.hs +++ b/src/Crypto/RNCryptor/V3/Encrypt.hs @@ -3,17 +3,26 @@ ( encrypt , encryptBlock , encryptStream + , encryptStreamWithContext ) where -import Data.ByteString (ByteString) -import qualified Data.ByteString as B +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 Crypto.RNCryptor.Padding -import Crypto.Cipher.AES +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 -------------------------------------------------------------------------------- -- | Encrypt a raw Bytestring block. The function returns the encrypt text block @@ -23,11 +32,12 @@ 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) +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 a message. Please be aware that this is a user-friendly @@ -36,14 +46,33 @@ -- 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) + 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 -------------------------------------------------------------------------------- -- | Efficiently encrypt an incoming stream of bytes. -encryptStream :: ByteString +encryptStreamWithContext :: RNCryptorContext + -- ^ The RNCryptorContext + -> S.InputStream ByteString + -- ^ The input source (mostly likely stdin) + -> S.OutputStream ByteString + -- ^ The output source (mostly likely stdout) + -> 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 + +-------------------------------------------------------------------------------- +-- | Efficiently encrypt an incoming stream of bytes. +encryptStream :: Password -- ^ The user key (e.g. password) -> S.InputStream ByteString -- ^ The input source (mostly likely stdin) @@ -51,14 +80,8 @@ -- ^ 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 - processStream ctx inS outS encryptBlock finaliseEncryption - where - 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 + hdr <- newRNCryptorHeader + let ctx = newRNCryptorContext userKey hdr + msgHdr = renderRNCryptorHeader hdr + ctx' = ctx { ctxHMACCtx = update (ctxHMACCtx ctx) msgHdr } + encryptStreamWithContext ctx' inS outS diff --git a/src/Crypto/RNCryptor/V3/Stream.hs b/src/Crypto/RNCryptor/V3/Stream.hs --- a/src/Crypto/RNCryptor/V3/Stream.hs +++ b/src/Crypto/RNCryptor/V3/Stream.hs @@ -9,7 +9,6 @@ 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 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,9 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Tests +import qualified PasswordBasedVectors as Pwd import Test.Tasty +import Test.Tasty.HUnit import Test.Tasty.QuickCheck +import Tests ---------------------------------------------------------------------- withQuickCheckDepth :: TestName -> Int -> [TestTree] -> TestTree @@ -15,7 +17,17 @@ main = do defaultMainWithIngredients defaultIngredients $ testGroup "RNCryptor tests" $ [ - withQuickCheckDepth "RNCryptor properties" 100 [ - testProperty "encrypt/decrypt roundtrip" testEncryptDecryptRoundtrip + testCase "Swift-encrypted input can be decrypted" testForeignEncryption + , testGroup "Password-Based Test Vectors" [ + testCase "All fields empty or zero" Pwd.allEmptyOrZero + , testCase "One byte" Pwd.oneByte + , testCase "Exactly one block" Pwd.exactlyOneBlock + , testCase "More than one block" Pwd.moreThanOneBlock + , testCase "Multibyte password" Pwd.multibytePassword + , testCase "Longer text and password" Pwd.longerTextAndPassword + ] + , withQuickCheckDepth "RNCryptor properties" 100 [ + testProperty "encrypt/decrypt roundtrip" testEncryptDecryptRoundtrip + , testProperty "encrypt/decrypt streaming roundtrip" testStreamingEncryptDecryptRoundtrip ] ] diff --git a/test/PasswordBasedVectors.hs b/test/PasswordBasedVectors.hs new file mode 100644 --- /dev/null +++ b/test/PasswordBasedVectors.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module PasswordBasedVectors where + +import Crypto.MAC.HMAC (update) +import Crypto.RNCryptor.Types +import Crypto.RNCryptor.V3.Encrypt +import Data.ByteString as B +import Data.ByteString.Base16 +import Data.Monoid +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified System.IO.Streams.ByteString as S +import qualified System.IO.Streams.List as S +import Test.Tasty.HUnit + +-------------------------------------------------------------------------------- +data TestVector = TestVector { + password :: !Password + , enc_salt_hex :: !EncryptionSalt + , hmac_salt_hex :: !HMACSalt + , iv_hex :: !IV + , plaintext_hex :: !ByteString + , ciphertext_hex :: !ByteString + } + +-------------------------------------------------------------------------------- +unhex :: ByteString -> ByteString +unhex = fst . decode + +-------------------------------------------------------------------------------- +withTestVector :: TestVector -> Assertion +withTestVector TestVector{..} = do + let header = newRNCryptorHeaderFrom (unhex enc_salt_hex) (unhex hmac_salt_hex) (unhex iv_hex) + let ctx = newRNCryptorContext password header + encrypt ctx (unhex plaintext_hex) @?= (unhex ciphertext_hex) + -- Test the streaming API + inS <- S.fromByteString (unhex plaintext_hex) + (outS, flush) <- S.listOutputStream + let ctx' = ctx { ctxHMACCtx = update (ctxHMACCtx ctx) (renderRNCryptorHeader header) } + encryptStreamWithContext ctx' inS outS + result <- flush + (B.unpack $ B.concat result) @?= (B.unpack $ unhex ciphertext_hex) + +-------------------------------------------------------------------------------- +allEmptyOrZero :: Assertion +allEmptyOrZero = withTestVector $ TestVector { + password = "a" + , enc_salt_hex = "0000000000000000" + , hmac_salt_hex = "0000000000000000" + , iv_hex = "00000000000000000000000000000000" + , plaintext_hex = "" + , ciphertext_hex = "03010000000000000000000000000000000000000000000000000000000000000000b3039be31cd7ece5e754" + <> "f5c8da17003666313ae8a89ddcf8e3cb41fdc130b2329dbe07d6f4d32c34e050c8bd7e933b12" + } + +-------------------------------------------------------------------------------- +oneByte :: Assertion +oneByte = withTestVector $ TestVector { + password = "thepassword" + , enc_salt_hex = "0001020304050607" + , hmac_salt_hex = "0102030405060708" + , iv_hex = "02030405060708090a0b0c0d0e0f0001" + , plaintext_hex = "01" + , ciphertext_hex = "03010001020304050607010203040506070802030405060708090a0b0c0d0e0f0001a1f8" + <> "730e0bf480eb7b70f690abf21e029514164ad3c474a51b30c7eaa1ca545b7de3de5b010acbad0a9a13857df696a8" + } + +-------------------------------------------------------------------------------- +exactlyOneBlock :: Assertion +exactlyOneBlock = withTestVector $ TestVector { + password = "thepassword" + , enc_salt_hex = "0102030405060700" + , hmac_salt_hex = "0203040506070801" + , iv_hex = "030405060708090a0b0c0d0e0f000102" + , plaintext_hex = "0123456789abcdef" + , ciphertext_hex = "030101020304050607000203040506070801030405060708090a0b0c0d0e0f0001020e437" + <> "fe809309c03fd53a475131e9a1978b8eaef576f60adb8ce2320849ba32d742900438ba897d22210c76c35c849df" + } + +-------------------------------------------------------------------------------- +moreThanOneBlock :: Assertion +moreThanOneBlock = withTestVector $ TestVector { + password = "thepassword" + , enc_salt_hex = "0203040506070001" + , hmac_salt_hex = "0304050607080102" + , iv_hex = "0405060708090a0b0c0d0e0f00010203" + , plaintext_hex = "0123456789abcdef01234567" + , ciphertext_hex = "0301020304050607000103040506070801020405060708090a0b0c0d0e0f00010203e01bbda5df2ca8adace3" + <> "8f6c588d291e03f951b78d3417bc2816581dc6b767f1a2e57597512b18e1638f21235fa5928c" + } + +-------------------------------------------------------------------------------- +multibytePassword :: Assertion +multibytePassword = withTestVector $ TestVector { + password = T.encodeUtf8 (T.pack "中文密码") + , enc_salt_hex = "0304050607000102" + , hmac_salt_hex = "0405060708010203" + , iv_hex = "05060708090a0b0c0d0e0f0001020304" + , plaintext_hex = "23456789abcdef0123456701" + , ciphertext_hex = "03010304050607000102040506070801020305060708090a0b0c0d0e0f00010203048a9e08bdec1c4bfe13e8" + <> "1fb85f009ab3ddb91387e809c4ad86d9e8a6014557716657bd317d4bb6a7644615b3de402341" + } + +-------------------------------------------------------------------------------- +longerTextAndPassword :: Assertion +longerTextAndPassword = withTestVector $ TestVector { + password = "It was the best of times, it was the worst of times; it was the age of wisdom, it was the age of foolishness;" + , enc_salt_hex = "0405060700010203" + , hmac_salt_hex = "0506070801020304" + , iv_hex = "060708090a0b0c0d0e0f000102030405" + , plaintext_hex = "697420776173207468652065706f6368206f662062656c6965662c20697420776173207468652065706f6368206f6620696e6" + <> "3726564756c6974793b206974207761732074686520736561736f6e206f66204c696768742c20697420776173207468652073" + <> "6561736f6e206f66204461726b6e6573733b206974207761732074686520737072696e67206f6620686f70652c20697420776" + <> "173207468652077696e746572206f6620646573706169723b207765206861642065766572797468696e67206265666f726520" + <> "75732c20776520686164206e6f7468696e67206265666f72652075733b207765207765726520616c6c20676f696e672064697" + <> "26563746c7920746f2048656176656e2c207765207765726520616c6c20676f696e6720746865206f74686572207761792e0a0a" + , ciphertext_hex = "030104050607000102030506070801020304060708090a0b0c0d0e0f000102030405d564c7a99da921a6e7c4078a82641d9" + <> "5479551283167a2c81f31ab80c9d7d8beb770111decd3e3d29bbdf7ebbfc5f10ac87e7e55bfb5a7f487bcd39835705e83b9" + <> "c049c6d6952be011f8ddb1a14fc0c925738de017e62b1d621ccdb75f2937d0a1a70e44d843b9c61037dee2998b2bbd740b9" + <> "10232eea71961168838f6995b9964173b34c0bcd311a2c87e271630928bae301a8f4703ac2ae4699f3c285abf1c55ac324b" + <> "073a958ae52ee8c3bd68f919c09eb1cd28142a1996a9e6cbff5f4f4e1dba07d29ff66860db9895a48233140ca249419d630" + <> "46448db1b0f4252a6e4edb947fd0071d1e52bc15600622fa548a6773963618150797a8a80e592446df5926d0bfd32b544b7" + <> "96f3359567394f77e7b171b2f9bc5f2caf7a0fac0da7d04d6a86744d6e06d02fbe15d0f580a1d5bd16ad91348003611358d" + <> "cb4ac9990955f6cbbbfb185941d4b4b71ce7f9ba6efc1270b7808838b6c7b7ef17e8db919b34fac" + } diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -1,18 +1,35 @@ {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} module Tests where -import Test.Tasty.QuickCheck -import Crypto.RNCryptor.V3 -import Control.Applicative +import Control.Applicative +import Crypto.RNCryptor.V3 import qualified Data.ByteString as B - +import Data.ByteString.Arbitrary +import qualified Data.ByteString.Char8 as C8 +import Data.Word +import System.IO.Streams.ByteString +import System.IO.Streams.List +import qualified Test.QuickCheck.Monadic as M +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck newtype TestVector = TV (UserInput, UserInput, RNCryptorHeader) deriving Show instance Arbitrary TestVector where arbitrary = TV <$> ((,,) <$> arbitrary <*> arbitrary <*> arbitrary) +newtype UserInput = UI { unInput :: B.ByteString } deriving Show +instance Arbitrary UserInput where + arbitrary = UI . C8.pack <$> arbitrary + +newtype UserInput10M = UI10M { unInput10M :: ArbByteString10M } deriving Show + +instance Arbitrary UserInput10M where + arbitrary = UI10M <$> arbitrary + +-------------------------------------------------------------------------------- testEncryptDecryptRoundtrip :: Property testEncryptDecryptRoundtrip = forAll arbitrary $ \(TV (input,pwd,hdr)) -> @@ -20,4 +37,38 @@ B.length (unInput pwd) > 0 ==> let ctx = newRNCryptorContext (unInput pwd) hdr encrypted = encrypt ctx (unInput input) - in decrypt encrypted (unInput pwd) == unInput input + in decrypt encrypted (unInput pwd) == Right (unInput input) + +-------------------------------------------------------------------------------- +streamingRoundTrip :: B.ByteString -> B.ByteString -> IO B.ByteString +streamingRoundTrip key plainText = do + plainTextInS <- fromByteString plainText + (cipherTextOutS, flushCipherText) <- listOutputStream + encryptStream key plainTextInS cipherTextOutS + cipherText <- flushCipherText + cipherTextInS <- fromByteString (B.concat cipherText) + (plainTextOutS, flushPlainText) <- listOutputStream + decryptStream key cipherTextInS plainTextOutS + plainTexts <- flushPlainText + return $ B.concat plainTexts + +-------------------------------------------------------------------------------- +testStreamingEncryptDecryptRoundtrip :: UserInput -> UserInput10M -> Property +testStreamingEncryptDecryptRoundtrip pwd input = M.monadicIO $ do + input' <- M.run (streamingRoundTrip (unInput pwd) (fromABS10M (unInput10M input))) + M.assert (fromABS10M (unInput10M input) == input') + +-------------------------------------------------------------------------------- +-- See: https://github.com/RNCryptor/rncryptor-hs/issues/11 +testForeignEncryption :: Assertion +testForeignEncryption = do + let swiftEncrypted = B.pack [ 3,1,79,179,121,154,223,37,248,95,96,196 + , 77,127,26,146,150,193,56,159,119,105,170 + , 94,152,113,222,244,244,178,4,107,58,50,174 + , 90,65,21,239,127,70,137,226,152,215,144,171 + , 28,45,176,19,56,244,99,70,23,56,2,26,95,138 + , 200,203,85,110,126,200,12,93,140,140,241,0 + , 179,206,223,169,158,86,9,155,172 + ] + let swiftPassword = B.pack [112,97,115,115,119,111,114,100] + decrypt swiftEncrypted swiftPassword @=? Right "01"