{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Test.Cardano.Ledger.ShelleyMA.Serialisation.Timelocks (
  timelockTests,
  MultiSig,
)
where

import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Allegra.Scripts (
  AllegraEraScript,
  Timelock (..),
  pattern RequireTimeExpire,
  pattern RequireTimeStart,
 )
import Cardano.Ledger.Core
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.Scripts (
  MultiSig,
  pattern RequireAllOf,
 )
import Cardano.Slotting.Slot (SlotNo (..))
import Data.Sequence.Strict (fromList)
import Test.Cardano.Ledger.Binary.RoundTrip (embedTripAnnExpectation, roundTripAnnExpectation)
import Test.Cardano.Ledger.Binary.TreeDiff (HexBytes (HexBytes), expectExprEqual)
import Test.Cardano.Ledger.Mary.Arbitrary ()
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
import Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators ()
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)
import Test.Tasty.QuickCheck (testProperty)

-- ================================================================

s1 :: AllegraEraScript era => NativeScript era
s1 :: forall era. AllegraEraScript era => NativeScript era
s1 = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
fromList [forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart (Word64 -> SlotNo
SlotNo Word64
12), forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire SlotNo
18])

s2 :: AllegraEraScript era => NativeScript era
s2 :: forall era. AllegraEraScript era => NativeScript era
s2 = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
fromList [forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart (Word64 -> SlotNo
SlotNo Word64
12), forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire (Word64 -> SlotNo
SlotNo Word64
23)])

s3 :: AllegraEraScript era => NativeScript era
s3 :: forall era. AllegraEraScript era => NativeScript era
s3 = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
fromList [forall era. AllegraEraScript era => NativeScript era
s1, forall era. AllegraEraScript era => NativeScript era
s2])

-- ================================================================

timelockTests :: TestTree
timelockTests :: TestTree
timelockTests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Timelock tests"
    forall a b. (a -> b) -> a -> b
$ ( TestName -> Expectation -> TestTree
testCase TestName
"Timelock examples roundtrip - Allegra" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t.
(Show t, Eq t, ToCBOR t, DecCBOR (Annotator t), HasCallStack) =>
t -> Expectation
roundTripAnnExpectation
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [forall era. AllegraEraScript era => NativeScript era
s1 @AllegraEra, forall era. AllegraEraScript era => NativeScript era
s2 @AllegraEra, forall era. AllegraEraScript era => NativeScript era
s3 @AllegraEra]
      )
      forall a. [a] -> [a] -> [a]
++ ( TestName -> Expectation -> TestTree
testCase TestName
"Timelock examples roundtrip - Mary" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t.
(Show t, Eq t, ToCBOR t, DecCBOR (Annotator t), HasCallStack) =>
t -> Expectation
roundTripAnnExpectation
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [forall era. AllegraEraScript era => NativeScript era
s1 @MaryEra, forall era. AllegraEraScript era => NativeScript era
s2 @MaryEra, forall era. AllegraEraScript era => NativeScript era
s3 @MaryEra]
         )
      forall a. [a] -> [a] -> [a]
++ [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"roundtripTimelock prop - Allegra" forall a b. (a -> b) -> a -> b
$ forall t.
(Show t, Eq t, ToCBOR t, DecCBOR (Annotator t), HasCallStack) =>
t -> Expectation
roundTripAnnExpectation @(Timelock AllegraEra)
         , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"roundtripTimelock prop - Mary" forall a b. (a -> b) -> a -> b
$ forall t.
(Show t, Eq t, ToCBOR t, DecCBOR (Annotator t), HasCallStack) =>
t -> Expectation
roundTripAnnExpectation @(Timelock MaryEra)
         , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"MultiSig deserialises as Timelock" forall a b. (a -> b) -> a -> b
$
            forall a b.
(ToCBOR a, DecCBOR (Annotator b), HasCallStack) =>
Version -> Version -> (b -> a -> Expectation) -> a -> Expectation
embedTripAnnExpectation @(MultiSig ShelleyEra)
              @(Timelock AllegraEra)
              (forall era. Era era => Version
eraProtVerHigh @ShelleyEra)
              (forall era. Era era => Version
eraProtVerLow @AllegraEra)
              ( \Timelock AllegraEra
timelock MultiSig ShelleyEra
multiSig ->
                  forall a. (Eq a, ToExpr a) => a -> a -> Expectation
expectExprEqual (ByteString -> HexBytes
HexBytes (forall t. SafeToHash t => t -> ByteString
originalBytes Timelock AllegraEra
timelock)) (ByteString -> HexBytes
HexBytes (forall t. SafeToHash t => t -> ByteString
originalBytes MultiSig ShelleyEra
multiSig))
              )
         ]