{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Allegra.Scripts (
  AllegraEraScript (..),
  mkRequireSignatureTimelock,
  getRequireSignatureTimelock,
  mkRequireAllOfTimelock,
  getRequireAllOfTimelock,
  mkRequireAnyOfTimelock,
  getRequireAnyOfTimelock,
  mkRequireMOfTimelock,
  getRequireMOfTimelock,
  mkTimeStartTimelock,
  getTimeStartTimelock,
  mkTimeExpireTimelock,
  getTimeExpireTimelock,
  Timelock (MkTimelock, TimelockConstr),
  pattern RequireTimeExpire,
  pattern RequireTimeStart,
  TimelockRaw (..),
  inInterval,
  showTimelock,
  evalTimelock,
  eqTimelockRaw,
  ValidityInterval (..),
  encodeVI,
  decodeVI,
  -- translate,
  translateTimelock,
) where

import Cardano.Ledger.Allegra.Era (AllegraEra)
import Cardano.Ledger.BaseTypes (StrictMaybe (SJust, SNothing))
import Cardano.Ledger.Binary (
  DecCBOR (decCBOR),
  EncCBOR (encCBOR),
  ToCBOR (..),
 )
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Density (..),
  Encode (..),
  Wrapped (..),
  decode,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.Core
import Cardano.Ledger.MemoBytes (
  EqRaw (..),
  MemoBytes (Memo),
  Memoized (..),
  byteCountMemoBytes,
  decodeMemoized,
  getMemoRawType,
  mkMemoizedEra,
  packMemoBytesM,
  unpackMemoBytesM,
 )
import Cardano.Ledger.MemoBytes.Internal (mkMemoBytes)
import Cardano.Ledger.Shelley.Scripts (
  ShelleyEraScript (..),
  nativeMultiSigTag,
  pattern RequireAllOf,
  pattern RequireAnyOf,
  pattern RequireMOf,
  pattern RequireSignature,
 )
import Cardano.Slotting.Slot (SlotNo (..))
import Control.DeepSeq (NFData (..))
import Data.Aeson (ToJSON (..), (.=))
import qualified Data.Aeson as Aeson
import Data.ByteString.Lazy (fromStrict)
import Data.ByteString.Short (fromShort)
import Data.Foldable as F (foldl')
import Data.MemPack
import Data.Sequence.Strict as Seq (StrictSeq (Empty, (:<|)))
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set (Set, member)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))

-- | ValidityInterval is a half open interval. Closed on the bottom, open on the top.
--   A SNothing on the bottom is negative infinity, and a SNothing on the top is positive infinity
data ValidityInterval = ValidityInterval
  { ValidityInterval -> StrictMaybe SlotNo
invalidBefore :: !(StrictMaybe SlotNo)
  , ValidityInterval -> StrictMaybe SlotNo
invalidHereafter :: !(StrictMaybe SlotNo)
  }
  deriving (Eq ValidityInterval
Eq ValidityInterval =>
(ValidityInterval -> ValidityInterval -> Ordering)
-> (ValidityInterval -> ValidityInterval -> Bool)
-> (ValidityInterval -> ValidityInterval -> Bool)
-> (ValidityInterval -> ValidityInterval -> Bool)
-> (ValidityInterval -> ValidityInterval -> Bool)
-> (ValidityInterval -> ValidityInterval -> ValidityInterval)
-> (ValidityInterval -> ValidityInterval -> ValidityInterval)
-> Ord ValidityInterval
ValidityInterval -> ValidityInterval -> Bool
ValidityInterval -> ValidityInterval -> Ordering
ValidityInterval -> ValidityInterval -> ValidityInterval
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ValidityInterval -> ValidityInterval -> Ordering
compare :: ValidityInterval -> ValidityInterval -> Ordering
$c< :: ValidityInterval -> ValidityInterval -> Bool
< :: ValidityInterval -> ValidityInterval -> Bool
$c<= :: ValidityInterval -> ValidityInterval -> Bool
<= :: ValidityInterval -> ValidityInterval -> Bool
$c> :: ValidityInterval -> ValidityInterval -> Bool
> :: ValidityInterval -> ValidityInterval -> Bool
$c>= :: ValidityInterval -> ValidityInterval -> Bool
>= :: ValidityInterval -> ValidityInterval -> Bool
$cmax :: ValidityInterval -> ValidityInterval -> ValidityInterval
max :: ValidityInterval -> ValidityInterval -> ValidityInterval
$cmin :: ValidityInterval -> ValidityInterval -> ValidityInterval
min :: ValidityInterval -> ValidityInterval -> ValidityInterval
Ord, ValidityInterval -> ValidityInterval -> Bool
(ValidityInterval -> ValidityInterval -> Bool)
-> (ValidityInterval -> ValidityInterval -> Bool)
-> Eq ValidityInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidityInterval -> ValidityInterval -> Bool
== :: ValidityInterval -> ValidityInterval -> Bool
$c/= :: ValidityInterval -> ValidityInterval -> Bool
/= :: ValidityInterval -> ValidityInterval -> Bool
Eq, (forall x. ValidityInterval -> Rep ValidityInterval x)
-> (forall x. Rep ValidityInterval x -> ValidityInterval)
-> Generic ValidityInterval
forall x. Rep ValidityInterval x -> ValidityInterval
forall x. ValidityInterval -> Rep ValidityInterval x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ValidityInterval -> Rep ValidityInterval x
from :: forall x. ValidityInterval -> Rep ValidityInterval x
$cto :: forall x. Rep ValidityInterval x -> ValidityInterval
to :: forall x. Rep ValidityInterval x -> ValidityInterval
Generic, Int -> ValidityInterval -> ShowS
[ValidityInterval] -> ShowS
ValidityInterval -> String
(Int -> ValidityInterval -> ShowS)
-> (ValidityInterval -> String)
-> ([ValidityInterval] -> ShowS)
-> Show ValidityInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidityInterval -> ShowS
showsPrec :: Int -> ValidityInterval -> ShowS
$cshow :: ValidityInterval -> String
show :: ValidityInterval -> String
$cshowList :: [ValidityInterval] -> ShowS
showList :: [ValidityInterval] -> ShowS
Show, Context -> ValidityInterval -> IO (Maybe ThunkInfo)
Proxy ValidityInterval -> String
(Context -> ValidityInterval -> IO (Maybe ThunkInfo))
-> (Context -> ValidityInterval -> IO (Maybe ThunkInfo))
-> (Proxy ValidityInterval -> String)
-> NoThunks ValidityInterval
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ValidityInterval -> IO (Maybe ThunkInfo)
noThunks :: Context -> ValidityInterval -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ValidityInterval -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ValidityInterval -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ValidityInterval -> String
showTypeOf :: Proxy ValidityInterval -> String
NoThunks, ValidityInterval -> ()
(ValidityInterval -> ()) -> NFData ValidityInterval
forall a. (a -> ()) -> NFData a
$crnf :: ValidityInterval -> ()
rnf :: ValidityInterval -> ()
NFData)

encodeVI :: ValidityInterval -> Encode ('Closed 'Dense) ValidityInterval
encodeVI :: ValidityInterval -> Encode ('Closed 'Dense) ValidityInterval
encodeVI (ValidityInterval StrictMaybe SlotNo
f StrictMaybe SlotNo
t) = (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval)
-> Encode
     ('Closed 'Dense)
     (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval)
forall t. t -> Encode ('Closed 'Dense) t
Rec StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval Encode
  ('Closed 'Dense)
  (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval)
