{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.ShelleyMA.Timelocks
  ( Timelock (RequireSignature, RequireAllOf, RequireAnyOf, RequireMOf, RequireTimeExpire, RequireTimeStart),
    pattern TimelockConstr,
    inInterval,
    showTimelock,
    evalTimelock,
    validateTimelock,
    ValidityInterval (..),
    encodeVI,
    decodeVI,
    translate,
  )
where

import Cardano.Binary
  ( Annotator (..),
    FromCBOR (fromCBOR),
    FullByteString (Full),
    ToCBOR (toCBOR),
  )
import Cardano.Ledger.BaseTypes (StrictMaybe (SJust, SNothing))
import qualified Cardano.Ledger.Core as Core
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Era (Era (Crypto))
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (Witness))
import Cardano.Ledger.SafeHash (SafeToHash)
import Cardano.Ledger.Serialization
  ( decodeStrictSeq,
    encodeFoldable,
  )
import Cardano.Ledger.Shelley.Constraints (UsesTxBody)
import Cardano.Ledger.Shelley.Scripts (MultiSig, getMultiSigBytes)
import Cardano.Ledger.Shelley.Tx (WitVKey)
import Cardano.Ledger.Shelley.TxBody
  ( witKeyHash,
  )
import Cardano.Slotting.Slot (SlotNo (..))
import Codec.CBOR.Read (deserialiseFromBytes)
import Control.DeepSeq (NFData (..))
import qualified Data.ByteString.Lazy as Lazy
import Data.ByteString.Short (fromShort)
import Data.Coders
  ( Decode (..),
    Density (..),
    Encode (..),
    Wrapped (..),
    decode,
    encode,
    (!>),
    (<!),
    (<*!),
  )
import Data.MemoBytes
  ( Mem,
    MemoBytes (..),
    memoBytes,
  )
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set, member)
import qualified Data.Set as Set
import Data.Typeable
import GHC.Generics (Generic)
import GHC.Records
import NoThunks.Class (NoThunks (..))

-- =================================================================
-- We translate a MultiSig by deserializing its bytes as a Timelock
-- If this succeeds (and it should, we designed Timelock to have
-- that property), then both version should have the same bytes,
-- because we are using FromCBOR(Annotator Timelock) instance.

translate :: CC.Crypto crypto => MultiSig crypto -> Timelock crypto
translate :: MultiSig crypto -> Timelock crypto
translate MultiSig crypto
multi =
  let bytes :: ByteString
bytes = ByteString -> ByteString
Lazy.fromStrict (ShortByteString -> ByteString
fromShort (MultiSig crypto -> ShortByteString
forall crypto. MultiSig crypto -> ShortByteString
getMultiSigBytes MultiSig crypto
multi))
   in case (forall s. Decoder s (Annotator (Timelock crypto)))
