content: {-# LANGUAGE OverloadedStrings #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  module SecretBoxProperties (
    testSecretBox
    ) where
  
  import           Util
  import           Crypto.Saltine.Core.SecretBox
  import           Crypto.Saltine.Class
  import           Crypto.Saltine.Internal.SecretBox as Internal
  
  import qualified Data.ByteString                      as S
  import           Data.Maybe (fromJust)
  import           Test.Framework.Providers.QuickCheck2
  import           Test.Framework
  import           Test.QuickCheck (Property, (==>))
  import           Test.QuickCheck.Arbitrary
  
  instance Arbitrary Nonce where
      arbitrary =
          do bs <- S.pack <$> vector Internal.secretbox_noncebytes
             pure $ fromJust  (decode bs)
  
  instance Arbitrary Key where
      arbitrary =
          do bs <- S.pack <$> vector Internal.secretbox_keybytes
             pure $ fromJust (decode bs)
  
  -- | Ciphertext can be decrypted
  rightInverseProp :: Key -> Nonce -> Message -> Bool
  rightInverseProp k n (Message bs) =
    Just bs == secretboxOpen k n (secretbox k n bs)
  
  -- | Detached ciphertext/tag can be decrypted
  rightInverseDetachedProp :: Key -> Nonce -> Message -> Bool
  rightInverseDetachedProp k n (Message bs) =
    Just bs == uncurry (secretboxOpenDetached k n) (secretboxDetached k n bs)
  
  -- | Ciphertext cannot be decrypted if the ciphertext is perturbed
  rightInverseFailureProp :: Key -> Nonce -> Message -> Perturb -> Property
  rightInverseFailureProp k n (Message bs) p =
    let ct     = secretbox k n bs
        fakeCT = perturb ct p
    in ct /= fakeCT ==> Nothing == secretboxOpen k n fakeCT
  
  -- | Ciphertext cannot be decrypted if the tag is perturbed
  rightInverseTagFailureProp :: Key -> Nonce -> Message -> Message -> Property
  rightInverseTagFailureProp k n (Message bs) (Message fakeTagBs) =
    let (realTag, ct) = secretboxDetached k n bs
        fakeTag       = Internal.Au fakeTagBs
    in realTag /= fakeTag ==> Nothing == secretboxOpenDetached k n fakeTag ct
  
  -- | Ciphertext cannot be decrypted if the ciphertext is perturbed
  rightInverseFailureDetachedProp :: Key -> Nonce -> Message -> Perturb -> Property
  rightInverseFailureDetachedProp k n (Message bs) p =
    let (tag,ct) = secretboxDetached k n bs
        fakeCT = perturb ct p
    in fakeCT /= ct ==> Nothing == secretboxOpenDetached k n tag fakeCT
  
  -- | Ciphertext cannot be decrypted with a different key
  cannotDecryptKeyProp :: Key -> Key -> Nonce -> Message -> Property
  cannotDecryptKeyProp k1 k2 n (Message bs) =
    k1 /= k2 ==> Nothing == secretboxOpen k2 n (secretbox k1 n bs)
  
  -- | Ciphertext cannot be decrypted with a different key
  cannotDecryptKeyDetachedProp :: Key -> Key -> Nonce -> Message -> Property
  cannotDecryptKeyDetachedProp k1 k2 n (Message bs) =
    k1 /= k2 ==> Nothing == uncurry (secretboxOpenDetached k2 n) (secretboxDetached k1 n bs)
  
  -- | Ciphertext cannot be decrypted with a different nonce
  cannotDecryptNonceProp :: Key -> Nonce -> Nonce -> Message -> Property
  cannotDecryptNonceProp k n1 n2 (Message bs) =
    n1 /= n2 ==> Nothing == secretboxOpen k n2 (secretbox k n1 bs)
  
  -- | Ciphertext cannot be decrypted with a different nonce
  cannotDecryptNonceDetachedProp :: Key -> Nonce -> Nonce -> Message -> Property
  cannotDecryptNonceDetachedProp k n1 n2 (Message bs) =
    n1 /= n2 ==> Nothing == uncurry (secretboxOpenDetached k n2) (secretboxDetached k n1 bs)
  
  testSecretBox :: Test
  testSecretBox = buildTest $ do
  
    return $ testGroup "...Internal.SecretBox" [
  
      testProperty "Can decrypt ciphertext"
      $ rightInverseProp,
  
      testProperty "Can decrypt ciphertext (detached)"
      $ rightInverseDetachedProp,
  
      testGroup "Cannot decrypt ciphertext when..." [
  
        testProperty "... ciphertext is perturbed"
        $ rightInverseFailureProp,
  
        testProperty "... ciphertext is perturbed (detached)"
        $ rightInverseFailureDetachedProp,
  
        testProperty "... tag is perturbed (detached)"
        $ rightInverseTagFailureProp,
  
        testProperty "... using the wrong key"
        $ cannotDecryptKeyProp,
  
        testProperty "... using the wrong key (detached)"
        $ cannotDecryptKeyDetachedProp,
  
        testProperty "... using the wrong nonce"
        $ cannotDecryptNonceProp,
  
        testProperty "... using the wrong nonce (detached"
        $ cannotDecryptNonceDetachedProp
  
        ]
      ]
  