saltine-0.2.0.0: tests/BoxProperties.hs

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

module BoxProperties (
  testBox
  ) where

import Crypto.Saltine.Core.Box
import Data.Monoid
import Test.Framework.Providers.QuickCheck2
import Test.Framework
import Test.QuickCheck.Property
import Test.QuickCheck.Monadic
import Util

-- | Ciphertext can be decrypted
rightInverseProp :: Keypair -> Keypair -> Nonce -> Message -> Bool
rightInverseProp (Keypair sk1 pk1) (Keypair sk2 pk2) n (Message bs) =
  Just bs == boxOpen pk1 sk2 n (box pk2 sk1 n bs)

-- | Cannot decrypt without the corrent secret key
rightInverseFailureProp1 :: Keypair -> Keypair -> Nonce -> Message -> Perturb -> Bool
rightInverseFailureProp1 (Keypair sk1 pk1) (Keypair sk2 pk2) n (Message bs) p =
  Nothing == boxOpen pk1 (perturb sk2 ([0] <> p)) n (box pk2 sk1 n bs)

-- | Cannot decrypt when not sent to you
rightInverseFailureProp2 :: Keypair -> Keypair -> Nonce -> Message -> Perturb -> Bool
rightInverseFailureProp2 (Keypair sk1 pk1) (Keypair sk2 pk2) n (Message bs) p =
  Nothing == boxOpen pk1 sk2 n (box (perturb pk2 p) sk1 n bs)

-- | Ciphertext cannot be decrypted (verification failure) if the
-- ciphertext is perturbed
rightInverseFailureProp3 :: Keypair -> Keypair -> Nonce -> Message -> Perturb -> Bool
rightInverseFailureProp3 (Keypair sk1 pk1) (Keypair sk2 pk2) n (Message bs) p =
  Nothing == boxOpen pk1 sk2 n (perturb (box pk2 sk1 n bs) p)

-- | Ciphertext cannot be decrypted with a different nonce
cannotDecryptNonceProp
  :: Keypair -> Keypair -> Nonce -> Nonce -> Message -> Bool
cannotDecryptNonceProp (Keypair sk1 pk1) (Keypair sk2 pk2) n1 n2 (Message bs) =
  Nothing == boxOpen pk1 sk2 n2 (box pk2 sk1 n1 bs)

-- | BeforeNM creates identical secret keys when called in an
-- anti-symmetric fashion.
beforeNMCreateSecretKeyProp :: Test.QuickCheck.Property.Property
beforeNMCreateSecretKeyProp = monadicIO . (assert =<<) . run $ do
  Keypair sk1 pk1 <- newKeypair
  Keypair sk2 pk2 <- newKeypair
  let ck_1for2 = beforeNM sk1 pk2
      ck_2for1 = beforeNM sk2 pk1
  return (ck_1for2 == ck_2for1)

-- | Ciphertext can be decrypted using combined keys
rightInverseAfterNMProp
  :: CombinedKey -> CombinedKey -> Nonce -> Message -> Bool
rightInverseAfterNMProp ck_1for2 ck_2for1 n (Message bs) =
  Just bs == boxOpenAfterNM ck_2for1 n (boxAfterNM ck_1for2 n bs)

-- | Perturbed ciphertext cannot be decrypted using combined keys
rightInverseFailureAfterNMProp1
  :: CombinedKey -> CombinedKey -> Nonce -> Message -> Perturb -> Bool
rightInverseFailureAfterNMProp1 ck_1for2 ck_2for1 n (Message bs) p =
  Nothing == boxOpenAfterNM ck_2for1 n (perturb (boxAfterNM ck_1for2 n bs) p)

testBox :: Test
testBox = buildTest $ do
  kp1@(Keypair sk1 pk1) <- newKeypair
  kp2@(Keypair sk2 pk2) <- newKeypair
  let ck_1for2 = beforeNM sk1 pk2
      ck_2for1 = beforeNM sk2 pk1
  n1 <- newNonce
  n2 <- newNonce

  return $ testGroup "...Internal.Box" [

    testGroup "Can decrypt ciphertext using..." [

       testProperty "... public key/secret key"
       $ rightInverseProp kp1 kp2 n1 ,

       testProperty "... combined key"
       $ rightInverseAfterNMProp ck_1for2 ck_2for1 n1

       ],

    testGroup "Fail to verify ciphertext when..." [

      testProperty "... not using proper secret key"
      $ rightInverseFailureProp1 kp1 kp2 n1,

      testProperty "... not actually sent to you"
      $ rightInverseFailureProp2 kp1 kp2 n1,

      testProperty "... ciphertext has been perturbed"
      $ rightInverseFailureProp3 kp1 kp2 n1,

      testProperty "... using the wrong nonce"
      $ cannotDecryptNonceProp kp1 kp2 n1 n2,

      testProperty "... using the wrong combined key"
      $ rightInverseFailureAfterNMProp1 ck_1for2 ck_2for1 n1

      ],

    testGroup "(properties)" [

      testProperty "beforeNM is anti-symmetric" beforeNMCreateSecretKeyProp

      ]
    ]