{-# 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
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
min :: ValidityInterval -> ValidityInterval -> ValidityInterval
$cmin :: ValidityInterval -> ValidityInterval -> ValidityInterval
max :: ValidityInterval -> ValidityInterval -> ValidityInterval
$cmax :: ValidityInterval -> ValidityInterval -> ValidityInterval
>= :: ValidityInterval -> ValidityInterval -> Bool
$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
compare :: ValidityInterval -> ValidityInterval -> Ordering
$ccompare :: ValidityInterval -> ValidityInterval -> Ordering
Ord, ValidityInterval -> ValidityInterval -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidityInterval -> ValidityInterval -> Bool
$c/= :: ValidityInterval -> ValidityInterval -> Bool
== :: ValidityInterval -> ValidityInterval -> Bool
$c== :: ValidityInterval -> ValidityInterval -> Bool
Eq, 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
$cto :: forall x. Rep ValidityInterval x -> ValidityInterval
$cfrom :: forall x. ValidityInterval -> Rep ValidityInterval x
Generic, Int -> ValidityInterval -> ShowS
[ValidityInterval] -> ShowS
ValidityInterval -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidityInterval] -> ShowS
$cshowList :: [ValidityInterval] -> ShowS
show :: ValidityInterval -> String
$cshow :: ValidityInterval -> String
showsPrec :: Int -> ValidityInterval -> ShowS
$cshowsPrec :: Int -> ValidityInterval -> ShowS
Show, Context -> ValidityInterval -> IO (Maybe ThunkInfo)
Proxy ValidityInterval -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ValidityInterval -> String
$cshowTypeOf :: Proxy ValidityInterval -> String
wNoThunks :: Context -> ValidityInterval -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ValidityInterval -> IO (Maybe ThunkInfo)
noThunks :: Context -> ValidityInterval -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ValidityInterval -> IO (Maybe ThunkInfo)
NoThunks, ValidityInterval -> ()
forall a. (a -> ()) -> NFData a
rnf :: ValidityInterval -> ()
$crnf :: ValidityInterval -> ()
NFData)

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

instance EncCBOR ValidityInterval where
  encCBOR :: ValidityInterval -> Encoding
encCBOR ValidityInterval
vi = 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 = forall t. t -> Decode ('Closed 'Dense) t
RecD StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From

instance DecCBOR ValidityInterval where
  decCBOR :: forall s. Decoder s ValidityInterval
