{-# 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 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,
ScriptHash (..),
nativeMultiSigTag,
eqMultiSigRaw,
MultiSigRaw,
)
where
import Cardano.Crypto.Hash.Class (HashAlgorithm)
import Cardano.Ledger.BaseTypes (invalidKey)
import Cardano.Ledger.Binary (
Annotator (..),
DecCBOR (decCBOR),
EncCBOR (..),
ToCBOR,
decodeRecordSum,
)
import Cardano.Ledger.Binary.Coders (Encode (..), (!>))
import Cardano.Ledger.Core
import Cardano.Ledger.Crypto (Crypto, HASH, StandardCrypto)
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (Witness))
import Cardano.Ledger.Keys.WitVKey (witVKeyHash)
import Cardano.Ledger.MemoBytes (
EqRaw (..),
Mem,
MemoBytes,
Memoized (..),
getMemoRawType,
memoBytes,
pattern Memo,
)
import Cardano.Ledger.SafeHash (SafeToHash (..))
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
=
RequireSignature' !(KeyHash 'Witness (EraCrypto era))
|
RequireAllOf' !(StrictSeq (MultiSig era))
|
RequireAnyOf' !(StrictSeq (MultiSig era))
|
RequireMOf' !Int !(StrictSeq (MultiSig era))
deriving (MultiSigRaw era -> MultiSigRaw era -> Bool
forall era. MultiSigRaw era -> MultiSigRaw era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiSigRaw era -> MultiSigRaw era -> Bool
$c/= :: forall era. MultiSigRaw era -> MultiSigRaw era -> Bool
== :: MultiSigRaw era -> MultiSigRaw era -> Bool
$c== :: forall era. MultiSigRaw era -> MultiSigRaw era -> Bool
Eq, 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
$cto :: forall era x. Rep (MultiSigRaw era) x -> MultiSigRaw era
$cfrom :: forall era x. MultiSigRaw era -> Rep (MultiSigRaw era) x
Generic)
deriving anyclass (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
showTypeOf :: Proxy (MultiSigRaw era) -> String
$cshowTypeOf :: forall era. Typeable era => Proxy (MultiSigRaw era) -> String
wNoThunks :: Context -> MultiSigRaw era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Typeable era =>
Context -> MultiSigRaw era -> IO (Maybe ThunkInfo)
noThunks :: Context -> MultiSigRaw era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
Typeable era =>
Context -> MultiSigRaw era -> IO (Maybe ThunkInfo)
NoThunks)
class EraScript era => ShelleyEraScript era where
mkRequireSignature :: KeyHash 'Witness (EraCrypto era) -> NativeScript era
getRequireSignature :: NativeScript era -> Maybe (KeyHash 'Witness (EraCrypto era))
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))
deriving instance HashAlgorithm (HASH (EraCrypto era)) => Show (MultiSigRaw era)
instance NFData (MultiSigRaw era)
newtype MultiSig era = MultiSigConstr (MemoBytes MultiSigRaw era)
deriving (MultiSig era -> MultiSig era -> Bool
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, 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 (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
ToCBOR, Context -> MultiSig era -> IO (Maybe ThunkInfo)
Proxy (MultiSig era) -> String
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, MultiSig era -> Int
MultiSig era -> ByteString
forall era. MultiSig era -> Int
forall era. MultiSig era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> MultiSig era -> SafeHash c index
forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> MultiSig era -> SafeHash c index
makeHashWithExplicitProxys :: forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> MultiSig era -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> MultiSig era -> SafeHash c index
originalBytesSize :: MultiSig era -> Int
$coriginalBytesSize :: forall era. MultiSig era -> Int
originalBytes :: MultiSig era -> ByteString
$coriginalBytes :: forall era. MultiSig era -> ByteString
SafeToHash)
instance Memoized MultiSig where
type RawType MultiSig = MultiSigRaw
deriving instance HashAlgorithm (HASH (EraCrypto era)) => Show (MultiSig era)
nativeMultiSigTag :: BS.ByteString
nativeMultiSigTag :: ByteString
nativeMultiSigTag = ByteString
"\00"
instance Crypto c => EraScript (ShelleyEra c) where
type Script (ShelleyEra c) = MultiSig (ShelleyEra c)
type NativeScript (ShelleyEra c) = MultiSig (ShelleyEra c)
upgradeScript :: EraScript (PreviousEra (ShelleyEra c)) =>
Script (PreviousEra (ShelleyEra c)) -> Script (ShelleyEra c)
upgradeScript = forall a. HasCallStack => String -> a
error String
"It is not possible to translate a script with 'upgradeScript' from Byron era"
getNativeScript :: Script (ShelleyEra c) -> Maybe (NativeScript (ShelleyEra c))
getNativeScript = forall a. a -> Maybe a
Just
fromNativeScript :: NativeScript (ShelleyEra c) -> Script (ShelleyEra c)
fromNativeScript = forall a. a -> a
id
scriptPrefixTag :: Script (ShelleyEra c) -> ByteString
scriptPrefixTag Script (ShelleyEra c)
_script = ByteString
nativeMultiSigTag
instance Crypto c => ShelleyEraScript (ShelleyEra c) where
{-# SPECIALIZE instance ShelleyEraScript (ShelleyEra StandardCrypto) #-}
mkRequireSignature :: KeyHash 'Witness (EraCrypto (ShelleyEra c))
-> NativeScript (ShelleyEra c)
mkRequireSignature KeyHash 'Witness (EraCrypto (ShelleyEra c))
kh =
forall era. MemoBytes MultiSigRaw era -> MultiSig era
MultiSigConstr forall a b. (a -> b) -> a -> b
$ forall era (w :: Wrapped) (t :: * -> *).
Era era =>
Encode w (t era) -> MemoBytes t era
memoBytes (forall t. t -> Word -> Encode 'Open t
Sum forall era. KeyHash 'Witness (EraCrypto era) -> MultiSigRaw era
RequireSignature' Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'Witness (EraCrypto (ShelleyEra c))
kh)
getRequireSignature :: NativeScript (ShelleyEra c)
-> Maybe (KeyHash 'Witness (EraCrypto (ShelleyEra c)))
getRequireSignature (MultiSigConstr (Memo (RequireSignature' KeyHash 'Witness (EraCrypto (ShelleyEra c))
kh) ShortByteString
_)) = forall a. a -> Maybe a
Just KeyHash 'Witness (EraCrypto (ShelleyEra c))
kh
getRequireSignature NativeScript (ShelleyEra c)
_ = forall a. Maybe a
Nothing
mkRequireAllOf :: StrictSeq (NativeScript (ShelleyEra c))
-> NativeScript (ShelleyEra c)
mkRequireAllOf StrictSeq (NativeScript (ShelleyEra c))
ms =
forall era. MemoBytes MultiSigRaw era -> MultiSig era
MultiSigConstr forall a b. (a -> b) -> a -> b
$ forall era (w :: Wrapped) (t :: * -> *).
Era era =>
Encode w (t era) -> MemoBytes t era
memoBytes (forall t. t -> Word -> Encode 'Open t
Sum forall era. StrictSeq (MultiSig era) -> MultiSigRaw era
RequireAllOf' Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (NativeScript (ShelleyEra c))
ms)
getRequireAllOf :: NativeScript (ShelleyEra c)
-> Maybe (StrictSeq (NativeScript (ShelleyEra c)))
getRequireAllOf (MultiSigConstr (Memo (RequireAllOf' StrictSeq (MultiSig (ShelleyEra c))
ms) ShortByteString
_)) = forall a. a -> Maybe a
Just StrictSeq (MultiSig (ShelleyEra c))
ms
getRequireAllOf NativeScript (ShelleyEra c)
_ = forall a. Maybe a
Nothing
mkRequireAnyOf :: StrictSeq (NativeScript (ShelleyEra c))
-> NativeScript (ShelleyEra c)
mkRequireAnyOf StrictSeq (NativeScript (ShelleyEra c))
ms =
forall era. MemoBytes MultiSigRaw era -> MultiSig era
MultiSigConstr forall a b. (a -> b) -> a -> b
$ forall era (w :: Wrapped) (t :: * -> *).
Era era =>
Encode w (t era) -> MemoBytes t era
memoBytes (forall t. t -> Word -> Encode 'Open t
Sum forall era. StrictSeq (MultiSig era) -> MultiSigRaw era
RequireAnyOf' Word
2 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (NativeScript (ShelleyEra c))
ms)
getRequireAnyOf :: NativeScript (ShelleyEra c)
-> Maybe (StrictSeq (NativeScript (ShelleyEra c)))
getRequireAnyOf (MultiSigConstr (Memo (RequireAnyOf' StrictSeq (MultiSig (ShelleyEra c))
ms) ShortByteString
_)) = forall a. a -> Maybe a
Just StrictSeq (MultiSig (ShelleyEra c))
ms
getRequireAnyOf NativeScript (ShelleyEra c)
_ = forall a. Maybe a
Nothing
mkRequireMOf :: Int
-> StrictSeq (NativeScript (ShelleyEra c))
-> NativeScript (ShelleyEra c)
mkRequireMOf Int
n StrictSeq (NativeScript (ShelleyEra c))
ms =
forall era. MemoBytes MultiSigRaw era -> MultiSig era
MultiSigConstr forall a b. (a -> b) -> a -> b
$ forall era (w :: Wrapped) (t :: * -> *).
Era era =>
Encode w (t era) -> MemoBytes t era
memoBytes (forall t. t -> Word -> Encode 'Open t
Sum forall era. Int -> StrictSeq (MultiSig era) -> MultiSigRaw era
RequireMOf' Word
3 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
n forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (NativeScript (ShelleyEra c))
ms)
getRequireMOf :: NativeScript (ShelleyEra c)
-> Maybe (Int, StrictSeq (NativeScript (ShelleyEra c)))
getRequireMOf (MultiSigConstr (Memo (RequireMOf' Int
n StrictSeq (MultiSig (ShelleyEra c))
ms) ShortByteString
_)) = forall a. a -> Maybe a
Just (Int
n, StrictSeq (MultiSig (ShelleyEra c))
ms)
getRequireMOf NativeScript (ShelleyEra c)
_ = forall a. Maybe a
Nothing
deriving newtype instance NFData (MultiSig era)
deriving via
Mem MultiSigRaw era
instance
Era era => DecCBOR (Annotator (MultiSig era))
instance EqRaw (MultiSig era) where
eqRaw :: MultiSig era -> MultiSig era -> Bool
eqRaw = forall era. MultiSig era -> MultiSig era -> Bool
eqMultiSigRaw
pattern RequireSignature ::
ShelleyEraScript era => KeyHash 'Witness (EraCrypto era) -> NativeScript era
pattern $bRequireSignature :: forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
$mRequireSignature :: forall {r} {era}.
ShelleyEraScript era =>
NativeScript era
-> (KeyHash 'Witness (EraCrypto era) -> r) -> ((# #) -> r) -> r
RequireSignature akh <- (getRequireSignature -> Just akh)
where
RequireSignature KeyHash 'Witness (EraCrypto era)
akh = forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
mkRequireSignature KeyHash 'Witness (EraCrypto era)
akh
pattern RequireAllOf :: ShelleyEraScript era => StrictSeq (NativeScript era) -> NativeScript era
pattern $bRequireAllOf :: forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
$mRequireAllOf :: forall {r} {era}.
ShelleyEraScript era =>
NativeScript era
-> (StrictSeq (NativeScript era) -> r) -> ((# #) -> r) -> r
RequireAllOf ms <- (getRequireAllOf -> Just ms)
where
RequireAllOf StrictSeq (NativeScript era)
ms = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
mkRequireAllOf StrictSeq (NativeScript era)
ms
pattern RequireAnyOf :: ShelleyEraScript era => StrictSeq (NativeScript era) -> NativeScript era
pattern $bRequireAnyOf :: forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
$mRequireAnyOf :: forall {r} {era}.
ShelleyEraScript era =>
NativeScript era
-> (StrictSeq (NativeScript era) -> r) -> ((# #) -> r) -> r
RequireAnyOf ms <- (getRequireAnyOf -> Just ms)
where
RequireAnyOf StrictSeq (NativeScript era)
ms = 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 $bRequireMOf :: forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
$mRequireMOf :: forall {r} {era}.
ShelleyEraScript era =>
NativeScript era
-> (Int -> StrictSeq (NativeScript era) -> r) -> ((# #) -> r) -> r
RequireMOf n ms <- (getRequireMOf -> Just (n, ms))
where
RequireMOf Int
n StrictSeq (NativeScript era)
ms = 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 (Annotator (MultiSigRaw era)) where
decCBOR :: forall s. Decoder s (Annotator (MultiSigRaw era))
decCBOR = forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"MultiSig" forall a b. (a -> b) -> a -> b
$
\case
Word
0 -> (,) Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. KeyHash 'Witness (EraCrypto era) -> MultiSigRaw era
RequireSignature' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c)) -> KeyHash r c
KeyHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
Word
1 -> do
Annotator (StrictSeq (MultiSig era))
multiSigs <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, forall era. StrictSeq (MultiSig era) -> MultiSigRaw era
RequireAllOf' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (StrictSeq (MultiSig era))
multiSigs)
Word
2 -> do
Annotator (StrictSeq (MultiSig era))
multiSigs <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, forall era. StrictSeq (MultiSig era) -> MultiSigRaw era
RequireAnyOf' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (StrictSeq (MultiSig era))
multiSigs)
Word
3 -> do
Int
m <- forall a s. DecCBOR a => Decoder s a
decCBOR
Annotator (StrictSeq (MultiSig era))
multiSigs <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, forall era. Int -> StrictSeq (MultiSig era) -> MultiSigRaw era
RequireMOf' Int
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (StrictSeq (MultiSig era))
multiSigs)
Word
k -> forall (m :: * -> *) 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 = forall era. MultiSigRaw era -> MultiSigRaw era -> Bool
go (forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType MultiSig era
t1) (forall (t :: * -> *) era. Memoized t => t era -> RawType t era
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) = 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 (RequireSignature' KeyHash 'Witness (EraCrypto era)
kh1) (RequireSignature' KeyHash 'Witness (EraCrypto era)
kh2) = KeyHash 'Witness (EraCrypto era)
kh1 forall a. Eq a => a -> a -> Bool
== KeyHash 'Witness (EraCrypto era)
kh2
go (RequireAllOf' StrictSeq (MultiSig era)
ts1) (RequireAllOf' StrictSeq (MultiSig era)
ts2) = forall {era}.
StrictSeq (MultiSig era) -> StrictSeq (MultiSig era) -> Bool
seqEq StrictSeq (MultiSig era)
ts1 StrictSeq (MultiSig era)
ts2
go (RequireAnyOf' StrictSeq (MultiSig era)
ts1) (RequireAnyOf' StrictSeq (MultiSig era)
ts2) = forall {era}.
StrictSeq (MultiSig era) -> StrictSeq (MultiSig era) -> Bool
seqEq StrictSeq (MultiSig era)
ts1 StrictSeq (MultiSig era)
ts2
go (RequireMOf' Int
n1 StrictSeq (MultiSig era)
ts1) (RequireMOf' Int
n2 StrictSeq (MultiSig era)
ts2) = Int
n1 forall a. Eq a => a -> a -> Bool
== Int
n2 Bool -> Bool -> 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 (EraCrypto era)) ->
NativeScript era ->
Bool
evalMultiSig :: forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
Set (KeyHash 'Witness (EraCrypto era)) -> NativeScript era -> Bool
evalMultiSig Set (KeyHash 'Witness (EraCrypto era))
vhks = NativeScript era -> Bool
go
where
isValidMOf :: Int -> StrictSeq (NativeScript era) -> Bool
isValidMOf Int
n StrictSeq (NativeScript era)
StrictSeq.Empty = Int
n forall a. Ord a => a -> a -> Bool
<= Int
0
isValidMOf Int
n (NativeScript era
msig StrictSeq.:<| StrictSeq (NativeScript era)
msigs) =
Int
n 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 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 (EraCrypto era)
hk -> forall a. Ord a => a -> Set a -> Bool
Set.member KeyHash 'Witness (EraCrypto era)
hk Set (KeyHash 'Witness (EraCrypto era))
vhks
RequireAllOf StrictSeq (NativeScript era)
msigs -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all NativeScript era -> Bool
go StrictSeq (NativeScript era)
msigs
RequireAnyOf StrictSeq (NativeScript era)
msigs -> 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
_ -> 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 =
forall era.
(ShelleyEraScript era, NativeScript era ~ MultiSig era) =>
Set (KeyHash 'Witness (EraCrypto era)) -> NativeScript era -> Bool
evalMultiSig forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall (kr :: KeyRole) c. WitVKey kr c -> KeyHash 'Witness c
witVKeyHash (Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness (EraCrypto era)))
addrTxWitsL)
{-# INLINE validateMultiSig #-}