-> ByteString
-> Either
     DeserialiseFailure (ByteString, Annotator (Timelock crypto))
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
deserialiseFromBytes forall s. Decoder s (Annotator (Timelock crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR ByteString
bytes of
        Left DeserialiseFailure
err -> [Char] -> Timelock crypto
forall a. HasCallStack => [Char] -> a
error ([Char]
"Translating MultiSig script to Timelock script fails\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DeserialiseFailure -> [Char]
forall a. Show a => a -> [Char]
show DeserialiseFailure
err)
        Right (ByteString
left, Annotator FullByteString -> Timelock crypto
f) | ByteString
left ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
Lazy.empty -> FullByteString -> Timelock crypto
f (ByteString -> FullByteString
Full ByteString
bytes)
        Right (ByteString
left, Annotator (Timelock crypto)
_) -> [Char] -> Timelock crypto
forall a. HasCallStack => [Char] -> a
error ([Char]
"Translating MultiSig script to Timelock script does not consume all they bytes: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
left)

-- ================================================================
-- An pair of optional SlotNo.

-- | 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
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
$cp1Ord :: Eq ValidityInterval
Ord, ValidityInterval -> ValidityInterval -> Bool
(ValidityInterval -> ValidityInterval -> Bool)
-> (ValidityInterval -> ValidityInterval -> Bool)
-> Eq ValidityInterval
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. 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
$cto :: forall x. Rep ValidityInterval x -> ValidityInterval
$cfrom :: forall x. ValidityInterval -> Rep ValidityInterval x
Generic, Int -> ValidityInterval -> [Char] -> [Char]
[ValidityInterval] -> [Char] -> [Char]
ValidityInterval -> [Char]
(Int -> ValidityInterval -> [Char] -> [Char])
-> (ValidityInterval -> [Char])
-> ([ValidityInterval] -> [Char] -> [Char])
-> Show ValidityInterval
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [ValidityInterval] -> [Char] -> [Char]
$cshowList :: [ValidityInterval] -> [Char] -> [Char]
show :: ValidityInterval -> [Char]
$cshow :: ValidityInterval -> [Char]
showsPrec :: Int -> ValidityInterval -> [Char] -> [Char]
$cshowsPrec :: Int -> ValidityInterval -> [Char] -> [Char]
Show, Context -> ValidityInterval -> IO (Maybe ThunkInfo)
Proxy ValidityInterval -> [Char]
(Context -> ValidityInterval -> IO (Maybe ThunkInfo))
-> (Context -> ValidityInterval -> IO (Maybe ThunkInfo))
-> (Proxy ValidityInterval -> [Char])
-> NoThunks ValidityInterval
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> [Char])
-> NoThunks a
showTypeOf :: Proxy ValidityInterval -> [Char]
$cshowTypeOf :: Proxy ValidityInterval -> [Char]
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 -> ()
(ValidityInterval -> ()) -> NFData 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) = (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. ToCBOR 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. ToCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe SlotNo
t

instance ToCBOR ValidityInterval where
  toCBOR :: ValidityInterval -> Encoding
toCBOR 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 (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (StrictMaybe SlotNo)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From Decode ('Closed 'Dense) (StrictMaybe SlotNo -> ValidityInterval)
-> Decode ('Closed Any) (StrictMaybe SlotNo)
-> Decode ('Closed 'Dense) ValidityInterval
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (StrictMaybe SlotNo)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From

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

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

data TimelockRaw crypto
  = Signature !(KeyHash 'Witness crypto)
  | AllOf !(StrictSeq (Timelock crypto)) -- NOTE that Timelock and
  | AnyOf !(StrictSeq (Timelock crypto)) -- TimelockRaw are mutually recursive.
  | MOfN !Int !(StrictSeq (Timelock crypto)) -- Note that the Int may be negative in which case (MOfN -2 [..]) is always True
  | TimeStart !SlotNo -- The start time
  | TimeExpire !SlotNo -- The time it expires
  deriving (TimelockRaw crypto -> TimelockRaw crypto -> Bool
(TimelockRaw crypto -> TimelockRaw crypto -> Bool)
-> (TimelockRaw crypto -> TimelockRaw crypto -> Bool)
-> Eq (TimelockRaw crypto)
forall crypto. TimelockRaw crypto -> TimelockRaw crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimelockRaw crypto -> TimelockRaw crypto -> Bool
$c/= :: forall crypto. TimelockRaw crypto -> TimelockRaw crypto -> Bool
== :: TimelockRaw crypto -> TimelockRaw crypto -> Bool
$c== :: forall crypto. TimelockRaw crypto -> TimelockRaw crypto -> Bool
Eq, Int -> TimelockRaw crypto -> [Char] -> [Char]
[TimelockRaw crypto] -> [Char] -> [Char]
TimelockRaw crypto -> [Char]
(Int -> TimelockRaw crypto -> [Char] -> [Char])
-> (TimelockRaw crypto -> [Char])
-> ([TimelockRaw crypto] -> [Char] -> [Char])
-> Show (TimelockRaw crypto)
forall crypto. Int -> TimelockRaw crypto -> [Char] -> [Char]
forall crypto. [TimelockRaw crypto] -> [Char] -> [Char]
forall crypto. TimelockRaw crypto -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [TimelockRaw crypto] -> [Char] -> [Char]
$cshowList :: forall crypto. [TimelockRaw crypto] -> [Char] -> [Char]
show :: TimelockRaw crypto -> [Char]
$cshow :: forall crypto. TimelockRaw crypto -> [Char]
showsPrec :: Int -> TimelockRaw crypto -> [Char] -> [Char]
$cshowsPrec :: forall crypto. Int -> TimelockRaw crypto -> [Char] -> [Char]
Show, Eq (TimelockRaw crypto)
Eq (TimelockRaw crypto)
-> (TimelockRaw crypto -> TimelockRaw crypto -> Ordering)
-> (TimelockRaw crypto -> TimelockRaw crypto -> Bool)
-> (TimelockRaw crypto -> TimelockRaw crypto -> Bool)
-> (TimelockRaw crypto -> TimelockRaw crypto -> Bool)
-> (TimelockRaw crypto -> TimelockRaw crypto -> Bool)
-> (TimelockRaw crypto -> TimelockRaw crypto -> TimelockRaw crypto)
-> (TimelockRaw crypto -> TimelockRaw crypto -> TimelockRaw crypto)
-> Ord (TimelockRaw crypto)
TimelockRaw crypto -> TimelockRaw crypto -> Bool
TimelockRaw crypto -> TimelockRaw crypto -> Ordering
TimelockRaw crypto -> TimelockRaw crypto -> TimelockRaw crypto
forall crypto. Eq (TimelockRaw crypto)
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
forall crypto. TimelockRaw crypto -> TimelockRaw crypto -> Bool
forall crypto. TimelockRaw crypto -> TimelockRaw crypto -> Ordering
forall crypto.
TimelockRaw crypto -> TimelockRaw crypto -> TimelockRaw crypto
min :: TimelockRaw crypto -> TimelockRaw crypto -> TimelockRaw crypto
$cmin :: forall crypto.
TimelockRaw crypto -> TimelockRaw crypto -> TimelockRaw crypto
max :: TimelockRaw crypto -> TimelockRaw crypto -> TimelockRaw crypto
$cmax :: forall crypto.
TimelockRaw crypto -> TimelockRaw crypto -> TimelockRaw crypto
>= :: TimelockRaw crypto -> TimelockRaw crypto -> Bool
$c>= :: forall crypto. TimelockRaw crypto -> TimelockRaw crypto -> Bool
> :: TimelockRaw crypto -> TimelockRaw crypto -> Bool
$c> :: forall crypto. TimelockRaw crypto -> TimelockRaw crypto -> Bool
<= :: TimelockRaw crypto -> TimelockRaw crypto -> Bool
$c<= :: forall crypto. TimelockRaw crypto -> TimelockRaw crypto -> Bool
< :: TimelockRaw crypto -> TimelockRaw crypto -> Bool
$c< :: forall crypto. TimelockRaw crypto -> TimelockRaw crypto -> Bool
compare :: TimelockRaw crypto -> TimelockRaw crypto -> Ordering
$ccompare :: forall crypto. TimelockRaw crypto -> TimelockRaw crypto -> Ordering
$cp1Ord :: forall crypto. Eq (TimelockRaw crypto)
Ord, (forall x. TimelockRaw crypto -> Rep (TimelockRaw crypto) x)
-> (forall x. Rep (TimelockRaw crypto) x -> TimelockRaw crypto)
-> Generic (TimelockRaw crypto)
forall x. Rep (TimelockRaw crypto) x -> TimelockRaw crypto
forall x. TimelockRaw crypto -> Rep (TimelockRaw crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (TimelockRaw crypto) x -> TimelockRaw crypto
forall crypto x. TimelockRaw crypto -> Rep (TimelockRaw crypto) x
$cto :: forall crypto x. Rep (TimelockRaw crypto) x -> TimelockRaw crypto
$cfrom :: forall crypto x. TimelockRaw crypto -> Rep (TimelockRaw crypto) x
Generic, TimelockRaw crypto -> ()
(TimelockRaw crypto -> ()) -> NFData (TimelockRaw crypto)
forall crypto. TimelockRaw crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: TimelockRaw crypto -> ()
$crnf :: forall crypto. TimelockRaw crypto -> ()
NFData)

deriving instance Typeable crypto => NoThunks (TimelockRaw crypto)

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

encRaw :: CC.Crypto crypto => TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
encRaw :: TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
encRaw (Signature KeyHash 'Witness crypto
hash) = (KeyHash 'Witness crypto -> TimelockRaw crypto)
-> Word
-> Encode 'Open (KeyHash 'Witness crypto -> TimelockRaw crypto)
forall t. t -> Word -> Encode 'Open t
Sum KeyHash 'Witness crypto -> TimelockRaw crypto
forall crypto. KeyHash 'Witness crypto -> TimelockRaw crypto
Signature Word
0 Encode 'Open (KeyHash 'Witness crypto -> TimelockRaw crypto)
-> Encode ('Closed 'Dense) (KeyHash 'Witness crypto)
-> Encode 'Open (TimelockRaw crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> KeyHash 'Witness crypto
-> Encode ('Closed 'Dense) (KeyHash 'Witness crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'Witness crypto
hash
encRaw (AllOf StrictSeq (Timelock crypto)
xs) = (StrictSeq (Timelock crypto) -> TimelockRaw crypto)
-> Word
-> Encode 'Open (StrictSeq (Timelock crypto) -> TimelockRaw crypto)
forall t. t -> Word -> Encode 'Open t
Sum StrictSeq (Timelock crypto) -> TimelockRaw crypto
forall crypto. StrictSeq (Timelock crypto) -> TimelockRaw crypto
AllOf Word
1 Encode 'Open (StrictSeq (Timelock crypto) -> TimelockRaw crypto)
-> Encode ('Closed 'Dense) (StrictSeq (Timelock crypto))
-> Encode 'Open (TimelockRaw crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictSeq (Timelock crypto) -> Encoding)
-> StrictSeq (Timelock crypto)
-> Encode ('Closed 'Dense) (StrictSeq (Timelock crypto))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E StrictSeq (Timelock crypto) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable StrictSeq (Timelock crypto)
xs
encRaw (AnyOf StrictSeq (Timelock crypto)
xs) = (StrictSeq (Timelock crypto) -> TimelockRaw crypto)
-> Word
-> Encode 'Open (StrictSeq (Timelock crypto) -> TimelockRaw crypto)
forall t. t -> Word -> Encode 'Open t
Sum StrictSeq (Timelock crypto) -> TimelockRaw crypto
forall crypto. StrictSeq (Timelock crypto) -> TimelockRaw crypto
AnyOf Word
2 Encode 'Open (StrictSeq (Timelock crypto) -> TimelockRaw crypto)
-> Encode ('Closed 'Dense) (StrictSeq (Timelock crypto))
-> Encode 'Open (TimelockRaw crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictSeq (Timelock crypto) -> Encoding)
-> StrictSeq (Timelock crypto)
-> Encode ('Closed 'Dense) (StrictSeq (Timelock crypto))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E StrictSeq (Timelock crypto) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable StrictSeq (Timelock crypto)
xs
encRaw (MOfN Int
m StrictSeq (Timelock crypto)
xs) = (Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto)
-> Word
-> Encode
     'Open (Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto)
forall t. t -> Word -> Encode 'Open t
Sum Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto
forall crypto.
Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto
MOfN Word
3 Encode
  'Open (Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto)
-> Encode ('Closed 'Dense) Int
-> Encode 'Open (StrictSeq (Timelock crypto) -> TimelockRaw crypto)
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. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Int
m Encode 'Open (StrictSeq (Timelock crypto) -> TimelockRaw crypto)
-> Encode ('Closed 'Dense) (StrictSeq (Timelock crypto))
-> Encode 'Open (TimelockRaw crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictSeq (Timelock crypto) -> Encoding)
-> StrictSeq (Timelock crypto)
-> Encode ('Closed 'Dense) (StrictSeq (Timelock crypto))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E StrictSeq (Timelock crypto) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable StrictSeq (Timelock crypto)
xs
encRaw (TimeStart SlotNo
m) = (SlotNo -> TimelockRaw crypto)
-> Word -> Encode 'Open (SlotNo -> TimelockRaw crypto)
forall t. t -> Word -> Encode 'Open t
Sum SlotNo -> TimelockRaw crypto
forall crypto. SlotNo -> TimelockRaw crypto
TimeStart Word
4 Encode 'Open (SlotNo -> TimelockRaw crypto)
-> Encode ('Closed 'Dense) SlotNo
-> Encode 'Open (TimelockRaw crypto)
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. ToCBOR t => t -> Encode ('Closed 'Dense) t
To SlotNo
m
encRaw (TimeExpire SlotNo
m) = (SlotNo -> TimelockRaw crypto)
-> Word -> Encode 'Open (SlotNo -> TimelockRaw crypto)
forall t. t -> Word -> Encode 'Open t
Sum SlotNo -> TimelockRaw crypto
forall crypto. SlotNo -> TimelockRaw crypto
TimeExpire Word
5 Encode 'Open (SlotNo -> TimelockRaw crypto)
-> Encode ('Closed 'Dense) SlotNo
-> Encode 'Open (TimelockRaw crypto)
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. ToCBOR t => t -> Encode ('Closed 'Dense) t
To SlotNo
m

decRaw :: CC.Crypto crypto => Word -> Decode 'Open (Annotator (TimelockRaw crypto))
decRaw :: Word -> Decode 'Open (Annotator (TimelockRaw crypto))
decRaw Word
0 = Decode 'Open (TimelockRaw crypto)
-> Decode 'Open (Annotator (TimelockRaw crypto))
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann ((KeyHash 'Witness crypto -> TimelockRaw crypto)
-> Decode 'Open (KeyHash 'Witness crypto -> TimelockRaw crypto)
forall t. t -> Decode 'Open t
SumD KeyHash 'Witness crypto -> TimelockRaw crypto
forall crypto. KeyHash 'Witness crypto -> TimelockRaw crypto
Signature Decode 'Open (KeyHash 'Witness crypto -> TimelockRaw crypto)
-> Decode ('Closed Any) (KeyHash 'Witness crypto)
-> Decode 'Open (TimelockRaw crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (KeyHash 'Witness crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From)
decRaw Word
1 = Decode 'Open (StrictSeq (Timelock crypto) -> TimelockRaw crypto)
-> Decode
     'Open
     (Annotator (StrictSeq (Timelock crypto) -> TimelockRaw crypto))
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann ((StrictSeq (Timelock crypto) -> TimelockRaw crypto)
-> Decode 'Open (StrictSeq (Timelock crypto) -> TimelockRaw crypto)
forall t. t -> Decode 'Open t
SumD StrictSeq (Timelock crypto) -> TimelockRaw crypto
forall crypto. StrictSeq (Timelock crypto) -> TimelockRaw crypto
AllOf) Decode
  'Open
  (Annotator (StrictSeq (Timelock crypto) -> TimelockRaw crypto))
-> Decode
     ('Closed 'Dense) (Annotator (StrictSeq (Timelock crypto)))
-> Decode 'Open (Annotator (TimelockRaw crypto))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! (forall s. Decoder s (Annotator (StrictSeq (Timelock crypto))))
-> Decode
     ('Closed 'Dense) (Annotator (StrictSeq (Timelock crypto)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (StrictSeq (Annotator (Timelock crypto))
-> Annotator (StrictSeq (Timelock crypto))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (StrictSeq (Annotator (Timelock crypto))
 -> Annotator (StrictSeq (Timelock crypto)))
-> Decoder s (StrictSeq (Annotator (Timelock crypto)))
-> Decoder s (Annotator (StrictSeq (Timelock crypto)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (Timelock crypto))
-> Decoder s (StrictSeq (Annotator (Timelock crypto)))
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s (Annotator (Timelock crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR)
decRaw Word
2 = Decode 'Open (StrictSeq (Timelock crypto) -> TimelockRaw crypto)
-> Decode
     'Open
     (Annotator (StrictSeq (Timelock crypto) -> TimelockRaw crypto))
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann ((StrictSeq (Timelock crypto) -> TimelockRaw crypto)
-> Decode 'Open (StrictSeq (Timelock crypto) -> TimelockRaw crypto)
forall t. t -> Decode 'Open t
SumD StrictSeq (Timelock crypto) -> TimelockRaw crypto
forall crypto. StrictSeq (Timelock crypto) -> TimelockRaw crypto
AnyOf) Decode
  'Open
  (Annotator (StrictSeq (Timelock crypto) -> TimelockRaw crypto))
-> Decode
     ('Closed 'Dense) (Annotator (StrictSeq (Timelock crypto)))
-> Decode 'Open (Annotator (TimelockRaw crypto))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! (forall s. Decoder s (Annotator (StrictSeq (Timelock crypto))))
-> Decode
     ('Closed 'Dense) (Annotator (StrictSeq (Timelock crypto)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (StrictSeq (Annotator (Timelock crypto))
-> Annotator (StrictSeq (Timelock crypto))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (StrictSeq (Annotator (Timelock crypto))
 -> Annotator (StrictSeq (Timelock crypto)))
-> Decoder s (StrictSeq (Annotator (Timelock crypto)))
-> Decoder s (Annotator (StrictSeq (Timelock crypto)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (Timelock crypto))
-> Decoder s (StrictSeq (Annotator (Timelock crypto)))
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s (Annotator (Timelock crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR)
decRaw Word
3 = Decode
  'Open (Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto)
-> Decode
     'Open
     (Annotator
        (Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto))
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann ((Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto)
-> Decode
     'Open (Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto)
forall t. t -> Decode 'Open t
SumD Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto
forall crypto.
Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto
MOfN) Decode
  'Open
  (Annotator
     (Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto))
-> Decode ('Closed Any) (Annotator Int)
-> Decode
     'Open
     (Annotator (StrictSeq (Timelock crypto) -> TimelockRaw crypto))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) Int -> Decode ('Closed Any) (Annotator Int)
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann Decode ('Closed Any) Int
forall t (w :: Wrapped). FromCBOR t => Decode w t
From Decode
  'Open
  (Annotator (StrictSeq (Timelock crypto) -> TimelockRaw crypto))
-> Decode
     ('Closed 'Dense) (Annotator (StrictSeq (Timelock crypto)))
-> Decode 'Open (Annotator (TimelockRaw crypto))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! (forall s. Decoder s (Annotator (StrictSeq (Timelock crypto))))
-> Decode
     ('Closed 'Dense) (Annotator (StrictSeq (Timelock crypto)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (StrictSeq (Annotator (Timelock crypto))
-> Annotator (StrictSeq (Timelock crypto))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (StrictSeq (Annotator (Timelock crypto))
 -> Annotator (StrictSeq (Timelock crypto)))
-> Decoder s (StrictSeq (Annotator (Timelock crypto)))
-> Decoder s (Annotator (StrictSeq (Timelock crypto)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (Timelock crypto))
-> Decoder s (StrictSeq (Annotator (Timelock crypto)))
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s (Annotator (Timelock crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR)
decRaw Word
4 = Decode 'Open (TimelockRaw crypto)
-> Decode 'Open (Annotator (TimelockRaw crypto))
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann ((SlotNo -> TimelockRaw crypto)
-> Decode 'Open (SlotNo -> TimelockRaw crypto)
forall t. t -> Decode 'Open t
SumD SlotNo -> TimelockRaw crypto
forall crypto. SlotNo -> TimelockRaw crypto
TimeStart Decode 'Open (SlotNo -> TimelockRaw crypto)
-> Decode ('Closed Any) SlotNo -> Decode 'Open (TimelockRaw crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) SlotNo
forall t (w :: Wrapped). FromCBOR t => Decode w t
From)
decRaw Word
5 = Decode 'Open (TimelockRaw crypto)
-> Decode 'Open (Annotator (TimelockRaw crypto))
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann ((SlotNo -> TimelockRaw crypto)
-> Decode 'Open (SlotNo -> TimelockRaw crypto)
forall t. t -> Decode 'Open t
SumD SlotNo -> TimelockRaw crypto
forall crypto. SlotNo -> TimelockRaw crypto
TimeExpire Decode 'Open (SlotNo -> TimelockRaw crypto)
-> Decode ('Closed Any) SlotNo -> Decode 'Open (TimelockRaw crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) SlotNo
forall t (w :: Wrapped). FromCBOR t => Decode w t
From)
decRaw Word
n = Word -> Decode 'Open (Annotator (TimelockRaw crypto))
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

-- This instance allows us to derive instance FromCBOR(Annotator (Timelock crypto)).
-- Since Timelock is a newtype around (Memo (Timelock crypto)).

instance CC.Crypto crypto => FromCBOR (Annotator (TimelockRaw crypto)) where
  fromCBOR :: Decoder s (Annotator (TimelockRaw crypto))
fromCBOR = Decode ('Closed 'Dense) (Annotator (TimelockRaw crypto))
-> Decoder s (Annotator (TimelockRaw crypto))
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode ([Char]
-> (Word -> Decode 'Open (Annotator (TimelockRaw crypto)))
-> Decode ('Closed 'Dense) (Annotator (TimelockRaw crypto))
forall t.
[Char] -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands [Char]
"TimelockRaw" Word -> Decode 'Open (Annotator (TimelockRaw crypto))
forall crypto.
Crypto crypto =>
Word -> Decode 'Open (Annotator (TimelockRaw crypto))
decRaw)

-- =================================================================
-- 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 crypto = TimelockConstr (MemoBytes (TimelockRaw crypto))
  deriving (Timelock crypto -> Timelock crypto -> Bool
(Timelock crypto -> Timelock crypto -> Bool)
-> (Timelock crypto -> Timelock crypto -> Bool)
-> Eq (Timelock crypto)
forall crypto. Timelock crypto -> Timelock crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timelock crypto -> Timelock crypto -> Bool
$c/= :: forall crypto. Timelock crypto -> Timelock crypto -> Bool
== :: Timelock crypto -> Timelock crypto -> Bool
$c== :: forall crypto. Timelock crypto -> Timelock crypto -> Bool
Eq, Eq (Timelock crypto)
Eq (Timelock crypto)
-> (Timelock crypto -> Timelock crypto -> Ordering)
-> (Timelock crypto -> Timelock crypto -> Bool)
-> (Timelock crypto -> Timelock crypto -> Bool)
-> (Timelock crypto -> Timelock crypto -> Bool)
-> (Timelock crypto -> Timelock crypto -> Bool)
-> (Timelock crypto -> Timelock crypto -> Timelock crypto)
-> (Timelock crypto -> Timelock crypto -> Timelock crypto)
-> Ord (Timelock crypto)
Timelock crypto -> Timelock crypto -> Bool
Timelock crypto -> Timelock crypto -> Ordering
Timelock crypto -> Timelock crypto -> Timelock crypto
forall crypto. Eq (Timelock crypto)
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
forall crypto. Timelock crypto -> Timelock crypto -> Bool
forall crypto. Timelock crypto -> Timelock crypto -> Ordering
forall crypto.
Timelock crypto -> Timelock crypto -> Timelock crypto
min :: Timelock crypto -> Timelock crypto -> Timelock crypto
$cmin :: forall crypto.
Timelock crypto -> Timelock crypto -> Timelock crypto
max :: Timelock crypto -> Timelock crypto -> Timelock crypto
$cmax :: forall crypto.
Timelock crypto -> Timelock crypto -> Timelock crypto
>= :: Timelock crypto -> Timelock crypto -> Bool
$c>= :: forall crypto. Timelock crypto -> Timelock crypto -> Bool
> :: Timelock crypto -> Timelock crypto -> Bool
$c> :: forall crypto. Timelock crypto -> Timelock crypto -> Bool
<= :: Timelock crypto -> Timelock crypto -> Bool
$c<= :: forall crypto. Timelock crypto -> Timelock crypto -> Bool
< :: Timelock crypto -> Timelock crypto -> Bool
$c< :: forall crypto. Timelock crypto -> Timelock crypto -> Bool
compare :: Timelock crypto -> Timelock crypto -> Ordering
$ccompare :: forall crypto. Timelock crypto -> Timelock crypto -> Ordering
$cp1Ord :: forall crypto. Eq (Timelock crypto)
Ord, Int -> Timelock crypto -> [Char] -> [Char]
[Timelock crypto] -> [Char] -> [Char]
Timelock crypto -> [Char]
(Int -> Timelock crypto -> [Char] -> [Char])
-> (Timelock crypto -> [Char])
-> ([Timelock crypto] -> [Char] -> [Char])
-> Show (Timelock crypto)
forall crypto. Int -> Timelock crypto -> [Char] -> [Char]
forall crypto. [Timelock crypto] -> [Char] -> [Char]
forall crypto. Timelock crypto -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Timelock crypto] -> [Char] -> [Char]
$cshowList :: forall crypto. [Timelock crypto] -> [Char] -> [Char]
show :: Timelock crypto -> [Char]
$cshow :: forall crypto. Timelock crypto -> [Char]
showsPrec :: Int -> Timelock crypto -> [Char] -> [Char]
$cshowsPrec :: forall crypto. Int -> Timelock crypto -> [Char] -> [Char]
Show, (forall x. Timelock crypto -> Rep (Timelock crypto) x)
-> (forall x. Rep (Timelock crypto) x -> Timelock crypto)
-> Generic (Timelock crypto)
forall x. Rep (Timelock crypto) x -> Timelock crypto
forall x. Timelock crypto -> Rep (Timelock crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (Timelock crypto) x -> Timelock crypto
forall crypto x. Timelock crypto -> Rep (Timelock crypto) x
$cto :: forall crypto x. Rep (Timelock crypto) x -> Timelock crypto
$cfrom :: forall crypto x. Timelock crypto -> Rep (Timelock crypto) x
Generic)
  deriving newtype (Typeable (Timelock crypto)
Typeable (Timelock crypto)
-> (Timelock crypto -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Timelock crypto) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Timelock crypto] -> Size)
-> ToCBOR (Timelock crypto)
Timelock crypto -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Timelock crypto] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Timelock crypto) -> Size
forall crypto. Typeable crypto => Typeable (Timelock crypto)
forall crypto. Typeable crypto => Timelock crypto -> Encoding
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 crypto.
Typeable crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Timelock crypto] -> Size
forall crypto.
Typeable crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Timelock crypto) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Timelock crypto] -> Size
$cencodedListSizeExpr :: forall crypto.
Typeable crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Timelock crypto] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Timelock crypto) -> Size
$cencodedSizeExpr :: forall crypto.
Typeable crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Timelock crypto) -> Size
toCBOR :: Timelock crypto -> Encoding
$ctoCBOR :: forall crypto. Typeable crypto => Timelock crypto -> Encoding
$cp1ToCBOR :: forall crypto. Typeable crypto => Typeable (Timelock crypto)
ToCBOR, Context -> Timelock crypto -> IO (Maybe ThunkInfo)
Proxy (Timelock crypto) -> [Char]
(Context -> Timelock crypto -> IO (Maybe ThunkInfo))
-> (Context -> Timelock crypto -> IO (Maybe ThunkInfo))
-> (Proxy (Timelock crypto) -> [Char])
-> NoThunks (Timelock crypto)
forall crypto.
Typeable crypto =>
Context -> Timelock crypto -> IO (Maybe ThunkInfo)
forall crypto. Typeable crypto => Proxy (Timelock crypto) -> [Char]
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> [Char])
-> NoThunks a
showTypeOf :: Proxy (Timelock crypto) -> [Char]
$cshowTypeOf :: forall crypto. Typeable crypto => Proxy (Timelock crypto) -> [Char]
wNoThunks :: Context -> Timelock crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto.
Typeable crypto =>
Context -> Timelock crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> Timelock crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto.
Typeable crypto =>
Context -> Timelock crypto -> IO (Maybe ThunkInfo)
NoThunks, Timelock crypto -> ()
(Timelock crypto -> ()) -> NFData (Timelock crypto)
forall crypto. Timelock crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: Timelock crypto -> ()
$crnf :: forall crypto. Timelock crypto -> ()
NFData, Proxy c -> Proxy index -> Timelock crypto -> SafeHash c index
Timelock crypto -> ByteString
(Timelock crypto -> ByteString)
-> (forall c index.
    HasAlgorithm c =>
    Proxy c -> Proxy index -> Timelock crypto -> SafeHash c index)
-> SafeToHash (Timelock crypto)
forall crypto. Timelock crypto -> ByteString
forall t.
(t -> ByteString)
-> (forall c index.
    HasAlgorithm c =>
    Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> Timelock crypto -> SafeHash c index
forall crypto c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> Timelock crypto -> SafeHash c index
makeHashWithExplicitProxys :: Proxy c -> Proxy index -> Timelock crypto -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall crypto c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> Timelock crypto -> SafeHash c index
originalBytes :: Timelock crypto -> ByteString
$coriginalBytes :: forall crypto. Timelock crypto -> ByteString
SafeToHash)

deriving via
  Mem (TimelockRaw crypto)
  instance
    CC.Crypto crypto => FromCBOR (Annotator (Timelock crypto))

pattern RequireSignature :: CC.Crypto crypto => KeyHash 'Witness crypto -> Timelock crypto
pattern $bRequireSignature :: KeyHash 'Witness crypto -> Timelock crypto
$mRequireSignature :: forall r crypto.
Crypto crypto =>
Timelock crypto
-> (KeyHash 'Witness crypto -> r) -> (Void# -> r) -> r
RequireSignature akh <-
  TimelockConstr (Memo (Signature akh) _)
  where
    RequireSignature KeyHash 'Witness crypto
akh =
      MemoBytes (TimelockRaw crypto) -> Timelock crypto
forall crypto. MemoBytes (TimelockRaw crypto) -> Timelock crypto
TimelockConstr (MemoBytes (TimelockRaw crypto) -> Timelock crypto)
-> MemoBytes (TimelockRaw crypto) -> Timelock crypto
forall a b. (a -> b) -> a -> b
$ Encode 'Open (TimelockRaw crypto) -> MemoBytes (TimelockRaw crypto)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes (TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
forall crypto.
Crypto crypto =>
TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
encRaw (KeyHash 'Witness crypto -> TimelockRaw crypto
forall crypto. KeyHash 'Witness crypto -> TimelockRaw crypto
Signature KeyHash 'Witness crypto
akh))

pattern RequireAllOf :: CC.Crypto crypto => StrictSeq (Timelock crypto) -> Timelock crypto
pattern $bRequireAllOf :: StrictSeq (Timelock crypto) -> Timelock crypto
$mRequireAllOf :: forall r crypto.
Crypto crypto =>
Timelock crypto
-> (StrictSeq (Timelock crypto) -> r) -> (Void# -> r) -> r
RequireAllOf ms <-
  TimelockConstr (Memo (AllOf ms) _)
  where
    RequireAllOf StrictSeq (Timelock crypto)
ms =
      MemoBytes (TimelockRaw crypto) -> Timelock crypto
forall crypto. MemoBytes (TimelockRaw crypto) -> Timelock crypto
TimelockConstr (MemoBytes (TimelockRaw crypto) -> Timelock crypto)
-> MemoBytes (TimelockRaw crypto) -> Timelock crypto
forall a b. (a -> b) -> a -> b
$ Encode 'Open (TimelockRaw crypto) -> MemoBytes (TimelockRaw crypto)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes (TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
forall crypto.
Crypto crypto =>
TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
encRaw (StrictSeq (Timelock crypto) -> TimelockRaw crypto
forall crypto. StrictSeq (Timelock crypto) -> TimelockRaw crypto
AllOf StrictSeq (Timelock crypto)
ms))

pattern RequireAnyOf :: CC.Crypto crypto => StrictSeq (Timelock crypto) -> Timelock crypto
pattern $bRequireAnyOf :: StrictSeq (Timelock crypto) -> Timelock crypto
$mRequireAnyOf :: forall r crypto.
Crypto crypto =>
Timelock crypto
-> (StrictSeq (Timelock crypto) -> r) -> (Void# -> r) -> r
RequireAnyOf ms <-
  TimelockConstr (Memo (AnyOf ms) _)
  where
    RequireAnyOf StrictSeq (Timelock crypto)
ms =
      MemoBytes (TimelockRaw crypto) -> Timelock crypto
forall crypto. MemoBytes (TimelockRaw crypto) -> Timelock crypto
TimelockConstr (MemoBytes (TimelockRaw crypto) -> Timelock crypto)
-> MemoBytes (TimelockRaw crypto) -> Timelock crypto
forall a b. (a -> b) -> a -> b
$ Encode 'Open (TimelockRaw crypto) -> MemoBytes (TimelockRaw crypto)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes (TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
forall crypto.
Crypto crypto =>
TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
encRaw (StrictSeq (Timelock crypto) -> TimelockRaw crypto
forall crypto. StrictSeq (Timelock crypto) -> TimelockRaw crypto
AnyOf StrictSeq (Timelock crypto)
ms))

pattern RequireMOf :: CC.Crypto crypto => Int -> StrictSeq (Timelock crypto) -> Timelock crypto
pattern $bRequireMOf :: Int -> StrictSeq (Timelock crypto) -> Timelock crypto
$mRequireMOf :: forall r crypto.
Crypto crypto =>
Timelock crypto
-> (Int -> StrictSeq (Timelock crypto) -> r) -> (Void# -> r) -> r
RequireMOf n ms <-
  TimelockConstr (Memo (MOfN n ms) _)
  where
    RequireMOf Int
n StrictSeq (Timelock crypto)
ms =
      MemoBytes (TimelockRaw crypto) -> Timelock crypto
forall crypto. MemoBytes (TimelockRaw crypto) -> Timelock crypto
TimelockConstr (MemoBytes (TimelockRaw crypto) -> Timelock crypto)
-> MemoBytes (TimelockRaw crypto) -> Timelock crypto
forall a b. (a -> b) -> a -> b
$ Encode 'Open (TimelockRaw crypto) -> MemoBytes (TimelockRaw crypto)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes (TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
forall crypto.
Crypto crypto =>
TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
encRaw (Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto
forall crypto.
Int -> StrictSeq (Timelock crypto) -> TimelockRaw crypto
MOfN Int
n StrictSeq (Timelock crypto)
ms))

pattern RequireTimeExpire :: CC.Crypto crypto => SlotNo -> Timelock crypto
pattern $bRequireTimeExpire :: SlotNo -> Timelock crypto
$mRequireTimeExpire :: forall r crypto.
Crypto crypto =>
Timelock crypto -> (SlotNo -> r) -> (Void# -> r) -> r
RequireTimeExpire mslot <-
  TimelockConstr (Memo (TimeExpire mslot) _)
  where
    RequireTimeExpire SlotNo
mslot =
      MemoBytes (TimelockRaw crypto) -> Timelock crypto
forall crypto. MemoBytes (TimelockRaw crypto) -> Timelock crypto
TimelockConstr (MemoBytes (TimelockRaw crypto) -> Timelock crypto)
-> MemoBytes (TimelockRaw crypto) -> Timelock crypto
forall a b. (a -> b) -> a -> b
$ Encode 'Open (TimelockRaw crypto) -> MemoBytes (TimelockRaw crypto)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes (TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
forall crypto.
Crypto crypto =>
TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
encRaw (SlotNo -> TimelockRaw crypto
forall crypto. SlotNo -> TimelockRaw crypto
TimeExpire SlotNo
mslot))

pattern RequireTimeStart :: CC.Crypto crypto => SlotNo -> Timelock crypto
pattern $bRequireTimeStart :: SlotNo -> Timelock crypto
$mRequireTimeStart :: forall r crypto.
Crypto crypto =>
Timelock crypto -> (SlotNo -> r) -> (Void# -> r) -> r
RequireTimeStart mslot <-
  TimelockConstr (Memo (TimeStart mslot) _)
  where
    RequireTimeStart SlotNo
mslot =
      MemoBytes (TimelockRaw crypto) -> Timelock crypto
forall crypto. MemoBytes (TimelockRaw crypto) -> Timelock crypto
TimelockConstr (MemoBytes (TimelockRaw crypto) -> Timelock crypto)
-> MemoBytes (TimelockRaw crypto) -> Timelock crypto
forall a b. (a -> b) -> a -> b
$ Encode 'Open (TimelockRaw crypto) -> MemoBytes (TimelockRaw crypto)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes (TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
forall crypto.
Crypto crypto =>
TimelockRaw crypto -> Encode 'Open (TimelockRaw crypto)
encRaw (SlotNo -> TimelockRaw crypto
forall crypto. SlotNo -> TimelockRaw crypto
TimeStart SlotNo
mslot))

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

-- =================================================================
-- 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 ::
  CC.Crypto crypto =>
  Set (KeyHash 'Witness crypto) ->
  ValidityInterval ->
  Timelock crypto ->
  Bool
evalTimelock :: Set (KeyHash 'Witness crypto)
-> ValidityInterval -> Timelock crypto -> Bool
evalTimelock Set (KeyHash 'Witness crypto)
_vhks (ValidityInterval StrictMaybe SlotNo
txStart StrictMaybe SlotNo
_) (RequireTimeStart SlotNo
lockStart) =
  SlotNo
lockStart SlotNo -> StrictMaybe SlotNo -> Bool
`lteNegInfty` StrictMaybe SlotNo
txStart
evalTimelock Set (KeyHash 'Witness crypto)
_vhks (ValidityInterval StrictMaybe SlotNo
_ StrictMaybe SlotNo
txExp) (RequireTimeExpire SlotNo
lockExp) =
  StrictMaybe SlotNo
txExp StrictMaybe SlotNo -> SlotNo -> Bool
`ltePosInfty` SlotNo
lockExp
evalTimelock Set (KeyHash 'Witness crypto)
vhks ValidityInterval
_vi (RequireSignature KeyHash 'Witness crypto
hash) = KeyHash 'Witness crypto -> Set (KeyHash 'Witness crypto) -> Bool
forall a. Ord a => a -> Set a -> Bool
member KeyHash 'Witness crypto
hash Set (KeyHash 'Witness crypto)
vhks
evalTimelock Set (KeyHash 'Witness crypto)
vhks ValidityInterval
vi (RequireAllOf StrictSeq (Timelock crypto)
xs) =
  (Timelock crypto -> Bool) -> StrictSeq (Timelock crypto) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Set (KeyHash 'Witness crypto)
-> ValidityInterval -> Timelock crypto -> Bool
forall crypto.
Crypto crypto =>
Set (KeyHash 'Witness crypto)
-> ValidityInterval -> Timelock crypto -> Bool
evalTimelock Set (KeyHash 'Witness crypto)
vhks ValidityInterval
vi) StrictSeq (Timelock crypto)
xs
evalTimelock Set (KeyHash 'Witness crypto)
vhks ValidityInterval
vi (RequireAnyOf StrictSeq (Timelock crypto)
xs) =
  (Timelock crypto -> Bool) -> StrictSeq (Timelock crypto) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Set (KeyHash 'Witness crypto)
-> ValidityInterval -> Timelock crypto -> Bool
forall crypto.
Crypto crypto =>
Set (KeyHash 'Witness crypto)
-> ValidityInterval -> Timelock crypto -> Bool
evalTimelock Set (KeyHash 'Witness crypto)
vhks ValidityInterval
vi) StrictSeq (Timelock crypto)
xs
evalTimelock Set (KeyHash 'Witness crypto)
vhks ValidityInterval
vi (RequireMOf Int
m StrictSeq (Timelock crypto)
xs) =
  Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= StrictSeq Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Timelock crypto -> Int)
-> StrictSeq (Timelock crypto) -> StrictSeq Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Timelock crypto
x -> if Set (KeyHash 'Witness crypto)
-> ValidityInterval -> Timelock crypto -> Bool
forall crypto.
Crypto crypto =>
Set (KeyHash 'Witness crypto)
-> ValidityInterval -> Timelock crypto -> Bool
evalTimelock Set (KeyHash 'Witness crypto)
vhks ValidityInterval
vi Timelock crypto
x then Int
1 else Int
0) StrictSeq (Timelock crypto)
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

-- =======================================================
-- Validating timelock scripts
-- We Assume that TxBody has field "vldt" that extracts a ValidityInterval
-- We still need to correctly compute the witness set for Core.TxBody as well.

evalFPS ::
  forall era.
  ( Era era,
    HasField "vldt" (Core.TxBody era) ValidityInterval
  ) =>
  Timelock (Crypto era) ->
  Set (KeyHash 'Witness (Crypto era)) ->
  Core.TxBody era ->
  Bool
evalFPS :: Timelock (Crypto era)
-> Set (KeyHash 'Witness (Crypto era)) -> TxBody era -> Bool
evalFPS Timelock (Crypto era)
timelock Set (KeyHash 'Witness (Crypto era))
vhks TxBody era
txb = Set (KeyHash 'Witness (Crypto era))
-> ValidityInterval -> Timelock (Crypto era) -> Bool
forall crypto.
Crypto crypto =>
Set (KeyHash 'Witness crypto)
-> ValidityInterval -> Timelock crypto -> Bool
evalTimelock Set (KeyHash 'Witness (Crypto era))
vhks (TxBody era -> ValidityInterval
forall k (x :: k) r a. HasField x r a => r -> a
getField @"vldt" TxBody era
txb) Timelock (Crypto era)
timelock

validateTimelock ::
  forall era.
  ( UsesTxBody era,
    HasField "vldt" (Core.TxBody era) ValidityInterval,
    HasField "addrWits" (Core.Tx era) (Set (WitVKey 'Witness (Crypto era)))
  ) =>
  Timelock (Crypto era) ->
  Core.Tx era ->
  Bool
validateTimelock :: Timelock (Crypto era) -> Tx era -> Bool
validateTimelock Timelock (Crypto era)
lock Tx era
tx = Timelock (Crypto era)
-> Set (KeyHash 'Witness (Crypto era)) -> TxBody era -> Bool
forall era.
(Era era, HasField "vldt" (TxBody era) ValidityInterval) =>
Timelock (Crypto era)
-> Set (KeyHash 'Witness (Crypto era)) -> TxBody era -> Bool
evalFPS @era Timelock (Crypto era)
lock Set (KeyHash 'Witness (Crypto era))
vhks (Tx era -> TxBody era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"body" Tx era
tx)
  where
    vhks :: Set (KeyHash 'Witness (Crypto era))
vhks = (WitVKey 'Witness (Crypto era) -> KeyHash 'Witness (Crypto era))
-> Set (WitVKey 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map WitVKey 'Witness (Crypto era) -> KeyHash 'Witness (Crypto era)
forall (kr :: KeyRole) crypto.
WitVKey kr crypto -> KeyHash 'Witness crypto
witKeyHash (Tx era -> Set (WitVKey 'Witness (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"addrWits" Tx era
tx)

showTimelock :: CC.Crypto crypto => Timelock crypto -> String
showTimelock :: Timelock crypto -> [Char]
showTimelock (RequireTimeStart (SlotNo Word64
i)) = [Char]
"(Start >= " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
showTimelock (RequireTimeExpire (SlotNo Word64
i)) = [Char]
"(Expire < " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
showTimelock (RequireAllOf StrictSeq (Timelock crypto)
xs) = [Char]
"(AllOf " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> Timelock crypto -> [Char])
-> [Char] -> StrictSeq (Timelock crypto) -> [Char]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Char] -> Timelock crypto -> [Char]
forall crypto. Crypto crypto => [Char] -> Timelock crypto -> [Char]
accum [Char]
")" StrictSeq (Timelock crypto)
xs
  where
    accum :: [Char] -> Timelock crypto -> [Char]
accum [Char]
ans Timelock crypto
x = Timelock crypto -> [Char]
forall crypto. Crypto crypto => Timelock crypto -> [Char]
showTimelock Timelock crypto
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ans
showTimelock (RequireAnyOf StrictSeq (Timelock crypto)
xs) = [Char]
"(AnyOf " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> Timelock crypto -> [Char])
-> [Char] -> StrictSeq (Timelock crypto) -> [Char]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Char] -> Timelock crypto -> [Char]
forall crypto. Crypto crypto => [Char] -> Timelock crypto -> [Char]
accum [Char]
")" StrictSeq (Timelock crypto)
xs
  where
    accum :: [Char] -> Timelock crypto -> [Char]
accum [Char]
ans Timelock crypto
x = Timelock crypto -> [Char]
forall crypto. Crypto crypto => Timelock crypto -> [Char]
showTimelock Timelock crypto
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ans
showTimelock (RequireMOf Int
m StrictSeq (Timelock crypto)
xs) = [Char]
"(MOf " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
m [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> Timelock crypto -> [Char])
-> [Char] -> StrictSeq (Timelock crypto) -> [Char]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Char] -> Timelock crypto -> [Char]
forall crypto. Crypto crypto => [Char] -> Timelock crypto -> [Char]
accum [Char]
")" StrictSeq (Timelock crypto)
xs
  where
    accum :: [Char] -> Timelock crypto -> [Char]
accum [Char]
ans Timelock crypto
x = Timelock crypto -> [Char]
forall crypto. Crypto crypto => Timelock crypto -> [Char]
showTimelock Timelock crypto
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ans
showTimelock (RequireSignature KeyHash 'Witness crypto
hash) = [Char]
"(Signature " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ KeyHash 'Witness crypto -> [Char]
forall a. Show a => a -> [Char]
show KeyHash 'Witness crypto
hash [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

-- ===============================================================
-- Pretty Printer