-> Encode ('Closed 'Dense) (StrictMaybe SlotNo)
-> Encode ('Closed 'Dense) (StrictMaybe SlotNo -> ValidityInterval)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> StrictMaybe SlotNo -> Encode ('Closed 'Dense) (StrictMaybe SlotNo)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe SlotNo
f Encode ('Closed 'Dense) (StrictMaybe SlotNo -> ValidityInterval)
-> Encode ('Closed 'Dense) (StrictMaybe SlotNo)
-> Encode ('Closed 'Dense) ValidityInterval
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> StrictMaybe SlotNo -> Encode ('Closed 'Dense) (StrictMaybe SlotNo)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe SlotNo
t

instance EncCBOR ValidityInterval where
  encCBOR :: ValidityInterval -> Encoding
encCBOR ValidityInterval
vi = Encode ('Closed 'Dense) ValidityInterval -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (ValidityInterval -> Encode ('Closed 'Dense) ValidityInterval
encodeVI ValidityInterval
vi)

decodeVI :: Decode ('Closed 'Dense) ValidityInterval
decodeVI :: Decode ('Closed 'Dense) ValidityInterval
decodeVI = (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval)
-> Decode
     ('Closed 'Dense)
     (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval)
forall t. t -> Decode ('Closed 'Dense) t
RecD StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval Decode
  ('Closed 'Dense)
  (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval)
