{-# 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
  ( -- transaction
    Tx
      ( Tx,
        Tx',
        _body,
        _witnessSet,
        _metadata,
        txFullBytes
      ),
    TxBody (..),
    TxOut (..),
    TxIn (..),
    TxId (..),
    decodeWits,
    segwitTx,
    -- witness data
    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,
  )

-- | Higher Kinded Data
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 #-}

-- | A fully formed transaction.
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
            }

-- | Typeclass for multis-signature script data types. Allows for script
-- validation and hashing.
class
  (Era era, ToCBOR (Core.Script era)) =>
  ValidateScript era
  where
  validateScript :: Core.Script era -> Tx era -> Bool
  hashScript :: Core.Script era -> ScriptHash (Crypto era)

-- | Script evaluator for native multi-signature scheme. 'vhks' is the set of
-- key hashes that signed the transaction to be validated.
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]

-- | Script validator for native multi-signature scheme.
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)

-- | Multi-signature script witness accessor function for Transactions
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)
extractKeyHashWitnessSet :: [Credential r crypto] -> Set (KeyHash 'Witness crypto)
extractKeyHashWitnessSet [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