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

module Shelley.Spec.Ledger.Scripts
  ( MultiSig
      ( RequireAllOf,
        RequireAnyOf,
        RequireSignature,
        RequireMOf
      ),
    getMultiSigBytes,
    ScriptHash (..),
    getKeyCombination,
    getKeyCombinations,
    hashMultiSigScript,
  )
where

import Cardano.Binary
  ( Annotator (..),
    FromCBOR (fromCBOR),
    ToCBOR,
    serialize',
  )
import qualified Cardano.Crypto.Hash as Hash
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Crypto (ADDRHASH)
import Cardano.Ledger.Era (Crypto (..))
import Cardano.Ledger.Shelley (ShelleyEra)
import Control.DeepSeq (NFData)
import Data.Aeson
import qualified Data.ByteString as BS
import Data.ByteString.Short (ShortByteString)
import Data.Coders (Encode (..), (!>))
import qualified Data.List as List (concat, concatMap, permutations)
import Data.MemoBytes
  ( Mem,
    MemoBytes (..),
    memoBytes,
  )
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Shelley.Spec.Ledger.BaseTypes (invalidKey)
import Shelley.Spec.Ledger.Keys (KeyHash (..), KeyRole (Witness))
import Shelley.Spec.Ledger.Serialization (decodeList, decodeRecordSum, encodeFoldable)

-- | Magic number representing the tag of the native multi-signature script
-- language. For each script language included, a new tag is chosen and the tag
-- is included in the script hash for a script.
nativeMultiSigTag :: BS.ByteString
nativeMultiSigTag :: ByteString
nativeMultiSigTag = ByteString
"\00"

