saltine-0.2.2.0: tests/SealedBoxProperties.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}

module SealedBoxProperties (
  testSealedBox
) where

import Crypto.Saltine.Core.Box
import Data.Monoid
import Test.Framework.Providers.QuickCheck2
import Test.Framework
import Test.QuickCheck.Property               (ioProperty)
import Util

-- | Ciphertext can be decrypted
rightInverseProp :: Keypair -> Message -> IO Bool
rightInverseProp (Keypair sk1 pk1) (Message bs) = do
  enc <- boxSeal pk1 bs
  return (Just bs == boxSealOpen pk1 sk1 enc)

-- | Cannot decrypt without the correct secret key
rightInverseFailureProp1 :: Keypair -> Message -> Perturb -> IO Bool
rightInverseFailureProp1 (Keypair sk1 pk1) (Message bs) p = do
  enc <- boxSeal pk1 bs
  return (Nothing == boxSealOpen pk1 (perturb sk1 ([0] <> p)) enc)

-- | Cannot decrypt without the correct public key
rightInverseFailureProp2 :: Keypair -> Message -> Perturb -> IO Bool
rightInverseFailureProp2 (Keypair sk1 pk1) (Message bs) p = do
  enc <- boxSeal pk1 bs
  return (Nothing == boxSealOpen (perturb pk1 p) sk1 enc)

-- | Cannot decrypt when not sent to you
rightInverseFailureProp3 :: Keypair -> Message -> Perturb -> IO Bool
rightInverseFailureProp3 (Keypair sk1 pk1) (Message bs) p = do
  enc <- boxSeal (perturb pk1 p) bs
  return (Nothing == boxSealOpen pk1 sk1 enc)

-- | Ciphertext cannot be decrypted (verification failure) if the
-- ciphertext is perturbed
rightInverseFailureProp4 :: Keypair -> Message -> Perturb -> IO Bool
rightInverseFailureProp4 (Keypair sk1 pk1) (Message bs) p = do
  enc <- boxSeal pk1 bs
  return (Nothing == boxSealOpen pk1 sk1 (perturb enc p))

testSealedBox :: Test
testSealedBox = buildTest $ do

  kp <- newKeypair

  return $ testGroup "... SealedBox" [

    testGroup "Can decrypt ciphertext using..." [
       testProperty "... public key/secret key"
       $ ioProperty . rightInverseProp kp
       ],

    testGroup "Fail to verify ciphertext when..." [
      testProperty "... not using proper secret key"
      $ ioProperty . uncurry (rightInverseFailureProp1 kp),

      testProperty "... not using proper public key"
      $ ioProperty . uncurry (rightInverseFailureProp2 kp),

      testProperty "... not actually sent to you"
      $ ioProperty . uncurry (rightInverseFailureProp3 kp),

      testProperty "... ciphertext has been perturbed"
      $ ioProperty . uncurry (rightInverseFailureProp4 kp)
      ]
    ]