{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.Tx
  ( -- transaction
    Tx
      ( Tx,
        body,
        wits,
        auxiliaryData
      ),
    TxBody (..),
    TxOut (..),
    TxIn (..),
    TxId (..),
    decodeWits,
    segwitTx,
    -- witness data
    WitnessSet,
    WitnessSetHKD
      ( WitnessSet,
        addrWits,
        bootWits,
        scriptWits,
        txWitsBytes
      ),
    WitVKey (..),
    ValidateScript (..), -- reexported from Cardano.Ledger.Era
    txwitsScript,
    extractKeyHashWitnessSet,
    addrWits',
    evalNativeMultiSigScript,
    hashMultiSigScript,
    validateNativeMultiSigScript,
    TransTx,
    TransWitnessSet,
    prettyWitnessSetParts,
  )
where

import Cardano.Binary
  ( FromCBOR (fromCBOR),
    ToCBOR (toCBOR),
    decodeWord,
    encodeListLen,
    encodeMapLen,
    encodeNull,
    encodePreEncoded,
    encodeWord,
    serialize,
    serializeEncoding,
    withSlice,
  )
import Cardano.Ledger.BaseTypes
  ( maybeToStrictMaybe,
  )
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Credential (Credential (..))
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Era
import Cardano.Ledger.Keys
import Cardano.Ledger.SafeHash (SafeToHash (..))
import Cardano.Ledger.Shelley.Address.Bootstrap (BootstrapWitness)
import Cardano.Ledger.Shelley.Scripts
import Cardano.Ledger.Shelley.TxBody
  ( TxBody (..),
    TxOut (..),
    WitVKey (..),
    witKeyHash,
  )
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import Control.DeepSeq (NFData)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Short as SBS
import Data.Coders
import Data.Constraint (Constraint)
import Data.Foldable (fold)
import Data.Functor.Identity (Identity)
import Data.Kind (Type)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes)
import Data.Maybe.Strict (StrictMaybe, strictMaybeToMaybe)
import Data.MemoBytes (Mem, MemoBytes (Memo), memoBytes)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import GHC.Records (HasField (..))
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))

-- ========================================================

data TxRaw era = TxRaw
  { TxRaw era -> TxBody era
_body :: !(Core.TxBody era),
    TxRaw era -> Witnesses era
_wits :: !(Core.Witnesses era),
    TxRaw era -> StrictMaybe (AuxiliaryData era)
_auxiliaryData :: !(StrictMaybe (Core.AuxiliaryData era))
  }
  deriving ((forall x. TxRaw era -> Rep (TxRaw era) x)
-> (forall x. Rep (TxRaw era) x -> TxRaw era)
-> Generic (TxRaw era)
forall x. Rep (TxRaw era) x -> TxRaw era
forall x. TxRaw era -> Rep (TxRaw era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (TxRaw era) x -> TxRaw era
forall era x. TxRaw era -> Rep (TxRaw era) x
$cto :: forall era x. Rep (TxRaw era) x -> TxRaw era
$cfrom :: forall era x. TxRaw era -> Rep (TxRaw era) x
Generic, Typeable)

instance
  ( NFData (Core.TxBody era),
    NFData (Core.Witnesses era),
    NFData (Core.AuxiliaryData era)
  ) =>
  NFData (TxRaw era)

deriving instance
  ( Era era,
    Eq (Core.AuxiliaryData era),
    Eq (Core.TxBody era),
    Eq (Core.Witnesses era)
  ) =>
  Eq (TxRaw era)

deriving instance
  ( Era era,
    Show (Core.AuxiliaryData era),
    Show (Core.TxBody era),
    Show (Core.Witnesses era)
  ) =>
  Show (TxRaw era)

instance
  ( Era era,
    NoThunks (Core.AuxiliaryData era),
    NoThunks (Core.TxBody era),
    NoThunks (Core.Witnesses era)
  ) =>
  NoThunks (TxRaw era)

newtype Tx era = TxConstr (MemoBytes (TxRaw era))
  deriving newtype (Proxy c -> Proxy index -> Tx era -> SafeHash c index
Tx era -> ByteString
(Tx era -> ByteString)
-> (forall c index.
    HasAlgorithm c =>
    Proxy c -> Proxy index -> Tx era -> SafeHash c index)
-> SafeToHash (Tx era)
forall era. Tx era -> ByteString
forall t.
(t -> ByteString)
-> (forall c index.
    HasAlgorithm c =>
    Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> Tx era -> SafeHash c index
forall era c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> Tx era -> SafeHash c index
makeHashWithExplicitProxys :: Proxy c -> Proxy index -> Tx era -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall era c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> Tx era -> SafeHash c index
originalBytes :: Tx era -> ByteString
$coriginalBytes :: forall era. Tx era -> ByteString
SafeToHash, Typeable (Tx era)
Typeable (Tx era)
-> (Tx era -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Tx era) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Tx era] -> Size)
-> ToCBOR (Tx era)
Tx era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Tx era] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy (Tx era) -> Size
forall era. Typeable era => Typeable (Tx era)
forall era. Typeable era => Tx era -> Encoding
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Tx era] -> Size
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy (Tx era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Tx era] -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Tx era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy (Tx era) -> Size
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy (Tx era) -> Size
toCBOR :: Tx era -> Encoding
$ctoCBOR :: forall era. Typeable era => Tx era -> Encoding
$cp1ToCBOR :: forall era. Typeable era => Typeable (Tx era)
ToCBOR)

