rncryptor-0.4.0.0: test/Tests.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Tests where

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)) ->
    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) == 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"

--------------------------------------------------------------------------------
-- Streaming with arbitrary chunking. A pipe hands io-streams whatever is in
-- the buffer at read time, down to a single byte, so the streaming code must
-- produce the same output for every way of cutting the input into chunks.

-- | Cut the input into chunks of the given sizes; whatever the sizes don't
-- cover becomes one final chunk. Non-positive sizes are skipped.
chunksOf :: [Int] -> B.ByteString -> [B.ByteString]
chunksOf _ bs | B.null bs = []
chunksOf [] bs = [bs]
chunksOf (n:ns) bs
  | n <= 0    = chunksOf ns bs
  | otherwise = let (h, t) = B.splitAt n bs in h : chunksOf ns t

-- | Chunk sizes biased towards slivers smaller than a block + HMAC.
newtype ChunkSizes = ChunkSizes [Int] deriving Show

instance Arbitrary ChunkSizes where
  arbitrary = ChunkSizes <$> listOf (frequency [(4, choose (1, 48)), (1, choose (49, 4096))])
  shrink (ChunkSizes xs) = ChunkSizes <$> shrink xs

chunkedRoundTrip :: B.ByteString -> [Int] -> [Int] -> B.ByteString -> IO B.ByteString
chunkedRoundTrip key encChunks decChunks plainText = do
  plainTextInS                      <- fromList (chunksOf encChunks plainText)
  (cipherTextOutS, flushCipherText) <- listOutputStream
  encryptStream key plainTextInS cipherTextOutS
  cipherText                        <- B.concat <$> flushCipherText
  cipherTextInS                     <- fromList (chunksOf decChunks cipherText)
  (plainTextOutS, flushPlainText)   <- listOutputStream
  decryptStream key cipherTextInS plainTextOutS
  B.concat <$> flushPlainText

testChunkedStreamingRoundtrip :: UserInput -> ChunkSizes -> ChunkSizes -> ArbByteString -> Property
testChunkedStreamingRoundtrip pwd (ChunkSizes encChunks) (ChunkSizes decChunks) input =
  B.length (unInput pwd) > 0 ==> M.monadicIO $ do
    let plainText = fromABS input
    input' <- M.run (chunkedRoundTrip (unInput pwd) encChunks decChunks plainText)
    M.assert (plainText == input')

testOneByteChunks :: Assertion
testOneByteChunks = do
  let plainText = C8.pack (take 1000 (cycle ['a'..'z']))
      ones      = repeat 1
  input' <- chunkedRoundTrip "password" ones ones plainText
  input' @?= plainText

-- The final chunk is exactly the 32-byte HMAC, so the last cipher block
-- arrives in the chunk before it.
testHMACAsFinalChunk :: Assertion
testHMACAsFinalChunk = do
  let plainText = C8.pack (take 1000 (cycle ['a'..'z']))
  plainTextInS                      <- fromByteString plainText
  (cipherTextOutS, flushCipherText) <- listOutputStream
  encryptStream "password" plainTextInS cipherTextOutS
  cipherText                        <- B.concat <$> flushCipherText
  cipherTextInS                     <- fromList (chunksOf [B.length cipherText - 32] cipherText)
  (plainTextOutS, flushPlainText)   <- listOutputStream
  decryptStream "password" cipherTextInS plainTextOutS
  input'                            <- B.concat <$> flushPlainText
  input' @?= plainText