{-# 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 (Allegra)
import Cardano.Ledger.Allegra.Scripts (
  AllegraEraScript,
  Timelock (..),
  pattern RequireTimeExpire,
  pattern RequireTimeStart,
 )
import Cardano.Ledger.Core (NativeScript, eraProtVerHigh, eraProtVerLow)
import Cardano.Ledger.Mary (Mary)
import Cardano.Ledger.SafeHash (originalBytes)
import Cardano.Ledger.Shelley (Shelley)
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 @Allegra, forall era. AllegraEraScript era => NativeScript era
s2 @Allegra, forall era. AllegraEraScript era => NativeScript era
s3 @Allegra]
      )
      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 @Mary, forall era. AllegraEraScript era => NativeScript era
s2 @Mary, forall era. AllegraEraScript era => NativeScript era
s3 @Mary]
         )
      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 Allegra)
         , 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 Mary)
         , 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 Shelley)
              @(Timelock Allegra)
              (forall era. Era era => Version
eraProtVerHigh @Shelley)
              (forall era. Era era => Version
eraProtVerLow @Allegra)
              ( \Timelock (AllegraEra StandardCrypto)
timelock MultiSig Shelley
multiSig ->
                  forall a. (Eq a, ToExpr a) => a -> a -> Expectation
expectExprEqual (ByteString -> HexBytes
HexBytes (forall t. SafeToHash t => t -> ByteString
originalBytes Timelock (AllegraEra StandardCrypto)
timelock)) (ByteString -> HexBytes
HexBytes (forall t. SafeToHash t => t -> ByteString
originalBytes MultiSig Shelley
multiSig))
              )
         ]