deriving newtype instance
  ( NFData (Core.TxBody era),
    NFData (Core.Witnesses era),
    NFData (Core.AuxiliaryData era)
  ) =>
  NFData (Tx era)

deriving newtype instance Eq (Tx era)

deriving newtype instance
  ( Era era,
    Show (Core.AuxiliaryData era),
    Show (Core.TxBody era),
    Show (Core.Witnesses era)
  ) =>
  Show (Tx era)

deriving newtype instance
  ( Era era,
    NoThunks (Core.AuxiliaryData era),
    NoThunks (Core.TxBody era),
    NoThunks (Core.Witnesses era)
  ) =>
  NoThunks (Tx era)

pattern Tx ::
  ( Era era,
    ToCBOR (Core.AuxiliaryData era),
    ToCBOR (Core.TxBody era),
    ToCBOR (Core.Witnesses era)
  ) =>
  Core.TxBody era ->
  Core.Witnesses era ->
  StrictMaybe (Core.AuxiliaryData era) ->
  Tx era
pattern $bTx :: TxBody era
-> Witnesses era -> StrictMaybe (AuxiliaryData era) -> Tx era
$mTx :: forall r era.
(Era era, ToCBOR (AuxiliaryData era), ToCBOR (TxBody era),
 ToCBOR (Witnesses era)) =>
Tx era
-> (TxBody era
    -> Witnesses era -> StrictMaybe (AuxiliaryData era) -> r)