decCBOR = 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 forall a b. (a -> b) -> a -> b
$
      [ Key
k 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall k (era :: k). TimelockRaw era -> TimelockRaw era -> Bool
Eq, 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
$cto :: forall k (era :: k) x. Rep (TimelockRaw era) x -> TimelockRaw era
$cfrom :: forall k (era :: k) x. TimelockRaw era -> Rep (TimelockRaw era) x
Generic, forall a. (a -> ()) -> NFData a
forall k (era :: k). TimelockRaw era -> ()
rnf :: TimelockRaw era -> ()
$crnf :: forall k (era :: k). 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 = forall {k} (era :: k). MemoBytes (TimelockRaw era) -> Timelock era
MkTimelock forall a b. (a -> b) -> a -> b
$ forall t. t -> ByteString -> MemoBytes t
mkMemoBytes TimelockRaw era2
rtl (ByteString -> ByteString
fromStrict 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 forall a b. (a -> b) -> a -> b
$ forall {k} (era :: k). KeyHash 'Witness -> TimelockRaw era
TimelockSignature KeyHash 'Witness
s
        TimelockAllOf StrictSeq (Timelock era1)
l -> TimelockRaw era2 -> Timelock era2
rewrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAllOf forall a b. (a -> b) -> a -> b
$ forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAnyOf forall a b. (a -> b) -> a -> b
$ forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock 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 forall a b. (a -> b) -> a -> b
$ forall {k} (era :: k).
Int -> StrictSeq (Timelock era) -> TimelockRaw era
TimelockMOf Int
n (forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Timelock era1)
l)
        TimelockTimeStart SlotNo
x -> TimelockRaw era2 -> Timelock era2
rewrap forall a b. (a -> b) -> a -> b
$ forall {k} (era :: k). SlotNo -> TimelockRaw era
TimelockTimeStart SlotNo
x
        TimelockTimeExpire SlotNo
x -> TimelockRaw era2 -> Timelock era2
rewrap forall a b. (a -> b) -> a -> b
$ 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 =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      TimelockSignature KeyHash 'Witness
hash -> forall t. t -> Word -> Encode 'Open t
Sum forall {k} (era :: k). KeyHash 'Witness -> TimelockRaw era
TimelockSignature Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'Witness
hash
      TimelockAllOf StrictSeq (Timelock era)
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAllOf Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (Timelock era)
xs
      TimelockAnyOf StrictSeq (Timelock era)
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAnyOf Word
2 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (Timelock era)
xs
      TimelockMOf Int
m StrictSeq (Timelock era)
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall {k} (era :: k).
Int -> StrictSeq (Timelock era) -> TimelockRaw era
TimelockMOf Word
3 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
m forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (Timelock era)
xs
      TimelockTimeStart SlotNo
m -> forall t. t -> Word -> Encode 'Open t
Sum forall {k} (era :: k). SlotNo -> TimelockRaw era
TimelockTimeStart Word
4 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To SlotNo
m
      TimelockTimeExpire SlotNo
m -> forall t. t -> Word -> Encode 'Open t
Sum forall {k} (era :: k). SlotNo -> TimelockRaw era
TimelockTimeExpire Word
5 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> 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 = forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$ forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"TimelockRaw" forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> forall t. t -> Decode 'Open t
SumD forall {k} (era :: k). KeyHash 'Witness -> TimelockRaw era
TimelockSignature forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
1 -> forall t. t -> Decode 'Open t
SumD forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAllOf forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> forall t. t -> Decode 'Open t
SumD forall {k} (era :: k). StrictSeq (Timelock era) -> TimelockRaw era
TimelockAnyOf forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
3 -> forall t. t -> Decode 'Open t
SumD forall {k} (era :: k).
Int -> StrictSeq (Timelock era) -> TimelockRaw era
TimelockMOf forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
4 -> forall t. t -> Decode 'Open t
SumD forall {k} (era :: k). SlotNo -> TimelockRaw era
TimelockTimeStart forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
5 -> forall t. t -> Decode 'Open t
SumD forall {k} (era :: k). SlotNo -> TimelockRaw era
TimelockTimeExpire forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall k (era :: k). Timelock era -> Timelock era -> Bool
Eq, 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
$cto :: forall k (era :: k) x. Rep (Timelock era) x -> Timelock era
$cfrom :: forall k (era :: k) x. Timelock era -> Rep (Timelock era) x
Generic)
  deriving newtype (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
encodedListSizeExpr :: (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
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Timelock era) -> Size
$cencodedSizeExpr :: forall k (era :: k).
(Typeable era, Typeable k) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Timelock era) -> Size
toCBOR :: Timelock era -> Encoding
$ctoCBOR :: forall k (era :: k).
(Typeable era, Typeable k) =>
Timelock era -> Encoding
ToCBOR, Timelock era -> ()
forall a. (a -> ()) -> NFData a
forall k (era :: k). Timelock era -> ()
rnf :: Timelock era -> ()
$crnf :: forall k (era :: k). Timelock era -> ()
NFData, Timelock era -> Int
Timelock era -> ByteString
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
makeHashWithExplicitProxys :: forall i. Proxy i -> Timelock era -> SafeHash i
$cmakeHashWithExplicitProxys :: forall k (era :: k) i. Proxy i -> Timelock era -> SafeHash i
originalBytesSize :: Timelock era -> Int
$coriginalBytesSize :: forall k (era :: k). Timelock era -> Int
originalBytes :: Timelock era -> ByteString
$coriginalBytes :: forall k (era :: k). Timelock era -> ByteString
SafeToHash)

pattern TimelockConstr :: MemoBytes (TimelockRaw era) -> Timelock era
pattern $bTimelockConstr :: forall {k} (era :: k). MemoBytes (TimelockRaw era) -> Timelock era
$mTimelockConstr :: forall {r} {k} {era :: k}.
Timelock era
-> (MemoBytes (TimelockRaw era) -> r) -> ((# #) -> r) -> r
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) = forall t. MemoBytes t -> Int
byteCountMemoBytes MemoBytes (TimelockRaw era)
mb
  packM :: forall s. Timelock era -> Pack s ()
packM (MkTimelock MemoBytes (TimelockRaw era)
mb) = forall t s. MemoBytes t -> Pack s ()
packMemoBytesM MemoBytes (TimelockRaw era)
mb
  unpackM :: forall b. Buffer b => Unpack b (Timelock era)
unpackM = forall {k} (era :: k). MemoBytes (TimelockRaw era) -> Timelock era
MkTimelock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall {k} (era :: k). MemoBytes (TimelockRaw era) -> Timelock era
MkTimelock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s t. Decoder s t -> Decoder s (MemoBytes t)
decodeMemoized 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 = 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 -> forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature KeyHash 'Witness
keyHash
    RequireAllOf StrictSeq (NativeScript ShelleyEra)
sigs -> forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf forall a b. (a -> b) -> a -> b
$ forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (NativeScript ShelleyEra)
sigs
    RequireAnyOf StrictSeq (NativeScript ShelleyEra)
sigs -> forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf forall a b. (a -> b) -> a -> b
$ forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (NativeScript ShelleyEra)
sigs
    RequireMOf Int
n StrictSeq (NativeScript ShelleyEra)
sigs -> forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
n forall a b. (a -> b) -> a -> b
$ forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (NativeScript ShelleyEra)
sigs
    Script (PreviousEra 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 = forall a. a -> Maybe a
Just

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

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

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

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

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

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

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

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

pattern RequireTimeStart :: AllegraEraScript era => SlotNo -> NativeScript era
pattern $bRequireTimeStart :: forall era. AllegraEraScript era => SlotNo -> NativeScript era
$mRequireTimeStart :: forall {r} {era}.
AllegraEraScript era =>
NativeScript era -> (SlotNo -> r) -> ((# #) -> r) -> r
RequireTimeStart mslot <- (getTimeStart -> Just mslot)
  where
    RequireTimeStart SlotNo
mslot = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
_)) = forall a. a -> Maybe a
Just KeyHash 'Witness
kh
getRequireSignatureTimelock Timelock era
_ = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
_)) = forall a. a -> Maybe a
Just StrictSeq (Timelock era)
ms
getRequireAllOfTimelock 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
_)) = forall a. a -> Maybe a
Just StrictSeq (Timelock era)
ms
getRequireAnyOfTimelock 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
_)) = forall a. a -> Maybe a
Just (Int
n, StrictSeq (Timelock era)
ms)
getRequireMOfTimelock 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
_)) = forall a. a -> Maybe a
Just SlotNo
mslot
getTimeStartTimelock Timelock era
_ = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
_)) = forall a. a -> Maybe a
Just SlotNo
mslot
getTimeExpireTimelock Timelock era
_ = 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 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 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 forall a. Ord a => a -> a -> Bool
<= Int
0
    isValidMOf Int
