{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

module Cardano.Ledger.Shelley.Scripts
  ( MultiSig
      ( RequireAllOf,
        RequireAnyOf,
        RequireSignature,
        RequireMOf
      ),
    getMultiSigBytes,
    ScriptHash (..),
  )
where

import Cardano.Binary
  ( Annotator (..),
    FromCBOR (fromCBOR),
    ToCBOR,
  )
import Cardano.Ledger.BaseTypes (invalidKey)
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Hashes (ScriptHash (..))
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (Witness))
import Cardano.Ledger.SafeHash (SafeToHash (..))
import Cardano.Ledger.Serialization (decodeList, decodeRecordSum, encodeFoldable)
import Control.DeepSeq (NFData)
import Data.ByteString.Short (ShortByteString)
import Data.Coders (Encode (..), (!>))
import Data.MemoBytes
  ( Mem,
    MemoBytes (..),
    memoBytes,
  )
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))

-- | A simple language for expressing conditions under which it is valid to
-- withdraw from a normal UTxO payment address or to use a stake address.
--
-- The use case is for expressing multi-signature payment addresses and
-- multi-signature stake addresses. These can be combined arbitrarily using
-- logical operations:
--
-- * multi-way \"and\";
-- * multi-way \"or\";
-- * multi-way \"N of M\".
--
-- This makes it easy to express multi-signature addresses, and provides an
-- extension point to express other validity conditions, e.g., as needed for
-- locking funds used with lightning.
data MultiSigRaw crypto
  = -- | Require the redeeming transaction be witnessed by the spending key
    --   corresponding to the given verification key hash.
    RequireSignature' !(KeyHash 'Witness crypto)
  | -- | Require all the sub-terms to be satisfied.
    RequireAllOf' ![MultiSig crypto]
  | -- | Require any one of the sub-terms to be satisfied.
    RequireAnyOf' ![MultiSig crypto]
  | -- | Require M of the given sub-terms to be satisfied.
    RequireMOf' !Int ![MultiSig crypto]
  deriving (Int -> MultiSigRaw crypto -> ShowS
[MultiSigRaw crypto] -> ShowS
MultiSigRaw crypto -> String
(Int -> MultiSigRaw crypto -> ShowS)
-> (MultiSigRaw crypto -> String)
-> ([MultiSigRaw crypto] -> ShowS)
-> Show (MultiSigRaw crypto)
forall crypto. Int -> MultiSigRaw crypto -> ShowS
forall crypto. [MultiSigRaw crypto] -> ShowS
forall crypto. MultiSigRaw crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultiSigRaw crypto] -> ShowS
$cshowList :: forall crypto. [MultiSigRaw crypto] -> ShowS
show :: MultiSigRaw crypto -> String
$cshow :: forall crypto. MultiSigRaw crypto -> String
showsPrec :: Int -> MultiSigRaw crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> MultiSigRaw crypto -> ShowS
Show, MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
(MultiSigRaw crypto -> MultiSigRaw crypto -> Bool)
-> (MultiSigRaw crypto -> MultiSigRaw crypto -> Bool)
-> Eq (MultiSigRaw crypto)
forall crypto. MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
$c/= :: forall crypto. MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
== :: MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
$c== :: forall crypto. MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
Eq, Eq (MultiSigRaw crypto)
Eq (MultiSigRaw crypto)
-> (MultiSigRaw crypto -> MultiSigRaw crypto -> Ordering)
-> (MultiSigRaw crypto -> MultiSigRaw crypto -> Bool)
-> (MultiSigRaw crypto -> MultiSigRaw crypto -> Bool)
-> (MultiSigRaw crypto -> MultiSigRaw crypto -> Bool)
-> (MultiSigRaw crypto -> MultiSigRaw crypto -> Bool)
-> (MultiSigRaw crypto -> MultiSigRaw crypto -> MultiSigRaw crypto)
-> (MultiSigRaw crypto -> MultiSigRaw crypto -> MultiSigRaw crypto)
-> Ord (MultiSigRaw crypto)
MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
MultiSigRaw crypto -> MultiSigRaw crypto -> Ordering
MultiSigRaw crypto -> MultiSigRaw crypto -> MultiSigRaw crypto
forall crypto. Eq (MultiSigRaw 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. MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
forall crypto. MultiSigRaw crypto -> MultiSigRaw crypto -> Ordering
forall crypto.
MultiSigRaw crypto -> MultiSigRaw crypto -> MultiSigRaw crypto
min :: MultiSigRaw crypto -> MultiSigRaw crypto -> MultiSigRaw crypto
$cmin :: forall crypto.
MultiSigRaw crypto -> MultiSigRaw crypto -> MultiSigRaw crypto
max :: MultiSigRaw crypto -> MultiSigRaw crypto -> MultiSigRaw crypto
$cmax :: forall crypto.
MultiSigRaw crypto -> MultiSigRaw crypto -> MultiSigRaw crypto
>= :: MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
$c>= :: forall crypto. MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
> :: MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
$c> :: forall crypto. MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
<= :: MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
$c<= :: forall crypto. MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
< :: MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
$c< :: forall crypto. MultiSigRaw crypto -> MultiSigRaw crypto -> Bool
compare :: MultiSigRaw crypto -> MultiSigRaw crypto -> Ordering
$ccompare :: forall crypto. MultiSigRaw crypto -> MultiSigRaw crypto -> Ordering
$cp1Ord :: forall crypto. Eq (MultiSigRaw crypto)
Ord, (forall x. MultiSigRaw crypto -> Rep (MultiSigRaw crypto) x)
-> (forall x. Rep (MultiSigRaw crypto) x -> MultiSigRaw crypto)
-> Generic (MultiSigRaw crypto)
forall x. Rep (MultiSigRaw crypto) x -> MultiSigRaw crypto
forall x. MultiSigRaw crypto -> Rep (MultiSigRaw crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (MultiSigRaw crypto) x -> MultiSigRaw crypto
forall crypto x. MultiSigRaw crypto -> Rep (MultiSigRaw crypto) x
$cto :: forall crypto x. Rep (MultiSigRaw crypto) x -> MultiSigRaw crypto
$cfrom :: forall crypto x. MultiSigRaw crypto -> Rep (MultiSigRaw crypto) x
Generic)
  deriving anyclass (Context -> MultiSigRaw crypto -> IO (Maybe ThunkInfo)
Proxy (MultiSigRaw crypto) -> String
(Context -> MultiSigRaw crypto -> IO (Maybe ThunkInfo))
-> (Context -> MultiSigRaw crypto -> IO (Maybe ThunkInfo))
-> (Proxy (MultiSigRaw crypto) -> String)
-> NoThunks (MultiSigRaw crypto)
forall crypto.
Typeable crypto =>
Context -> MultiSigRaw crypto -> IO (Maybe ThunkInfo)
forall crypto.
Typeable crypto =>
Proxy (MultiSigRaw crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (MultiSigRaw crypto) -> String
$cshowTypeOf :: forall crypto.
Typeable crypto =>
Proxy (MultiSigRaw crypto) -> String
wNoThunks :: Context -> MultiSigRaw crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto.
Typeable crypto =>
Context -> MultiSigRaw crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> MultiSigRaw crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto.
Typeable crypto =>
Context -> MultiSigRaw crypto -> IO (Maybe ThunkInfo)
NoThunks)

instance NFData (MultiSigRaw era)

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

deriving newtype instance NFData (MultiSig era)

getMultiSigBytes :: MultiSig crypto -> ShortByteString
getMultiSigBytes :: MultiSig crypto -> ShortByteString
getMultiSigBytes (MultiSigConstr (Memo MultiSigRaw crypto
_ ShortByteString
bytes)) = ShortByteString
bytes

deriving via
  Mem (MultiSigRaw crypto)
  instance
    CC.Crypto crypto =>
    FromCBOR (Annotator (MultiSig crypto))

pattern RequireSignature :: CC.Crypto crypto => KeyHash 'Witness crypto -> MultiSig crypto
pattern $bRequireSignature :: KeyHash 'Witness crypto -> MultiSig crypto
$mRequireSignature :: forall r crypto.
Crypto crypto =>
MultiSig crypto
-> (KeyHash 'Witness crypto -> r) -> (Void# -> r) -> r
RequireSignature akh <-
  MultiSigConstr (Memo (RequireSignature' akh) _)
  where
    RequireSignature KeyHash 'Witness crypto
akh =
      MemoBytes (MultiSigRaw crypto) -> MultiSig crypto
forall crypto. MemoBytes (MultiSigRaw crypto) -> MultiSig crypto
MultiSigConstr (MemoBytes (MultiSigRaw crypto) -> MultiSig crypto)
-> MemoBytes (MultiSigRaw crypto) -> MultiSig crypto
forall a b. (a -> b) -> a -> b
$ Encode 'Open (MultiSigRaw crypto) -> MemoBytes (MultiSigRaw crypto)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes ((KeyHash 'Witness crypto -> MultiSigRaw crypto)
-> Word
-> Encode 'Open (KeyHash 'Witness crypto -> MultiSigRaw crypto)
forall t. t -> Word -> Encode 'Open t
Sum KeyHash 'Witness crypto -> MultiSigRaw crypto
forall crypto. KeyHash 'Witness crypto -> MultiSigRaw crypto
RequireSignature' Word
0 Encode 'Open (KeyHash 'Witness crypto -> MultiSigRaw crypto)
-> Encode ('Closed 'Dense) (KeyHash 'Witness crypto)
-> Encode 'Open (MultiSigRaw 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
akh)

pattern RequireAllOf :: CC.Crypto crypto => [MultiSig crypto] -> MultiSig crypto
pattern $bRequireAllOf :: [MultiSig crypto] -> MultiSig crypto
$mRequireAllOf :: forall r crypto.
Crypto crypto =>
MultiSig crypto -> ([MultiSig crypto] -> r) -> (Void# -> r) -> r
RequireAllOf ms <-
  MultiSigConstr (Memo (RequireAllOf' ms) _)
  where
    RequireAllOf [MultiSig crypto]
ms =
      MemoBytes (MultiSigRaw crypto) -> MultiSig crypto
forall crypto. MemoBytes (MultiSigRaw crypto) -> MultiSig crypto
MultiSigConstr (MemoBytes (MultiSigRaw crypto) -> MultiSig crypto)
-> MemoBytes (MultiSigRaw crypto) -> MultiSig crypto
forall a b. (a -> b) -> a -> b
$ Encode 'Open (MultiSigRaw crypto) -> MemoBytes (MultiSigRaw crypto)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes (([MultiSig crypto] -> MultiSigRaw crypto)
-> Word -> Encode 'Open ([MultiSig crypto] -> MultiSigRaw crypto)
forall t. t -> Word -> Encode 'Open t
Sum [MultiSig crypto] -> MultiSigRaw crypto
forall crypto. [MultiSig crypto] -> MultiSigRaw crypto
RequireAllOf' Word
1 Encode 'Open ([MultiSig crypto] -> MultiSigRaw crypto)
-> Encode ('Closed 'Dense) [MultiSig crypto]
-> Encode 'Open (MultiSigRaw crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ([MultiSig crypto] -> Encoding)
-> [MultiSig crypto] -> Encode ('Closed 'Dense) [MultiSig crypto]
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E [MultiSig crypto] -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable [MultiSig crypto]
ms)

pattern RequireAnyOf :: CC.Crypto crypto => [MultiSig crypto] -> MultiSig crypto
pattern $bRequireAnyOf :: [MultiSig crypto] -> MultiSig crypto
$mRequireAnyOf :: forall r crypto.
Crypto crypto =>
MultiSig crypto -> ([MultiSig crypto] -> r) -> (Void# -> r) -> r
RequireAnyOf ms <-
  MultiSigConstr (Memo (RequireAnyOf' ms) _)
  where
    RequireAnyOf [MultiSig crypto]
ms =
      MemoBytes (MultiSigRaw crypto) -> MultiSig crypto
forall crypto. MemoBytes (MultiSigRaw crypto) -> MultiSig crypto
MultiSigConstr (MemoBytes (MultiSigRaw crypto) -> MultiSig crypto)
-> MemoBytes (MultiSigRaw crypto) -> MultiSig crypto
forall a b. (a -> b) -> a -> b
$ Encode 'Open (MultiSigRaw crypto) -> MemoBytes (MultiSigRaw crypto)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes (([MultiSig crypto] -> MultiSigRaw crypto)
-> Word -> Encode 'Open ([MultiSig crypto] -> MultiSigRaw crypto)
forall t. t -> Word -> Encode 'Open t
Sum [MultiSig crypto] -> MultiSigRaw crypto
forall crypto. [MultiSig crypto] -> MultiSigRaw crypto
RequireAnyOf' Word
2 Encode 'Open ([MultiSig crypto] -> MultiSigRaw crypto)
-> Encode ('Closed 'Dense) [MultiSig crypto]
-> Encode 'Open (MultiSigRaw crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ([MultiSig crypto] -> Encoding)
-> [MultiSig crypto] -> Encode ('Closed 'Dense) [MultiSig crypto]
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E [MultiSig crypto] -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable [MultiSig crypto]
ms)

pattern RequireMOf :: CC.Crypto crypto => Int -> [MultiSig crypto] -> MultiSig crypto
pattern $bRequireMOf :: Int -> [MultiSig crypto] -> MultiSig crypto
$mRequireMOf :: forall r crypto.
Crypto crypto =>
MultiSig crypto
-> (Int -> [MultiSig crypto] -> r) -> (Void# -> r) -> r
RequireMOf n ms <-
  MultiSigConstr (Memo (RequireMOf' n ms) _)
  where
    RequireMOf Int
n [MultiSig crypto]
ms =
      MemoBytes (MultiSigRaw crypto) -> MultiSig crypto
forall crypto. MemoBytes (MultiSigRaw crypto) -> MultiSig crypto
MultiSigConstr (MemoBytes (MultiSigRaw crypto) -> MultiSig crypto)
-> MemoBytes (MultiSigRaw crypto) -> MultiSig crypto
forall a b. (a -> b) -> a -> b
$ Encode 'Open (MultiSigRaw crypto) -> MemoBytes (MultiSigRaw crypto)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes ((Int -> [MultiSig crypto] -> MultiSigRaw crypto)
-> Word
-> Encode 'Open (Int -> [MultiSig crypto] -> MultiSigRaw crypto)
forall t. t -> Word -> Encode 'Open t
Sum Int -> [MultiSig crypto] -> MultiSigRaw crypto
forall crypto. Int -> [MultiSig crypto] -> MultiSigRaw crypto
RequireMOf' Word
3 Encode 'Open (Int -> [MultiSig crypto] -> MultiSigRaw crypto)
-> Encode ('Closed 'Dense) Int
-> Encode 'Open ([MultiSig crypto] -> MultiSigRaw 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
n Encode 'Open ([MultiSig crypto] -> MultiSigRaw crypto)
-> Encode ('Closed 'Dense) [MultiSig crypto]
-> Encode 'Open (MultiSigRaw crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ([MultiSig crypto] -> Encoding)
-> [MultiSig crypto] -> Encode ('Closed 'Dense) [MultiSig crypto]
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E [MultiSig crypto] -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable [MultiSig crypto]
ms)

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

instance
  CC.Crypto crypto =>
  FromCBOR (Annotator (MultiSigRaw crypto))
  where
  fromCBOR :: Decoder s (Annotator (MultiSigRaw crypto))
fromCBOR = String
-> (Word -> Decoder s (Int, Annotator (MultiSigRaw crypto)))
-> Decoder s (Annotator (MultiSigRaw crypto))
forall s a. String -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum String
"MultiSig" ((Word -> Decoder s (Int, Annotator (MultiSigRaw crypto)))
 -> Decoder s (Annotator (MultiSigRaw crypto)))
-> (Word -> Decoder s (Int, Annotator (MultiSigRaw crypto)))
-> Decoder s (Annotator (MultiSigRaw crypto))
forall a b. (a -> b) -> a -> b
$
    \case
      Word
0 -> (,) Int
2 (Annotator (MultiSigRaw crypto)
 -> (Int, Annotator (MultiSigRaw crypto)))
-> (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
    -> Annotator (MultiSigRaw crypto))
-> Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> (Int, Annotator (MultiSigRaw crypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiSigRaw crypto -> Annotator (MultiSigRaw crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MultiSigRaw crypto -> Annotator (MultiSigRaw crypto))
-> (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
    -> MultiSigRaw crypto)
-> Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> Annotator (MultiSigRaw crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Witness crypto -> MultiSigRaw crypto
forall crypto. KeyHash 'Witness crypto -> MultiSigRaw crypto
RequireSignature' (KeyHash 'Witness crypto -> MultiSigRaw crypto)
-> (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
    -> KeyHash 'Witness crypto)
-> Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> MultiSigRaw crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> KeyHash 'Witness crypto
forall (discriminator :: KeyRole) crypto.
Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> KeyHash discriminator crypto
KeyHash (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
 -> (Int, Annotator (MultiSigRaw crypto)))
-> Decoder s (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)))
-> Decoder s (Int, Annotator (MultiSigRaw crypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word
1 -> do
        Annotator [MultiSig crypto]
multiSigs <- [Annotator (MultiSig crypto)] -> Annotator [MultiSig crypto]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Annotator (MultiSig crypto)] -> Annotator [MultiSig crypto])
-> Decoder s [Annotator (MultiSig crypto)]
-> Decoder s (Annotator [MultiSig crypto])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (MultiSig crypto))
-> Decoder s [Annotator (MultiSig crypto)]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Annotator (MultiSig crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR
        (Int, Annotator (MultiSigRaw crypto))
-> Decoder s (Int, Annotator (MultiSigRaw crypto))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, [MultiSig crypto] -> MultiSigRaw crypto
forall crypto. [MultiSig crypto] -> MultiSigRaw crypto
RequireAllOf' ([MultiSig crypto] -> MultiSigRaw crypto)
-> Annotator [MultiSig crypto] -> Annotator (MultiSigRaw crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator [MultiSig crypto]
multiSigs)
      Word
2 -> do
        Annotator [MultiSig crypto]
multiSigs <- [Annotator (MultiSig crypto)] -> Annotator [MultiSig crypto]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Annotator (MultiSig crypto)] -> Annotator [MultiSig crypto])
-> Decoder s [Annotator (MultiSig crypto)]
-> Decoder s (Annotator [MultiSig crypto])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (MultiSig crypto))
-> Decoder s [Annotator (MultiSig crypto)]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Annotator (MultiSig crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR
        (Int, Annotator (MultiSigRaw crypto))
-> Decoder s (Int, Annotator (MultiSigRaw crypto))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, [MultiSig crypto] -> MultiSigRaw crypto
forall crypto. [MultiSig crypto] -> MultiSigRaw crypto
RequireAnyOf' ([MultiSig crypto] -> MultiSigRaw crypto)
-> Annotator [MultiSig crypto] -> Annotator (MultiSigRaw crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator [MultiSig crypto]
multiSigs)
      Word
3 -> do
        Int
m <- Decoder s Int
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Annotator [MultiSig crypto]
multiSigs <- [Annotator (MultiSig crypto)] -> Annotator [MultiSig crypto]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Annotator (MultiSig crypto)] -> Annotator [MultiSig crypto])
-> Decoder s [Annotator (MultiSig crypto)]
-> Decoder s (Annotator [MultiSig crypto])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (MultiSig crypto))
-> Decoder s [Annotator (MultiSig crypto)]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Annotator (MultiSig crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR
        (Int, Annotator (MultiSigRaw crypto))
-> Decoder s (Int, Annotator (MultiSigRaw crypto))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Int -> [MultiSig crypto] -> MultiSigRaw crypto
forall crypto. Int -> [MultiSig crypto] -> MultiSigRaw crypto
RequireMOf' Int
m ([MultiSig crypto] -> MultiSigRaw crypto)
-> Annotator [MultiSig crypto] -> Annotator (MultiSigRaw crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator [MultiSig crypto]
multiSigs)
      Word
k -> Word -> Decoder s (Int, Annotator (MultiSigRaw crypto))
forall s a. Word -> Decoder s a
invalidKey Word
k