{-# 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 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,
    getKeyCombinations,
    getKeyCombination,
    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 CryptoClass
import Cardano.Ledger.Era
import Cardano.Ledger.Shelley (ShelleyBased, ShelleyEra, TxBodyConstraints)
import qualified Cardano.Ledger.Shelley as Shelley
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.MetaData (MetaData)
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 era))
addrWits' :: !(HKD f (Set (WitVKey 'Witness era))),
    WitnessSetHKD f era -> HKD f (Map (ScriptHash era) (Script era))
scriptWits' :: !(HKD f (Map (ScriptHash era) (Core.Script era))),
    WitnessSetHKD f era -> HKD f (Set (BootstrapWitness era))
bootWits' :: !(HKD f (Set (BootstrapWitness 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 era)
a Map (ScriptHash era) (Script era)
b Set (BootstrapWitness era)
c) <> :: WitnessSetHKD Identity era
-> WitnessSetHKD Identity era -> WitnessSetHKD Identity era
<> (WitnessSet Set (WitVKey 'Witness era)
a' Map (ScriptHash era) (Script era)
b' Set (BootstrapWitness era)
c') =
    Set (WitVKey 'Witness era)
-> Map (ScriptHash era) (Script era)
-> Set (BootstrapWitness era)
-> WitnessSetHKD Identity era
forall era.
(Era era, AnnotatedData (Script era)) =>
Set (WitVKey 'Witness era)
-> Map (ScriptHash era) (Script era)
-> Set (BootstrapWitness era)
-> WitnessSet era
WitnessSet (Set (WitVKey 'Witness era)
a Set (WitVKey 'Witness era)
-> Set (WitVKey 'Witness era) -> Set (WitVKey 'Witness era)
forall a. Semigroup a => a -> a -> a
<> Set (WitVKey 'Witness era)
a') (Map (ScriptHash era) (Script era)
b Map (ScriptHash era) (Script era)
-> Map (ScriptHash era) (Script era)
-> Map (ScriptHash era) (Script era)
forall a. Semigroup a => a -> a -> a
<> Map (ScriptHash era) (Script era)
b') (Set (BootstrapWitness era)
c Set (BootstrapWitness era)
-> Set (BootstrapWitness era) -> Set (BootstrapWitness era)
forall a. Semigroup a => a -> a -> a
<> Set (BootstrapWitness era)
c')

instance
  (Era era, Core.AnnotatedData (Core.Script era)) =>
  Monoid (WitnessSetHKD Identity era)
  where
  mempty :: WitnessSetHKD Identity era
mempty = Set (WitVKey 'Witness era)
-> Map (ScriptHash era) (Script era)
-> Set (BootstrapWitness era)
-> WitnessSetHKD Identity era
forall era.
(Era era, AnnotatedData (Script era)) =>
Set (WitVKey 'Witness era)
-> Map (ScriptHash era) (Script era)
-> Set (BootstrapWitness era)
-> WitnessSet era
WitnessSet Set (WitVKey 'Witness era)
forall a. Monoid a => a
mempty Map (ScriptHash era) (Script era)
forall a. Monoid a => a
mempty Set (BootstrapWitness era)
forall a. Monoid a => a
mempty

pattern WitnessSet ::
  (Era era, Core.AnnotatedData (Core.Script era)) =>
  Set (WitVKey 'Witness era) ->
  Map (ScriptHash era) (Core.Script era) ->
  Set (BootstrapWitness era) ->
  WitnessSet era
pattern $bWitnessSet :: Set (WitVKey 'Witness era)
-> Map (ScriptHash era) (Script era)
-> Set (BootstrapWitness era)
-> WitnessSet era
$mWitnessSet :: forall r era.
(Era era, AnnotatedData (Script era)) =>
WitnessSet era
-> (Set (WitVKey 'Witness era)
    -> Map (ScriptHash era) (Script era)
    -> Set (BootstrapWitness era)
    -> r)
-> (Void# -> r)
-> r
WitnessSet {WitnessSet era
-> (Era era, AnnotatedData (Script era)) =>
   Set (WitVKey 'Witness era)
addrWits, WitnessSet era
-> (Era era, AnnotatedData (Script era)) =>
   Map (ScriptHash era) (Script era)
scriptWits, WitnessSet era
-> (Era era, AnnotatedData (Script era)) =>
   Set (BootstrapWitness era)
bootWits} <-
  WitnessSet' addrWits scriptWits bootWits _
  where
    WitnessSet Set (WitVKey 'Witness era)
awits Map (ScriptHash era) (Script era)
scriptWitMap Set (BootstrapWitness 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 era) -> Encoding)
-> Set (WitVKey 'Witness era)
-> Maybe Encoding
forall (t :: * -> *) a.
Foldable t =>
Word -> (t a -> Encoding) -> t a -> Maybe Encoding
encodeMapElement Word
0 Set (WitVKey 'Witness era) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Set (WitVKey 'Witness era)
awits,
                Word
-> (Map (ScriptHash era) (Script era) -> Encoding)
-> Map (ScriptHash era) (Script era)
-> Maybe Encoding
forall (t :: * -> *) a.
Foldable t =>
Word -> (t a -> Encoding) -> t a -> Maybe Encoding
encodeMapElement Word
1 Map (ScriptHash era) (Script era) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Map (ScriptHash era) (Script era)
scriptWitMap,
                Word
-> (Set (BootstrapWitness era) -> Encoding)
-> Set (BootstrapWitness era)
-> Maybe Encoding
forall (t :: * -> *) a.
Foldable t =>
Word -> (t a -> Encoding) -> t a -> Maybe Encoding
encodeMapElement Word
2 Set (BootstrapWitness era) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Set (BootstrapWitness 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 era))
-> HKD f (Map (ScriptHash era) (Script era))
-> HKD f (Set (BootstrapWitness era))
-> ByteString
-> WitnessSetHKD f era
WitnessSet'
            { addrWits' :: HKD Identity (Set (WitVKey 'Witness era))
addrWits' = Set (WitVKey 'Witness era)
HKD Identity (Set (WitVKey 'Witness era))
awits,
              scriptWits' :: HKD Identity (Map (ScriptHash era) (Script era))
scriptWits' = Map (ScriptHash era) (Script era)
HKD Identity (Map (ScriptHash era) (Script era))
scriptWitMap,
              bootWits' :: HKD Identity (Set (BootstrapWitness era))
bootWits' = Set (BootstrapWitness era)
HKD Identity (Set (BootstrapWitness 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 MetaData
_metadata' :: !(StrictMaybe MetaData),
    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 ::
  (Shelley.TxBodyConstraints era) =>
  Core.TxBody era ->
  WitnessSet era ->
  StrictMaybe MetaData ->
  Tx era
pattern $bTx :: TxBody era -> WitnessSet era -> StrictMaybe MetaData -> Tx era
$mTx :: forall r era.
TxBodyConstraints era =>
Tx era
-> (TxBody era -> WitnessSet era -> StrictMaybe MetaData -> r)
-> (Void# -> r)
-> r
Tx {Tx era -> TxBodyConstraints era => TxBody era
_body, Tx era -> TxBodyConstraints era => WitnessSet era
_witnessSet, Tx era -> TxBodyConstraints era => StrictMaybe MetaData
_metadata} <-
  Tx' _body _witnessSet _metadata _
  where
    Tx TxBody era
body WitnessSet era
witnessSet StrictMaybe MetaData
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
$
              (MetaData -> Encoding) -> Maybe MetaData -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe MetaData -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (StrictMaybe MetaData -> Maybe MetaData
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe MetaData
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 MetaData -> ByteString -> Tx era
Tx'
            { _body' :: TxBody era
_body' = TxBody era
body,
              _witnessSet' :: WitnessSet era
_witnessSet' = WitnessSet era
witnessSet,
              _metadata' :: StrictMaybe MetaData
_metadata' = StrictMaybe MetaData
metadata,
              txFullBytes :: ByteString
txFullBytes = ByteString
fullBytes
            }

{-# COMPLETE Tx #-}

instance ShelleyBased era => HashAnnotated (Tx era) era where
  type HashIndex (Tx era) = EraIndependentTx

segwitTx ::
  (Shelley.TxBodyConstraints era) =>
  Annotator (Core.TxBody era) ->
  Annotator (WitnessSet era) ->
  Maybe (Annotator MetaData) ->
  Annotator (Tx era)
segwitTx :: Annotator (TxBody era)
-> Annotator (WitnessSet era)
-> Maybe (Annotator MetaData)
-> Annotator (Tx era)
segwitTx
  Annotator (TxBody era)
bodyAnn
  Annotator (WitnessSet era)
witsAnn
  Maybe (Annotator MetaData)
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 MetaData
metadata = (Annotator MetaData -> FullByteString -> MetaData)
-> FullByteString -> Annotator MetaData -> MetaData
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator MetaData -> FullByteString -> MetaData
forall a. Annotator a -> FullByteString -> a
runAnnotator FullByteString
bytes (Annotator MetaData -> MetaData)
-> Maybe (Annotator MetaData) -> Maybe MetaData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Annotator MetaData)
metaAnn
        wrappedMetadataBytes :: ByteString
wrappedMetadataBytes = case Maybe MetaData
metadata of
          Maybe MetaData
Nothing -> Encoding -> ByteString
serializeEncoding Encoding
encodeNull
          Just MetaData
b -> MetaData -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize MetaData
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 MetaData -> ByteString -> Tx era
Tx'
          { _body' :: TxBody era
_body' = TxBody era
body,
            _witnessSet' :: WitnessSet era
_witnessSet' = WitnessSet era
witnessSet,
            _metadata' :: StrictMaybe MetaData
_metadata' = Maybe MetaData -> StrictMaybe MetaData
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe MetaData
metadata,
            txFullBytes :: ByteString
txFullBytes = ByteString
fullBytes
          }

decodeWits ::
  forall era s.
  ( Shelley.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 era))
-> Decoder s [Annotator (WitVKey 'Witness era)]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Annotator (WitVKey 'Witness era))
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s [Annotator (WitVKey 'Witness era)]
-> ([Annotator (WitVKey 'Witness 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 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 era))
addrWits' = [WitVKey 'Witness era] -> Set (WitVKey 'Witness era)
forall a. Ord a => [a] -> Set a
Set.fromList ([WitVKey 'Witness era] -> Set (WitVKey 'Witness era))
-> Annotator [WitVKey 'Witness era]
-> Annotator (Set (WitVKey 'Witness era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Annotator (WitVKey 'Witness era)]
-> Annotator [WitVKey 'Witness era]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Annotator (WitVKey 'Witness 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 era) (Script era))
scriptWits' = (Script era -> ScriptHash era)
-> [Script era] -> Map (ScriptHash era) (Script era)
forall k a. Ord k => (a -> k) -> [a] -> Map k a
keyBy Script era -> ScriptHash era
forall era. ValidateScript era => Script era -> ScriptHash era
hashScript ([Script era] -> Map (ScriptHash era) (Script era))
-> Annotator [Script era]
-> Annotator (Map (ScriptHash 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 era))
-> Decoder s [Annotator (BootstrapWitness era)]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Annotator (BootstrapWitness era))
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s [Annotator (BootstrapWitness era)]
-> ([Annotator (BootstrapWitness 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 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 era))
bootWits' = [BootstrapWitness era] -> Set (BootstrapWitness era)
forall a. Ord a => [a] -> Set a
Set.fromList ([BootstrapWitness era] -> Set (BootstrapWitness era))
-> Annotator [BootstrapWitness era]
-> Annotator (Set (BootstrapWitness era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Annotator (BootstrapWitness era)]
-> Annotator [BootstrapWitness era]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Annotator (BootstrapWitness 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 era))
-> HKD f (Map (ScriptHash era) (Script era))
-> HKD f (Set (BootstrapWitness era))
-> ByteString
-> WitnessSetHKD f era
WitnessSet'
          { addrWits' :: HKD Annotator (Set (WitVKey 'Witness era))
addrWits' = Set (WitVKey 'Witness era)
-> Annotator (Set (WitVKey 'Witness era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set (WitVKey 'Witness era)
forall a. Monoid a => a
mempty,
            scriptWits' :: HKD Annotator (Map (ScriptHash era) (Script era))
scriptWits' = Map (ScriptHash era) (Script era)
-> Annotator (Map (ScriptHash era) (Script era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (ScriptHash era) (Script era)
forall a. Monoid a => a
mempty,
            bootWits' :: HKD Annotator (Set (BootstrapWitness era))
bootWits' = Set (BootstrapWitness era)
-> Annotator (Set (BootstrapWitness era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set (BootstrapWitness 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 era)
-> Map (ScriptHash era) (Script era)
-> Set (BootstrapWitness era)
-> ByteString
-> WitnessSet era
forall (f :: * -> *) era.
HKD f (Set (WitVKey 'Witness era))
-> HKD f (Map (ScriptHash era) (Script era))
-> HKD f (Set (BootstrapWitness era))
-> ByteString
-> WitnessSetHKD f era
WitnessSet'
      (Set (WitVKey 'Witness era)
 -> Map (ScriptHash era) (Script era)
 -> Set (BootstrapWitness era)
 -> ByteString
 -> WitnessSet era)
-> Annotator (Set (WitVKey 'Witness era))
-> Annotator
     (Map (ScriptHash era) (Script era)
      -> Set (BootstrapWitness era) -> ByteString -> WitnessSet era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WitnessSetHKD Annotator era
-> HKD Annotator (Set (WitVKey 'Witness era))
forall (f :: * -> *) era.
WitnessSetHKD f era -> HKD f (Set (WitVKey 'Witness era))
addrWits' WitnessSetHKD Annotator era
witSet
      Annotator
  (Map (ScriptHash era) (Script era)
   -> Set (BootstrapWitness era) -> ByteString -> WitnessSet era)
-> Annotator (Map (ScriptHash era) (Script era))
-> Annotator
     (Set (BootstrapWitness era) -> ByteString -> WitnessSet era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WitnessSetHKD Annotator era
-> HKD Annotator (Map (ScriptHash era) (Script era))
forall (f :: * -> *) era.
WitnessSetHKD f era -> HKD f (Map (ScriptHash era) (Script era))
scriptWits' WitnessSetHKD Annotator era
witSet
      Annotator
  (Set (BootstrapWitness era) -> ByteString -> WitnessSet era)
-> Annotator (Set (BootstrapWitness 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 era))
forall (f :: * -> *) era.
WitnessSetHKD f era -> HKD f (Set (BootstrapWitness 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 MetaData)
meta <- (Decoder s (Annotator MetaData)
-> Decoder s (Maybe (Annotator MetaData))
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s (Annotator MetaData)
forall a s. FromCBOR a => Decoder s a
fromCBOR :: Decoder s (Maybe (Annotator MetaData)))
      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 MetaData -> 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 MetaData
_metadata' = (Maybe MetaData -> StrictMaybe MetaData
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe MetaData -> StrictMaybe MetaData)
-> Maybe MetaData -> StrictMaybe MetaData
forall a b. (a -> b) -> a -> b
$ (Annotator MetaData -> FullByteString -> MetaData)
-> FullByteString -> Annotator MetaData -> MetaData
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator MetaData -> FullByteString -> MetaData
forall a. Annotator a -> FullByteString -> a
runAnnotator FullByteString
fullBytes (Annotator MetaData -> MetaData)
-> Maybe (Annotator MetaData) -> Maybe MetaData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Annotator MetaData)
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 era

-- | instance of MultiSignatureScript type class
instance
  (CryptoClass.Crypto c, TxBodyConstraints (ShelleyEra c)) =>
  ValidateScript (ShelleyEra c)
  where
  validateScript :: Script (ShelleyEra c) -> Tx (ShelleyEra c) -> Bool
validateScript = Script (ShelleyEra c) -> Tx (ShelleyEra c) -> Bool
forall era. TxBodyConstraints era => MultiSig era -> Tx era -> Bool
validateNativeMultiSigScript
  hashScript :: Script (ShelleyEra c) -> ScriptHash (ShelleyEra c)
hashScript = Script (ShelleyEra c) -> ScriptHash (ShelleyEra c)
forall era. Era era => MultiSig era -> ScriptHash era
hashMultiSigScript

-- | Script evaluator for native multi-signature scheme. 'vhks' is the set of
-- key hashes that signed the transaction to be validated.
evalNativeMultiSigScript ::
  Era era =>
  MultiSig era ->
  Set (KeyHash 'Witness (Crypto era)) ->
  Bool
evalNativeMultiSigScript :: MultiSig era -> Set (KeyHash 'Witness (Crypto era)) -> Bool
evalNativeMultiSigScript (RequireSignature KeyHash 'Witness (Crypto era)
hk) Set (KeyHash 'Witness (Crypto era))
vhks = KeyHash 'Witness (Crypto era)
-> Set (KeyHash 'Witness (Crypto era)) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member KeyHash 'Witness (Crypto era)
hk Set (KeyHash 'Witness (Crypto era))
vhks
evalNativeMultiSigScript (RequireAllOf [MultiSig era]
msigs) Set (KeyHash 'Witness (Crypto era))
vhks =
  (MultiSig era -> Bool) -> [MultiSig era] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (MultiSig era -> Set (KeyHash 'Witness (Crypto era)) -> Bool
forall era.
Era era =>
MultiSig era -> Set (KeyHash 'Witness (Crypto era)) -> Bool
`evalNativeMultiSigScript` Set (KeyHash 'Witness (Crypto era))
vhks) [MultiSig era]
msigs
evalNativeMultiSigScript (RequireAnyOf [MultiSig era]
msigs) Set (KeyHash 'Witness (Crypto era))
vhks =
  (MultiSig era -> Bool) -> [MultiSig era] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (MultiSig era -> Set (KeyHash 'Witness (Crypto era)) -> Bool
forall era.
Era era =>
MultiSig era -> Set (KeyHash 'Witness (Crypto era)) -> Bool
`evalNativeMultiSigScript` Set (KeyHash 'Witness (Crypto era))
vhks) [MultiSig era]
msigs
evalNativeMultiSigScript (RequireMOf Int
m [MultiSig era]
msigs) Set (KeyHash 'Witness (Crypto era))
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 era -> Set (KeyHash 'Witness (Crypto era)) -> Bool
forall era.
Era era =>
MultiSig era -> Set (KeyHash 'Witness (Crypto era)) -> Bool
evalNativeMultiSigScript MultiSig era
msig Set (KeyHash 'Witness (Crypto era))
vhks then Int
1 else Int
0 | MultiSig era
msig <- [MultiSig era]
msigs]

-- | Script validator for native multi-signature scheme.
validateNativeMultiSigScript ::
  (Shelley.TxBodyConstraints era) =>
  MultiSig era ->
  Tx era ->
  Bool
validateNativeMultiSigScript :: MultiSig era -> Tx era -> Bool
validateNativeMultiSigScript MultiSig era
msig Tx era
tx =
  MultiSig era -> Set (KeyHash 'Witness (Crypto era)) -> Bool
forall era.
Era era =>
MultiSig era -> Set (KeyHash 'Witness (Crypto era)) -> Bool
evalNativeMultiSigScript MultiSig 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 => WitnessSet era
forall era. Tx era -> TxBodyConstraints era => WitnessSet era
_witnessSet Tx era
tx
    vhks :: Set (KeyHash 'Witness (Crypto era))
vhks = (WitVKey 'Witness era -> KeyHash 'Witness (Crypto era))
-> Set (WitVKey 'Witness era)
-> Set (KeyHash 'Witness (Crypto era))
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map WitVKey 'Witness era -> KeyHash 'Witness (Crypto era)
forall (kr :: KeyRole) era.
WitVKey kr era -> KeyHash 'Witness (Crypto era)
witKeyHash (WitnessSet era -> HKD Identity (Set (WitVKey 'Witness era))
forall (f :: * -> *) era.
WitnessSetHKD f era -> HKD f (Set (WitVKey 'Witness era))
addrWits' WitnessSet era
witsSet)

-- | Multi-signature script witness accessor function for Transactions
txwitsScript ::
  (Shelley.TxBodyConstraints era) =>
  Tx era ->
  Map (ScriptHash era) (Core.Script era)
txwitsScript :: Tx era -> Map (ScriptHash era) (Script era)
txwitsScript = WitnessSetHKD Identity era -> Map (ScriptHash era) (Script era)
forall (f :: * -> *) era.
WitnessSetHKD f era -> HKD f (Map (ScriptHash era) (Script era))
scriptWits' (WitnessSetHKD Identity era -> Map (ScriptHash era) (Script era))
-> (Tx era -> WitnessSetHKD Identity era)
-> Tx era
-> Map (ScriptHash era) (Script era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> WitnessSetHKD Identity era
forall era. Tx era -> TxBodyConstraints era => WitnessSet era
_witnessSet

extractKeyHashWitnessSet ::
  forall (r :: KeyRole) era.
  [Credential r era] ->
  Set (KeyHash 'Witness (Crypto era))
extractKeyHashWitnessSet :: [Credential r era] -> Set (KeyHash 'Witness (Crypto era))
extractKeyHashWitnessSet [Credential r era]
credentials = (Credential r era
 -> Set (KeyHash 'Witness (Crypto era))
 -> Set (KeyHash 'Witness (Crypto era)))
-> Set (KeyHash 'Witness (Crypto era))
-> [Credential r era]
-> Set (KeyHash 'Witness (Crypto era))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Credential r era
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall (r :: KeyRole) era.
Credential r era
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
accum Set (KeyHash 'Witness (Crypto era))
forall a. Set a
Set.empty [Credential r era]
credentials
  where
    accum :: Credential r era
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
accum (KeyHashObj KeyHash r (Crypto era)
hk) Set (KeyHash 'Witness (Crypto era))
ans = KeyHash 'Witness (Crypto era)
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall a. Ord a => a -> Set a -> Set a
Set.insert (KeyHash r (Crypto era) -> KeyHash 'Witness (Crypto era)
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto.
HasKeyRole a =>
a r crypto -> a 'Witness crypto
asWitness KeyHash r (Crypto era)
hk) Set (KeyHash 'Witness (Crypto era))
ans
    accum Credential r era
_other Set (KeyHash 'Witness (Crypto era))
ans = Set (KeyHash 'Witness (Crypto era))
ans