-- 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 ]