n (NativeScript era
ts SSeq.:<| StrictSeq (NativeScript era)
tss) =
      Int
n 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 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 forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (KeyHash 'Witness)
vhks
      RequireAllOf StrictSeq (NativeScript era)
xs -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all NativeScript era -> Bool
go StrictSeq (NativeScript era)
xs
      RequireAnyOf StrictSeq (NativeScript era)
xs -> 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 forall a. Ord a => a -> a -> Bool
< SlotNo
top
inInterval SlotNo
slot (ValidityInterval (SJust SlotNo
bottom) StrictMaybe SlotNo
SNothing) = SlotNo
bottom forall a. Ord a => a -> a -> Bool
<= SlotNo
slot
inInterval SlotNo
slot (ValidityInterval (SJust SlotNo
bottom) (SJust SlotNo
top)) =
  SlotNo
bottom forall a. Ord a => a -> a -> Bool
<= SlotNo
slot Bool -> Bool -> Bool
&& SlotNo
slot 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 >= " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word64
i forall a. [a] -> [a] -> [a]
++ String
")"
showTimelock (RequireTimeExpire (SlotNo Word64
i)) = String
"(Expire < " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word64
i forall a. [a] -> [a] -> [a]
++ String
")"
showTimelock (RequireAllOf StrictSeq (NativeScript era)
xs) = String
"(AllOf " forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall {era}.
AllegraEraScript era =>
String -> NativeScript era -> String
accum String
")" StrictSeq (NativeScript era)
xs
  where
    accum :: String -> NativeScript era -> String
accum String
ans NativeScript era
x = forall era. AllegraEraScript era => NativeScript era -> String
showTimelock NativeScript era
x forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
ans
showTimelock (RequireAnyOf StrictSeq (NativeScript era)
xs) = String
"(AnyOf " forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall {era}.
AllegraEraScript era =>
String -> NativeScript era -> String
accum String
")" StrictSeq (NativeScript era)
xs
  where
    accum :: String -> NativeScript era -> String
accum String
ans NativeScript era
x = forall era. AllegraEraScript era => NativeScript era -> String
showTimelock NativeScript era
x forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
ans
showTimelock (RequireMOf Int
m StrictSeq (NativeScript era)
xs) = String
"(MOf " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
m forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall {era}.
AllegraEraScript era =>
String -> NativeScript era -> String
accum String
")" StrictSeq (NativeScript era)
xs
  where
    accum :: String -> NativeScript era -> String
accum String
ans NativeScript era
x = forall era. AllegraEraScript era => NativeScript era -> String
showTimelock NativeScript era
x forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
ans
showTimelock (RequireSignature KeyHash 'Witness
hash) = String
"(Signature " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show KeyHash 'Witness
hash 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 = forall k (era :: k). TimelockRaw era -> TimelockRaw era -> Bool
go (forall t. Memoized t => t -> RawType t
getMemoRawType Timelock era
t1) (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) = 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 forall a. Eq a => a -> a -> Bool
== KeyHash 'Witness
kh2
    go (TimelockAllOf StrictSeq (Timelock era)
ts1) (TimelockAllOf StrictSeq (Timelock era)
ts2) = 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) = 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 forall a. Eq a => a -> a -> Bool
== Int
n2 Bool -> Bool -> 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 forall a. Eq a => a -> a -> Bool
== SlotNo
sn2
    go (TimelockTimeExpire SlotNo
sn1) (TimelockTimeExpire SlotNo
sn2) = SlotNo
sn1 forall a. Eq a => a -> a -> Bool
== SlotNo
sn2
    go TimelockRaw era
_ TimelockRaw era
_ = Bool
False