Timelock.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Tests for 'Morley.Tezos.Crypto.Timelock'.
module Test.Tezos.Crypto.Timelock
  ( test_ChestSerializationRoundtrip
  , test_Chest
  ) where

import Prelude hiding (negate)

import Hedgehog (forAll, property, withTests, (===))
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range
import Test.Tasty (TestTree)
import Test.Tasty.Hedgehog (testProperty)

import Hedgehog.Gen.Tezos.Crypto.Timelock
import Morley.Tezos.Crypto.Timelock
import Test.Cleveland.Util

test_ChestSerializationRoundtrip :: [TestTree]
test_ChestSerializationRoundtrip =
  [ roundtripTree (fst <$> genChestAndKey) chestBytes chestFromBytes
  , roundtripTree (snd <$> genChestAndKey) chestKeyBytes chestKeyFromBytes
  ]

test_Chest :: [TestTree]
test_Chest =
  [ testProperty "Chest value decodes" $ property do
      ((chest, key), (payload, time)) <- forAll $ genChestAndKeyWithParams Nothing
      openChest chest key time === Correct payload
    -- the next test is pretty slow, so we halve the number of tests
  , testProperty "Chest value doesn't decode with a wrong key" $ withTests 50 $ property do
      time <- forAll $ genTLTime
      ((chest, key), _) <- forAll $ genChestAndKeyWithParams (Just time)
      ((chest', key'), _) <-
        forAll . Gen.filter ((/= key) . snd . fst) $ genChestAndKeyWithParams (Just time)
      openChest chest key' time === BogusOpening
      openChest chest' key time === BogusOpening
  , testProperty "Chest value doesn't decode with a bogus ciphertext" $ property do
      ((Chest{..}, key), (_, time)) <- forAll $ genChestAndKeyWithParams Nothing
      let Ciphertext{..} = chestCiphertext
      payload' <- forAll . Gen.filter (/= ctPayload) $ Gen.bytes (Range.constant 100 500)
      openChest Chest{chestCiphertext=Ciphertext{ctPayload = payload', ..}, ..} key time
        === BogusCipher
  , testProperty "Chest value doesn't decode with a wrong time" $ property do
      ((chest, key), (_, time)) <- forAll $ genChestAndKeyWithParams Nothing
      time' <- forAll . Gen.filter (/= time) $ genTLTime
      openChest chest key time' === BogusOpening
  ]