-> Decode ('Closed Any) (StrictMaybe SlotNo)
-> Decode ('Closed 'Dense) (StrictMaybe SlotNo -> ValidityInterval)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (StrictMaybe SlotNo)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode ('Closed 'Dense) (StrictMaybe SlotNo -> ValidityInterval)
-> Decode ('Closed Any) (StrictMaybe SlotNo)
-> Decode ('Closed 'Dense) ValidityInterval
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (StrictMaybe SlotNo)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From

instance DecCBOR ValidityInterval where
  decCBOR :: forall s. Decoder s ValidityInterval
decCBOR = Decode ('Closed 'Dense) ValidityInterval
-> Decoder s ValidityInterval
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode Decode ('Closed 'Dense) ValidityInterval
decodeVI

instance ToJSON ValidityInterval where
  toJSON :: ValidityInterval -> Value
toJSON ValidityInterval
vi =
    [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
k Key -> SlotNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo
v
      | (Key
k, SJust SlotNo
v) <-
          [ (Key
"invalidBefore", ValidityInterval -> StrictMaybe SlotNo
invalidBefore ValidityInterval
vi)
          , (Key
"invalidHereafter", ValidityInterval -> StrictMaybe SlotNo
invalidHereafter ValidityInterval
vi)
          ]
      ]

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

data TimelockRaw era
  = TimelockSignature !(KeyHash 'Witness)
  | TimelockAllOf !(StrictSeq (Timelock era)) -- NOTE that Timelock and
  | TimelockAnyOf !(StrictSeq (Timelock era)) -- TimelockRaw are mutually recursive.
  | TimelockMOf !Int !(StrictSeq (Timelock era))
  | -- Note that the Int may be negative in which case (TimelockMOf (-2) [..]) is always True
    TimelockTimeStart !SlotNo -- The start time
  | TimelockTimeExpire !SlotNo -- The time it expires
  deriving (TimelockRaw era -> TimelockRaw era -> Bool
(TimelockRaw era -> TimelockRaw era -> Bool)
-> (TimelockRaw era -> TimelockRaw era -> Bool)
-> Eq (TimelockRaw era)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (era :: k). TimelockRaw era -> TimelockRaw era -> Bool
$c== :: forall k (era :: k). TimelockRaw era -> TimelockRaw era -> Bool
== :: TimelockRaw era -> TimelockRaw era -> Bool
$c/= :: forall k (era :: k). TimelockRaw era -> TimelockRaw era -> Bool
/= :: TimelockRaw era -> TimelockRaw era -> Bool
Eq, (forall x. TimelockRaw era -> Rep (TimelockRaw era) x)
-> (forall x. Rep (TimelockRaw era) x -> TimelockRaw era)
-> Generic (TimelockRaw era)
forall x. Rep (TimelockRaw era) x -> TimelockRaw era
forall x. TimelockRaw era -> Rep (TimelockRaw era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (era :: k) x. Rep (TimelockRaw era) x -> TimelockRaw era
forall k (era :: k) x. TimelockRaw era -> Rep (TimelockRaw era) x
$cfrom :: forall k (era :: k) x. TimelockRaw era -> Rep (TimelockRaw era) x
from :: forall x. TimelockRaw era -> Rep (TimelockRaw era) x
$cto :: forall k (era :: k) x. Rep (TimelockRaw era) x -> TimelockRaw era
to :: forall x. Rep (TimelockRaw era) x -> TimelockRaw era
Generic, TimelockRaw era -> ()
(TimelockRaw era -> ()) -> NFData (TimelockRaw era)
forall a. (a -> ()) -> NFData a
forall k (era :: k). TimelockRaw era -> ()
$crnf :: forall k (era :: k). TimelockRaw era -> ()
rnf :: TimelockRaw era -> ()
NFData)

class ShelleyEraScript era => AllegraEraScript era where
  mkTimeStart :: SlotNo -> NativeScript era
  getTimeStart :: NativeScript era -> Maybe SlotNo

  mkTimeExpire :: SlotNo -> NativeScript era
  getTimeExpire :: NativeScript era -> Maybe SlotNo

deriving instance Era era => NoThunks (TimelockRaw era)

deriving instance Show (TimelockRaw era)

-- | This function deconstructs and then reconstructs the timelock script
-- to prove the compiler that we can arbirarily switch out the eras as long
-- as the cryptos for both eras are the same.
translateTimelock ::
  forall era1 era2.
  ( Era era1
  , Era era2
  ) =>
  Timelock era1 ->
  Timelock era2
translateTimelock :: forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock (MkTimelock (Memo TimelockRaw era1
tl ShortByteString
bs)) =
  let rewrap :: TimelockRaw era2 -> Timelock era2
rewrap TimelockRaw era2
rtl = MemoBytes (TimelockRaw era2) -> Timelock era2
forall {k} (era :: k). MemoBytes (TimelockRaw era) -> Timelock era
MkTimelock (MemoBytes (TimelockRaw era2) -> Timelock era2)
-> MemoBytes (TimelockRaw era2) -> Timelock era2
forall a b. (a -> b) -> a -> b
$ TimelockRaw era2 -> ByteString -> MemoBytes (TimelockRaw era2)
forall t. t -> ByteString -> MemoBytes t
mkMemoBytes TimelockRaw era2
rtl (ByteString -> ByteString
fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteString
fromShort ShortByteString
bs)
   in case TimelockRaw era1
tl of
        TimelockSignature KeyHash 'Witness
s -> TimelockRaw era2 -> Timelock era2
rewrap (TimelockRaw era2 -> Timelock era2)
-> TimelockRaw era2 -> Timelock era2
forall a b. (a -> b) -> a -> b
$ KeyHash 'Witness -> TimelockRaw era2
forall {k} (era :: k). KeyHash 'Witness -> TimelockRaw era
TimelockSignature KeyHash 'Witness
s
        TimelockAllOf StrictSeq (Timelock era1)
l -> TimelockRaw era2 -> Timelock era2
rewrap (TimelockRaw era2 -> Timelock era2)
-> (StrictSeq (Timelock era2) -> TimelockRaw era2)
-> StrictSeq (Timelock era2)
-> Timelock era2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq (Timelock era2) -> TimelockRaw era2
forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAllOf (StrictSeq (Timelock era2) -> Timelock era2)
-> StrictSeq (Timelock era2) -> Timelock era2
forall a b. (a -> b) -> a -> b
$ Timelock era1 -> Timelock era2
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock (Timelock era1 -> Timelock era2)
-> StrictSeq (Timelock era1) -> StrictSeq (Timelock era2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Timelock era1)
l
        TimelockAnyOf StrictSeq (Timelock era1)
l -> TimelockRaw era2 -> Timelock era2
rewrap (TimelockRaw era2 -> Timelock era2)
-> (StrictSeq (Timelock era2) -> TimelockRaw era2)
-> StrictSeq (Timelock era2)
-> Timelock era2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq (Timelock era2) -> TimelockRaw era2
forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAnyOf (StrictSeq (Timelock era2) -> Timelock era2)
-> StrictSeq (Timelock era2) -> Timelock era2
forall a b. (a -> b) -> a -> b
$ Timelock era1 -> Timelock era2
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock (Timelock era1 -> Timelock era2)
-> StrictSeq (Timelock era1) -> StrictSeq (Timelock era2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Timelock era1)
l
        TimelockMOf Int
n StrictSeq (Timelock era1)
l -> TimelockRaw era2 -> Timelock era2
rewrap (TimelockRaw era2 -> Timelock era2)
-> TimelockRaw era2 -> Timelock era2
forall a b. (a -> b) -> a -> b
$ Int -> StrictSeq (Timelock era2) -> TimelockRaw era2
forall {k} (era :: k).
Int -> StrictSeq (Timelock era) -> TimelockRaw era
TimelockMOf Int
n (Timelock era1 -> Timelock era2
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock (Timelock era1 -> Timelock era2)
-> StrictSeq (Timelock era1) -> StrictSeq (Timelock era2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Timelock era1)
l)
        TimelockTimeStart SlotNo
x -> TimelockRaw era2 -> Timelock era2
rewrap (TimelockRaw era2 -> Timelock era2)
-> TimelockRaw era2 -> Timelock era2
forall a b. (a -> b) -> a -> b
$ SlotNo -> TimelockRaw era2
forall {k} (era :: k). SlotNo -> TimelockRaw era
TimelockTimeStart SlotNo
x
        TimelockTimeExpire SlotNo
x -> TimelockRaw era2 -> Timelock era2
rewrap (TimelockRaw era2 -> Timelock era2)
-> TimelockRaw era2 -> Timelock era2
forall a b. (a -> b) -> a -> b
$ SlotNo -> TimelockRaw era2
forall {k} (era :: k). SlotNo -> TimelockRaw era
TimelockTimeExpire SlotNo
x

-- These coding choices are chosen so that a MultiSig script
-- can be deserialised as a Timelock script

instance Era era => EncCBOR (TimelockRaw era) where
  encCBOR :: TimelockRaw era -> Encoding
encCBOR =
    Encode 'Open (TimelockRaw era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (TimelockRaw era) -> Encoding)
-> (TimelockRaw era -> Encode 'Open (TimelockRaw era))
-> TimelockRaw era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      TimelockSignature KeyHash 'Witness
hash -> (KeyHash 'Witness -> TimelockRaw era)
-> Word -> Encode 'Open (KeyHash 'Witness -> TimelockRaw era)
forall t. t -> Word -> Encode 'Open t
Sum KeyHash 'Witness -> TimelockRaw era
forall {k} (era :: k). KeyHash 'Witness -> TimelockRaw era
TimelockSignature Word
0 Encode 'Open (KeyHash 'Witness -> TimelockRaw era)
-> Encode ('Closed 'Dense) (KeyHash 'Witness)
-> Encode 'Open (TimelockRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> KeyHash 'Witness -> Encode ('Closed 'Dense) (KeyHash 'Witness)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'Witness
hash
      TimelockAllOf StrictSeq (Timelock era)
xs -> (StrictSeq (Timelock era) -> TimelockRaw era)
-> Word
-> Encode 'Open (StrictSeq (Timelock era) -> TimelockRaw era)
forall t. t -> Word -> Encode 'Open t
Sum StrictSeq (Timelock era) -> TimelockRaw era
forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAllOf Word
1 Encode 'Open (StrictSeq (Timelock era) -> TimelockRaw era)
-> Encode ('Closed 'Dense) (StrictSeq (Timelock era))
-> Encode 'Open (TimelockRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> StrictSeq (Timelock era)
-> Encode ('Closed 'Dense) (StrictSeq (Timelock era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (Timelock era)
xs
      TimelockAnyOf StrictSeq (Timelock era)
xs -> (StrictSeq (Timelock era) -> TimelockRaw era)
-> Word
-> Encode 'Open (StrictSeq (Timelock era) -> TimelockRaw era)
forall t. t -> Word -> Encode 'Open t
Sum StrictSeq (Timelock era) -> TimelockRaw era
forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAnyOf Word
2 Encode 'Open (StrictSeq (Timelock era) -> TimelockRaw era)
-> Encode ('Closed 'Dense) (StrictSeq (Timelock era))
-> Encode 'Open (TimelockRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> StrictSeq (Timelock era)
-> Encode ('Closed 'Dense) (StrictSeq (Timelock era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (Timelock era)
xs
      TimelockMOf Int
m StrictSeq (Timelock era)
xs -> (Int -> StrictSeq (Timelock era) -> TimelockRaw era)
-> Word
-> Encode
     'Open (Int -> StrictSeq (Timelock era) -> TimelockRaw era)
forall t. t -> Word -> Encode 'Open t
Sum Int -> StrictSeq (Timelock era) -> TimelockRaw era
forall {k} (era :: k).
Int -> StrictSeq (Timelock era) -> TimelockRaw era
TimelockMOf Word
3 Encode 'Open (Int -> StrictSeq (Timelock era) -> TimelockRaw era)
-> Encode ('Closed 'Dense) Int
-> Encode 'Open (StrictSeq (Timelock era) -> TimelockRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
m Encode 'Open (StrictSeq (Timelock era) -> TimelockRaw era)
-> Encode ('Closed 'Dense) (StrictSeq (Timelock era))
-> Encode 'Open (TimelockRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> StrictSeq (Timelock era)
-> Encode ('Closed 'Dense) (StrictSeq (Timelock era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (Timelock era)
xs
      TimelockTimeStart SlotNo
m -> (SlotNo -> TimelockRaw era)
-> Word -> Encode 'Open (SlotNo -> TimelockRaw era)
forall t. t -> Word -> Encode 'Open t
Sum SlotNo -> TimelockRaw era
forall {k} (era :: k). SlotNo -> TimelockRaw era
TimelockTimeStart Word
4 Encode 'Open (SlotNo -> TimelockRaw era)
-> Encode ('Closed 'Dense) SlotNo -> Encode 'Open (TimelockRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> SlotNo -> Encode ('Closed 'Dense) SlotNo
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To SlotNo
m
      TimelockTimeExpire SlotNo
m -> (SlotNo -> TimelockRaw era)
-> Word -> Encode 'Open (SlotNo -> TimelockRaw era)
forall t. t -> Word -> Encode 'Open t
Sum SlotNo -> TimelockRaw era
forall {k} (era :: k). SlotNo -> TimelockRaw era
TimelockTimeExpire Word
5 Encode 'Open (SlotNo -> TimelockRaw era)
-> Encode ('Closed 'Dense) SlotNo -> Encode 'Open (TimelockRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> SlotNo -> Encode ('Closed 'Dense) SlotNo
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To SlotNo
m

instance Era era => DecCBOR (TimelockRaw era) where
  decCBOR :: forall s. Decoder s (TimelockRaw era)
decCBOR = Decode ('Closed 'Dense) (TimelockRaw era)
-> Decoder s (TimelockRaw era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (TimelockRaw era)
 -> Decoder s (TimelockRaw era))
-> Decode ('Closed 'Dense) (TimelockRaw era)
-> Decoder s (TimelockRaw era)
forall a b. (a -> b) -> a -> b
$ Text
-> (Word -> Decode 'Open (TimelockRaw era))
-> Decode ('Closed 'Dense) (TimelockRaw era)
forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"TimelockRaw" ((Word -> Decode 'Open (TimelockRaw era))
 -> Decode ('Closed 'Dense) (TimelockRaw era))
-> (Word -> Decode 'Open (TimelockRaw era))
-> Decode ('Closed 'Dense) (TimelockRaw era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> (KeyHash 'Witness -> TimelockRaw era)
-> Decode 'Open (KeyHash 'Witness -> TimelockRaw era)
forall t. t -> Decode 'Open t
SumD KeyHash 'Witness -> TimelockRaw era
forall {k} (era :: k). KeyHash 'Witness -> TimelockRaw era
TimelockSignature Decode 'Open (KeyHash 'Witness -> TimelockRaw era)
-> Decode ('Closed Any) (KeyHash 'Witness)
-> Decode 'Open (TimelockRaw era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (KeyHash 'Witness)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
1 -> (StrictSeq (Timelock era) -> TimelockRaw era)
-> Decode 'Open (StrictSeq (Timelock era) -> TimelockRaw era)
forall t. t -> Decode 'Open t
SumD StrictSeq (Timelock era) -> TimelockRaw era
forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAllOf Decode 'Open (StrictSeq (Timelock era) -> TimelockRaw era)
-> Decode ('Closed Any) (StrictSeq (Timelock era))
-> Decode 'Open (TimelockRaw era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (StrictSeq (Timelock era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> (StrictSeq (Timelock era) -> TimelockRaw era)
-> Decode 'Open (StrictSeq (Timelock era) -> TimelockRaw era)
forall t. t -> Decode 'Open t
SumD StrictSeq (Timelock era) -> TimelockRaw era
forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAnyOf Decode 'Open (StrictSeq (Timelock era) -> TimelockRaw era)
-> Decode ('Closed Any) (StrictSeq (Timelock era))
-> Decode 'Open (TimelockRaw era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (StrictSeq (Timelock era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
3 -> (Int -> StrictSeq (Timelock era) -> TimelockRaw era)
-> Decode
     'Open (Int -> StrictSeq (Timelock era) -> TimelockRaw era)
forall t. t -> Decode 'Open t
SumD Int -> StrictSeq (Timelock era) -> TimelockRaw era
forall {k} (era :: k).
Int -> StrictSeq (Timelock era) -> TimelockRaw era
TimelockMOf Decode 'Open (Int -> StrictSeq (Timelock era) -> TimelockRaw era)
-> Decode ('Closed Any) Int
-> Decode 'Open (StrictSeq (Timelock era) -> TimelockRaw era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (StrictSeq (Timelock era) -> TimelockRaw era)
-> Decode ('Closed Any) (StrictSeq (Timelock era))
-> Decode 'Open (TimelockRaw era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (StrictSeq (Timelock era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
4 -> (SlotNo -> TimelockRaw era)
-> Decode 'Open (SlotNo -> TimelockRaw era)
forall t. t -> Decode 'Open t
SumD SlotNo -> TimelockRaw era
forall {k} (era :: k). SlotNo -> TimelockRaw era
TimelockTimeStart Decode 'Open (SlotNo -> TimelockRaw era)
-> Decode ('Closed Any) SlotNo -> Decode 'Open (TimelockRaw era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) SlotNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
5 -> (SlotNo -> TimelockRaw era)
-> Decode 'Open (SlotNo -> TimelockRaw era)
forall t. t -> Decode 'Open t
SumD SlotNo -> TimelockRaw era
forall {k} (era :: k). SlotNo -> TimelockRaw era
TimelockTimeExpire Decode 'Open (SlotNo -> TimelockRaw era)
-> Decode ('Closed Any) SlotNo -> Decode 'Open (TimelockRaw era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) SlotNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> Word -> Decode 'Open (TimelockRaw era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

-- =================================================================
-- Native Scripts are Memoized TimelockRaw.
-- The patterns give the appearence that the mutual recursion is not present.
-- They rely on memoBytes, and TimelockRaw to memoize each constructor of Timelock
-- =================================================================

newtype Timelock era = MkTimelock (MemoBytes (TimelockRaw era))
  deriving (Timelock era -> Timelock era -> Bool
(Timelock era -> Timelock era -> Bool)
-> (Timelock era -> Timelock era -> Bool) -> Eq (Timelock era)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (era :: k). Timelock era -> Timelock era -> Bool
$c== :: forall k (era :: k). Timelock era -> Timelock era -> Bool
== :: Timelock era -> Timelock era -> Bool
$c/= :: forall k (era :: k). Timelock era -> Timelock era -> Bool
/= :: Timelock era -> Timelock era -> Bool
Eq, (forall x. Timelock era -> Rep (Timelock era) x)
-> (forall x. Rep (Timelock era) x -> Timelock era)
-> Generic (Timelock era)
forall x. Rep (Timelock era) x -> Timelock era
forall x. Timelock era -> Rep (Timelock era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (era :: k) x. Rep (Timelock era) x -> Timelock era
forall k (era :: k) x. Timelock era -> Rep (Timelock era) x
$cfrom :: forall k (era :: k) x. Timelock era -> Rep (Timelock era) x
from :: forall x. Timelock era -> Rep (Timelock era) x
$cto :: forall k (era :: k) x. Rep (Timelock era) x -> Timelock era
to :: forall x. Rep (Timelock era) x -> Timelock era
Generic)
  deriving newtype (Typeable (Timelock era)
Typeable (Timelock era) =>
(Timelock era -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Timelock era) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Timelock era] -> Size)
-> ToCBOR (Timelock era)
Timelock era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Timelock era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Timelock era) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall k (era :: k).
(Typeable era, Typeable k) =>
Typeable (Timelock era)
forall k (era :: k).
(Typeable era, Typeable k) =>
Timelock era -> Encoding
forall k (era :: k).
(Typeable era, Typeable k) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Timelock era] -> Size
forall k (era :: k).
(Typeable era, Typeable k) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Timelock era) -> Size
$ctoCBOR :: forall k (era :: k).
(Typeable era, Typeable k) =>
Timelock era -> Encoding
toCBOR :: Timelock era -> Encoding
$cencodedSizeExpr :: forall k (era :: k).
(Typeable era, Typeable k) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Timelock era) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Timelock era) -> Size
$cencodedListSizeExpr :: forall k (era :: k).
(Typeable era, Typeable k) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Timelock era] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Timelock era] -> Size
ToCBOR, Timelock era -> ()
(Timelock era -> ()) -> NFData (Timelock era)
forall a. (a -> ()) -> NFData a
forall k (era :: k). Timelock era -> ()
$crnf :: forall k (era :: k). Timelock era -> ()
rnf :: Timelock era -> ()
NFData, Timelock era -> Int
Timelock era -> ByteString
(Timelock era -> ByteString)
-> (Timelock era -> Int)
-> (forall i. Proxy i -> Timelock era -> SafeHash i)
-> SafeToHash (Timelock era)
forall i. Proxy i -> Timelock era -> SafeHash i
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall k (era :: k). Timelock era -> Int
forall k (era :: k). Timelock era -> ByteString
forall k (era :: k) i. Proxy i -> Timelock era -> SafeHash i
$coriginalBytes :: forall k (era :: k). Timelock era -> ByteString
originalBytes :: Timelock era -> ByteString
$coriginalBytesSize :: forall k (era :: k). Timelock era -> Int
originalBytesSize :: Timelock era -> Int
$cmakeHashWithExplicitProxys :: forall k (era :: k) i. Proxy i -> Timelock era -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> Timelock era -> SafeHash i
SafeToHash)

pattern TimelockConstr :: MemoBytes (TimelockRaw era) -> Timelock era
pattern $mTimelockConstr :: forall {r} {k} {era :: k}.
Timelock era
-> (MemoBytes (TimelockRaw era) -> r) -> ((# #) -> r) -> r
$bTimelockConstr :: forall {k} (era :: k). MemoBytes (TimelockRaw era) -> Timelock era
TimelockConstr timelockRaw = MkTimelock timelockRaw

{-# COMPLETE TimelockConstr #-}

{-# DEPRECATED TimelockConstr "In favor of more consistently name `MkTimelock`" #-}

instance Era era => MemPack (Timelock era) where
  packedByteCount :: Timelock era -> Int
packedByteCount (MkTimelock MemoBytes (TimelockRaw era)
mb) = MemoBytes (TimelockRaw era) -> Int
forall t. MemoBytes t -> Int
byteCountMemoBytes MemoBytes (TimelockRaw era)
mb
  packM :: forall s. Timelock era -> Pack s ()
packM (MkTimelock MemoBytes (TimelockRaw era)
mb) = MemoBytes (TimelockRaw era) -> Pack s ()
forall t s. MemoBytes t -> Pack s ()
packMemoBytesM MemoBytes (TimelockRaw era)
mb
  unpackM :: forall b. Buffer b => Unpack b (Timelock era)
unpackM = MemoBytes (TimelockRaw era) -> Timelock era
forall {k} (era :: k). MemoBytes (TimelockRaw era) -> Timelock era
MkTimelock (MemoBytes (TimelockRaw era) -> Timelock era)
-> Unpack b (MemoBytes (TimelockRaw era))
-> Unpack b (Timelock era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Unpack b (MemoBytes (TimelockRaw era))
forall t b.
(DecCBOR t, Buffer b) =>
Version -> Unpack b (MemoBytes t)
unpackMemoBytesM (forall era. Era era => Version
eraProtVerLow @era)

instance Era era => NoThunks (Timelock era)

instance Era era => EncCBOR (Timelock era)

instance Era era => DecCBOR (Timelock era) where
  decCBOR :: forall s. Decoder s (Timelock era)
decCBOR = MemoBytes (TimelockRaw era) -> Timelock era
forall {k} (era :: k). MemoBytes (TimelockRaw era) -> Timelock era
MkTimelock (MemoBytes (TimelockRaw era) -> Timelock era)
-> Decoder s (MemoBytes (TimelockRaw era))
-> Decoder s (Timelock era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (TimelockRaw era)
-> Decoder s (MemoBytes (TimelockRaw era))
forall s t. Decoder s t -> Decoder s (MemoBytes t)
decodeMemoized Decoder s (TimelockRaw era)
forall s. Decoder s (TimelockRaw era)
forall a s. DecCBOR a => Decoder s a
decCBOR

instance Memoized (Timelock era) where
  type RawType (Timelock era) = TimelockRaw era

deriving instance Show (Timelock era)

instance EqRaw (Timelock era) where
  eqRaw :: Timelock era -> Timelock era -> Bool
eqRaw = Timelock era -> Timelock era -> Bool
forall k (era :: k). Timelock era -> Timelock era -> Bool
eqTimelockRaw

-- | Since Timelock scripts are a strictly backwards compatible extension of
-- MultiSig scripts, we can use the same 'scriptPrefixTag' tag here as we did
-- for the ValidateScript instance in MultiSig
instance EraScript AllegraEra where
  type Script AllegraEra = Timelock AllegraEra
  type NativeScript AllegraEra = Timelock AllegraEra

  upgradeScript :: EraScript (PreviousEra AllegraEra) =>
Script (PreviousEra AllegraEra) -> Script AllegraEra
upgradeScript = \case
    RequireSignature KeyHash 'Witness
keyHash -> KeyHash 'Witness -> NativeScript AllegraEra
forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature KeyHash 'Witness
keyHash
    RequireAllOf StrictSeq (NativeScript ShelleyEra)
sigs -> StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra)
-> StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
forall a b. (a -> b) -> a -> b
$ Script (PreviousEra AllegraEra) -> Script AllegraEra
Script (PreviousEra AllegraEra) -> Timelock AllegraEra
forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript (Script (PreviousEra AllegraEra) -> Timelock AllegraEra)
-> StrictSeq (Script (PreviousEra AllegraEra))
-> StrictSeq (Timelock AllegraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Script (PreviousEra AllegraEra))
StrictSeq (NativeScript ShelleyEra)
sigs
    RequireAnyOf StrictSeq (NativeScript ShelleyEra)
sigs -> StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra)
-> StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
forall a b. (a -> b) -> a -> b
$ Script (PreviousEra AllegraEra) -> Script AllegraEra
Script (PreviousEra AllegraEra) -> Timelock AllegraEra
forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript (Script (PreviousEra AllegraEra) -> Timelock AllegraEra)
-> StrictSeq (Script (PreviousEra AllegraEra))
-> StrictSeq (Timelock AllegraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Script (PreviousEra AllegraEra))
StrictSeq (NativeScript ShelleyEra)
sigs
    RequireMOf Int
n StrictSeq (NativeScript ShelleyEra)
sigs -> Int
-> StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
n (StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra)
-> StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
forall a b. (a -> b) -> a -> b
$ Script (PreviousEra AllegraEra) -> Script AllegraEra
Script (PreviousEra AllegraEra) -> Timelock AllegraEra
forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript (Script (PreviousEra AllegraEra) -> Timelock AllegraEra)
-> StrictSeq (Script (PreviousEra AllegraEra))
-> StrictSeq (Timelock AllegraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Script (PreviousEra AllegraEra))
StrictSeq (NativeScript ShelleyEra)
sigs
    Script (PreviousEra AllegraEra)
_ -> String -> Timelock AllegraEra
forall a. HasCallStack => String -> a
error String
"Impossible: All NativeScripts should have been accounted for"

  scriptPrefixTag :: Script AllegraEra -> ByteString
scriptPrefixTag Script AllegraEra
_script = ByteString
nativeMultiSigTag -- "\x00"

  getNativeScript :: Script AllegraEra -> Maybe (NativeScript AllegraEra)
getNativeScript = Script AllegraEra -> Maybe (NativeScript AllegraEra)
Timelock AllegraEra -> Maybe (Timelock AllegraEra)
forall a. a -> Maybe a
Just

  fromNativeScript :: NativeScript AllegraEra -> Script AllegraEra
fromNativeScript = NativeScript AllegraEra -> Script AllegraEra
Timelock AllegraEra -> Timelock AllegraEra
forall a. a -> a
id

instance ShelleyEraScript AllegraEra where
  mkRequireSignature :: KeyHash 'Witness -> NativeScript AllegraEra
mkRequireSignature = KeyHash 'Witness -> NativeScript AllegraEra
KeyHash 'Witness -> Timelock AllegraEra
forall era. Era era => KeyHash 'Witness -> Timelock era
mkRequireSignatureTimelock
  getRequireSignature :: NativeScript AllegraEra -> Maybe (KeyHash 'Witness)
getRequireSignature = NativeScript AllegraEra -> Maybe (KeyHash 'Witness)
Timelock AllegraEra -> Maybe (KeyHash 'Witness)
forall {k} (era :: k). Timelock era -> Maybe (KeyHash 'Witness)
getRequireSignatureTimelock

  mkRequireAllOf :: StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
mkRequireAllOf = StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
StrictSeq (Timelock AllegraEra) -> Timelock AllegraEra
forall era. Era era => StrictSeq (Timelock era) -> Timelock era
mkRequireAllOfTimelock
  getRequireAllOf :: NativeScript AllegraEra
-> Maybe (StrictSeq (NativeScript AllegraEra))
getRequireAllOf = NativeScript AllegraEra
-> Maybe (StrictSeq (NativeScript AllegraEra))
Timelock AllegraEra -> Maybe (StrictSeq (Timelock AllegraEra))
forall {k} (era :: k).
Timelock era -> Maybe (StrictSeq (Timelock era))
getRequireAllOfTimelock

  mkRequireAnyOf :: StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
mkRequireAnyOf = StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
StrictSeq (Timelock AllegraEra) -> Timelock AllegraEra
forall era. Era era => StrictSeq (Timelock era) -> Timelock era
mkRequireAnyOfTimelock
  getRequireAnyOf :: NativeScript AllegraEra
-> Maybe (StrictSeq (NativeScript AllegraEra))
getRequireAnyOf = NativeScript AllegraEra
-> Maybe (StrictSeq (NativeScript AllegraEra))
Timelock AllegraEra -> Maybe (StrictSeq (Timelock AllegraEra))
forall {k} (era :: k).
Timelock era -> Maybe (StrictSeq (Timelock era))
getRequireAnyOfTimelock

  mkRequireMOf :: Int
-> StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
mkRequireMOf = Int
-> StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
Int -> StrictSeq (Timelock AllegraEra) -> Timelock AllegraEra
forall era.
Era era =>
Int -> StrictSeq (Timelock era) -> Timelock era
mkRequireMOfTimelock
  getRequireMOf :: NativeScript AllegraEra
-> Maybe (Int, StrictSeq (NativeScript AllegraEra))
getRequireMOf = NativeScript AllegraEra
-> Maybe (Int, StrictSeq (NativeScript AllegraEra))
Timelock AllegraEra -> Maybe (Int, StrictSeq (Timelock AllegraEra))
forall {k} (era :: k).
Timelock era -> Maybe (Int, StrictSeq (Timelock era))
getRequireMOfTimelock

instance AllegraEraScript AllegraEra where
  mkTimeStart :: SlotNo -> NativeScript AllegraEra
mkTimeStart = SlotNo -> NativeScript AllegraEra
SlotNo -> Timelock AllegraEra
forall era. Era era => SlotNo -> Timelock era
mkTimeStartTimelock
  getTimeStart :: NativeScript AllegraEra -> Maybe SlotNo
getTimeStart = NativeScript AllegraEra -> Maybe SlotNo
Timelock AllegraEra -> Maybe SlotNo
forall {k} (era :: k). Timelock era -> Maybe SlotNo
getTimeStartTimelock

  mkTimeExpire :: SlotNo -> NativeScript AllegraEra
mkTimeExpire = SlotNo -> NativeScript AllegraEra
SlotNo -> Timelock AllegraEra
forall era. Era era => SlotNo -> Timelock era
mkTimeExpireTimelock
  getTimeExpire :: NativeScript AllegraEra -> Maybe SlotNo
getTimeExpire = NativeScript AllegraEra -> Maybe SlotNo
Timelock AllegraEra -> Maybe SlotNo
forall {k} (era :: k). Timelock era -> Maybe SlotNo
getTimeExpireTimelock

pattern RequireTimeExpire :: AllegraEraScript era => SlotNo -> NativeScript era
pattern $mRequireTimeExpire :: forall {r} {era}.
AllegraEraScript era =>
NativeScript era -> (SlotNo -> r) -> ((# #) -> r) -> r
$bRequireTimeExpire :: forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire mslot <- (getTimeExpire -> Just mslot)
  where
    RequireTimeExpire SlotNo
mslot = SlotNo -> NativeScript era
forall era. AllegraEraScript era => SlotNo -> NativeScript era
mkTimeExpire SlotNo
mslot

pattern RequireTimeStart :: AllegraEraScript era => SlotNo -> NativeScript era
pattern $mRequireTimeStart :: forall {r} {era}.
AllegraEraScript era =>
NativeScript era -> (SlotNo -> r) -> ((# #) -> r) -> r
$bRequireTimeStart :: forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart mslot <- (getTimeStart -> Just mslot)
  where
    RequireTimeStart SlotNo
mslot = SlotNo -> NativeScript era
forall era. AllegraEraScript era => SlotNo -> NativeScript era
mkTimeStart SlotNo
mslot

{-# COMPLETE
  RequireSignature
  , RequireAllOf
  , RequireAnyOf
  , RequireMOf
  , RequireTimeExpire
  , RequireTimeStart
  #-}

mkRequireSignatureTimelock :: forall era. Era era => KeyHash 'Witness -> Timelock era
mkRequireSignatureTimelock :: forall era. Era era => KeyHash 'Witness -> Timelock era
mkRequireSignatureTimelock = forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @era (TimelockRaw era -> Timelock era)
-> (KeyHash 'Witness -> TimelockRaw era)
-> KeyHash 'Witness
-> Timelock era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Witness -> TimelockRaw era
forall {k} (era :: k). KeyHash 'Witness -> TimelockRaw era
TimelockSignature

getRequireSignatureTimelock :: Timelock era -> Maybe (KeyHash 'Witness)
getRequireSignatureTimelock :: forall {k} (era :: k). Timelock era -> Maybe (KeyHash 'Witness)
getRequireSignatureTimelock (MkTimelock (Memo (TimelockSignature KeyHash 'Witness
kh) ShortByteString
_)) = KeyHash 'Witness -> Maybe (KeyHash 'Witness)
forall a. a -> Maybe a
Just KeyHash 'Witness
kh
getRequireSignatureTimelock Timelock era
_ = Maybe (KeyHash 'Witness)
forall a. Maybe a
Nothing

mkRequireAllOfTimelock :: forall era. Era era => StrictSeq (Timelock era) -> Timelock era
mkRequireAllOfTimelock :: forall era. Era era => StrictSeq (Timelock era) -> Timelock era
mkRequireAllOfTimelock = forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @era (TimelockRaw era -> Timelock era)
-> (StrictSeq (Timelock era) -> TimelockRaw era)
-> StrictSeq (Timelock era)
-> Timelock era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq (Timelock era) -> TimelockRaw era
forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAllOf

getRequireAllOfTimelock :: Timelock era -> Maybe (StrictSeq (Timelock era))
getRequireAllOfTimelock :: forall {k} (era :: k).
Timelock era -> Maybe (StrictSeq (Timelock era))
getRequireAllOfTimelock (MkTimelock (Memo (TimelockAllOf StrictSeq (Timelock era)
ms) ShortByteString
_)) = StrictSeq (Timelock era) -> Maybe (StrictSeq (Timelock era))
forall a. a -> Maybe a
Just StrictSeq (Timelock era)
ms
getRequireAllOfTimelock Timelock era
_ = Maybe (StrictSeq (Timelock era))
forall a. Maybe a
Nothing

mkRequireAnyOfTimelock :: forall era. Era era => StrictSeq (Timelock era) -> Timelock era
mkRequireAnyOfTimelock :: forall era. Era era => StrictSeq (Timelock era) -> Timelock era
mkRequireAnyOfTimelock = forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @era (TimelockRaw era -> Timelock era)
-> (StrictSeq (Timelock era) -> TimelockRaw era)
-> StrictSeq (Timelock era)
-> Timelock era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq (Timelock era) -> TimelockRaw era
forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAnyOf

getRequireAnyOfTimelock :: Timelock era -> Maybe (StrictSeq (Timelock era))
getRequireAnyOfTimelock :: forall {k} (era :: k).
Timelock era -> Maybe (StrictSeq (Timelock era))
getRequireAnyOfTimelock (MkTimelock (Memo (TimelockAnyOf StrictSeq (Timelock era)
ms) ShortByteString
_)) = StrictSeq (Timelock era) -> Maybe (StrictSeq (Timelock era))
forall a. a -> Maybe a
Just StrictSeq (Timelock era)
ms
getRequireAnyOfTimelock Timelock era
_ = Maybe (StrictSeq (Timelock era))
forall a. Maybe a
Nothing

mkRequireMOfTimelock :: forall era. Era era => Int -> StrictSeq (Timelock era) -> Timelock era
mkRequireMOfTimelock :: forall era.
Era era =>
Int -> StrictSeq (Timelock era) -> Timelock era
mkRequireMOfTimelock Int
n = forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @era (TimelockRaw era -> Timelock era)
-> (StrictSeq (Timelock era) -> TimelockRaw era)
-> StrictSeq (Timelock era)
-> Timelock era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StrictSeq (Timelock era) -> TimelockRaw era
forall {k} (era :: k).
Int -> StrictSeq (Timelock era) -> TimelockRaw era
TimelockMOf Int
n

getRequireMOfTimelock :: Timelock era -> Maybe (Int, StrictSeq (Timelock era))
getRequireMOfTimelock :: forall {k} (era :: k).
Timelock era -> Maybe (Int, StrictSeq (Timelock era))
getRequireMOfTimelock (MkTimelock (Memo (TimelockMOf Int
n StrictSeq (Timelock era)
ms) ShortByteString
_)) = (Int, StrictSeq (Timelock era))
-> Maybe (Int, StrictSeq (Timelock era))
forall a. a -> Maybe a
Just (Int
n, StrictSeq (Timelock era)
ms)
getRequireMOfTimelock Timelock era
_ = Maybe (Int, StrictSeq (Timelock era))
forall a. Maybe a
Nothing

mkTimeStartTimelock :: forall era. Era era => SlotNo -> Timelock era
mkTimeStartTimelock :: forall era. Era era => SlotNo -> Timelock era
mkTimeStartTimelock = forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @era (TimelockRaw era -> Timelock era)
-> (SlotNo -> TimelockRaw era) -> SlotNo -> Timelock era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> TimelockRaw era
forall {k} (era :: k). SlotNo -> TimelockRaw era
TimelockTimeStart

getTimeStartTimelock :: Timelock era -> Maybe SlotNo
getTimeStartTimelock :: forall {k} (era :: k). Timelock era -> Maybe SlotNo
getTimeStartTimelock (MkTimelock (Memo (TimelockTimeStart SlotNo
mslot) ShortByteString
_)) = SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just SlotNo
mslot
getTimeStartTimelock Timelock era
_ = Maybe SlotNo
forall a. Maybe a
Nothing

mkTimeExpireTimelock :: forall era. Era era => SlotNo -> Timelock era
mkTimeExpireTimelock :: forall era. Era era => SlotNo -> Timelock era
mkTimeExpireTimelock = forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @era (TimelockRaw era -> Timelock era)
-> (SlotNo -> TimelockRaw era) -> SlotNo -> Timelock era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> TimelockRaw era
forall {k} (era :: k). SlotNo -> TimelockRaw era
TimelockTimeExpire

getTimeExpireTimelock :: Timelock era -> Maybe SlotNo
getTimeExpireTimelock :: forall {k} (era :: k). Timelock era -> Maybe SlotNo
getTimeExpireTimelock (MkTimelock (Memo (TimelockTimeExpire SlotNo
mslot) ShortByteString
_)) = SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just SlotNo
mslot
getTimeExpireTimelock Timelock era
_ = Maybe SlotNo
forall a. Maybe a
Nothing

-- =================================================================
-- Evaluating and validating a Timelock

-- | less-than-equal comparison, where Nothing is negative infinity
lteNegInfty :: SlotNo -> StrictMaybe SlotNo -> Bool
lteNegInfty :: SlotNo -> StrictMaybe SlotNo -> Bool
lteNegInfty SlotNo
_ StrictMaybe SlotNo
SNothing = Bool
False -- i > -∞
lteNegInfty SlotNo
i (SJust SlotNo
j) = SlotNo
i SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
j

-- | less-than-equal comparison, where Nothing is positive infinity
ltePosInfty :: StrictMaybe SlotNo -> SlotNo -> Bool
ltePosInfty :: StrictMaybe SlotNo -> SlotNo -> Bool
ltePosInfty StrictMaybe SlotNo
SNothing SlotNo
_ = Bool
False -- ∞ > j
ltePosInfty (SJust SlotNo
i) SlotNo
j = SlotNo
i SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
j

evalTimelock ::
  AllegraEraScript era =>
  Set.Set (KeyHash 'Witness) ->
  ValidityInterval ->
  NativeScript era ->
  Bool
evalTimelock :: forall era.
AllegraEraScript era =>
Set (KeyHash 'Witness)
-> ValidityInterval -> NativeScript era -> Bool
evalTimelock Set (KeyHash 'Witness)
vhks (ValidityInterval StrictMaybe SlotNo
txStart StrictMaybe SlotNo
txExp) = NativeScript era -> Bool
go
  where
    -- The important part of this validator is that it will stop as soon as it reaches the
    -- required number of valid scripts
    isValidMOf :: Int -> StrictSeq (NativeScript era) -> Bool
isValidMOf Int
n StrictSeq (NativeScript era)
SSeq.Empty = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
    isValidMOf Int
n (NativeScript era
ts SSeq.:<| StrictSeq (NativeScript era)
tss) =
      Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| if NativeScript era -> Bool
go NativeScript era
ts then Int -> StrictSeq (NativeScript era) -> Bool
isValidMOf (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) StrictSeq (NativeScript era)
tss else Int -> StrictSeq (NativeScript era) -> Bool
isValidMOf Int
n StrictSeq (NativeScript era)
tss
    go :: NativeScript era -> Bool
go = \case
      RequireTimeStart SlotNo
lockStart -> SlotNo
lockStart SlotNo -> StrictMaybe SlotNo -> Bool
`lteNegInfty` StrictMaybe SlotNo
txStart
      RequireTimeExpire SlotNo
lockExp -> StrictMaybe SlotNo
txExp StrictMaybe SlotNo -> SlotNo -> Bool
`ltePosInfty` SlotNo
lockExp
      RequireSignature KeyHash 'Witness
hash -> KeyHash 'Witness
hash KeyHash 'Witness -> Set (KeyHash 'Witness) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (KeyHash 'Witness)
vhks
      RequireAllOf StrictSeq (NativeScript era)
xs -> (NativeScript era -> Bool) -> StrictSeq (NativeScript era) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all NativeScript era -> Bool
go StrictSeq (NativeScript era)
xs
      RequireAnyOf StrictSeq (NativeScript era)
xs -> (NativeScript era -> Bool) -> StrictSeq (NativeScript era) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any NativeScript era -> Bool
go StrictSeq (NativeScript era)
xs
      RequireMOf Int
m StrictSeq (NativeScript era)
xs -> Int -> StrictSeq (NativeScript era) -> Bool
isValidMOf Int
m StrictSeq (NativeScript era)
xs

-- =========================================================
-- Operations on Timelock scripts

-- | Test if a slot is in the Validity interval. Recall that a ValidityInterval
--   is a half Open interval, that is why we use (slot < top)
inInterval :: SlotNo -> ValidityInterval -> Bool
inInterval :: SlotNo -> ValidityInterval -> Bool
inInterval SlotNo
_slot (ValidityInterval StrictMaybe SlotNo
SNothing StrictMaybe SlotNo
SNothing) = Bool
True
inInterval SlotNo
slot (ValidityInterval StrictMaybe SlotNo
SNothing (SJust SlotNo
top)) = SlotNo
slot SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
top
inInterval SlotNo
slot (ValidityInterval (SJust SlotNo
bottom) StrictMaybe SlotNo
SNothing) = SlotNo
bottom SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
slot
inInterval SlotNo
slot (ValidityInterval (SJust SlotNo
bottom) (SJust SlotNo
top)) =
  SlotNo
bottom SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
slot Bool -> Bool -> Bool
&& SlotNo
slot SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
top

showTimelock :: AllegraEraScript era => NativeScript era -> String
showTimelock :: forall era. AllegraEraScript era => NativeScript era -> String
showTimelock (RequireTimeStart (SlotNo Word64
i)) = String
"(Start >= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
showTimelock (RequireTimeExpire (SlotNo Word64
i)) = String
"(Expire < " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
showTimelock (RequireAllOf StrictSeq (NativeScript era)
xs) = String
"(AllOf " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> NativeScript era -> String)
-> String -> StrictSeq (NativeScript era) -> String
forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' String -> NativeScript era -> String
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AllegraEraScript era) =>
String -> NativeScript era -> String
accum String
")" StrictSeq (NativeScript era)
xs
  where
    accum :: String -> NativeScript era -> String
accum String
ans NativeScript era
x = NativeScript era -> String
forall era. AllegraEraScript era => NativeScript era -> String
showTimelock NativeScript era
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ans
showTimelock (RequireAnyOf StrictSeq (NativeScript era)
xs) = String
"(AnyOf " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> NativeScript era -> String)
-> String -> StrictSeq (NativeScript era) -> String
forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' String -> NativeScript era -> String
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AllegraEraScript era) =>
String -> NativeScript era -> String
accum String
")" StrictSeq (NativeScript era)
xs
  where
    accum :: String -> NativeScript era -> String
accum String
ans NativeScript era
x = NativeScript era -> String
forall era. AllegraEraScript era => NativeScript era -> String
showTimelock NativeScript era
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ans
showTimelock (RequireMOf Int
m StrictSeq (NativeScript era)
xs) = String
"(MOf " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> NativeScript era -> String)
-> String -> StrictSeq (NativeScript era) -> String
forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' String -> NativeScript era -> String
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AllegraEraScript era) =>
String -> NativeScript era -> String
accum String
")" StrictSeq (NativeScript era)
xs
  where
    accum :: String -> NativeScript era -> String
accum String
ans NativeScript era
x = NativeScript era -> String
forall era. AllegraEraScript era => NativeScript era -> String
showTimelock NativeScript era
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ans
showTimelock (RequireSignature KeyHash 'Witness
hash) = String
"(Signature " String -> ShowS
forall a. [a] -> [a] -> [a]
++ KeyHash 'Witness -> String
forall a. Show a => a -> String
show KeyHash 'Witness
hash String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

-- | Check the equality of two underlying types, while ignoring their binary
-- representation, which `Eq` instance normally does. This is used for testing.
eqTimelockRaw :: Timelock era -> Timelock era -> Bool
eqTimelockRaw :: forall k (era :: k). Timelock era -> Timelock era -> Bool
eqTimelockRaw Timelock era
t1 Timelock era
t2 = TimelockRaw era -> TimelockRaw era -> Bool
forall k (era :: k). TimelockRaw era -> TimelockRaw era -> Bool
go (Timelock era -> RawType (Timelock era)
forall t. Memoized t => t -> RawType t
getMemoRawType Timelock era
t1) (Timelock era -> RawType (Timelock era)
forall t. Memoized t => t -> RawType t
getMemoRawType Timelock era
t2)
  where
    seqEq :: StrictSeq (Timelock era) -> StrictSeq (Timelock era) -> Bool
seqEq StrictSeq (Timelock era)
Empty StrictSeq (Timelock era)
Empty = Bool
True
    seqEq (Timelock era
x :<| StrictSeq (Timelock era)
xs) (Timelock era
y :<| StrictSeq (Timelock era)
ys) = Timelock era -> Timelock era -> Bool
forall k (era :: k). Timelock era -> Timelock era -> Bool
eqTimelockRaw Timelock era
x Timelock era
y Bool -> Bool -> Bool
&& StrictSeq (Timelock era) -> StrictSeq (Timelock era) -> Bool
seqEq StrictSeq (Timelock era)
xs StrictSeq (Timelock era)
ys
    seqEq StrictSeq (Timelock era)
_ StrictSeq (Timelock era)
_ = Bool
False
    go :: TimelockRaw era -> TimelockRaw era -> Bool
go (TimelockSignature KeyHash 'Witness
kh1) (TimelockSignature KeyHash 'Witness
kh2) = KeyHash 'Witness
kh1 KeyHash 'Witness -> KeyHash 'Witness -> Bool
forall a. Eq a => a -> a -> Bool
== KeyHash 'Witness
kh2
    go (TimelockAllOf StrictSeq (Timelock era)
ts1) (TimelockAllOf StrictSeq (Timelock era)
ts2) = StrictSeq (Timelock era) -> StrictSeq (Timelock era) -> Bool
forall {k} {era :: k}.
StrictSeq (Timelock era) -> StrictSeq (Timelock era) -> Bool
seqEq StrictSeq (Timelock era)
ts1 StrictSeq (Timelock era)
ts2
    go (TimelockAnyOf StrictSeq (Timelock era)
ts1) (TimelockAnyOf StrictSeq (Timelock era)
ts2) = StrictSeq (Timelock era) -> StrictSeq (Timelock era) -> Bool
forall {k} {era :: k}.
StrictSeq (Timelock era) -> StrictSeq (Timelock era) -> Bool
seqEq StrictSeq (Timelock era)
ts1 StrictSeq (Timelock era)
ts2
    go (TimelockMOf Int
n1 StrictSeq (Timelock era)
ts1) (TimelockMOf Int
n2 StrictSeq (Timelock era)
ts2) = Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2 Bool -> Bool -> Bool
&& StrictSeq (Timelock era) -> StrictSeq (Timelock era) -> Bool
forall {k} {era :: k}.
StrictSeq (Timelock era) -> StrictSeq (Timelock era) -> Bool
seqEq StrictSeq (Timelock era)
ts1 StrictSeq (Timelock era)
ts2
    go (TimelockTimeStart SlotNo
sn1) (TimelockTimeStart SlotNo
sn2) = SlotNo
sn1 SlotNo -> SlotNo -> Bool
forall a. Eq a => a -> a -> Bool
== SlotNo
sn2
    go (TimelockTimeExpire SlotNo
sn1) (TimelockTimeExpire SlotNo
sn2) = SlotNo
sn1 SlotNo -> SlotNo -> Bool
forall a. Eq a => a -> a -> Bool
== SlotNo
sn2
    go TimelockRaw era
_ TimelockRaw era
_ = Bool
False