-- | 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 MultiSig' era
  = -- | Require the redeeming transaction be witnessed by the spending key
    --   corresponding to the given verification key hash.
    RequireSignature' !(KeyHash 'Witness (Crypto era))
  | -- | Require all the sub-terms to be satisfied.
    RequireAllOf' ![MultiSig era]
  | -- | Require any one of the sub-terms to be satisfied.
    RequireAnyOf' ![MultiSig era]
  | -- | Require M of the given sub-terms to be satisfied.
    RequireMOf' !Int ![MultiSig era]
  deriving (Int -> MultiSig' era -> ShowS
[MultiSig' era] -> ShowS
MultiSig' era -> String
(Int -> MultiSig' era -> ShowS)
-> (MultiSig' era -> String)
-> ([MultiSig' era] -> ShowS)
-> Show (MultiSig' era)
forall era. Int -> MultiSig' era -> ShowS
forall era. [MultiSig' era] -> ShowS
forall era. MultiSig' era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultiSig' era] -> ShowS
$cshowList :: forall era. [MultiSig' era] -> ShowS
show :: MultiSig' era -> String
$cshow :: forall era. MultiSig' era -> String
showsPrec :: Int -> MultiSig' era -> ShowS
$cshowsPrec :: forall era. Int -> MultiSig' era -> ShowS
Show, MultiSig' era -> MultiSig' era -> Bool
(MultiSig' era -> MultiSig' era -> Bool)
-> (MultiSig' era -> MultiSig' era -> Bool) -> Eq (MultiSig' era)
forall era. MultiSig' era -> MultiSig' era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiSig' era -> MultiSig' era -> Bool
$c/= :: forall era. MultiSig' era -> MultiSig' era -> Bool
== :: MultiSig' era -> MultiSig' era -> Bool
$c== :: forall era. MultiSig' era -> MultiSig' era -> Bool
Eq, Eq (MultiSig' era)
Eq (MultiSig' era)
-> (MultiSig' era -> MultiSig' era -> Ordering)
-> (MultiSig' era -> MultiSig' era -> Bool)
-> (MultiSig' era -> MultiSig' era -> Bool)
-> (MultiSig' era -> MultiSig' era -> Bool)
-> (MultiSig' era -> MultiSig' era -> Bool)
-> (MultiSig' era -> MultiSig' era -> MultiSig' era)
-> (MultiSig' era -> MultiSig' era -> MultiSig' era)
-> Ord (MultiSig' era)
MultiSig' era -> MultiSig' era -> Bool
MultiSig' era -> MultiSig' era -> Ordering
MultiSig' era -> MultiSig' era -> MultiSig' era
forall era. Eq (MultiSig' era)
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 era. MultiSig' era -> MultiSig' era -> Bool
forall era. MultiSig' era -> MultiSig' era -> Ordering
forall era. MultiSig' era -> MultiSig' era -> MultiSig' era
min :: MultiSig' era -> MultiSig' era -> MultiSig' era
$cmin :: forall era. MultiSig' era -> MultiSig' era -> MultiSig' era
max :: MultiSig' era -> MultiSig' era -> MultiSig' era
$cmax :: forall era. MultiSig' era -> MultiSig' era -> MultiSig' era
>= :: MultiSig' era -> MultiSig' era -> Bool
$c>= :: forall era. MultiSig' era -> MultiSig' era -> Bool
> :: MultiSig' era -> MultiSig' era -> Bool
$c> :: forall era. MultiSig' era -> MultiSig' era -> Bool
<= :: MultiSig' era -> MultiSig' era -> Bool
$c<= :: forall era. MultiSig' era -> MultiSig' era -> Bool
< :: MultiSig' era -> MultiSig' era -> Bool
$c< :: forall era. MultiSig' era -> MultiSig' era -> Bool
compare :: MultiSig' era -> MultiSig' era -> Ordering
$ccompare :: forall era. MultiSig' era -> MultiSig' era -> Ordering
$cp1Ord :: forall era. Eq (MultiSig' era)
Ord, (forall x. MultiSig' era -> Rep (MultiSig' era) x)
-> (forall x. Rep (MultiSig' era) x -> MultiSig' era)
-> Generic (MultiSig' era)
forall x. Rep (MultiSig' era) x -> MultiSig' era
forall x. MultiSig' era -> Rep (MultiSig' era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (MultiSig' era) x -> MultiSig' era
forall era x. MultiSig' era -> Rep (MultiSig' era) x
$cto :: forall era x. Rep (MultiSig' era) x -> MultiSig' era
$cfrom :: forall era x. MultiSig' era -> Rep (MultiSig' era) x
Generic)
  deriving anyclass (Context -> MultiSig' era -> IO (Maybe ThunkInfo)
Proxy (MultiSig' era) -> String
(Context -> MultiSig' era -> IO (Maybe ThunkInfo))
-> (Context -> MultiSig' era -> IO (Maybe ThunkInfo))
-> (Proxy (MultiSig' era) -> String)
-> NoThunks (MultiSig' era)
forall era.
Typeable era =>
Context -> MultiSig' era -> IO (Maybe ThunkInfo)
forall era. Typeable era => Proxy (MultiSig' era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (MultiSig' era) -> String
$cshowTypeOf :: forall era. Typeable era => Proxy (MultiSig' era) -> String
wNoThunks :: Context -> MultiSig' era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Typeable era =>
Context -> MultiSig' era -> IO (Maybe ThunkInfo)
noThunks :: Context -> MultiSig' era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
Typeable era =>
Context -> MultiSig' era -> IO (Maybe ThunkInfo)
NoThunks)

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

getMultiSigBytes :: MultiSig era -> ShortByteString
getMultiSigBytes :: MultiSig era -> ShortByteString
getMultiSigBytes (MultiSig (Memo MultiSig' era
_ ShortByteString
bytes)) = ShortByteString
bytes

deriving via
  (Mem (MultiSig' era))
  instance
    (Era era) =>
    FromCBOR (Annotator (MultiSig era))

pattern RequireSignature :: Era era => KeyHash 'Witness (Crypto era) -> MultiSig era
pattern $bRequireSignature :: KeyHash 'Witness (Crypto era) -> MultiSig era
$mRequireSignature :: forall r era.
Era era =>
MultiSig era
-> (KeyHash 'Witness (Crypto era) -> r) -> (Void# -> r) -> r
RequireSignature akh <-
  MultiSig (Memo (RequireSignature' akh) _)
  where
    RequireSignature KeyHash 'Witness (Crypto era)
akh =
      MemoBytes (MultiSig' era) -> MultiSig era
forall era. MemoBytes (MultiSig' era) -> MultiSig era
MultiSig (MemoBytes (MultiSig' era) -> MultiSig era)
-> MemoBytes (MultiSig' era) -> MultiSig era
forall a b. (a -> b) -> a -> b
$ Encode 'Open (MultiSig' era) -> MemoBytes (MultiSig' era)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes ((KeyHash 'Witness (Crypto era) -> MultiSig' era)
-> Word
-> Encode 'Open (KeyHash 'Witness (Crypto era) -> MultiSig' era)
forall t. t -> Word -> Encode 'Open t
Sum KeyHash 'Witness (Crypto era) -> MultiSig' era
forall era. KeyHash 'Witness (Crypto era) -> MultiSig' era
RequireSignature' Word
0 Encode 'Open (KeyHash 'Witness (Crypto era) -> MultiSig' era)
-> Encode ('Closed 'Dense) (KeyHash 'Witness (Crypto era))
-> Encode 'Open (MultiSig' era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> KeyHash 'Witness (Crypto era)
-> Encode ('Closed 'Dense) (KeyHash 'Witness (Crypto era))
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'Witness (Crypto era)
akh)

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

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

pattern RequireMOf :: Era era => Int -> [MultiSig era] -> MultiSig era
pattern $bRequireMOf :: Int -> [MultiSig era] -> MultiSig era
$mRequireMOf :: forall r era.
Era era =>
MultiSig era -> (Int -> [MultiSig era] -> r) -> (Void# -> r) -> r
RequireMOf n ms <-
  MultiSig (Memo (RequireMOf' n ms) _)
  where
    RequireMOf Int
n [MultiSig era]
ms =
      MemoBytes (MultiSig' era) -> MultiSig era
forall era. MemoBytes (MultiSig' era) -> MultiSig era
MultiSig (MemoBytes (MultiSig' era) -> MultiSig era)
-> MemoBytes (MultiSig' era) -> MultiSig era
forall a b. (a -> b) -> a -> b
$ Encode 'Open (MultiSig' era) -> MemoBytes (MultiSig' era)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes ((Int -> [MultiSig era] -> MultiSig' era)
-> Word -> Encode 'Open (Int -> [MultiSig era] -> MultiSig' era)
forall t. t -> Word -> Encode 'Open t
Sum Int -> [MultiSig era] -> MultiSig' era
forall era. Int -> [MultiSig era] -> MultiSig' era
RequireMOf' Word
3 Encode 'Open (Int -> [MultiSig era] -> MultiSig' era)
-> Encode ('Closed 'Dense) Int
-> Encode 'Open ([MultiSig era] -> MultiSig' era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Int
n Encode 'Open ([MultiSig era] -> MultiSig' era)
-> Encode ('Closed 'Dense) [MultiSig era]
-> Encode 'Open (MultiSig' era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ([MultiSig era] -> Encoding)
-> [MultiSig era] -> Encode ('Closed 'Dense) [MultiSig era]
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E [MultiSig era] -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable [MultiSig era]
ms)

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

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

deriving newtype instance
  (Era era, Typeable (Core.Script era)) =>
  ToCBOR (ScriptHash era)

deriving newtype instance
  (Era era, Typeable (Core.Script era)) =>
  FromCBOR (ScriptHash era)

deriving newtype instance (Era era) => ToJSON (ScriptHash era)

deriving newtype instance Era era => FromJSON (ScriptHash era)

type instance Core.Script (ShelleyEra c) = MultiSig (ShelleyEra c)

-- | Hashes native multi-signature script.
hashMultiSigScript ::
  Era era =>
  MultiSig era ->
  ScriptHash era
hashMultiSigScript :: MultiSig era -> ScriptHash era
hashMultiSigScript =
  Hash (ADDRHASH (Crypto era)) (Script era) -> ScriptHash era
forall era.
Hash (ADDRHASH (Crypto era)) (Script era) -> ScriptHash era
ScriptHash
    (Hash (ADDRHASH (Crypto era)) (Script era) -> ScriptHash era)
-> (MultiSig era -> Hash (ADDRHASH (Crypto era)) (Script era))
-> MultiSig era
-> ScriptHash era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (ADDRHASH (Crypto era)) (MultiSig era)
-> Hash (ADDRHASH (Crypto era)) (Script era)
forall h a b. Hash h a -> Hash h b
Hash.castHash
    (Hash (ADDRHASH (Crypto era)) (MultiSig era)
 -> Hash (ADDRHASH (Crypto era)) (Script era))
-> (MultiSig era -> Hash (ADDRHASH (Crypto era)) (MultiSig era))
-> MultiSig era
-> Hash (ADDRHASH (Crypto era)) (Script era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiSig era -> ByteString)
-> MultiSig era -> Hash (ADDRHASH (Crypto era)) (MultiSig era)
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith (\MultiSig era
x -> ByteString
nativeMultiSigTag ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> MultiSig era -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize' MultiSig era
x)

-- | Get one possible combination of keys for multi signature script
getKeyCombination :: Era era => MultiSig era -> [KeyHash 'Witness (Crypto era)]
getKeyCombination :: MultiSig era -> [KeyHash 'Witness (Crypto era)]
getKeyCombination (RequireSignature KeyHash 'Witness (Crypto era)
hk) = [KeyHash 'Witness (Crypto era)
hk]
getKeyCombination (RequireAllOf [MultiSig era]
msigs) =
  (MultiSig era -> [KeyHash 'Witness (Crypto era)])
-> [MultiSig era] -> [KeyHash 'Witness (Crypto era)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap MultiSig era -> [KeyHash 'Witness (Crypto era)]
forall era.
Era era =>
MultiSig era -> [KeyHash 'Witness (Crypto era)]
getKeyCombination [MultiSig era]
msigs
getKeyCombination (RequireAnyOf [MultiSig era]
msigs) =
  case [MultiSig era]
msigs of
    [] -> []
    MultiSig era
x : [MultiSig era]
_ -> MultiSig era -> [KeyHash 'Witness (Crypto era)]
forall era.
Era era =>
MultiSig era -> [KeyHash 'Witness (Crypto era)]
getKeyCombination MultiSig era
x
getKeyCombination (RequireMOf Int
m [MultiSig era]
msigs) =
  (MultiSig era -> [KeyHash 'Witness (Crypto era)])
-> [MultiSig era] -> [KeyHash 'Witness (Crypto era)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap MultiSig era -> [KeyHash 'Witness (Crypto era)]
forall era.
Era era =>
MultiSig era -> [KeyHash 'Witness (Crypto era)]
getKeyCombination (Int -> [MultiSig era] -> [MultiSig era]
forall a. Int -> [a] -> [a]
take Int
m [MultiSig era]
msigs)

-- | Get all valid combinations of keys for given multi signature. This is
-- mainly useful for testing.
getKeyCombinations :: Era era => MultiSig era -> [[KeyHash 'Witness (Crypto era)]]
getKeyCombinations :: MultiSig era -> [[KeyHash 'Witness (Crypto era)]]
getKeyCombinations (RequireSignature KeyHash 'Witness (Crypto era)
hk) = [[KeyHash 'Witness (Crypto era)
hk]]
getKeyCombinations (RequireAllOf [MultiSig era]
msigs) =
  [ [[KeyHash 'Witness (Crypto era)]]
-> [KeyHash 'Witness (Crypto era)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat ([[KeyHash 'Witness (Crypto era)]]
 -> [KeyHash 'Witness (Crypto era)])
-> [[KeyHash 'Witness (Crypto era)]]
-> [KeyHash 'Witness (Crypto era)]
forall a b. (a -> b) -> a -> b
$
      (MultiSig era -> [[KeyHash 'Witness (Crypto era)]])
-> [MultiSig era] -> [[KeyHash 'Witness (Crypto era)]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap MultiSig era -> [[KeyHash 'Witness (Crypto era)]]
forall era.
Era era =>
MultiSig era -> [[KeyHash 'Witness (Crypto era)]]
getKeyCombinations [MultiSig era]
msigs
  ]
getKeyCombinations (RequireAnyOf [MultiSig era]
msigs) = (MultiSig era -> [[KeyHash 'Witness (Crypto era)]])
-> [MultiSig era] -> [[KeyHash 'Witness (Crypto era)]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap MultiSig era -> [[KeyHash 'Witness (Crypto era)]]
forall era.
Era era =>
MultiSig era -> [[KeyHash 'Witness (Crypto era)]]
getKeyCombinations [MultiSig era]
msigs
getKeyCombinations (RequireMOf Int
m [MultiSig era]
msigs) =
  let perms :: [[MultiSig era]]
perms = ([MultiSig era] -> [MultiSig era])
-> [[MultiSig era]] -> [[MultiSig era]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [MultiSig era] -> [MultiSig era]
forall a. Int -> [a] -> [a]
take Int
m) ([[MultiSig era]] -> [[MultiSig era]])
-> [[MultiSig era]] -> [[MultiSig era]]
forall a b. (a -> b) -> a -> b
$ [MultiSig era] -> [[MultiSig era]]
forall a. [a] -> [[a]]
List.permutations [MultiSig era]
msigs
   in ([MultiSig era] -> [KeyHash 'Witness (Crypto era)])
-> [[MultiSig era]] -> [[KeyHash 'Witness (Crypto era)]]
forall a b. (a -> b) -> [a] -> [b]
map ([[KeyHash 'Witness (Crypto era)]]
-> [KeyHash 'Witness (Crypto era)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KeyHash 'Witness (Crypto era)]]
 -> [KeyHash 'Witness (Crypto era)])
-> ([MultiSig era] -> [[KeyHash 'Witness (Crypto era)]])
-> [MultiSig era]
-> [KeyHash 'Witness (Crypto era)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiSig era -> [[KeyHash 'Witness (Crypto era)]])
-> [MultiSig era] -> [[KeyHash 'Witness (Crypto era)]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap MultiSig era -> [[KeyHash 'Witness (Crypto era)]]
forall era.
Era era =>
MultiSig era -> [[KeyHash 'Witness (Crypto era)]]
getKeyCombinations) [[MultiSig era]]
perms

-- CBOR

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