-> (Void# -> r)
-> r
Tx {Tx era
-> (Era era, ToCBOR (AuxiliaryData era), ToCBOR (TxBody era),
    ToCBOR (Witnesses era)) =>
   TxBody era
body, Tx era
-> (Era era, ToCBOR (AuxiliaryData era), ToCBOR (TxBody era),
    ToCBOR (Witnesses era)) =>
   Witnesses era
wits, Tx era
-> (Era era, ToCBOR (AuxiliaryData era), ToCBOR (TxBody era),
    ToCBOR (Witnesses era)) =>
   StrictMaybe (AuxiliaryData era)
auxiliaryData} <-
  TxConstr
    ( Memo
        TxRaw
          { _body = body,
            _wits = wits,
            _auxiliaryData = auxiliaryData
          }
        _
      )
  where
    Tx TxBody era
b Witnesses era
w StrictMaybe (AuxiliaryData era)
a = MemoBytes (TxRaw era) -> Tx era
forall era. MemoBytes (TxRaw era) -> Tx era
TxConstr (MemoBytes (TxRaw era) -> Tx era)
-> MemoBytes (TxRaw era) -> Tx era
forall a b. (a -> b) -> a -> b
$ Encode ('Closed 'Dense) (TxRaw era) -> MemoBytes (TxRaw era)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes (TxRaw era -> Encode ('Closed 'Dense) (TxRaw era)
forall era.
(ToCBOR (AuxiliaryData era), ToCBOR (TxBody era),
 ToCBOR (Witnesses era)) =>
TxRaw era -> Encode ('Closed 'Dense) (TxRaw era)
encodeTxRaw (TxRaw era -> Encode ('Closed 'Dense) (TxRaw era))
-> TxRaw era -> Encode ('Closed 'Dense) (TxRaw era)
forall a b. (a -> b) -> a -> b
$ TxBody era
-> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era
forall era.
TxBody era
-> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era
TxRaw TxBody era
b Witnesses era
w StrictMaybe (AuxiliaryData era)
a)

{-# COMPLETE Tx #-}

--------------------------------------------------------------------------------
-- Field accessors
--------------------------------------------------------------------------------

instance
  aux ~ Core.AuxiliaryData era =>
  HasField "auxiliaryData" (Tx era) (StrictMaybe aux)
  where
  getField :: Tx era -> StrictMaybe aux
getField (TxConstr (Memo (TxRaw TxBody era
_ Witnesses era
_ StrictMaybe (AuxiliaryData era)
a) ShortByteString
_)) = StrictMaybe aux
StrictMaybe (AuxiliaryData era)
a

instance (body ~ Core.TxBody era) => HasField "body" (Tx era) body where
  getField :: Tx era -> body
getField (TxConstr (Memo (TxRaw TxBody era
b Witnesses era
_ StrictMaybe (AuxiliaryData era)
_) ShortByteString
_)) = body
TxBody era
b

instance
  (wits ~ Core.Witnesses era) =>
  HasField "wits" (Tx era) wits
  where
  getField :: Tx era -> wits
getField (TxConstr (Memo (TxRaw TxBody era
_ Witnesses era
w StrictMaybe (AuxiliaryData era)
_) ShortByteString
_)) = wits
Witnesses era
w

instance HasField "txsize" (Tx era) Integer where
  getField :: Tx era -> Integer
getField (TxConstr (Memo TxRaw era
_ ShortByteString
bytes)) = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int
SBS.length ShortByteString
bytes

--------------------------------------------------------------------------------
-- Serialisation
--------------------------------------------------------------------------------

encodeTxRaw ::
  ( ToCBOR (Core.AuxiliaryData era),
    ToCBOR (Core.TxBody era),
    ToCBOR (Core.Witnesses era)
  ) =>
  TxRaw era ->
  Encode ('Closed 'Dense) (TxRaw era)
encodeTxRaw :: TxRaw era -> Encode ('Closed 'Dense) (TxRaw era)
encodeTxRaw TxRaw {TxBody era
_body :: TxBody era
_body :: forall era. TxRaw era -> TxBody era
_body, Witnesses era
_wits :: Witnesses era
_wits :: forall era. TxRaw era -> Witnesses era
_wits, StrictMaybe (AuxiliaryData era)
_auxiliaryData :: StrictMaybe (AuxiliaryData era)
_auxiliaryData :: forall era. TxRaw era -> StrictMaybe (AuxiliaryData era)
_auxiliaryData} =
  (TxBody era
 -> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era)
-> Encode
     ('Closed 'Dense)
     (TxBody era
      -> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era)
forall t. t -> Encode ('Closed 'Dense) t
Rec TxBody era
-> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era
forall era.
TxBody era
-> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era
TxRaw
    Encode
  ('Closed 'Dense)
  (TxBody era
   -> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era)
-> Encode ('Closed 'Dense) (TxBody era)
-> Encode
     ('Closed 'Dense)
     (Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxBody era -> Encode ('Closed 'Dense) (TxBody era)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To TxBody era
_body
    Encode
  ('Closed 'Dense)
  (Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era)
-> Encode ('Closed 'Dense) (Witnesses era)
-> Encode
     ('Closed 'Dense) (StrictMaybe (AuxiliaryData era) -> TxRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Witnesses era -> Encode ('Closed 'Dense) (Witnesses era)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Witnesses era
_wits
    Encode
  ('Closed 'Dense) (StrictMaybe (AuxiliaryData era) -> TxRaw era)
-> Encode ('Closed 'Dense) (StrictMaybe (AuxiliaryData era))
-> Encode ('Closed 'Dense) (TxRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe (AuxiliaryData era) -> Encoding)
-> StrictMaybe (AuxiliaryData era)
-> Encode ('Closed 'Dense) (StrictMaybe (AuxiliaryData era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((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 (Maybe (AuxiliaryData era) -> Encoding)
-> (StrictMaybe (AuxiliaryData era) -> Maybe (AuxiliaryData era))
-> StrictMaybe (AuxiliaryData era)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMaybe (AuxiliaryData era) -> Maybe (AuxiliaryData era)
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe) StrictMaybe (AuxiliaryData era)
_auxiliaryData

instance
  ( Era era,
    FromCBOR (Annotator (Core.TxBody era)),
    FromCBOR (Annotator (Core.AuxiliaryData era)),
    FromCBOR (Annotator (Core.Witnesses era))
  ) =>
  FromCBOR (Annotator (TxRaw era))
  where
  fromCBOR :: Decoder s (Annotator (TxRaw era))
fromCBOR =
    Decode ('Closed 'Dense) (Annotator (TxRaw era))
-> Decoder s (Annotator (TxRaw era))
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (Annotator (TxRaw era))
 -> Decoder s (Annotator (TxRaw era)))
-> Decode ('Closed 'Dense) (Annotator (TxRaw era))
-> Decoder s (Annotator (TxRaw era))
forall a b. (a -> b) -> a -> b
$
      Decode
  ('Closed 'Dense)
  (TxBody era
   -> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era)
-> Decode
     ('Closed 'Dense)
     (Annotator
        (TxBody era
         -> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era))
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann ((TxBody era
 -> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era)
-> Decode
     ('Closed 'Dense)
     (TxBody era
      -> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era)
forall t. t -> Decode ('Closed 'Dense) t
RecD TxBody era
-> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era
forall era.
TxBody era
-> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era
TxRaw)
        Decode
  ('Closed 'Dense)
  (Annotator
     (TxBody era
      -> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era))
-> Decode ('Closed Any) (Annotator (TxBody era))
-> Decode
     ('Closed 'Dense)
     (Annotator
        (Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) (Annotator (TxBody era))
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Annotator
     (Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era))
-> Decode ('Closed Any) (Annotator (Witnesses era))
-> Decode
     ('Closed 'Dense)
     (Annotator (StrictMaybe (AuxiliaryData era) -> TxRaw era))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) (Annotator (Witnesses era))
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Annotator (StrictMaybe (AuxiliaryData era) -> TxRaw era))
-> Decode
     ('Closed 'Dense) (Annotator (StrictMaybe (AuxiliaryData era)))
-> Decode ('Closed 'Dense) (Annotator (TxRaw era))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! (forall s. Decoder s (Annotator (StrictMaybe (AuxiliaryData era))))
-> Decode
     ('Closed 'Dense) (Annotator (StrictMaybe (AuxiliaryData era)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D
          ( StrictMaybe (Annotator (AuxiliaryData era))
-> Annotator (StrictMaybe (AuxiliaryData era))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (StrictMaybe (Annotator (AuxiliaryData era))
 -> Annotator (StrictMaybe (AuxiliaryData era)))
-> (Maybe (Annotator (AuxiliaryData era))
    -> StrictMaybe (Annotator (AuxiliaryData era)))
-> Maybe (Annotator (AuxiliaryData era))
-> Annotator (StrictMaybe (AuxiliaryData era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Annotator (AuxiliaryData era))
-> StrictMaybe (Annotator (AuxiliaryData era))
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe
              (Maybe (Annotator (AuxiliaryData era))
 -> Annotator (StrictMaybe (AuxiliaryData era)))
-> Decoder s (Maybe (Annotator (AuxiliaryData era)))
-> Decoder s (Annotator (StrictMaybe (AuxiliaryData era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
          )

deriving via
  Mem (TxRaw era)
  instance
    ( Era era,
      FromCBOR (Annotator (Core.TxBody era)),
      FromCBOR (Annotator (Core.AuxiliaryData era)),
      FromCBOR (Annotator (Core.Witnesses era))
    ) =>
    FromCBOR (Annotator (Tx era))

-- | Construct a Tx containing the explicit serialised bytes.
--
--   This function is marked as unsafe since it makes no guarantee that the
--   represented bytes are indeed the correct serialisation of the transaction.
--   Thus, when calling this function, the caller is responsible for making this
--   guarantee.
--
--   The only intended use case for this is for segregated witness.
unsafeConstructTxWithBytes ::
  Core.TxBody era ->
  Core.Witnesses era ->
  StrictMaybe (Core.AuxiliaryData era) ->
  SBS.ShortByteString ->
  Tx era
unsafeConstructTxWithBytes :: TxBody era
-> Witnesses era
-> StrictMaybe (AuxiliaryData era)
-> ShortByteString
-> Tx era
unsafeConstructTxWithBytes TxBody era
b Witnesses era
w StrictMaybe (AuxiliaryData era)
a ShortByteString
bytes = MemoBytes (TxRaw era) -> Tx era
forall era. MemoBytes (TxRaw era) -> Tx era
TxConstr (TxRaw era -> ShortByteString -> MemoBytes (TxRaw era)
forall t. t -> ShortByteString -> MemoBytes t
Memo (TxBody era
-> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era
forall era.
TxBody era
-> Witnesses era -> StrictMaybe (AuxiliaryData era) -> TxRaw era
TxRaw TxBody era
b Witnesses era
w StrictMaybe (AuxiliaryData era)
a) ShortByteString
bytes)

--------------------------------------------------------------------------------
-- Witnessing
--------------------------------------------------------------------------------

-- | 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
  }

type TransWitnessSet (c :: Type -> Constraint) era = c (Core.Script era)

deriving instance
  (Era era, TransWitnessSet Show era) =>
  Show (WitnessSetHKD Identity era)

deriving instance
  (Era era, TransWitnessSet Eq era) =>
  Eq (WitnessSetHKD Identity era)

deriving instance Era era => Generic (WitnessSetHKD Identity era)

instance
  ( Era era,
    NFData (Core.Script era),
    NFData (WitVKey 'Witness (Crypto era)),
    NFData (BootstrapWitness (Crypto era))
  ) =>
  NFData (WitnessSetHKD Identity era)

deriving via
  AllowThunksIn
    '[ "txWitsBytes"
     ]
    (WitnessSetHKD Identity era)
  instance
    (Era era, TransWitnessSet NoThunks 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' HKD Identity (Set (WitVKey 'Witness (Crypto era)))
a HKD Identity (Map (ScriptHash (Crypto era)) (Script era))
b HKD Identity (Set (BootstrapWitness (Crypto era)))
c ByteString
_) <> :: WitnessSetHKD Identity era
-> WitnessSetHKD Identity era -> WitnessSetHKD Identity era
<> WitnessSetHKD Identity era
y | Set (WitVKey 'Witness (Crypto era)) -> Bool
forall a. Set a -> Bool
Set.null Set (WitVKey 'Witness (Crypto era))
HKD Identity (Set (WitVKey 'Witness (Crypto era)))
a Bool -> Bool -> Bool
&& Map (ScriptHash (Crypto era)) (Script era) -> Bool
forall k a. Map k a -> Bool
Map.null Map (ScriptHash (Crypto era)) (Script era)
HKD Identity (Map (ScriptHash (Crypto era)) (Script era))
b Bool -> Bool -> Bool
&& Set (BootstrapWitness (Crypto era)) -> Bool
forall a. Set a -> Bool
Set.null Set (BootstrapWitness (Crypto era))
HKD Identity (Set (BootstrapWitness (Crypto era)))
c = WitnessSetHKD Identity era
y
  WitnessSetHKD Identity era
y <> (WitnessSet' HKD Identity (Set (WitVKey 'Witness (Crypto era)))
a HKD Identity (Map (ScriptHash (Crypto era)) (Script era))
b HKD Identity (Set (BootstrapWitness (Crypto era)))
c ByteString
_) | Set (WitVKey 'Witness (Crypto era)) -> Bool
forall a. Set a -> Bool
Set.null Set (WitVKey 'Witness (Crypto era))
HKD Identity (Set (WitVKey 'Witness (Crypto era)))
a Bool -> Bool -> Bool
&& Map (ScriptHash (Crypto era)) (Script era) -> Bool
forall k a. Map k a -> Bool
Map.null Map (ScriptHash (Crypto era)) (Script era)
HKD Identity (Map (ScriptHash (Crypto era)) (Script era))
b Bool -> Bool -> Bool
&& Set (BootstrapWitness (Crypto era)) -> Bool
forall a. Set a -> Bool
Set.null Set (BootstrapWitness (Crypto era))
HKD Identity (Set (BootstrapWitness (Crypto era)))
c = WitnessSetHKD Identity era
y
  (WitnessSet Set (WitVKey 'Witness (Crypto era))
a Map (ScriptHash (Crypto era)) (Script era)
b Set (BootstrapWitness (Crypto era))
c) <> (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
              [ 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 #-}

instance SafeToHash (WitnessSetHKD Identity era) where
  originalBytes :: WitnessSetHKD Identity era -> ByteString
originalBytes = 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

-- | Exports the relevant parts from a (WintessSetHKD Identity era) for
--     use by the pretty printer without all the horrible constraints.
--     Uses the non-exported WitnessSet' constructor.
prettyWitnessSetParts ::
  WitnessSetHKD Identity era ->
  ( Set (WitVKey 'Witness (Crypto era)),
    Map (ScriptHash (Crypto era)) (Core.Script era),
    Set (BootstrapWitness (Crypto era))
  )
prettyWitnessSetParts :: WitnessSetHKD Identity era
-> (Set (WitVKey 'Witness (Crypto era)),
    Map (ScriptHash (Crypto era)) (Script era),
    Set (BootstrapWitness (Crypto era)))
prettyWitnessSetParts (WitnessSet' HKD Identity (Set (WitVKey 'Witness (Crypto era)))
a HKD Identity (Map (ScriptHash (Crypto era)) (Script era))
b HKD Identity (Set (BootstrapWitness (Crypto era)))
c ByteString
_) = (Set (WitVKey 'Witness (Crypto era))
HKD Identity (Set (WitVKey 'Witness (Crypto era)))
a, Map (ScriptHash (Crypto era)) (Script era)
HKD Identity (Map (ScriptHash (Crypto era)) (Script era))
b, Set (BootstrapWitness (Crypto era))
HKD Identity (Set (BootstrapWitness (Crypto era)))
c)

type TransTx (c :: Type -> Constraint) era =
  (Era era, c (Core.Script era), c (Core.TxBody era), c (Core.AuxiliaryData era))

instance
  (c ~ Crypto era, Core.Witnesses era ~ WitnessSet era) =>
  HasField "addrWits" (Tx era) (Set (WitVKey 'Witness c))
  where
  getField :: Tx era -> Set (WitVKey 'Witness c)
getField = WitnessSet era -> Set (WitVKey 'Witness c)
forall (f :: * -> *) era.
WitnessSetHKD f era -> HKD f (Set (WitVKey 'Witness (Crypto era)))
addrWits' (WitnessSet era -> Set (WitVKey 'Witness c))
-> (Tx era -> WitnessSet era) -> Tx era -> Set (WitVKey 'Witness c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "wits" r a => r -> a
getField @"wits"

instance
  (c ~ Crypto era, Core.Witnesses era ~ WitnessSet era) =>
  HasField "addrWits" (WitnessSet era) (Set (WitVKey 'Witness c))
  where
  getField :: WitnessSet era -> Set (WitVKey 'Witness c)
getField = WitnessSet era -> Set (WitVKey 'Witness c)
forall (f :: * -> *) era.
WitnessSetHKD f era -> HKD f (Set (WitVKey 'Witness (Crypto era)))
addrWits'

instance
  ( c ~ Crypto era,
    script ~ Core.Script era,
    Core.Witnesses era ~ WitnessSet era
  ) =>
  HasField "scriptWits" (Tx era) (Map (ScriptHash c) script)
  where
  getField :: Tx era -> Map (ScriptHash c) script
getField = WitnessSet era -> Map (ScriptHash c) script
forall (f :: * -> *) era.
WitnessSetHKD f era
-> HKD f (Map (ScriptHash (Crypto era)) (Script era))
scriptWits' (WitnessSet era -> Map (ScriptHash c) script)
-> (Tx era -> WitnessSet era)
-> Tx era
-> Map (ScriptHash c) script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "wits" r a => r -> a
getField @"wits"

instance
  ( c ~ Crypto era,
    script ~ Core.Script era,
    Core.Witnesses era ~ WitnessSet era
  ) =>
  HasField "scriptWits" (WitnessSet era) (Map (ScriptHash c) script)
  where
  getField :: WitnessSet era -> Map (ScriptHash c) script
getField = WitnessSet era -> Map (ScriptHash c) script
forall (f :: * -> *) era.
WitnessSetHKD f era
-> HKD f (Map (ScriptHash (Crypto era)) (Script era))
scriptWits'

instance
  (c ~ Crypto era, Core.Witnesses era ~ WitnessSet era) =>
  HasField "bootWits" (Tx era) (Set (BootstrapWitness c))
  where
  getField :: Tx era -> Set (BootstrapWitness c)
getField = WitnessSet era -> Set (BootstrapWitness c)
forall (f :: * -> *) era.
WitnessSetHKD f era -> HKD f (Set (BootstrapWitness (Crypto era)))
bootWits' (WitnessSet era -> Set (BootstrapWitness c))
-> (Tx era -> WitnessSet era) -> Tx era -> Set (BootstrapWitness c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "wits" r a => r -> a
getField @"wits"

--------------------------------------------------------------------------------
-- Segregated witness
--------------------------------------------------------------------------------

segwitTx ::
  ( ToCBOR (Core.TxBody era),
    ToCBOR (Core.Witnesses era),
    ToCBOR (Core.AuxiliaryData era)
  ) =>
  Annotator (Core.TxBody era) ->
  Annotator (Core.Witnesses era) ->
  Maybe (Annotator (Core.AuxiliaryData era)) ->
  Annotator (Tx era)
segwitTx :: Annotator (TxBody era)
-> Annotator (Witnesses era)
-> Maybe (Annotator (AuxiliaryData era))
-> Annotator (Tx era)
segwitTx
  Annotator (TxBody era)
bodyAnn
  Annotator (Witnesses 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 :: Witnesses era
witnessSet = Annotator (Witnesses era) -> FullByteString -> Witnesses era
forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (Witnesses 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 (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
<> Witnesses era -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize Witnesses era
witnessSet
            ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
wrappedMetadataBytes
     in TxBody era
-> Witnesses era
-> StrictMaybe (AuxiliaryData era)
-> ShortByteString
-> Tx era
forall era.
TxBody era
-> Witnesses era
-> StrictMaybe (AuxiliaryData era)
-> ShortByteString
-> Tx era
unsafeConstructTxWithBytes
          TxBody era
body'
          Witnesses era
witnessSet
          (Maybe (AuxiliaryData era) -> StrictMaybe (AuxiliaryData era)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (AuxiliaryData era)
metadata)
          (ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (ByteString -> ByteString) -> ByteString -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ShortByteString) -> ByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ ByteString
fullBytes)

instance
  ( Typeable era,
    FromCBOR (Annotator (Core.Script era)),
    ValidateScript era
  ) =>
  FromCBOR (Annotator (WitnessSetHKD Identity era))
  where
  fromCBOR :: Decoder s (Annotator (WitnessSetHKD Identity era))
fromCBOR = Decoder s (Annotator (WitnessSetHKD Identity era))
forall era s.
(FromCBOR (Annotator (Script era)), ValidateScript era) =>
Decoder s (Annotator (WitnessSet era))
decodeWits

newtype IgnoreSigOrd kr crypto = IgnoreSigOrd {IgnoreSigOrd kr crypto -> WitVKey kr crypto
unIgnoreSigOrd :: WitVKey kr crypto}
  deriving (IgnoreSigOrd kr crypto -> IgnoreSigOrd kr crypto -> Bool
(IgnoreSigOrd kr crypto -> IgnoreSigOrd kr crypto -> Bool)
-> (IgnoreSigOrd kr crypto -> IgnoreSigOrd kr crypto -> Bool)
-> Eq (IgnoreSigOrd kr crypto)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (kr :: KeyRole) crypto.
Crypto crypto =>
IgnoreSigOrd kr crypto -> IgnoreSigOrd kr crypto -> Bool
/= :: IgnoreSigOrd kr crypto -> IgnoreSigOrd kr crypto -> Bool
$c/= :: forall (kr :: KeyRole) crypto.
Crypto crypto =>
IgnoreSigOrd kr crypto -> IgnoreSigOrd kr crypto -> Bool
== :: IgnoreSigOrd kr crypto -> IgnoreSigOrd kr crypto -> Bool
$c== :: forall (kr :: KeyRole) crypto.
Crypto crypto =>
IgnoreSigOrd kr crypto -> IgnoreSigOrd kr crypto -> Bool
Eq)

instance (Typeable kr, CC.Crypto crypto) => Ord (IgnoreSigOrd kr crypto) where
  compare :: IgnoreSigOrd kr crypto -> IgnoreSigOrd kr crypto -> Ordering
compare (IgnoreSigOrd WitVKey kr crypto
w1) (IgnoreSigOrd WitVKey kr crypto
w2) = KeyHash 'Witness crypto -> KeyHash 'Witness crypto -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (WitVKey kr crypto -> KeyHash 'Witness crypto
forall (kr :: KeyRole) crypto.
WitVKey kr crypto -> KeyHash 'Witness crypto
witKeyHash WitVKey kr crypto
w1) (WitVKey kr crypto -> KeyHash 'Witness crypto
forall (kr :: KeyRole) crypto.
WitVKey kr crypto -> KeyHash 'Witness crypto
witKeyHash WitVKey kr crypto
w2)

decodeWits ::
  forall era s.
  ( FromCBOR (Annotator (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' =
                          (IgnoreSigOrd 'Witness (Crypto era)
 -> WitVKey 'Witness (Crypto era))
-> Set (IgnoreSigOrd 'Witness (Crypto era))
-> Set (WitVKey 'Witness (Crypto era))
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map IgnoreSigOrd 'Witness (Crypto era) -> WitVKey 'Witness (Crypto era)
forall (kr :: KeyRole) crypto.
IgnoreSigOrd kr crypto -> WitVKey kr crypto
unIgnoreSigOrd (Set (IgnoreSigOrd 'Witness (Crypto era))
 -> Set (WitVKey 'Witness (Crypto era)))
-> ([WitVKey 'Witness (Crypto era)]
    -> Set (IgnoreSigOrd 'Witness (Crypto era)))
-> [WitVKey 'Witness (Crypto era)]
-> Set (WitVKey 'Witness (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IgnoreSigOrd 'Witness (Crypto era)]
-> Set (IgnoreSigOrd 'Witness (Crypto era))
forall a. Ord a => [a] -> Set a
Set.fromList ([IgnoreSigOrd 'Witness (Crypto era)]
 -> Set (IgnoreSigOrd 'Witness (Crypto era)))
-> ([WitVKey 'Witness (Crypto era)]
    -> [IgnoreSigOrd 'Witness (Crypto era)])
-> [WitVKey 'Witness (Crypto era)]
-> Set (IgnoreSigOrd 'Witness (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WitVKey 'Witness (Crypto era)
 -> IgnoreSigOrd 'Witness (Crypto era))
-> [WitVKey 'Witness (Crypto era)]
-> [IgnoreSigOrd 'Witness (Crypto era)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WitVKey 'Witness (Crypto era) -> IgnoreSigOrd 'Witness (Crypto era)
forall (kr :: KeyRole) crypto.
WitVKey kr crypto -> IgnoreSigOrd kr crypto
IgnoreSigOrd ([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

-- ===============================================================

-- | Hashes native multi-signature script.
hashMultiSigScript ::
  forall era.
  ( ValidateScript era,
    Core.Script era ~ MultiSig (Crypto era)
  ) =>
  MultiSig (Crypto era) ->
  ScriptHash (Crypto era)
hashMultiSigScript :: MultiSig (Crypto era) -> ScriptHash (Crypto era)
hashMultiSigScript = ValidateScript era => Script era -> ScriptHash (Crypto era)
forall era.
ValidateScript era =>
Script era -> ScriptHash (Crypto era)
hashScript @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 ::
  (TransTx ToCBOR era, Core.Witnesses era ~ WitnessSet 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
    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 (Tx era -> Set (WitVKey 'Witness (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"addrWits" Tx era
tx)

-- | Multi-signature script witness accessor function for Transactions
txwitsScript ::
  Core.Witnesses era ~ WitnessSet era =>
  Tx era ->
  Map (ScriptHash (Crypto era)) (Core.Script era)
txwitsScript :: Tx era -> Map (ScriptHash (Crypto era)) (Script era)
txwitsScript = forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "scriptWits" r a => r -> a
getField @"scriptWits"

extractKeyHashWitnessSet ::
  forall (r :: KeyRole) crypto.
  [Credential r crypto] ->
  Set (KeyHash 'Witness crypto)
extractKeyHashWitnessSet :: [Credential r crypto] -> Set (KeyHash 'Witness crypto)
extractKeyHashWitnessSet = (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
  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