{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Shelley.Spec.Ledger.Tx
(
Tx
( Tx,
Tx',
_body,
_witnessSet,
_metadata,
txFullBytes
),
TxBody (..),
TxOut (..),
TxIn (..),
TxId (..),
decodeWits,
segwitTx,
WitnessSet,
WitnessSetHKD
( WitnessSet,
addrWits,
bootWits,
scriptWits,
txWitsBytes
),
WitVKey (..),
ValidateScript (..),
txwitsScript,
extractKeyHashWitnessSet,
addrWits',
evalNativeMultiSigScript,
hashMultiSigScript,
validateNativeMultiSigScript,
)
where
import Cardano.Binary
( Annotator (..),
Decoder,
FromCBOR (fromCBOR),
ToCBOR (toCBOR),
annotatorSlice,
decodeWord,
encodeListLen,
encodeMapLen,
encodeNull,
encodePreEncoded,
encodeWord,
serialize,
serializeEncoding,
withSlice,
)
import qualified Cardano.Ledger.Core as Core
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Era
import Cardano.Ledger.Shelley.Constraints (ShelleyBased, TxBodyConstraints)
import qualified Data.ByteString.Lazy as BSL
import Data.Foldable (fold)
import Data.Functor.Identity (Identity)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes)
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Generics (Generic)
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))
import Shelley.Spec.Ledger.Address.Bootstrap (BootstrapWitness)
import Shelley.Spec.Ledger.BaseTypes
( StrictMaybe,
invalidKey,
maybeToStrictMaybe,
strictMaybeToMaybe,
)
import Shelley.Spec.Ledger.Credential (Credential (..))
import Shelley.Spec.Ledger.Hashing (EraIndependentTx, HashAnnotated (..))
import Shelley.Spec.Ledger.Keys
import Shelley.Spec.Ledger.Scripts
import Shelley.Spec.Ledger.Serialization
( decodeList,
decodeMapContents,
decodeNullMaybe,
decodeRecordNamed,
encodeFoldable,
encodeNullMaybe,
)
import Shelley.Spec.Ledger.TxBody
( TxBody (..),
TxId (..),
TxIn (..),
TxOut (..),
WitVKey (..),
witKeyHash,
)
type family HKD f a where
HKD Identity a = a
HKD f a = f a
data WitnessSetHKD f era = WitnessSet'
{ WitnessSetHKD f era -> HKD f (Set (WitVKey 'Witness (Crypto era)))
addrWits' :: !(HKD f (Set (WitVKey 'Witness (Crypto era)))),
WitnessSetHKD f era
-> HKD f (Map (ScriptHash (Crypto era)) (Script era))
scriptWits' :: !(HKD f (Map (ScriptHash (Crypto era)) (Core.Script era))),
WitnessSetHKD f era -> HKD f (Set (BootstrapWitness (Crypto era)))
bootWits' :: !(HKD f (Set (BootstrapWitness (Crypto era)))),
WitnessSetHKD f era -> ByteString
txWitsBytes :: BSL.ByteString
}
deriving instance
(Era era, Core.ChainData (Core.Script era)) =>
Show (WitnessSetHKD Identity era)
deriving instance
(Era era, Core.ChainData (Core.Script era)) =>
Eq (WitnessSetHKD Identity era)
deriving instance Era era => Generic (WitnessSetHKD Identity era)
deriving via
AllowThunksIn
'[ "txWitsBytes"
]
(WitnessSetHKD Identity era)
instance
(Era era, Core.ChainData (Core.Script era)) =>
(NoThunks (WitnessSetHKD Identity era))
type WitnessSet = WitnessSetHKD Identity
instance Era era => ToCBOR (WitnessSetHKD Identity era) where
toCBOR :: WitnessSetHKD Identity era -> Encoding
toCBOR = ByteString -> Encoding
encodePreEncoded (ByteString -> Encoding)
-> (WitnessSetHKD Identity era -> ByteString)
-> WitnessSetHKD Identity era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (WitnessSetHKD Identity era -> ByteString)
-> WitnessSetHKD Identity era
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitnessSetHKD Identity era -> ByteString
forall (f :: * -> *) era. WitnessSetHKD f era -> ByteString
txWitsBytes
instance
(Era era, Core.AnnotatedData (Core.Script era)) =>
Semigroup (WitnessSetHKD Identity era)
where
(WitnessSet Set (WitVKey 'Witness (Crypto era))
a Map (ScriptHash (Crypto era)) (Script era)
b Set (BootstrapWitness (Crypto era))
c) <> :: WitnessSetHKD Identity era
-> WitnessSetHKD Identity era -> WitnessSetHKD Identity era
<> (WitnessSet Set (WitVKey 'Witness (Crypto era))
a' Map (ScriptHash (Crypto era)) (Script era)
b' Set (BootstrapWitness (Crypto era))
c') =
Set (WitVKey 'Witness (Crypto era))
-> Map (ScriptHash (Crypto era)) (Script era)
-> Set (BootstrapWitness (Crypto era))
-> WitnessSetHKD Identity era
forall era.
(Era era, AnnotatedData (Script era)) =>
Set (WitVKey 'Witness (Crypto era))
-> Map (ScriptHash (Crypto era)) (Script era)
-> Set (BootstrapWitness (Crypto era))
-> WitnessSet era
WitnessSet (Set (WitVKey 'Witness (Crypto era))
a Set (WitVKey 'Witness (Crypto era))
-> Set (WitVKey 'Witness (Crypto era))
-> Set (WitVKey 'Witness (Crypto era))
forall a. Semigroup a => a -> a -> a
<> Set (WitVKey 'Witness (Crypto era))
a') (Map (ScriptHash (Crypto era)) (Script era)
b Map (ScriptHash (Crypto era)) (Script era)
-> Map (ScriptHash (Crypto era)) (Script era)
-> Map (ScriptHash (Crypto era)) (Script era)
forall a. Semigroup a => a -> a -> a
<> Map (ScriptHash (Crypto era)) (Script era)
b') (Set (BootstrapWitness (Crypto era))
c Set (BootstrapWitness (Crypto era))
-> Set (BootstrapWitness (Crypto era))
-> Set (BootstrapWitness (Crypto era))
forall a. Semigroup a => a -> a -> a
<> Set (BootstrapWitness (Crypto era))
c')
instance
(Era era, Core.AnnotatedData (Core.Script era)) =>
Monoid (WitnessSetHKD Identity era)
where
mempty :: WitnessSetHKD Identity era
mempty = Set (WitVKey 'Witness (Crypto era))
-> Map (ScriptHash (Crypto era)) (Script era)
-> Set (BootstrapWitness (Crypto era))
-> WitnessSetHKD Identity era
forall era.
(Era era, AnnotatedData (Script era)) =>
Set (WitVKey 'Witness (Crypto era))
-> Map (ScriptHash (Crypto era)) (Script era)
-> Set (BootstrapWitness (Crypto era))
-> WitnessSet era
WitnessSet Set (WitVKey 'Witness (Crypto era))
forall a. Monoid a => a
mempty Map (ScriptHash (Crypto era)) (Script era)
forall a. Monoid a => a
mempty Set (BootstrapWitness (Crypto era))
forall a. Monoid a => a
mempty
pattern WitnessSet ::
(Era era, Core.AnnotatedData (Core.Script era)) =>
Set (WitVKey 'Witness (Crypto era)) ->
Map (ScriptHash (Crypto era)) (Core.Script era) ->
Set (BootstrapWitness (Crypto era)) ->
WitnessSet era
pattern $bWitnessSet :: Set (WitVKey 'Witness (Crypto era))
-> Map (ScriptHash (Crypto era)) (Script era)
-> Set (BootstrapWitness (Crypto era))
-> WitnessSet era
$mWitnessSet :: forall r era.
(Era era, AnnotatedData (Script era)) =>
WitnessSet era
-> (Set (WitVKey 'Witness (Crypto era))
-> Map (ScriptHash (Crypto era)) (Script era)
-> Set (BootstrapWitness (Crypto era))
-> r)
-> (Void# -> r)
-> r
WitnessSet {WitnessSet era
-> (Era era, AnnotatedData (Script era)) =>
Set (WitVKey 'Witness (Crypto era))
addrWits, WitnessSet era
-> (Era era, AnnotatedData (Script era)) =>
Map (ScriptHash (Crypto era)) (Script era)
scriptWits, WitnessSet era
-> (Era era, AnnotatedData (Script era)) =>
Set (BootstrapWitness (Crypto era))
bootWits} <-
WitnessSet' addrWits scriptWits bootWits _
where
WitnessSet Set (WitVKey 'Witness (Crypto era))
awits Map (ScriptHash (Crypto era)) (Script era)
scriptWitMap Set (BootstrapWitness (Crypto era))
bootstrapWits =
let encodeMapElement :: Word -> (t a -> Encoding) -> t a -> Maybe Encoding
encodeMapElement Word
ix t a -> Encoding
enc t a
x =
if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
x then Maybe Encoding
forall a. Maybe a
Nothing else Encoding -> Maybe Encoding
forall a. a -> Maybe a
Just (Word -> Encoding
encodeWord Word
ix Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> t a -> Encoding
enc t a
x)
l :: [Encoding]
l =
[Maybe Encoding] -> [Encoding]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Encoding] -> [Encoding]) -> [Maybe Encoding] -> [Encoding]
forall a b. (a -> b) -> a -> b
$
[ Word
-> (Set (WitVKey 'Witness (Crypto era)) -> Encoding)
-> Set (WitVKey 'Witness (Crypto era))
-> Maybe Encoding
forall (t :: * -> *) a.
Foldable t =>
Word -> (t a -> Encoding) -> t a -> Maybe Encoding
encodeMapElement Word
0 Set (WitVKey 'Witness (Crypto era)) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Set (WitVKey 'Witness (Crypto era))
awits,
Word
-> (Map (ScriptHash (Crypto era)) (Script era) -> Encoding)
-> Map (ScriptHash (Crypto era)) (Script era)
-> Maybe Encoding
forall (t :: * -> *) a.
Foldable t =>
Word -> (t a -> Encoding) -> t a -> Maybe Encoding
encodeMapElement Word
1 Map (ScriptHash (Crypto era)) (Script era) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Map (ScriptHash (Crypto era)) (Script era)
scriptWitMap,
Word
-> (Set (BootstrapWitness (Crypto era)) -> Encoding)
-> Set (BootstrapWitness (Crypto era))
-> Maybe Encoding
forall (t :: * -> *) a.
Foldable t =>
Word -> (t a -> Encoding) -> t a -> Maybe Encoding
encodeMapElement Word
2 Set (BootstrapWitness (Crypto era)) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Set (BootstrapWitness (Crypto era))
bootstrapWits
]
n :: Word
n = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ [Encoding] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Encoding]
l
witsBytes :: ByteString
witsBytes = Encoding -> ByteString
serializeEncoding (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Word -> Encoding
encodeMapLen Word
n Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Encoding] -> Encoding
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Encoding]
l
in WitnessSet' :: forall (f :: * -> *) era.
HKD f (Set (WitVKey 'Witness (Crypto era)))
-> HKD f (Map (ScriptHash (Crypto era)) (Script era))
-> HKD f (Set (BootstrapWitness (Crypto era)))
-> ByteString
-> WitnessSetHKD f era
WitnessSet'
{ addrWits' :: HKD Identity (Set (WitVKey 'Witness (Crypto era)))
addrWits' = Set (WitVKey 'Witness (Crypto era))
HKD Identity (Set (WitVKey 'Witness (Crypto era)))
awits,
scriptWits' :: HKD Identity (Map (ScriptHash (Crypto era)) (Script era))
scriptWits' = Map (ScriptHash (Crypto era)) (Script era)
HKD Identity (Map (ScriptHash (Crypto era)) (Script era))
scriptWitMap,
bootWits' :: HKD Identity (Set (BootstrapWitness (Crypto era)))
bootWits' = Set (BootstrapWitness (Crypto era))
HKD Identity (Set (BootstrapWitness (Crypto era)))
bootstrapWits,
txWitsBytes :: ByteString
txWitsBytes = ByteString
witsBytes
}
{-# COMPLETE WitnessSet #-}
data Tx era = Tx'
{ Tx era -> TxBody era
_body' :: !(Core.TxBody era),
Tx era -> WitnessSet era
_witnessSet' :: !(WitnessSet era),
Tx era -> StrictMaybe (AuxiliaryData era)
_metadata' :: !(StrictMaybe (Core.AuxiliaryData era)),
Tx era -> ByteString
txFullBytes :: BSL.ByteString
}
deriving ((forall x. Tx era -> Rep (Tx era) x)
-> (forall x. Rep (Tx era) x -> Tx era) -> Generic (Tx era)
forall x. Rep (Tx era) x -> Tx era
forall x. Tx era -> Rep (Tx era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (Tx era) x -> Tx era
forall era x. Tx era -> Rep (Tx era) x
$cto :: forall era x. Rep (Tx era) x -> Tx era
$cfrom :: forall era x. Tx era -> Rep (Tx era) x
Generic)
deriving via
AllowThunksIn
'[ "txFullBytes"
]
(Tx era)
instance
ShelleyBased era => NoThunks (Tx era)
deriving instance
ShelleyBased era =>
Show (Tx era)
deriving instance
ShelleyBased era =>
Eq (Tx era)
pattern Tx ::
( TxBodyConstraints era,
ToCBOR (Core.AuxiliaryData era)
) =>
Core.TxBody era ->
WitnessSet era ->
StrictMaybe (Core.AuxiliaryData era) ->
Tx era
pattern $bTx :: TxBody era
-> WitnessSet era -> StrictMaybe (AuxiliaryData era) -> Tx era
$mTx :: forall r era.
(TxBodyConstraints era, ToCBOR (AuxiliaryData era)) =>
Tx era
-> (TxBody era
-> WitnessSet era -> StrictMaybe (AuxiliaryData era) -> r)
-> (Void# -> r)
-> r
Tx {Tx era
-> (TxBodyConstraints era, ToCBOR (AuxiliaryData era)) =>
TxBody era
_body, Tx era
-> (TxBodyConstraints era, ToCBOR (AuxiliaryData era)) =>
WitnessSet era
_witnessSet, Tx era
-> (TxBodyConstraints era, ToCBOR (AuxiliaryData era)) =>
StrictMaybe (AuxiliaryData era)
_metadata} <-
Tx' _body _witnessSet _metadata _
where
Tx TxBody era
body WitnessSet era
witnessSet StrictMaybe (AuxiliaryData era)
metadata =
let bodyBytes :: ByteString
bodyBytes = TxBody era -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize TxBody era
body
wrappedMetadataBytes :: ByteString
wrappedMetadataBytes =
Encoding -> ByteString
serializeEncoding (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
(AuxiliaryData era -> Encoding)
-> Maybe (AuxiliaryData era) -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe AuxiliaryData era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (StrictMaybe (AuxiliaryData era) -> Maybe (AuxiliaryData era)
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (AuxiliaryData era)
metadata)
fullBytes :: ByteString
fullBytes =
(Encoding -> ByteString
serializeEncoding (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Word -> Encoding
encodeListLen Word
3)
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bodyBytes
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> WitnessSet era -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize WitnessSet era
witnessSet
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
wrappedMetadataBytes
in Tx' :: forall era.
TxBody era
-> WitnessSet era
-> StrictMaybe (AuxiliaryData era)
-> ByteString
-> Tx era
Tx'
{ _body' :: TxBody era
_body' = TxBody era
body,
_witnessSet' :: WitnessSet era
_witnessSet' = WitnessSet era
witnessSet,
_metadata' :: StrictMaybe (AuxiliaryData era)
_metadata' = StrictMaybe (AuxiliaryData era)
metadata,
txFullBytes :: ByteString
txFullBytes = ByteString
fullBytes
}
{-# COMPLETE Tx #-}
instance ShelleyBased era => HashAnnotated (Tx era) era where
type HashIndex (Tx era) = EraIndependentTx
segwitTx ::
( TxBodyConstraints era,
ToCBOR (Core.AuxiliaryData era)
) =>
Annotator (Core.TxBody era) ->
Annotator (WitnessSet era) ->
Maybe (Annotator (Core.AuxiliaryData era)) ->
Annotator (Tx era)
segwitTx :: Annotator (TxBody era)
-> Annotator (WitnessSet era)
-> Maybe (Annotator (AuxiliaryData era))
-> Annotator (Tx era)
segwitTx
Annotator (TxBody era)
bodyAnn
Annotator (WitnessSet era)
witsAnn
Maybe (Annotator (AuxiliaryData era))
metaAnn = (FullByteString -> Tx era) -> Annotator (Tx era)
forall a. (FullByteString -> a) -> Annotator a
Annotator ((FullByteString -> Tx era) -> Annotator (Tx era))
-> (FullByteString -> Tx era) -> Annotator (Tx era)
forall a b. (a -> b) -> a -> b
$ \FullByteString
bytes ->
let body :: TxBody era
body = Annotator (TxBody era) -> FullByteString -> TxBody era
forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxBody era)
bodyAnn FullByteString
bytes
witnessSet :: WitnessSet era
witnessSet = Annotator (WitnessSet era) -> FullByteString -> WitnessSet era
forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (WitnessSet era)
witsAnn FullByteString
bytes
metadata :: Maybe (AuxiliaryData era)
metadata = (Annotator (AuxiliaryData era)
-> FullByteString -> AuxiliaryData era)
-> FullByteString
-> Annotator (AuxiliaryData era)
-> AuxiliaryData era
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (AuxiliaryData era)
-> FullByteString -> AuxiliaryData era
forall a. Annotator a -> FullByteString -> a
runAnnotator FullByteString
bytes (Annotator (AuxiliaryData era) -> AuxiliaryData era)
-> Maybe (Annotator (AuxiliaryData era))
-> Maybe (AuxiliaryData era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Annotator (AuxiliaryData era))
metaAnn
wrappedMetadataBytes :: ByteString
wrappedMetadataBytes = case Maybe (AuxiliaryData era)
metadata of
Maybe (AuxiliaryData era)
Nothing -> Encoding -> ByteString
serializeEncoding Encoding
encodeNull
Just AuxiliaryData era
b -> AuxiliaryData era -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize AuxiliaryData era
b
fullBytes :: ByteString
fullBytes =
(Encoding -> ByteString
serializeEncoding (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Word -> Encoding
encodeListLen Word
3)
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> TxBody era -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize TxBody era
body
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> WitnessSet era -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize WitnessSet era
witnessSet
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
wrappedMetadataBytes
in Tx' :: forall era.
TxBody era
-> WitnessSet era
-> StrictMaybe (AuxiliaryData era)
-> ByteString
-> Tx era
Tx'
{ _body' :: TxBody era
_body' = TxBody era
body,
_witnessSet' :: WitnessSet era
_witnessSet' = WitnessSet era
witnessSet,
_metadata' :: StrictMaybe (AuxiliaryData era)
_metadata' = Maybe (AuxiliaryData era) -> StrictMaybe (AuxiliaryData era)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (AuxiliaryData era)
metadata,
txFullBytes :: ByteString
txFullBytes = ByteString
fullBytes
}
decodeWits ::
forall era s.
( TxBodyConstraints era,
Core.AnnotatedData (Core.Script era),
ValidateScript era
) =>
Decoder s (Annotator (WitnessSet era))
decodeWits :: Decoder s (Annotator (WitnessSet era))
decodeWits = do
([WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era]
mapParts, Annotator ByteString
annBytes) <-
Decoder
s [WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era]
-> Decoder
s
([WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era],
Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice (Decoder
s [WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era]
-> Decoder
s
([WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era],
Annotator ByteString))
-> Decoder
s [WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era]
-> Decoder
s
([WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era],
Annotator ByteString)
forall a b. (a -> b) -> a -> b
$
Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
-> Decoder
s [WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era]
forall s a. Decoder s a -> Decoder s [a]
decodeMapContents (Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
-> Decoder
s [WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era])
-> Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
-> Decoder
s [WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era]
forall a b. (a -> b) -> a -> b
$
Decoder s Word
forall s. Decoder s Word
decodeWord Decoder s Word
-> (Word
-> Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era))
-> Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word
0 ->
Decoder s (Annotator (WitVKey 'Witness (Crypto era)))
-> Decoder s [Annotator (WitVKey 'Witness (Crypto era))]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Annotator (WitVKey 'Witness (Crypto era)))
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s [Annotator (WitVKey 'Witness (Crypto era))]
-> ([Annotator (WitVKey 'Witness (Crypto era))]
-> Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era))
-> Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Annotator (WitVKey 'Witness (Crypto era))]
x ->
(WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
-> Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\WitnessSetHKD Annotator era
ws -> WitnessSetHKD Annotator era
ws {addrWits' :: HKD Annotator (Set (WitVKey 'Witness (Crypto era)))
addrWits' = [WitVKey 'Witness (Crypto era)]
-> Set (WitVKey 'Witness (Crypto era))
forall a. Ord a => [a] -> Set a
Set.fromList ([WitVKey 'Witness (Crypto era)]
-> Set (WitVKey 'Witness (Crypto era)))
-> Annotator [WitVKey 'Witness (Crypto era)]
-> Annotator (Set (WitVKey 'Witness (Crypto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Annotator (WitVKey 'Witness (Crypto era))]
-> Annotator [WitVKey 'Witness (Crypto era)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Annotator (WitVKey 'Witness (Crypto era))]
x})
Word
1 ->
Decoder s (Annotator (Script era))
-> Decoder s [Annotator (Script era)]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Annotator (Script era))
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s [Annotator (Script era)]
-> ([Annotator (Script era)]
-> Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era))
-> Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Annotator (Script era)]
x ->
(WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
-> Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\WitnessSetHKD Annotator era
ws -> WitnessSetHKD Annotator era
ws {scriptWits' :: HKD Annotator (Map (ScriptHash (Crypto era)) (Script era))
scriptWits' = (Script era -> ScriptHash (Crypto era))
-> [Script era] -> Map (ScriptHash (Crypto era)) (Script era)
forall k a. Ord k => (a -> k) -> [a] -> Map k a
keyBy (ValidateScript era => Script era -> ScriptHash (Crypto era)
forall era.
ValidateScript era =>
Script era -> ScriptHash (Crypto era)
hashScript @era) ([Script era] -> Map (ScriptHash (Crypto era)) (Script era))
-> Annotator [Script era]
-> Annotator (Map (ScriptHash (Crypto era)) (Script era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Annotator (Script era)] -> Annotator [Script era]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Annotator (Script era)]
x})
Word
2 ->
Decoder s (Annotator (BootstrapWitness (Crypto era)))
-> Decoder s [Annotator (BootstrapWitness (Crypto era))]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Annotator (BootstrapWitness (Crypto era)))
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s [Annotator (BootstrapWitness (Crypto era))]
-> ([Annotator (BootstrapWitness (Crypto era))]
-> Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era))
-> Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Annotator (BootstrapWitness (Crypto era))]
x ->
(WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
-> Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\WitnessSetHKD Annotator era
ws -> WitnessSetHKD Annotator era
ws {bootWits' :: HKD Annotator (Set (BootstrapWitness (Crypto era)))
bootWits' = [BootstrapWitness (Crypto era)]
-> Set (BootstrapWitness (Crypto era))
forall a. Ord a => [a] -> Set a
Set.fromList ([BootstrapWitness (Crypto era)]
-> Set (BootstrapWitness (Crypto era)))
-> Annotator [BootstrapWitness (Crypto era)]
-> Annotator (Set (BootstrapWitness (Crypto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Annotator (BootstrapWitness (Crypto era))]
-> Annotator [BootstrapWitness (Crypto era)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Annotator (BootstrapWitness (Crypto era))]
x})
Word
k -> Word
-> Decoder
s (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
forall s a. Word -> Decoder s a
invalidKey Word
k
let witSet :: WitnessSetHKD Annotator era
witSet = ((WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
-> WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
-> WitnessSetHKD Annotator era
-> [WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era]
-> WitnessSetHKD Annotator era
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era)
-> WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era
forall a b. (a -> b) -> a -> b
($) WitnessSetHKD Annotator era
emptyWitnessSetHKD [WitnessSetHKD Annotator era -> WitnessSetHKD Annotator era]
mapParts
emptyWitnessSetHKD :: WitnessSetHKD Annotator era
emptyWitnessSetHKD :: WitnessSetHKD Annotator era
emptyWitnessSetHKD =
WitnessSet' :: forall (f :: * -> *) era.
HKD f (Set (WitVKey 'Witness (Crypto era)))
-> HKD f (Map (ScriptHash (Crypto era)) (Script era))
-> HKD f (Set (BootstrapWitness (Crypto era)))
-> ByteString
-> WitnessSetHKD f era
WitnessSet'
{ addrWits' :: HKD Annotator (Set (WitVKey 'Witness (Crypto era)))
addrWits' = Set (WitVKey 'Witness (Crypto era))
-> Annotator (Set (WitVKey 'Witness (Crypto era)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set (WitVKey 'Witness (Crypto era))
forall a. Monoid a => a
mempty,
scriptWits' :: HKD Annotator (Map (ScriptHash (Crypto era)) (Script era))
scriptWits' = Map (ScriptHash (Crypto era)) (Script era)
-> Annotator (Map (ScriptHash (Crypto era)) (Script era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (ScriptHash (Crypto era)) (Script era)
forall a. Monoid a => a
mempty,
bootWits' :: HKD Annotator (Set (BootstrapWitness (Crypto era)))
bootWits' = Set (BootstrapWitness (Crypto era))
-> Annotator (Set (BootstrapWitness (Crypto era)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set (BootstrapWitness (Crypto era))
forall a. Monoid a => a
mempty,
txWitsBytes :: ByteString
txWitsBytes = ByteString
forall a. Monoid a => a
mempty
}
Annotator (WitnessSet era)
-> Decoder s (Annotator (WitnessSet era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotator (WitnessSet era)
-> Decoder s (Annotator (WitnessSet era)))
-> Annotator (WitnessSet era)
-> Decoder s (Annotator (WitnessSet era))
forall a b. (a -> b) -> a -> b
$
Set (WitVKey 'Witness (Crypto era))
-> Map (ScriptHash (Crypto era)) (Script era)
-> Set (BootstrapWitness (Crypto era))
-> ByteString
-> WitnessSet era
forall (f :: * -> *) era.
HKD f (Set (WitVKey 'Witness (Crypto era)))
-> HKD f (Map (ScriptHash (Crypto era)) (Script era))
-> HKD f (Set (BootstrapWitness (Crypto era)))
-> ByteString
-> WitnessSetHKD f era
WitnessSet'
(Set (WitVKey 'Witness (Crypto era))
-> Map (ScriptHash (Crypto era)) (Script era)
-> Set (BootstrapWitness (Crypto era))
-> ByteString
-> WitnessSet era)
-> Annotator (Set (WitVKey 'Witness (Crypto era)))
-> Annotator
(Map (ScriptHash (Crypto era)) (Script era)
-> Set (BootstrapWitness (Crypto era))
-> ByteString
-> WitnessSet era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WitnessSetHKD Annotator era
-> HKD Annotator (Set (WitVKey 'Witness (Crypto era)))
forall (f :: * -> *) era.
WitnessSetHKD f era -> HKD f (Set (WitVKey 'Witness (Crypto era)))
addrWits' WitnessSetHKD Annotator era
witSet
Annotator
(Map (ScriptHash (Crypto era)) (Script era)
-> Set (BootstrapWitness (Crypto era))
-> ByteString
-> WitnessSet era)
-> Annotator (Map (ScriptHash (Crypto era)) (Script era))
-> Annotator
(Set (BootstrapWitness (Crypto era))
-> ByteString -> WitnessSet era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WitnessSetHKD Annotator era
-> HKD Annotator (Map (ScriptHash (Crypto era)) (Script era))
forall (f :: * -> *) era.
WitnessSetHKD f era
-> HKD f (Map (ScriptHash (Crypto era)) (Script era))
scriptWits' WitnessSetHKD Annotator era
witSet
Annotator
(Set (BootstrapWitness (Crypto era))
-> ByteString -> WitnessSet era)
-> Annotator (Set (BootstrapWitness (Crypto era)))
-> Annotator (ByteString -> WitnessSet era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WitnessSetHKD Annotator era
-> HKD Annotator (Set (BootstrapWitness (Crypto era)))
forall (f :: * -> *) era.
WitnessSetHKD f era -> HKD f (Set (BootstrapWitness (Crypto era)))
bootWits' WitnessSetHKD Annotator era
witSet
Annotator (ByteString -> WitnessSet era)
-> Annotator ByteString -> Annotator (WitnessSet era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
annBytes
keyBy :: Ord k => (a -> k) -> [a] -> Map k a
keyBy :: (a -> k) -> [a] -> Map k a
keyBy a -> k
f [a]
xs = [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, a)] -> Map k a) -> [(k, a)] -> Map k a
forall a b. (a -> b) -> a -> b
$ (\a
x -> (a -> k
f a
x, a
x)) (a -> (k, a)) -> [a] -> [(k, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs
instance
ShelleyBased era =>
ToCBOR (Tx era)
where
toCBOR :: Tx era -> Encoding
toCBOR Tx era
tx = ByteString -> Encoding
encodePreEncoded (ByteString -> Encoding)
-> (ByteString -> ByteString) -> ByteString -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ Tx era -> ByteString
forall era. Tx era -> ByteString
txFullBytes Tx era
tx
instance
(ShelleyBased era, ValidateScript era) =>
FromCBOR (Annotator (Tx era))
where
fromCBOR :: Decoder s (Annotator (Tx era))
fromCBOR = Decoder s (Annotator (ByteString -> Tx era))
-> Decoder s (Annotator (Tx era))
forall s a.
Decoder s (Annotator (ByteString -> a)) -> Decoder s (Annotator a)
annotatorSlice (Decoder s (Annotator (ByteString -> Tx era))
-> Decoder s (Annotator (Tx era)))
-> Decoder s (Annotator (ByteString -> Tx era))
-> Decoder s (Annotator (Tx era))
forall a b. (a -> b) -> a -> b
$
Text
-> (Annotator (ByteString -> Tx era) -> Int)
-> Decoder s (Annotator (ByteString -> Tx era))
-> Decoder s (Annotator (ByteString -> Tx era))
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Tx" (Int -> Annotator (ByteString -> Tx era) -> Int
forall a b. a -> b -> a
const Int
3) (Decoder s (Annotator (ByteString -> Tx era))
-> Decoder s (Annotator (ByteString -> Tx era)))
-> Decoder s (Annotator (ByteString -> Tx era))
-> Decoder s (Annotator (ByteString -> Tx era))
forall a b. (a -> b) -> a -> b
$ do
Annotator (TxBody era)
body <- Decoder s (Annotator (TxBody era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
Annotator (WitnessSet era)
wits <- Decoder s (Annotator (WitnessSet era))
forall era s.
(TxBodyConstraints era, AnnotatedData (Script era),
ValidateScript era) =>
Decoder s (Annotator (WitnessSet era))
decodeWits
Maybe (Annotator (AuxiliaryData era))
meta <-
( Decoder s (Annotator (AuxiliaryData era))
-> Decoder s (Maybe (Annotator (AuxiliaryData era)))
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s (Annotator (AuxiliaryData era))
forall a s. FromCBOR a => Decoder s a
fromCBOR ::
Decoder s (Maybe (Annotator (Core.AuxiliaryData era)))
)
Annotator (ByteString -> Tx era)
-> Decoder s (Annotator (ByteString -> Tx era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotator (ByteString -> Tx era)
-> Decoder s (Annotator (ByteString -> Tx era)))
-> Annotator (ByteString -> Tx era)
-> Decoder s (Annotator (ByteString -> Tx era))
forall a b. (a -> b) -> a -> b
$
(FullByteString -> ByteString -> Tx era)
-> Annotator (ByteString -> Tx era)
forall a. (FullByteString -> a) -> Annotator a
Annotator ((FullByteString -> ByteString -> Tx era)
-> Annotator (ByteString -> Tx era))
-> (FullByteString -> ByteString -> Tx era)
-> Annotator (ByteString -> Tx era)
forall a b. (a -> b) -> a -> b
$ \FullByteString
fullBytes ByteString
bytes ->
Tx' :: forall era.
TxBody era
-> WitnessSet era
-> StrictMaybe (AuxiliaryData era)
-> ByteString
-> Tx era
Tx'
{ _body' :: TxBody era
_body' = Annotator (TxBody era) -> FullByteString -> TxBody era
forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxBody era)
body FullByteString
fullBytes,
_witnessSet' :: WitnessSet era
_witnessSet' = Annotator (WitnessSet era) -> FullByteString -> WitnessSet era
forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (WitnessSet era)
wits FullByteString
fullBytes,
_metadata' :: StrictMaybe (AuxiliaryData era)
_metadata' = Maybe (AuxiliaryData era) -> StrictMaybe (AuxiliaryData era)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe (AuxiliaryData era) -> StrictMaybe (AuxiliaryData era))
-> Maybe (AuxiliaryData era) -> StrictMaybe (AuxiliaryData era)
forall a b. (a -> b) -> a -> b
$ (Annotator (AuxiliaryData era)
-> FullByteString -> AuxiliaryData era)
-> FullByteString
-> Annotator (AuxiliaryData era)
-> AuxiliaryData era
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (AuxiliaryData era)
-> FullByteString -> AuxiliaryData era
forall a. Annotator a -> FullByteString -> a
runAnnotator FullByteString
fullBytes (Annotator (AuxiliaryData era) -> AuxiliaryData era)
-> Maybe (Annotator (AuxiliaryData era))
-> Maybe (AuxiliaryData era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Annotator (AuxiliaryData era))
meta,
txFullBytes :: ByteString
txFullBytes = ByteString
bytes
}
class
(Era era, ToCBOR (Core.Script era)) =>
ValidateScript era
where
validateScript :: Core.Script era -> Tx era -> Bool
hashScript :: Core.Script era -> ScriptHash (Crypto era)
evalNativeMultiSigScript ::
CC.Crypto crypto =>
MultiSig crypto ->
Set (KeyHash 'Witness crypto) ->
Bool
evalNativeMultiSigScript :: MultiSig crypto -> Set (KeyHash 'Witness crypto) -> Bool
evalNativeMultiSigScript (RequireSignature KeyHash 'Witness crypto
hk) Set (KeyHash 'Witness crypto)
vhks = KeyHash 'Witness crypto -> Set (KeyHash 'Witness crypto) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member KeyHash 'Witness crypto
hk Set (KeyHash 'Witness crypto)
vhks
evalNativeMultiSigScript (RequireAllOf [MultiSig crypto]
msigs) Set (KeyHash 'Witness crypto)
vhks =
(MultiSig crypto -> Bool) -> [MultiSig crypto] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (MultiSig crypto -> Set (KeyHash 'Witness crypto) -> Bool
forall crypto.
Crypto crypto =>
MultiSig crypto -> Set (KeyHash 'Witness crypto) -> Bool
`evalNativeMultiSigScript` Set (KeyHash 'Witness crypto)
vhks) [MultiSig crypto]
msigs
evalNativeMultiSigScript (RequireAnyOf [MultiSig crypto]
msigs) Set (KeyHash 'Witness crypto)
vhks =
(MultiSig crypto -> Bool) -> [MultiSig crypto] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (MultiSig crypto -> Set (KeyHash 'Witness crypto) -> Bool
forall crypto.
Crypto crypto =>
MultiSig crypto -> Set (KeyHash 'Witness crypto) -> Bool
`evalNativeMultiSigScript` Set (KeyHash 'Witness crypto)
vhks) [MultiSig crypto]
msigs
evalNativeMultiSigScript (RequireMOf Int
m [MultiSig crypto]
msigs) Set (KeyHash 'Witness crypto)
vhks =
Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [if MultiSig crypto -> Set (KeyHash 'Witness crypto) -> Bool
forall crypto.
Crypto crypto =>
MultiSig crypto -> Set (KeyHash 'Witness crypto) -> Bool
evalNativeMultiSigScript MultiSig crypto
msig Set (KeyHash 'Witness crypto)
vhks then Int
1 else Int
0 | MultiSig crypto
msig <- [MultiSig crypto]
msigs]
validateNativeMultiSigScript ::
( TxBodyConstraints era,
ToCBOR (Core.AuxiliaryData era)
) =>
MultiSig (Crypto era) ->
Tx era ->
Bool
validateNativeMultiSigScript :: MultiSig (Crypto era) -> Tx era -> Bool
validateNativeMultiSigScript MultiSig (Crypto era)
msig Tx era
tx =
MultiSig (Crypto era)
-> Set (KeyHash 'Witness (Crypto era)) -> Bool
forall crypto.
Crypto crypto =>
MultiSig crypto -> Set (KeyHash 'Witness crypto) -> Bool
evalNativeMultiSigScript MultiSig (Crypto era)
msig (KeyHash 'Witness (Crypto era) -> KeyHash 'Witness (Crypto era)
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto
(r' :: KeyRole).
HasKeyRole a =>
a r crypto -> a r' crypto
coerceKeyRole (KeyHash 'Witness (Crypto era) -> KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall b a. Ord b => (a -> b) -> Set a -> Set b
`Set.map` Set (KeyHash 'Witness (Crypto era))
vhks)
where
witsSet :: WitnessSet era
witsSet = Tx era
-> (TxBodyConstraints era, ToCBOR (AuxiliaryData era)) =>
WitnessSet era
forall era.
Tx era
-> (TxBodyConstraints era, ToCBOR (AuxiliaryData era)) =>
WitnessSet era
_witnessSet Tx era
tx
vhks :: Set (KeyHash 'Witness (Crypto era))
vhks = (WitVKey 'Witness (Crypto era) -> KeyHash 'Witness (Crypto era))
-> Set (WitVKey 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map WitVKey 'Witness (Crypto era) -> KeyHash 'Witness (Crypto era)
forall (kr :: KeyRole) crypto.
WitVKey kr crypto -> KeyHash 'Witness crypto
witKeyHash (WitnessSet era
-> HKD Identity (Set (WitVKey 'Witness (Crypto era)))
forall (f :: * -> *) era.
WitnessSetHKD f era -> HKD f (Set (WitVKey 'Witness (Crypto era)))
addrWits' WitnessSet era
witsSet)
txwitsScript ::
(TxBodyConstraints era, ToCBOR (Core.AuxiliaryData era)) =>
Tx era ->
Map (ScriptHash (Crypto era)) (Core.Script era)
txwitsScript :: Tx era -> Map (ScriptHash (Crypto era)) (Script era)
txwitsScript = WitnessSetHKD Identity era
-> Map (ScriptHash (Crypto era)) (Script era)
forall (f :: * -> *) era.
WitnessSetHKD f era
-> HKD f (Map (ScriptHash (Crypto era)) (Script era))
scriptWits' (WitnessSetHKD Identity era
-> Map (ScriptHash (Crypto era)) (Script era))
-> (Tx era -> WitnessSetHKD Identity era)
-> Tx era
-> Map (ScriptHash (Crypto era)) (Script era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> WitnessSetHKD Identity era
forall era.
Tx era
-> (TxBodyConstraints era, ToCBOR (AuxiliaryData era)) =>
WitnessSet era
_witnessSet
extractKeyHashWitnessSet ::
forall (r :: KeyRole) crypto.
[Credential r crypto] ->
Set (KeyHash 'Witness crypto)
[Credential r crypto]
credentials = (Credential r crypto
-> Set (KeyHash 'Witness crypto) -> Set (KeyHash 'Witness crypto))
-> Set (KeyHash 'Witness crypto)
-> [Credential r crypto]
-> Set (KeyHash 'Witness crypto)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Credential r crypto
-> Set (KeyHash 'Witness crypto) -> Set (KeyHash 'Witness crypto)
forall (r :: KeyRole) crypto.
Credential r crypto
-> Set (KeyHash 'Witness crypto) -> Set (KeyHash 'Witness crypto)
accum Set (KeyHash 'Witness crypto)
forall a. Set a
Set.empty [Credential r crypto]
credentials
where
accum :: Credential r crypto
-> Set (KeyHash 'Witness crypto) -> Set (KeyHash 'Witness crypto)
accum (KeyHashObj KeyHash r crypto
hk) Set (KeyHash 'Witness crypto)
ans = KeyHash 'Witness crypto
-> Set (KeyHash 'Witness crypto) -> Set (KeyHash 'Witness crypto)
forall a. Ord a => a -> Set a -> Set a
Set.insert (KeyHash r crypto -> KeyHash 'Witness crypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto.
HasKeyRole a =>
a r crypto -> a 'Witness crypto
asWitness KeyHash r crypto
hk) Set (KeyHash 'Witness crypto)
ans
accum Credential r crypto
_other Set (KeyHash 'Witness crypto)
ans = Set (KeyHash 'Witness crypto)
ans