{-# 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 #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Ledger.Shelley.Scripts (
MultiSig (..),
ShelleyEraScript (..),
pattern RequireSignature,
pattern RequireAllOf,
pattern RequireAnyOf,
pattern RequireMOf,
evalMultiSig,
validateMultiSig,
nativeMultiSigTag,
eqMultiSigRaw,
MultiSigRaw (..),
) where
import Cardano.Ledger.Binary (
DecCBOR (decCBOR),
EncCBOR (..),
ToCBOR,
decodeRecordSum,
invalidKey,
)
import Cardano.Ledger.Binary.Coders (
Encode (Sum, To),
(!>),
)
import Cardano.Ledger.Core
import Cardano.Ledger.Keys.WitVKey (witVKeyHash)
import Cardano.Ledger.MemoBytes (
EqRaw (..),
MemoBytes,
Memoized (..),
decodeMemoized,
getMemoRawType,
pattern Memo,
)
import Cardano.Ledger.MemoBytes.Internal (memoBytesEra)
import Cardano.Ledger.Shelley.Era
import Control.DeepSeq (NFData)
import qualified Data.ByteString as BS
import Data.Sequence.Strict (StrictSeq (..))
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))
data MultiSigRaw era
=
MultiSigSignature !(KeyHash 'Witness)
|
MultiSigAllOf !(StrictSeq (MultiSig era))
|
MultiSigAnyOf !(StrictSeq (MultiSig era))
|
MultiSigMOf !Int !(StrictSeq (MultiSig era))
deriving (MultiSigRaw era -> MultiSigRaw era -> Bool
(MultiSigRaw era -> MultiSigRaw era -> Bool)
-> (MultiSigRaw era -> MultiSigRaw era -> Bool)
-> Eq (MultiSigRaw era)
forall era. MultiSigRaw era -> MultiSigRaw era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. MultiSigRaw era -> MultiSigRaw era -> Bool
== :: MultiSigRaw era -> MultiSigRaw era -> Bool
$c/= :: forall era. MultiSigRaw era -> MultiSigRaw era -> Bool
/= :: MultiSigRaw era -> MultiSigRaw era -> Bool
Eq, Int -> MultiSigRaw era -> ShowS
[MultiSigRaw era] -> ShowS
MultiSigRaw era -> String
(Int -> MultiSigRaw era -> ShowS)
-> (MultiSigRaw era -> String)
-> ([MultiSigRaw era] -> ShowS)
-> Show (MultiSigRaw era)
forall era. Int -> MultiSigRaw era -> ShowS
forall era. [MultiSigRaw era] -> ShowS
forall era. MultiSigRaw era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> MultiSigRaw era -> ShowS
showsPrec :: Int -> MultiSigRaw era -> ShowS
$cshow :: forall era. MultiSigRaw era -> String
show :: MultiSigRaw era -> String
$cshowList :: forall era. [MultiSigRaw era] -> ShowS
showList :: [MultiSigRaw era] -> ShowS
Show, (forall x. MultiSigRaw era -> Rep (MultiSigRaw era) x)
-> (forall x. Rep (MultiSigRaw era) x -> MultiSigRaw era)
-> Generic (MultiSigRaw era)
forall x. Rep (MultiSigRaw era) x -> MultiSigRaw era
forall x. MultiSigRaw era -> Rep (MultiSigRaw era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (MultiSigRaw era) x -> MultiSigRaw era
forall era x. MultiSigRaw era -> Rep (MultiSigRaw era) x
$cfrom :: forall era x. MultiSigRaw era -> Rep (MultiSigRaw era) x
from :: forall x. MultiSigRaw era -> Rep (MultiSigRaw era) x
$cto :: forall era x. Rep (MultiSigRaw era) x -> MultiSigRaw era
to :: forall x. Rep (MultiSigRaw era) x -> MultiSigRaw era
Generic)
deriving anyclass (Context -> MultiSigRaw era -> IO (Maybe ThunkInfo)
Proxy (MultiSigRaw era) -> String
(Context -> MultiSigRaw era -> IO (Maybe ThunkInfo))
-> (Context -> MultiSigRaw era -> IO (Maybe ThunkInfo))
-> (Proxy (MultiSigRaw era) -> String)
-> NoThunks (MultiSigRaw era)
forall era.
Typeable era =>
Context -> MultiSigRaw era -> IO (Maybe ThunkInfo)
forall era. Typeable era => Proxy (MultiSigRaw era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall era.
Typeable era =>
Context -> MultiSigRaw era -> IO (Maybe ThunkInfo)
noThunks :: Context -> MultiSigRaw era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Typeable era =>
Context -> MultiSigRaw era -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> MultiSigRaw era -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall era. Typeable era => Proxy (MultiSigRaw era) -> String
showTypeOf :: Proxy (MultiSigRaw era) -> String
NoThunks)
class EraScript era => ShelleyEraScript era where
mkRequireSignature :: KeyHash 'Witness -> NativeScript era
getRequireSignature :: NativeScript era -> Maybe (KeyHash 'Witness)
mkRequireAllOf :: StrictSeq (NativeScript era) -> NativeScript era
getRequireAllOf :: NativeScript era -> Maybe (StrictSeq (NativeScript era))
mkRequireAnyOf :: StrictSeq (NativeScript era) -> NativeScript era
getRequireAnyOf :: NativeScript era -> Maybe (StrictSeq (NativeScript era))
mkRequireMOf :: Int -> StrictSeq (NativeScript era) -> NativeScript era
getRequireMOf :: NativeScript era -> Maybe (Int, StrictSeq (NativeScript era))
instance NFData (MultiSigRaw era)
newtype MultiSig era = MkMultiSig (MemoBytes (MultiSigRaw 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
$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
Eq, 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
$cshowsPrec :: forall era. Int -> MultiSig era -> ShowS
showsPrec :: Int -> MultiSig era -> ShowS
$cshow :: forall era. MultiSig era -> String
show :: MultiSig era -> String
$cshowList :: forall era. [MultiSig era] -> ShowS
showList :: [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
$cfrom :: forall era x. MultiSig era -> Rep (MultiSig era) x
from :: forall x. MultiSig era -> Rep (MultiSig era) x
$cto :: forall era x. Rep (MultiSig era) x -> MultiSig era
to :: forall x. Rep (MultiSig era) x -> MultiSig era
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
$ctoCBOR :: forall era. Typeable era => MultiSig era -> Encoding
toCBOR :: MultiSig era -> Encoding
$cencodedSizeExpr :: 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
$cencodedListSizeExpr :: 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
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
$cnoThunks :: forall era.
Typeable era =>
Context -> MultiSig era -> IO (Maybe ThunkInfo)
noThunks :: Context -> MultiSig era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Typeable era =>
Context -> MultiSig era -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> MultiSig era -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall era. Typeable era => Proxy (MultiSig era) -> String
showTypeOf :: Proxy (MultiSig era) -> String
NoThunks, MultiSig era -> Int
MultiSig era -> ByteString
(MultiSig era -> ByteString)
-> (MultiSig era -> Int)
-> (forall i. Proxy i -> MultiSig era -> SafeHash i)
-> SafeToHash (MultiSig era)
forall i. Proxy i -> MultiSig era -> SafeHash i
forall era. MultiSig era -> Int
forall era. MultiSig era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall era i. Proxy i -> MultiSig era -> SafeHash i
$coriginalBytes :: forall era. MultiSig era -> ByteString
originalBytes :: MultiSig era -> ByteString
$coriginalBytesSize :: forall era. MultiSig era -> Int
originalBytesSize :: MultiSig era -> Int
$cmakeHashWithExplicitProxys :: forall era i. Proxy i -> MultiSig era -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> MultiSig era -> SafeHash i
SafeToHash)
instance Memoized (MultiSig era) where
type RawType (MultiSig era) = MultiSigRaw era
nativeMultiSigTag :: BS.ByteString
nativeMultiSigTag :: ByteString
nativeMultiSigTag = ByteString
"\00"
instance EraScript ShelleyEra where
type Script ShelleyEra = MultiSig ShelleyEra
type NativeScript ShelleyEra = MultiSig ShelleyEra
upgradeScript :: EraScript (PreviousEra ShelleyEra) =>
Script (PreviousEra ShelleyEra) -> Script ShelleyEra
upgradeScript = String -> Script ByronEra -> MultiSig ShelleyEra
forall a. HasCallStack => String -> a
error String
"It is not possible to translate a script with 'upgradeScript' from Byron era"
getNativeScript :: Script ShelleyEra -> Maybe (NativeScript ShelleyEra)
getNativeScript = Script ShelleyEra -> Maybe (NativeScript ShelleyEra)
MultiSig ShelleyEra -> Maybe (MultiSig ShelleyEra)
forall a. a -> Maybe a
Just
fromNativeScript :: NativeScript ShelleyEra -> Script ShelleyEra
fromNativeScript = NativeScript ShelleyEra -> Script ShelleyEra
MultiSig ShelleyEra -> MultiSig ShelleyEra
forall a. a -> a
id
scriptPrefixTag :: Script ShelleyEra -> ByteString
scriptPrefixTag Script ShelleyEra
_script = ByteString
nativeMultiSigTag
instance ShelleyEraScript ShelleyEra where
mkRequireSignature :: KeyHash 'Witness -> NativeScript ShelleyEra
mkRequireSignature KeyHash 'Witness
kh =
MemoBytes (MultiSigRaw ShelleyEra) -> MultiSig ShelleyEra
forall era. MemoBytes (MultiSigRaw era) -> MultiSig era
MkMultiSig (MemoBytes (MultiSigRaw ShelleyEra) -> MultiSig ShelleyEra)
-> MemoBytes (MultiSigRaw ShelleyEra) -> MultiSig ShelleyEra
forall a b. (a -> b) -> a -> b
$ forall era (w :: Wrapped) t. Era era => Encode w t -> MemoBytes t
memoBytesEra @ShelleyEra ((KeyHash 'Witness -> MultiSigRaw ShelleyEra)
-> Word
-> Encode 'Open (KeyHash 'Witness -> MultiSigRaw ShelleyEra)
forall t. t -> Word -> Encode 'Open t
Sum KeyHash 'Witness -> MultiSigRaw ShelleyEra
forall era. KeyHash 'Witness -> MultiSigRaw era
MultiSigSignature Word
0 Encode 'Open (KeyHash 'Witness -> MultiSigRaw ShelleyEra)
-> Encode ('Closed 'Dense) (KeyHash 'Witness)
-> Encode 'Open (MultiSigRaw ShelleyEra)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> KeyHash 'Witness -> Encode ('Closed 'Dense) (KeyHash 'Witness)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'Witness
kh)
getRequireSignature :: NativeScript ShelleyEra -> Maybe (KeyHash 'Witness)
getRequireSignature (MkMultiSig (Memo (MultiSigSignature KeyHash 'Witness
kh) ShortByteString
_)) = KeyHash 'Witness -> Maybe (KeyHash 'Witness)
forall a. a -> Maybe a
Just KeyHash 'Witness
kh
getRequireSignature NativeScript ShelleyEra
_ = Maybe (KeyHash 'Witness)
forall a. Maybe a
Nothing
mkRequireAllOf :: StrictSeq (NativeScript ShelleyEra) -> NativeScript ShelleyEra
mkRequireAllOf StrictSeq (NativeScript ShelleyEra)
ms =
MemoBytes (MultiSigRaw ShelleyEra) -> MultiSig ShelleyEra
forall era. MemoBytes (MultiSigRaw era) -> MultiSig era
MkMultiSig (MemoBytes (MultiSigRaw ShelleyEra) -> MultiSig ShelleyEra)
-> MemoBytes (MultiSigRaw ShelleyEra) -> MultiSig ShelleyEra
forall a b. (a -> b) -> a -> b
$ forall era (w :: Wrapped) t. Era era => Encode w t -> MemoBytes t
memoBytesEra @ShelleyEra ((StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra)
-> Word
-> Encode
'Open (StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra)
forall t. t -> Word -> Encode 'Open t
Sum StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra
forall era. StrictSeq (MultiSig era) -> MultiSigRaw era
MultiSigAllOf Word
1 Encode
'Open (StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra)
-> Encode ('Closed 'Dense) (StrictSeq (MultiSig ShelleyEra))
-> Encode 'Open (MultiSigRaw ShelleyEra)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> StrictSeq (MultiSig ShelleyEra)
-> Encode ('Closed 'Dense) (StrictSeq (MultiSig ShelleyEra))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (NativeScript ShelleyEra)
StrictSeq (MultiSig ShelleyEra)
ms)
getRequireAllOf :: NativeScript ShelleyEra
-> Maybe (StrictSeq (NativeScript ShelleyEra))
getRequireAllOf (MkMultiSig (Memo (MultiSigAllOf StrictSeq (MultiSig ShelleyEra)
ms) ShortByteString
_)) = StrictSeq (MultiSig ShelleyEra)
-> Maybe (StrictSeq (MultiSig ShelleyEra))
forall a. a -> Maybe a
Just StrictSeq (MultiSig ShelleyEra)
ms
getRequireAllOf NativeScript ShelleyEra
_ = Maybe (StrictSeq (NativeScript ShelleyEra))
Maybe (StrictSeq (MultiSig ShelleyEra))
forall a. Maybe a
Nothing
mkRequireAnyOf :: StrictSeq (NativeScript ShelleyEra) -> NativeScript ShelleyEra
mkRequireAnyOf StrictSeq (NativeScript ShelleyEra)
ms =
MemoBytes (MultiSigRaw ShelleyEra) -> MultiSig ShelleyEra
forall era. MemoBytes (MultiSigRaw era) -> MultiSig era
MkMultiSig (MemoBytes (MultiSigRaw ShelleyEra) -> MultiSig ShelleyEra)
-> MemoBytes (MultiSigRaw ShelleyEra) -> MultiSig ShelleyEra
forall a b. (a -> b) -> a -> b
$ forall era (w :: Wrapped) t. Era era => Encode w t -> MemoBytes t
memoBytesEra @ShelleyEra ((StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra)
-> Word
-> Encode
'Open (StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra)
forall t. t -> Word -> Encode 'Open t
Sum StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra
forall era. StrictSeq (MultiSig era) -> MultiSigRaw era
MultiSigAnyOf Word
2 Encode
'Open (StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra)
-> Encode ('Closed 'Dense) (StrictSeq (MultiSig ShelleyEra))
-> Encode 'Open (MultiSigRaw ShelleyEra)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> StrictSeq (MultiSig ShelleyEra)
-> Encode ('Closed 'Dense) (StrictSeq (MultiSig ShelleyEra))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (NativeScript ShelleyEra)
StrictSeq (MultiSig ShelleyEra)
ms)
getRequireAnyOf :: NativeScript ShelleyEra
-> Maybe (StrictSeq (NativeScript ShelleyEra))
getRequireAnyOf (MkMultiSig (Memo (MultiSigAnyOf StrictSeq (MultiSig ShelleyEra)
ms) ShortByteString
_)) = StrictSeq (MultiSig ShelleyEra)
-> Maybe (StrictSeq (MultiSig ShelleyEra))
forall a. a -> Maybe a
Just StrictSeq (MultiSig ShelleyEra)
ms
getRequireAnyOf NativeScript ShelleyEra
_ = Maybe (StrictSeq (NativeScript ShelleyEra))
Maybe (StrictSeq (MultiSig ShelleyEra))
forall a. Maybe a
Nothing
mkRequireMOf :: Int
-> StrictSeq (NativeScript ShelleyEra) -> NativeScript ShelleyEra
mkRequireMOf Int
n StrictSeq (NativeScript ShelleyEra)
ms =
MemoBytes (MultiSigRaw ShelleyEra) -> MultiSig ShelleyEra
forall era. MemoBytes (MultiSigRaw era) -> MultiSig era
MkMultiSig (MemoBytes (MultiSigRaw ShelleyEra) -> MultiSig ShelleyEra)
-> MemoBytes (MultiSigRaw ShelleyEra) -> MultiSig ShelleyEra
forall a b. (a -> b) -> a -> b
$ forall era (w :: Wrapped) t. Era era => Encode w t -> MemoBytes t
memoBytesEra @ShelleyEra ((Int -> StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra)
-> Word
-> Encode
'Open
(Int -> StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra)
forall t. t -> Word -> Encode 'Open t
Sum Int -> StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra
forall era. Int -> StrictSeq (MultiSig era) -> MultiSigRaw era
MultiSigMOf Word
3 Encode
'Open
(Int -> StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra)
-> Encode ('Closed 'Dense) Int
-> Encode
'Open (StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
n Encode
'Open (StrictSeq (MultiSig ShelleyEra) -> MultiSigRaw ShelleyEra)
-> Encode ('Closed 'Dense) (StrictSeq (MultiSig ShelleyEra))
-> Encode 'Open (MultiSigRaw ShelleyEra)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> StrictSeq (MultiSig ShelleyEra)
-> Encode ('Closed 'Dense) (StrictSeq (MultiSig ShelleyEra))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (NativeScript ShelleyEra)
StrictSeq (MultiSig ShelleyEra)
ms)
getRequireMOf :: NativeScript ShelleyEra
-> Maybe (Int, StrictSeq (NativeScript ShelleyEra))
getRequireMOf (MkMultiSig (Memo (MultiSigMOf Int
n StrictSeq (MultiSig ShelleyEra)
ms) ShortByteString
_)) = (Int, StrictSeq (MultiSig ShelleyEra))
-> Maybe (Int, StrictSeq (MultiSig ShelleyEra))
forall a. a -> Maybe a
Just (Int
n, StrictSeq (MultiSig ShelleyEra)
ms)
getRequireMOf NativeScript ShelleyEra
_ = Maybe (Int, StrictSeq (NativeScript ShelleyEra))
Maybe (Int, StrictSeq (MultiSig ShelleyEra))
forall a. Maybe a
Nothing
deriving newtype instance NFData (MultiSig era)
instance EqRaw (MultiSig era) where
eqRaw :: MultiSig era -> MultiSig era -> Bool
eqRaw = MultiSig era -> MultiSig era -> Bool
forall era. MultiSig era -> MultiSig era -> Bool
eqMultiSigRaw
pattern RequireSignature :: ShelleyEraScript era => KeyHash 'Witness -> NativeScript era
pattern $mRequireSignature :: forall {r} {era}.
ShelleyEraScript era =>
NativeScript era -> (KeyHash 'Witness -> r) -> ((# #) -> r) -> r
$bRequireSignature :: forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature akh <- (getRequireSignature -> Just akh)
where
RequireSignature KeyHash 'Witness
akh = KeyHash 'Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
mkRequireSignature KeyHash 'Witness
akh
pattern RequireAllOf :: ShelleyEraScript era => StrictSeq (NativeScript era) -> NativeScript era
pattern $mRequireAllOf :: forall {r} {era}.
ShelleyEraScript era =>
NativeScript era
-> (StrictSeq (NativeScript era) -> r) -> ((# #) -> r) -> r
$bRequireAllOf :: forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf ms <- (getRequireAllOf -> Just ms)
where
RequireAllOf StrictSeq (NativeScript era)
ms = StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
mkRequireAllOf StrictSeq (NativeScript era)
ms
pattern RequireAnyOf :: ShelleyEraScript era => StrictSeq (NativeScript era) -> NativeScript era
pattern $mRequireAnyOf :: forall {r} {era}.
ShelleyEraScript era =>
NativeScript era
-> (StrictSeq (NativeScript era) -> r) -> ((# #) -> r) -> r
$bRequireAnyOf :: forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf ms <- (getRequireAnyOf -> Just ms)
where
RequireAnyOf StrictSeq (NativeScript era)
ms = StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
mkRequireAnyOf StrictSeq (NativeScript era)
ms
pattern RequireMOf ::
ShelleyEraScript era => Int -> StrictSeq (NativeScript era) -> NativeScript era
pattern $mRequireMOf :: forall {r} {era}.
ShelleyEraScript era =>
NativeScript era
-> (Int -> StrictSeq (NativeScript era) -> r) -> ((# #) -> r) -> r
$bRequireMOf :: forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf n ms <- (getRequireMOf -> Just (n, ms))
where
RequireMOf Int
n StrictSeq (NativeScript era)
ms = Int -> StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
mkRequireMOf Int
n StrictSeq (NativeScript era)
ms
instance Era era => EncCBOR (MultiSig era)
instance Era era => DecCBOR (MultiSig era) where
decCBOR :: forall s. Decoder s (MultiSig era)
decCBOR = MemoBytes (MultiSigRaw era) -> MultiSig era
forall era. MemoBytes (MultiSigRaw era) -> MultiSig era
MkMultiSig (MemoBytes (MultiSigRaw era) -> MultiSig era)
-> Decoder s (MemoBytes (MultiSigRaw era))
-> Decoder s (MultiSig era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (MultiSigRaw era)
-> Decoder s (MemoBytes (MultiSigRaw era))
forall s t. Decoder s t -> Decoder s (MemoBytes t)
decodeMemoized Decoder s (MultiSigRaw era)
forall s. Decoder s (MultiSigRaw era)
forall a s. DecCBOR a => Decoder s a
decCBOR
instance Era era => DecCBOR (MultiSigRaw era) where
decCBOR :: forall s. Decoder s (MultiSigRaw era)
decCBOR = Text
-> (Word -> Decoder s (Int, MultiSigRaw era))
-> Decoder s (MultiSigRaw era)
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"MultiSig" ((Word -> Decoder s (Int, MultiSigRaw era))
-> Decoder s (MultiSigRaw era))
-> (Word -> Decoder s (Int, MultiSigRaw era))
-> Decoder s (MultiSigRaw era)
forall a b. (a -> b) -> a -> b
$ do
\case
Word
0 -> (,) Int
2 (MultiSigRaw era -> (Int, MultiSigRaw era))
-> (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> MultiSigRaw era)
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
-> (Int, MultiSigRaw era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Witness -> MultiSigRaw era
forall era. KeyHash 'Witness -> MultiSigRaw era
MultiSigSignature (KeyHash 'Witness -> MultiSigRaw era)
-> (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'Witness)
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
-> MultiSigRaw era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'Witness
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> (Int, MultiSigRaw era))
-> Decoder s (Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> Decoder s (Int, MultiSigRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Hash ADDRHASH (VerKeyDSIGN DSIGN))
forall s. Decoder s (Hash ADDRHASH (VerKeyDSIGN DSIGN))
forall a s. DecCBOR a => Decoder s a
decCBOR
Word
1 -> (,) Int
2 (MultiSigRaw era -> (Int, MultiSigRaw era))
-> (StrictSeq (MultiSig era) -> MultiSigRaw era)
-> StrictSeq (MultiSig era)
-> (Int, MultiSigRaw era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq (MultiSig era) -> MultiSigRaw era
forall era. StrictSeq (MultiSig era) -> MultiSigRaw era
MultiSigAllOf (StrictSeq (MultiSig era) -> (Int, MultiSigRaw era))
-> Decoder s (StrictSeq (MultiSig era))
-> Decoder s (Int, MultiSigRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (StrictSeq (MultiSig era))
forall s. Decoder s (StrictSeq (MultiSig era))
forall a s. DecCBOR a => Decoder s a
decCBOR
Word
2 -> (,) Int
2 (MultiSigRaw era -> (Int, MultiSigRaw era))
-> (StrictSeq (MultiSig era) -> MultiSigRaw era)
-> StrictSeq (MultiSig era)
-> (Int, MultiSigRaw era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq (MultiSig era) -> MultiSigRaw era
forall era. StrictSeq (MultiSig era) -> MultiSigRaw era
MultiSigAnyOf (StrictSeq (MultiSig era) -> (Int, MultiSigRaw era))
-> Decoder s (StrictSeq (MultiSig era))
-> Decoder s (Int, MultiSigRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (StrictSeq (MultiSig era))
forall s. Decoder s (StrictSeq (MultiSig era))
forall a s. DecCBOR a => Decoder s a
decCBOR
Word
3 -> (,) Int
3 (MultiSigRaw era -> (Int, MultiSigRaw era))
-> Decoder s (MultiSigRaw era) -> Decoder s (Int, MultiSigRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> StrictSeq (MultiSig era) -> MultiSigRaw era
forall era. Int -> StrictSeq (MultiSig era) -> MultiSigRaw era
MultiSigMOf (Int -> StrictSeq (MultiSig era) -> MultiSigRaw era)
-> Decoder s Int
-> Decoder s (StrictSeq (MultiSig era) -> MultiSigRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int
forall s. Decoder s Int
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (StrictSeq (MultiSig era) -> MultiSigRaw era)
-> Decoder s (StrictSeq (MultiSig era))
-> Decoder s (MultiSigRaw era)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (StrictSeq (MultiSig era))
forall s. Decoder s (StrictSeq (MultiSig era))
forall a s. DecCBOR a => Decoder s a
decCBOR)
Word
k -> Word -> Decoder s (Int, MultiSigRaw era)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
k
eqMultiSigRaw :: MultiSig era -> MultiSig era -> Bool
eqMultiSigRaw :: forall era. MultiSig era -> MultiSig era -> Bool
eqMultiSigRaw MultiSig era
t1 MultiSig era
t2 = MultiSigRaw era -> MultiSigRaw era -> Bool
forall era. MultiSigRaw era -> MultiSigRaw era -> Bool
go (MultiSig era -> RawType (MultiSig era)
forall t. Memoized t => t -> RawType t
getMemoRawType MultiSig era
t1) (MultiSig era -> RawType (MultiSig era)
forall t. Memoized t => t -> RawType t
getMemoRawType MultiSig era
t2)
where
seqEq :: StrictSeq (MultiSig era) -> StrictSeq (MultiSig era) -> Bool
seqEq StrictSeq (MultiSig era)
Empty StrictSeq (MultiSig era)
Empty = Bool
True
seqEq (MultiSig era
x :<| StrictSeq (MultiSig era)
xs) (MultiSig era
y :<| StrictSeq (MultiSig era)
ys) = MultiSig era -> MultiSig era -> Bool
forall era. MultiSig era -> MultiSig era -> Bool
eqMultiSigRaw MultiSig era
x MultiSig era
y Bool -> Bool -> Bool
&& StrictSeq (MultiSig era) -> StrictSeq (MultiSig era) -> Bool
seqEq StrictSeq (MultiSig era)
xs StrictSeq (MultiSig era)
ys
seqEq StrictSeq (MultiSig era)
_ StrictSeq (MultiSig era)
_ = Bool
False
go :: MultiSigRaw era -> MultiSigRaw era -> Bool
go (MultiSigSignature KeyHash 'Witness
kh1) (MultiSigSignature KeyHash 'Witness
kh2) = KeyHash 'Witness
kh1 KeyHash 'Witness -> KeyHash 'Witness -> Bool
forall a. Eq a => a -> a -> Bool
== KeyHash 'Witness
kh2
go (MultiSigAllOf StrictSeq (MultiSig era)
ts1) (MultiSigAllOf StrictSeq (MultiSig era)
ts2) = StrictSeq (MultiSig era) -> StrictSeq (MultiSig era) -> Bool
forall {era}.
StrictSeq (MultiSig era) -> StrictSeq (MultiSig era) -> Bool
seqEq StrictSeq (MultiSig era)
ts1 StrictSeq (MultiSig era)
ts2
go (MultiSigAnyOf StrictSeq (MultiSig era)
ts1) (MultiSigAnyOf StrictSeq (MultiSig era)
ts2) = StrictSeq (MultiSig era) -> StrictSeq (MultiSig era) -> Bool
forall {era}.
StrictSeq (MultiSig era) -> StrictSeq (MultiSig era) -> Bool
seqEq StrictSeq (MultiSig era)
ts1 StrictSeq (MultiSig era)
ts2
go (MultiSigMOf Int
n1 StrictSeq (MultiSig era)
ts1) (MultiSigMOf Int
n2 StrictSeq (MultiSig era)
ts2) = Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2 Bool -> Bool -> Bool
&& StrictSeq (MultiSig era) -> StrictSeq (MultiSig era) -> Bool
forall {era}.
StrictSeq (MultiSig era) -> StrictSeq (MultiSig era) -> Bool
seqEq StrictSeq (MultiSig era)
ts1 StrictSeq (MultiSig era)
ts2
go MultiSigRaw era
_ MultiSigRaw era
_ = Bool
False
evalMultiSig ::
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
Set.Set (KeyHash 'Witness) ->
NativeScript era ->
Bool
evalMultiSig :: forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
Set (KeyHash 'Witness) -> NativeScript era -> Bool
evalMultiSig Set (KeyHash 'Witness)
vhks = NativeScript era -> Bool
go
where
isValidMOf :: Int -> StrictSeq (NativeScript era) -> Bool
isValidMOf Int
n StrictSeq (NativeScript era)
StrictSeq.Empty = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
isValidMOf Int
n (NativeScript era
msig StrictSeq.:<| StrictSeq (NativeScript era)
msigs) =
Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| if NativeScript era -> Bool
go NativeScript era
msig then Int -> StrictSeq (NativeScript era) -> Bool
isValidMOf (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) StrictSeq (NativeScript era)
msigs else Int -> StrictSeq (NativeScript era) -> Bool
isValidMOf Int
n StrictSeq (NativeScript era)
msigs
go :: NativeScript era -> Bool
go = \case
RequireSignature KeyHash 'Witness
hk -> KeyHash 'Witness -> Set (KeyHash 'Witness) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member KeyHash 'Witness
hk Set (KeyHash 'Witness)
vhks
RequireAllOf StrictSeq (NativeScript era)
msigs -> (NativeScript era -> Bool) -> StrictSeq (NativeScript era) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all NativeScript era -> Bool
go StrictSeq (NativeScript era)
msigs
RequireAnyOf StrictSeq (NativeScript era)
msigs -> (NativeScript era -> Bool) -> StrictSeq (NativeScript era) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any NativeScript era -> Bool
go StrictSeq (NativeScript era)
msigs
RequireMOf Int
m StrictSeq (NativeScript era)
msigs -> Int -> StrictSeq (NativeScript era) -> Bool
isValidMOf Int
m StrictSeq (NativeScript era)
msigs
NativeScript era
_ -> String -> Bool
forall a. HasCallStack => String -> a
error String
"Impossible: All NativeScripts should have been accounted for"
validateMultiSig ::
(ShelleyEraScript era, EraTx era, NativeScript era ~ MultiSig era) =>
Tx era ->
NativeScript era ->
Bool
validateMultiSig :: forall era.
(ShelleyEraScript era, EraTx era,
NativeScript era ~ MultiSig era) =>
Tx era -> NativeScript era -> Bool
validateMultiSig Tx era
tx =
Set (KeyHash 'Witness) -> NativeScript era -> Bool
forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
Set (KeyHash 'Witness) -> NativeScript era -> Bool
evalMultiSig (Set (KeyHash 'Witness) -> NativeScript era -> Bool)
-> Set (KeyHash 'Witness) -> NativeScript era -> Bool
forall a b. (a -> b) -> a -> b
$ (WitVKey 'Witness -> KeyHash 'Witness)
-> Set (WitVKey 'Witness) -> Set (KeyHash 'Witness)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map WitVKey 'Witness -> KeyHash 'Witness
forall (kr :: KeyRole). WitVKey kr -> KeyHash 'Witness
witVKeyHash (Tx era
tx Tx era
-> Getting
(Set (WitVKey 'Witness)) (Tx era) (Set (WitVKey 'Witness))
-> Set (WitVKey 'Witness)
forall s a. s -> Getting a s a -> a
^. (TxWits era -> Const (Set (WitVKey 'Witness)) (TxWits era))
-> Tx era -> Const (Set (WitVKey 'Witness)) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Const (Set (WitVKey 'Witness)) (TxWits era))
-> Tx era -> Const (Set (WitVKey 'Witness)) (Tx era))
-> ((Set (WitVKey 'Witness)
-> Const (Set (WitVKey 'Witness)) (Set (WitVKey 'Witness)))
-> TxWits era -> Const (Set (WitVKey 'Witness)) (TxWits era))
-> Getting
(Set (WitVKey 'Witness)) (Tx era) (Set (WitVKey 'Witness))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness)
-> Const (Set (WitVKey 'Witness)) (Set (WitVKey 'Witness)))
-> TxWits era -> Const (Set (WitVKey 'Witness)) (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL)
{-# INLINE validateMultiSig #-}