{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.Rpc.Server.Internal.UtxoRpc.Predicate
  ( -- * UTxO predicates
    matchesUtxoPredicate
  , matchesAnyUtxoPattern
  , matchesTxOutputPattern
  , matchesAddressPattern
  , matchesAssetPattern
  , exactAddressPredicate
  , extractAddressesFromPredicate
  , predicateLeaves
  , CompiledUtxoPredicate
  , compileUtxoPredicate
  , compiledPredicateAddresses
  , matchesCompiledPredicate

    -- * Transaction predicates
  , matchesTxPredicate
  , matchesAnyChainTxPattern
  , matchesTxPattern
  , matchesAddressPatternBytes
  , matchesAssetPatternProto

    -- * Certificate matching
  , matchesCertificatePattern
  , CertificateCredentials (..)
  , certificateCredentials
  , certificateStakeCredentials
  , certificatePoolKeyHashes
  , certificateDRepBytes

    -- * Credential serialisation
  , credentialBytes
  , serialisePaymentCredential
  , serialiseStakeCredential
  )
where

import Cardano.Api.Address
import Cardano.Api.Era
import Cardano.Api.Serialise.Raw
import Cardano.Api.Tx
import Cardano.Api.Value
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
import Cardano.Rpc.Proto.Api.UtxoRpc.Submit qualified as Submit
import Cardano.Rpc.Server.Internal.UtxoRpc.Type.BigInt (utxoRpcBigIntToInteger)

import RIO hiding (toList)

import Data.ByteString qualified as BS
import Data.Map.Strict qualified as Map
import Data.ProtoLens (defMessage)
import GHC.IsList
import Network.GRPC.Spec (Proto (..))

-- | Check if a UTxO entry matches a 'UtxoPredicate'.
-- All present fields are combined with AND logic.
matchesUtxoPredicate
  :: IsCardanoEra era
  => Proto UtxoRpc.UtxoPredicate
  -> TxOut CtxUTxO era
  -> Bool
matchesUtxoPredicate :: forall era.
IsCardanoEra era =>
Proto UtxoPredicate -> TxOut CtxUTxO era -> Bool
matchesUtxoPredicate Proto UtxoPredicate
p TxOut CtxUTxO era
txOut =
  (Proto AnyUtxoPattern -> Bool)
-> Maybe (Proto AnyUtxoPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto AnyUtxoPattern -> TxOut CtxUTxO era -> Bool
forall era.
IsCardanoEra era =>
Proto AnyUtxoPattern -> TxOut CtxUTxO era -> Bool
`matchesAnyUtxoPattern` TxOut CtxUTxO era
txOut) (Proto UtxoPredicate
p Proto UtxoPredicate
-> Getting
     (Maybe (Proto AnyUtxoPattern))
     (Proto UtxoPredicate)
     (Maybe (Proto AnyUtxoPattern))
-> Maybe (Proto AnyUtxoPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto AnyUtxoPattern))
  (Proto UtxoPredicate)
  (Maybe (Proto AnyUtxoPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'match" a) =>
LensLike' f s a
UtxoRpc.maybe'match)
    Bool -> Bool -> Bool
&& Bool -> Bool
not ((Proto UtxoPredicate -> Bool) -> [Proto UtxoPredicate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Proto UtxoPredicate -> TxOut CtxUTxO era -> Bool
forall era.
IsCardanoEra era =>
Proto UtxoPredicate -> TxOut CtxUTxO era -> Bool
`matchesUtxoPredicate` TxOut CtxUTxO era
txOut) (Proto UtxoPredicate
p Proto UtxoPredicate
-> Getting
     [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
-> [Proto UtxoPredicate]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "not" a) =>
LensLike' f s a
UtxoRpc.not))
    Bool -> Bool -> Bool
&& (Proto UtxoPredicate -> Bool) -> [Proto UtxoPredicate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto UtxoPredicate -> TxOut CtxUTxO era -> Bool
forall era.
IsCardanoEra era =>
Proto UtxoPredicate -> TxOut CtxUTxO era -> Bool
`matchesUtxoPredicate` TxOut CtxUTxO era
txOut) (Proto UtxoPredicate
p Proto UtxoPredicate
-> Getting
     [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
-> [Proto UtxoPredicate]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "allOf" a) =>
LensLike' f s a
UtxoRpc.allOf)
    Bool -> Bool -> Bool
&& ([Proto UtxoPredicate] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Proto UtxoPredicate
p Proto UtxoPredicate
-> Getting
     [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
-> [Proto UtxoPredicate]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "anyOf" a) =>
LensLike' f s a
UtxoRpc.anyOf) Bool -> Bool -> Bool
|| (Proto UtxoPredicate -> Bool) -> [Proto UtxoPredicate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Proto UtxoPredicate -> TxOut CtxUTxO era -> Bool
forall era.
IsCardanoEra era =>
Proto UtxoPredicate -> TxOut CtxUTxO era -> Bool
`matchesUtxoPredicate` TxOut CtxUTxO era
txOut) (Proto UtxoPredicate
p Proto UtxoPredicate
-> Getting
     [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
-> [Proto UtxoPredicate]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "anyOf" a) =>
LensLike' f s a
UtxoRpc.anyOf))

-- | Check if a UTxO entry matches an 'AnyUtxoPattern'.
-- Delegates to the Cardano-specific 'TxOutputPattern' if present.
matchesAnyUtxoPattern
  :: IsCardanoEra era
  => Proto UtxoRpc.AnyUtxoPattern
  -> TxOut CtxUTxO era
  -> Bool
matchesAnyUtxoPattern :: forall era.
IsCardanoEra era =>
Proto AnyUtxoPattern -> TxOut CtxUTxO era -> Bool
matchesAnyUtxoPattern Proto AnyUtxoPattern
pat TxOut CtxUTxO era
txOut =
  (Proto TxOutputPattern -> Bool)
-> Maybe (Proto TxOutputPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto TxOutputPattern -> TxOut CtxUTxO era -> Bool
forall era.
IsCardanoEra era =>
Proto TxOutputPattern -> TxOut CtxUTxO era -> Bool
`matchesTxOutputPattern` TxOut CtxUTxO era
txOut) (Proto AnyUtxoPattern
pat Proto AnyUtxoPattern
-> Getting
     (Maybe (Proto TxOutputPattern))
     (Proto AnyUtxoPattern)
     (Maybe (Proto TxOutputPattern))
-> Maybe (Proto TxOutputPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto TxOutputPattern))
  (Proto AnyUtxoPattern)
  (Maybe (Proto TxOutputPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'cardano" a) =>
LensLike' f s a
UtxoRpc.maybe'cardano)

-- | Check if a tx output matches a 'TxOutputPattern'.
-- Address and asset filters are combined with AND; absent fields are vacuously true.
matchesTxOutputPattern
  :: IsCardanoEra era
  => Proto UtxoRpc.TxOutputPattern
  -> TxOut CtxUTxO era
  -> Bool
matchesTxOutputPattern :: forall era.
IsCardanoEra era =>
Proto TxOutputPattern -> TxOut CtxUTxO era -> Bool
matchesTxOutputPattern Proto TxOutputPattern
pat (TxOut AddressInEra era
addrInEra TxOutValue era
txOutValue TxOutDatum CtxUTxO era
_datum ReferenceScript era
_script) =
  (Proto AddressPattern -> Bool)
-> Maybe (Proto AddressPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto AddressPattern -> AddressInEra era -> Bool
forall era.
IsCardanoEra era =>
Proto AddressPattern -> AddressInEra era -> Bool
`matchesAddressPattern` AddressInEra era
addrInEra) (Proto TxOutputPattern
pat Proto TxOutputPattern
-> Getting
     (Maybe (Proto AddressPattern))
     (Proto TxOutputPattern)
     (Maybe (Proto AddressPattern))
-> Maybe (Proto AddressPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto AddressPattern))
  (Proto TxOutputPattern)
  (Maybe (Proto AddressPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'address" a) =>
LensLike' f s a
UtxoRpc.maybe'address)
    Bool -> Bool -> Bool
&& (Proto AssetPattern -> Bool) -> Maybe (Proto AssetPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto AssetPattern -> Value -> Bool
`matchesAssetPattern` TxOutValue era -> Value
forall era. TxOutValue era -> Value
txOutValueToValue TxOutValue era
txOutValue) (Proto TxOutputPattern
pat Proto TxOutputPattern
-> Getting
     (Maybe (Proto AssetPattern))
     (Proto TxOutputPattern)
     (Maybe (Proto AssetPattern))
-> Maybe (Proto AssetPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto AssetPattern))
  (Proto TxOutputPattern)
  (Maybe (Proto AssetPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'asset" a) =>
LensLike' f s a
UtxoRpc.maybe'asset)

-- | proto3 optional bytes default to empty when absent; treat that as "don't care".
matchesRawField :: ByteString -> ByteString -> Bool
matchesRawField :: ByteString -> ByteString -> Bool
matchesRawField ByteString
field ByteString
actual = ByteString -> Bool
BS.null ByteString
field Bool -> Bool -> Bool
|| ByteString
field ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
actual

-- | proto3 optional bytes default to empty when absent: an absent filter
-- accepts anything, a set filter needs the component present and equal.
matchesFilter :: ByteString -> Maybe ByteString -> Bool
matchesFilter :: ByteString -> Maybe ByteString -> Bool
matchesFilter ByteString
field Maybe ByteString
mComponent =
  Bool -> (ByteString -> Bool) -> Maybe ByteString -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\ByteString
wanted -> Maybe ByteString
mComponent Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
wanted) (ByteString -> Maybe ByteString
nonEmptyField ByteString
field)

-- | 'Nothing' for a proto3 optional bytes field left unset, which decodes as empty bytes.
nonEmptyField :: ByteString -> Maybe ByteString
nonEmptyField :: ByteString -> Maybe ByteString
nonEmptyField ByteString
field = if ByteString -> Bool
BS.null ByteString
field then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
field

-- | Check if an address matches an 'AddressPattern'.
-- All present fields (exact, payment, delegation) must match (AND logic).
-- Byron addresses only support exact matching; payment\/delegation filters reject them.
matchesAddressPattern
  :: IsCardanoEra era
  => Proto UtxoRpc.AddressPattern
  -> AddressInEra era
  -> Bool
matchesAddressPattern :: forall era.
IsCardanoEra era =>
Proto AddressPattern -> AddressInEra era -> Bool
matchesAddressPattern Proto AddressPattern
pat AddressInEra era
address =
  ByteString -> Maybe ByteString -> Bool
matchesFilter (Proto AddressPattern
pat Proto AddressPattern
-> Getting ByteString (Proto AddressPattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto AddressPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "exactAddress" a) =>
LensLike' f s a
UtxoRpc.exactAddress) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ AddressInEra era -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes AddressInEra era
address)
    Bool -> Bool -> Bool
&& ByteString -> Maybe ByteString -> Bool
matchesFilter (Proto AddressPattern
pat Proto AddressPattern
-> Getting ByteString (Proto AddressPattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto AddressPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "paymentPart" a) =>
LensLike' f s a
UtxoRpc.paymentPart) Maybe ByteString
mPaymentCredentialBytes
    Bool -> Bool -> Bool
&& ByteString -> Maybe ByteString -> Bool
matchesFilter (Proto AddressPattern
pat Proto AddressPattern
-> Getting ByteString (Proto AddressPattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto AddressPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "delegationPart" a) =>
LensLike' f s a
UtxoRpc.delegationPart) Maybe ByteString
mStakeCredentialBytes
 where
  mShelleyAddress :: Maybe (Address ShelleyAddr)
  mShelleyAddress :: Maybe (Address ShelleyAddr)
mShelleyAddress = case AddressInEra era
address of
    AddressInEra ShelleyAddressInEra{} Address addrtype
shelleyAddress -> Address ShelleyAddr -> Maybe (Address ShelleyAddr)
forall a. a -> Maybe a
Just Address addrtype
Address ShelleyAddr
shelleyAddress
    AddressInEra AddressTypeInEra addrtype era
ByronAddressInAnyEra Address addrtype
_ -> Maybe (Address ShelleyAddr)
forall a. Maybe a
Nothing
  mPaymentCredentialBytes :: Maybe ByteString
mPaymentCredentialBytes =
    Maybe (Address ShelleyAddr)
mShelleyAddress Maybe (Address ShelleyAddr)
-> (Address ShelleyAddr -> ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(ShelleyAddress Network
_ Credential Payment
paymentCredential StakeReference
_) ->
      PaymentCredential -> ByteString
serialisePaymentCredential (PaymentCredential -> ByteString)
-> PaymentCredential -> ByteString
forall a b. (a -> b) -> a -> b
$ Credential Payment -> PaymentCredential
fromShelleyPaymentCredential Credential Payment
paymentCredential
  mStakeCredentialBytes :: Maybe ByteString
mStakeCredentialBytes = do
    ShelleyAddress _ _ stakeReference <- Maybe (Address ShelleyAddr)
mShelleyAddress
    StakeAddressByValue credential <- pure $ fromShelleyStakeReference stakeReference
    pure $ serialiseStakeCredential credential

-- | A 'UtxoPredicate' matching UTxOs at the exact address.
exactAddressPredicate
  :: IsCardanoEra era
  => AddressInEra era
  -> Proto UtxoRpc.UtxoPredicate
exactAddressPredicate :: forall era.
IsCardanoEra era =>
AddressInEra era -> Proto UtxoPredicate
exactAddressPredicate AddressInEra era
address =
  Proto UtxoPredicate
forall msg. Message msg => msg
defMessage
    Proto UtxoPredicate
-> (Proto UtxoPredicate -> Proto UtxoPredicate)
-> Proto UtxoPredicate
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto UtxoPredicate) (Proto AnyUtxoPattern)
forall (f :: * -> *) s a.
(Functor f, HasField s "match" a) =>
LensLike' f s a
UtxoRpc.match
      LensLike' Identity (Proto UtxoPredicate) (Proto AnyUtxoPattern)
-> Proto AnyUtxoPattern
-> Proto UtxoPredicate
-> Proto UtxoPredicate
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( Proto AnyUtxoPattern
forall msg. Message msg => msg
defMessage
             Proto AnyUtxoPattern
-> (Proto AnyUtxoPattern -> Proto AnyUtxoPattern)
-> Proto AnyUtxoPattern
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto AnyUtxoPattern) (Proto TxOutputPattern)
forall (f :: * -> *) s a.
(Functor f, HasField s "cardano" a) =>
LensLike' f s a
UtxoRpc.cardano
               LensLike' Identity (Proto AnyUtxoPattern) (Proto TxOutputPattern)
-> Proto TxOutputPattern
-> Proto AnyUtxoPattern
-> Proto AnyUtxoPattern
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Proto TxOutputPattern
forall msg. Message msg => msg
defMessage Proto TxOutputPattern
-> (Proto TxOutputPattern -> Proto TxOutputPattern)
-> Proto TxOutputPattern
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto TxOutputPattern) (Proto AddressPattern)
forall (f :: * -> *) s a.
(Functor f, HasField s "address" a) =>
LensLike' f s a
UtxoRpc.address LensLike' Identity (Proto TxOutputPattern) (Proto AddressPattern)
-> Proto AddressPattern
-> Proto TxOutputPattern
-> Proto TxOutputPattern
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Proto AddressPattern
forall msg. Message msg => msg
defMessage Proto AddressPattern
-> (Proto AddressPattern -> Proto AddressPattern)
-> Proto AddressPattern
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto AddressPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "exactAddress" a) =>
LensLike' f s a
UtxoRpc.exactAddress LensLike' Identity (Proto AddressPattern) ByteString
-> ByteString -> Proto AddressPattern -> Proto AddressPattern
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AddressInEra era -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes AddressInEra era
address))
         )

-- | Serialise a 'PaymentCredential' to raw bytes (the key or script hash).
serialisePaymentCredential :: PaymentCredential -> ByteString
serialisePaymentCredential :: PaymentCredential -> ByteString
serialisePaymentCredential (PaymentCredentialByKey Hash PaymentKey
h) = Hash PaymentKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes Hash PaymentKey
h
serialisePaymentCredential (PaymentCredentialByScript ScriptHash
h) = ScriptHash -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes ScriptHash
h

-- | Serialise a 'StakeCredential' to raw bytes (the key or script hash).
serialiseStakeCredential :: StakeCredential -> ByteString
serialiseStakeCredential :: StakeCredential -> ByteString
serialiseStakeCredential (StakeCredentialByKey Hash StakeKey
h) = Hash StakeKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes Hash StakeKey
h
serialiseStakeCredential (StakeCredentialByScript ScriptHash
h) = ScriptHash -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes ScriptHash
h

-- | Check if a 'Value' contains a native asset matching an 'AssetPattern'.
-- Ada entries are always skipped; zero-quantity entries do not match.
matchesAssetPattern
  :: Proto UtxoRpc.AssetPattern
  -> Value
  -> Bool
matchesAssetPattern :: Proto AssetPattern -> Value -> Bool
matchesAssetPattern Proto AssetPattern
pat Value
value =
  ((AssetId, Quantity) -> Bool) -> [(AssetId, Quantity)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AssetId, Quantity) -> Bool
matchesEntry (Value -> [Item Value]
forall l. IsList l => l -> [Item l]
toList Value
value)
 where
  patternPolicy :: ByteString
patternPolicy = Proto AssetPattern
pat Proto AssetPattern
-> Getting ByteString (Proto AssetPattern) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto AssetPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "policyId" a) =>
LensLike' f s a
UtxoRpc.policyId
  patternTokenName :: ByteString
patternTokenName = Proto AssetPattern
pat Proto AssetPattern
-> Getting ByteString (Proto AssetPattern) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto AssetPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "assetName" a) =>
LensLike' f s a
UtxoRpc.assetName
  matchesEntry :: (AssetId, Quantity) -> Bool
matchesEntry (AssetId PolicyId
policy AssetName
tokenName, Quantity Integer
qty) =
    (ByteString -> Bool
BS.null ByteString
patternPolicy Bool -> Bool -> Bool
|| PolicyId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes PolicyId
policy ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
patternPolicy)
      Bool -> Bool -> Bool
&& (ByteString -> Bool
BS.null ByteString
patternTokenName Bool -> Bool -> Bool
|| AssetName -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes AssetName
tokenName ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
patternTokenName)
      Bool -> Bool -> Bool
&& Integer
qty Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0
  matchesEntry (AssetId
AdaAssetId, Quantity
_) = Bool
False

-- | Compile a predicate once into a per-address lookup table: matching a UTxO
-- then costs one map lookup, not a walk over every address term. Same acceptance rule as 'extractAddressesFromPredicate'.
compileUtxoPredicate :: Proto UtxoRpc.UtxoPredicate -> Maybe CompiledUtxoPredicate
compileUtxoPredicate :: Proto UtxoPredicate -> Maybe CompiledUtxoPredicate
compileUtxoPredicate Proto UtxoPredicate
p =
  case (Proto UtxoPredicate
p Proto UtxoPredicate
-> Getting
     (Maybe (Proto AnyUtxoPattern))
     (Proto UtxoPredicate)
     (Maybe (Proto AnyUtxoPattern))
-> Maybe (Proto AnyUtxoPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto AnyUtxoPattern))
  (Proto UtxoPredicate)
  (Maybe (Proto AnyUtxoPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'match" a) =>
LensLike' f s a
UtxoRpc.maybe'match, Proto UtxoPredicate
p Proto UtxoPredicate
-> Getting
     [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
-> [Proto UtxoPredicate]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "not" a) =>
LensLike' f s a
UtxoRpc.not, Proto UtxoPredicate
p Proto UtxoPredicate
-> Getting
     [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
-> [Proto UtxoPredicate]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "allOf" a) =>
LensLike' f s a
UtxoRpc.allOf, Proto UtxoPredicate
p Proto UtxoPredicate
-> Getting
     [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
-> [Proto UtxoPredicate]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "anyOf" a) =>
LensLike' f s a
UtxoRpc.anyOf) of
    (Just Proto AnyUtxoPattern
pat, [], [], []) ->
      Map AddressAny AddressMatcher -> CompiledUtxoPredicate
CompiledUtxoPredicate (Map AddressAny AddressMatcher -> CompiledUtxoPredicate)
-> ((AddressAny, AddressMatcher) -> Map AddressAny AddressMatcher)
-> (AddressAny, AddressMatcher)
-> CompiledUtxoPredicate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddressAny -> AddressMatcher -> Map AddressAny AddressMatcher)
-> (AddressAny, AddressMatcher) -> Map AddressAny AddressMatcher
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AddressAny -> AddressMatcher -> Map AddressAny AddressMatcher
forall k a. k -> a -> Map k a
Map.singleton ((AddressAny, AddressMatcher) -> CompiledUtxoPredicate)
-> Maybe (AddressAny, AddressMatcher)
-> Maybe CompiledUtxoPredicate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proto AnyUtxoPattern -> Maybe (AddressAny, AddressMatcher)
compileLeaf Proto AnyUtxoPattern
pat
    (Maybe (Proto AnyUtxoPattern)
Nothing, [], [], anyPreds :: [Proto UtxoPredicate]
anyPreds@(Proto UtxoPredicate
_ : [Proto UtxoPredicate]
_)) ->
      Map AddressAny AddressMatcher -> CompiledUtxoPredicate
CompiledUtxoPredicate (Map AddressAny AddressMatcher -> CompiledUtxoPredicate)
-> ([CompiledUtxoPredicate] -> Map AddressAny AddressMatcher)
-> [CompiledUtxoPredicate]
-> CompiledUtxoPredicate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddressMatcher -> AddressMatcher -> AddressMatcher)
-> [Map AddressAny AddressMatcher] -> Map AddressAny AddressMatcher
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith AddressMatcher -> AddressMatcher -> AddressMatcher
forall a. Semigroup a => a -> a -> a
(<>) ([Map AddressAny AddressMatcher] -> Map AddressAny AddressMatcher)
-> ([CompiledUtxoPredicate] -> [Map AddressAny AddressMatcher])
-> [CompiledUtxoPredicate]
-> Map AddressAny AddressMatcher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompiledUtxoPredicate -> Map AddressAny AddressMatcher)
-> [CompiledUtxoPredicate] -> [Map AddressAny AddressMatcher]
forall a b. (a -> b) -> [a] -> [b]
map CompiledUtxoPredicate -> Map AddressAny AddressMatcher
unCompiled
        ([CompiledUtxoPredicate] -> CompiledUtxoPredicate)
-> Maybe [CompiledUtxoPredicate] -> Maybe CompiledUtxoPredicate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Proto UtxoPredicate -> Maybe CompiledUtxoPredicate)
-> [Proto UtxoPredicate] -> Maybe [CompiledUtxoPredicate]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Proto UtxoPredicate -> Maybe CompiledUtxoPredicate
compileUtxoPredicate [Proto UtxoPredicate]
anyPreds
    (Maybe (Proto AnyUtxoPattern), [Proto UtxoPredicate],
 [Proto UtxoPredicate], [Proto UtxoPredicate])
_ -> Maybe CompiledUtxoPredicate
forall a. Maybe a
Nothing
 where
  unCompiled :: CompiledUtxoPredicate -> Map AddressAny AddressMatcher
unCompiled (CompiledUtxoPredicate Map AddressAny AddressMatcher
matchersByAddress) = Map AddressAny AddressMatcher
matchersByAddress

-- | The exact addresses a compiled predicate names, for 'QueryUTxOByAddress'.
compiledPredicateAddresses :: CompiledUtxoPredicate -> Set AddressAny
compiledPredicateAddresses :: CompiledUtxoPredicate -> Set AddressAny
compiledPredicateAddresses (CompiledUtxoPredicate Map AddressAny AddressMatcher
matchersByAddress) = Map AddressAny AddressMatcher -> Set AddressAny
forall k a. Map k a -> Set k
Map.keysSet Map AddressAny AddressMatcher
matchersByAddress

-- | Match a UTxO entry against a predicate already compiled by 'compileUtxoPredicate'.
matchesCompiledPredicate
  :: IsCardanoEra era
  => CompiledUtxoPredicate
  -> TxOut CtxUTxO era
  -> Bool
matchesCompiledPredicate :: forall era.
IsCardanoEra era =>
CompiledUtxoPredicate -> TxOut CtxUTxO era -> Bool
matchesCompiledPredicate (CompiledUtxoPredicate Map AddressAny AddressMatcher
matchersByAddress) txOut :: TxOut CtxUTxO era
txOut@(TxOut (AddressInEra AddressTypeInEra addrtype era
_ Address addrtype
address) TxOutValue era
_ TxOutDatum CtxUTxO era
_ ReferenceScript era
_) =
  Bool -> (AddressMatcher -> Bool) -> Maybe AddressMatcher -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False AddressMatcher -> Bool
matchesAddressMatcher (Maybe AddressMatcher -> Bool) -> Maybe AddressMatcher -> Bool
forall a b. (a -> b) -> a -> b
$ AddressAny -> Map AddressAny AddressMatcher -> Maybe AddressMatcher
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Address addrtype -> AddressAny
forall addr. Address addr -> AddressAny
toAddressAny Address addrtype
address) Map AddressAny AddressMatcher
matchersByAddress
 where
  matchesAddressMatcher :: AddressMatcher -> Bool
matchesAddressMatcher AddressMatcher
AcceptAll = Bool
True
  matchesAddressMatcher (AnyOfPatterns [Proto AnyUtxoPattern]
patterns) = (Proto AnyUtxoPattern -> Bool) -> [Proto AnyUtxoPattern] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Proto AnyUtxoPattern -> TxOut CtxUTxO era -> Bool
forall era.
IsCardanoEra era =>
Proto AnyUtxoPattern -> TxOut CtxUTxO era -> Bool
`matchesAnyUtxoPattern` TxOut CtxUTxO era
txOut) [Proto AnyUtxoPattern]
patterns

-- | Try to extract a set of exact addresses from the predicate for use with 'QueryUTxOByAddress'.
-- Returns 'Just' if the optimization is applicable, 'Nothing' otherwise.
extractAddressesFromPredicate :: Proto UtxoRpc.UtxoPredicate -> Maybe (Set AddressAny)
extractAddressesFromPredicate :: Proto UtxoPredicate -> Maybe (Set AddressAny)
extractAddressesFromPredicate = (CompiledUtxoPredicate -> Set AddressAny)
-> Maybe CompiledUtxoPredicate -> Maybe (Set AddressAny)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledUtxoPredicate -> Set AddressAny
compiledPredicateAddresses (Maybe CompiledUtxoPredicate -> Maybe (Set AddressAny))
-> (Proto UtxoPredicate -> Maybe CompiledUtxoPredicate)
-> Proto UtxoPredicate
-> Maybe (Set AddressAny)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto UtxoPredicate -> Maybe CompiledUtxoPredicate
compileUtxoPredicate

-- | How a compiled predicate finishes matching a UTxO once its address is
-- found: unconditionally, or via the leaves that also carry a payment\/delegation\/asset filter.
data AddressMatcher
  = AcceptAll
  | AnyOfPatterns [Proto UtxoRpc.AnyUtxoPattern]

instance Semigroup AddressMatcher where
  AddressMatcher
AcceptAll <> :: AddressMatcher -> AddressMatcher -> AddressMatcher
<> AddressMatcher
_ = AddressMatcher
AcceptAll
  AddressMatcher
_ <> AddressMatcher
AcceptAll = AddressMatcher
AcceptAll
  AnyOfPatterns [Proto AnyUtxoPattern]
patterns1 <> AnyOfPatterns [Proto AnyUtxoPattern]
patterns2 = [Proto AnyUtxoPattern] -> AddressMatcher
AnyOfPatterns ([Proto AnyUtxoPattern]
patterns1 [Proto AnyUtxoPattern]
-> [Proto AnyUtxoPattern] -> [Proto AnyUtxoPattern]
forall a. Semigroup a => a -> a -> a
<> [Proto AnyUtxoPattern]
patterns2)

-- | A 'UtxoPredicate' compiled into a per-address lookup table; see 'compileUtxoPredicate'.
newtype CompiledUtxoPredicate = CompiledUtxoPredicate (Map AddressAny AddressMatcher)

-- | Compile one leaf: same acceptance rule as the old per-leaf extraction
-- (non-empty, deserialisable exact address). A leaf with no other filter set becomes 'AcceptAll'.
compileLeaf :: Proto UtxoRpc.AnyUtxoPattern -> Maybe (AddressAny, AddressMatcher)
compileLeaf :: Proto AnyUtxoPattern -> Maybe (AddressAny, AddressMatcher)
compileLeaf Proto AnyUtxoPattern
leaf = do
  txoPat <- Proto AnyUtxoPattern
leaf Proto AnyUtxoPattern
-> Getting
     (Maybe (Proto TxOutputPattern))
     (Proto AnyUtxoPattern)
     (Maybe (Proto TxOutputPattern))
-> Maybe (Proto TxOutputPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto TxOutputPattern))
  (Proto AnyUtxoPattern)
  (Maybe (Proto TxOutputPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'cardano" a) =>
LensLike' f s a
UtxoRpc.maybe'cardano
  addrPat <- txoPat ^. UtxoRpc.maybe'address
  let exact = Proto AddressPattern
addrPat Proto AddressPattern
-> Getting ByteString (Proto AddressPattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto AddressPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "exactAddress" a) =>
LensLike' f s a
UtxoRpc.exactAddress
  guard $ not (BS.null exact)
  addrAny <- either (const Nothing) Just $ deserialiseFromRawBytes AsAddressAny exact
  let isPureExact =
        ByteString -> Bool
BS.null (Proto AddressPattern
addrPat Proto AddressPattern
-> Getting ByteString (Proto AddressPattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto AddressPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "paymentPart" a) =>
LensLike' f s a
UtxoRpc.paymentPart)
          Bool -> Bool -> Bool
&& ByteString -> Bool
BS.null (Proto AddressPattern
addrPat Proto AddressPattern
-> Getting ByteString (Proto AddressPattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto AddressPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "delegationPart" a) =>
LensLike' f s a
UtxoRpc.delegationPart)
          Bool -> Bool -> Bool
&& Maybe (Proto AssetPattern) -> Bool
forall a. Maybe a -> Bool
isNothing (Proto TxOutputPattern
txoPat Proto TxOutputPattern
-> Getting
     (Maybe (Proto AssetPattern))
     (Proto TxOutputPattern)
     (Maybe (Proto AssetPattern))
-> Maybe (Proto AssetPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto AssetPattern))
  (Proto TxOutputPattern)
  (Maybe (Proto AssetPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'asset" a) =>
LensLike' f s a
UtxoRpc.maybe'asset)
  pure (addrAny, if isPureExact then AcceptAll else AnyOfPatterns [leaf])

-- | Every 'match' leaf in the predicate tree, duplicates included, descending
-- through 'not', 'allOf' and 'anyOf'. Lazy, so a caller can stop after N leaves.
predicateLeaves :: Proto UtxoRpc.UtxoPredicate -> [Proto UtxoRpc.AnyUtxoPattern]
predicateLeaves :: Proto UtxoPredicate -> [Proto AnyUtxoPattern]
predicateLeaves Proto UtxoPredicate
p =
  Maybe (Proto AnyUtxoPattern) -> [Proto AnyUtxoPattern]
forall a. Maybe a -> [a]
maybeToList (Proto UtxoPredicate
p Proto UtxoPredicate
-> Getting
     (Maybe (Proto AnyUtxoPattern))
     (Proto UtxoPredicate)
     (Maybe (Proto AnyUtxoPattern))
-> Maybe (Proto AnyUtxoPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto AnyUtxoPattern))
  (Proto UtxoPredicate)
  (Maybe (Proto AnyUtxoPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'match" a) =>
LensLike' f s a
UtxoRpc.maybe'match)
    [Proto AnyUtxoPattern]
-> [Proto AnyUtxoPattern] -> [Proto AnyUtxoPattern]
forall a. Semigroup a => a -> a -> a
<> (Proto UtxoPredicate -> [Proto AnyUtxoPattern])
-> [Proto UtxoPredicate] -> [Proto AnyUtxoPattern]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Proto UtxoPredicate -> [Proto AnyUtxoPattern]
predicateLeaves (Proto UtxoPredicate
p Proto UtxoPredicate
-> Getting
     [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
-> [Proto UtxoPredicate]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "not" a) =>
LensLike' f s a
UtxoRpc.not [Proto UtxoPredicate]
-> [Proto UtxoPredicate] -> [Proto UtxoPredicate]
forall a. Semigroup a => a -> a -> a
<> Proto UtxoPredicate
p Proto UtxoPredicate
-> Getting
     [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
-> [Proto UtxoPredicate]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "allOf" a) =>
LensLike' f s a
UtxoRpc.allOf [Proto UtxoPredicate]
-> [Proto UtxoPredicate] -> [Proto UtxoPredicate]
forall a. Semigroup a => a -> a -> a
<> Proto UtxoPredicate
p Proto UtxoPredicate
-> Getting
     [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
-> [Proto UtxoPredicate]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto UtxoPredicate] (Proto UtxoPredicate) [Proto UtxoPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "anyOf" a) =>
LensLike' f s a
UtxoRpc.anyOf)

-- ---------------------------------------------------------------------------
-- TxPredicate: matching a mempool\/submitted tx (proto-native, no ledger types)
-- ---------------------------------------------------------------------------

-- | Check if a tx matches a 'TxPredicate'.
-- All present fields are combined with AND logic.
matchesTxPredicate
  :: Proto Submit.TxPredicate
  -> Proto UtxoRpc.Tx
  -> Bool
matchesTxPredicate :: Proto TxPredicate -> Proto Tx -> Bool
matchesTxPredicate Proto TxPredicate
p Proto Tx
tx =
  (Proto AnyChainTxPattern -> Bool)
-> Maybe (Proto AnyChainTxPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto AnyChainTxPattern -> Proto Tx -> Bool
`matchesAnyChainTxPattern` Proto Tx
tx) (Proto TxPredicate
p Proto TxPredicate
-> Getting
     (Maybe (Proto AnyChainTxPattern))
     (Proto TxPredicate)
     (Maybe (Proto AnyChainTxPattern))
-> Maybe (Proto AnyChainTxPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto AnyChainTxPattern))
  (Proto TxPredicate)
  (Maybe (Proto AnyChainTxPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'match" a) =>
LensLike' f s a
Submit.maybe'match)
    Bool -> Bool -> Bool
&& Bool -> Bool
not ((Proto TxPredicate -> Bool) -> [Proto TxPredicate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Proto TxPredicate -> Proto Tx -> Bool
`matchesTxPredicate` Proto Tx
tx) (Proto TxPredicate
p Proto TxPredicate
-> Getting
     [Proto TxPredicate] (Proto TxPredicate) [Proto TxPredicate]
-> [Proto TxPredicate]
forall s a. s -> Getting a s a -> a
^. Getting [Proto TxPredicate] (Proto TxPredicate) [Proto TxPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "not" a) =>
LensLike' f s a
Submit.not))
    Bool -> Bool -> Bool
&& (Proto TxPredicate -> Bool) -> [Proto TxPredicate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto TxPredicate -> Proto Tx -> Bool
`matchesTxPredicate` Proto Tx
tx) (Proto TxPredicate
p Proto TxPredicate
-> Getting
     [Proto TxPredicate] (Proto TxPredicate) [Proto TxPredicate]
-> [Proto TxPredicate]
forall s a. s -> Getting a s a -> a
^. Getting [Proto TxPredicate] (Proto TxPredicate) [Proto TxPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "allOf" a) =>
LensLike' f s a
Submit.allOf)
    Bool -> Bool -> Bool
&& ([Proto TxPredicate] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Proto TxPredicate
p Proto TxPredicate
-> Getting
     [Proto TxPredicate] (Proto TxPredicate) [Proto TxPredicate]
-> [Proto TxPredicate]
forall s a. s -> Getting a s a -> a
^. Getting [Proto TxPredicate] (Proto TxPredicate) [Proto TxPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "anyOf" a) =>
LensLike' f s a
Submit.anyOf) Bool -> Bool -> Bool
|| (Proto TxPredicate -> Bool) -> [Proto TxPredicate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Proto TxPredicate -> Proto Tx -> Bool
`matchesTxPredicate` Proto Tx
tx) (Proto TxPredicate
p Proto TxPredicate
-> Getting
     [Proto TxPredicate] (Proto TxPredicate) [Proto TxPredicate]
-> [Proto TxPredicate]
forall s a. s -> Getting a s a -> a
^. Getting [Proto TxPredicate] (Proto TxPredicate) [Proto TxPredicate]
forall (f :: * -> *) s a.
(Functor f, HasField s "anyOf" a) =>
LensLike' f s a
Submit.anyOf))

-- | Check if a tx matches an 'AnyChainTxPattern'.
-- Delegates to the Cardano-specific 'TxPattern' if present.
matchesAnyChainTxPattern
  :: Proto Submit.AnyChainTxPattern
  -> Proto UtxoRpc.Tx
  -> Bool
matchesAnyChainTxPattern :: Proto AnyChainTxPattern -> Proto Tx -> Bool
matchesAnyChainTxPattern Proto AnyChainTxPattern
pat Proto Tx
tx =
  (Proto TxPattern -> Bool) -> Maybe (Proto TxPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto TxPattern -> Proto Tx -> Bool
`matchesTxPattern` Proto Tx
tx) (Proto AnyChainTxPattern
pat Proto AnyChainTxPattern
-> Getting
     (Maybe (Proto TxPattern))
     (Proto AnyChainTxPattern)
     (Maybe (Proto TxPattern))
-> Maybe (Proto TxPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto TxPattern))
  (Proto AnyChainTxPattern)
  (Maybe (Proto TxPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'cardano" a) =>
LensLike' f s a
Submit.maybe'cardano)

-- | Check if a tx matches a 'TxPattern'. All present fields are combined with
-- AND logic; absent fields are vacuously true.
--
-- 'consumes' and the input side of 'has_address'\/'moves_asset' rely on
-- 'TxInput.as_output', which the mempool tx conversion never populates
-- (resolving it needs a UTxO lookup outside the pure conversion) - these
-- fields never fire on real mempool traffic today, only in tests that build
-- fixtures with 'as_output' set.
matchesTxPattern
  :: Proto UtxoRpc.TxPattern
  -> Proto UtxoRpc.Tx
  -> Bool
matchesTxPattern :: Proto TxPattern -> Proto Tx -> Bool
matchesTxPattern Proto TxPattern
pat Proto Tx
tx =
  (Proto TxOutputPattern -> Bool)
-> Maybe (Proto TxOutputPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto Tx -> Proto TxOutputPattern -> Bool
matchesConsumesPattern Proto Tx
tx) (Proto TxPattern
pat Proto TxPattern
-> Getting
     (Maybe (Proto TxOutputPattern))
     (Proto TxPattern)
     (Maybe (Proto TxOutputPattern))
-> Maybe (Proto TxOutputPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto TxOutputPattern))
  (Proto TxPattern)
  (Maybe (Proto TxOutputPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'consumes" a) =>
LensLike' f s a
UtxoRpc.maybe'consumes)
    Bool -> Bool -> Bool
&& (Proto TxOutputPattern -> Bool)
-> Maybe (Proto TxOutputPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto Tx -> Proto TxOutputPattern -> Bool
matchesProducesPattern Proto Tx
tx) (Proto TxPattern
pat Proto TxPattern
-> Getting
     (Maybe (Proto TxOutputPattern))
     (Proto TxPattern)
     (Maybe (Proto TxOutputPattern))
-> Maybe (Proto TxOutputPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto TxOutputPattern))
  (Proto TxPattern)
  (Maybe (Proto TxOutputPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'produces" a) =>
LensLike' f s a
UtxoRpc.maybe'produces)
    Bool -> Bool -> Bool
&& (Proto AddressPattern -> Bool)
-> Maybe (Proto AddressPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto Tx -> Proto AddressPattern -> Bool
matchesHasAddressPattern Proto Tx
tx) (Proto TxPattern
pat Proto TxPattern
-> Getting
     (Maybe (Proto AddressPattern))
     (Proto TxPattern)
     (Maybe (Proto AddressPattern))
-> Maybe (Proto AddressPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto AddressPattern))
  (Proto TxPattern)
  (Maybe (Proto AddressPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'hasAddress" a) =>
LensLike' f s a
UtxoRpc.maybe'hasAddress)
    Bool -> Bool -> Bool
&& (Proto AssetPattern -> Bool) -> Maybe (Proto AssetPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto Tx -> Proto AssetPattern -> Bool
matchesMovesAssetPattern Proto Tx
tx) (Proto TxPattern
pat Proto TxPattern
-> Getting
     (Maybe (Proto AssetPattern))
     (Proto TxPattern)
     (Maybe (Proto AssetPattern))
-> Maybe (Proto AssetPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto AssetPattern))
  (Proto TxPattern)
  (Maybe (Proto AssetPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'movesAsset" a) =>
LensLike' f s a
UtxoRpc.maybe'movesAsset)
    Bool -> Bool -> Bool
&& (Proto AssetPattern -> Bool) -> Maybe (Proto AssetPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto Tx -> Proto AssetPattern -> Bool
matchesMintsAssetPattern Proto Tx
tx) (Proto TxPattern
pat Proto TxPattern
-> Getting
     (Maybe (Proto AssetPattern))
     (Proto TxPattern)
     (Maybe (Proto AssetPattern))
-> Maybe (Proto AssetPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto AssetPattern))
  (Proto TxPattern)
  (Maybe (Proto AssetPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'mintsAsset" a) =>
LensLike' f s a
UtxoRpc.maybe'mintsAsset)
    Bool -> Bool -> Bool
&& (Proto CertificatePattern -> Bool)
-> Maybe (Proto CertificatePattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto Tx -> Proto CertificatePattern -> Bool
matchesHasCertificatePattern Proto Tx
tx) (Proto TxPattern
pat Proto TxPattern
-> Getting
     (Maybe (Proto CertificatePattern))
     (Proto TxPattern)
     (Maybe (Proto CertificatePattern))
-> Maybe (Proto CertificatePattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto CertificatePattern))
  (Proto TxPattern)
  (Maybe (Proto CertificatePattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'hasCertificate" a) =>
LensLike' f s a
UtxoRpc.maybe'hasCertificate)

-- | Resolved outputs of the tx's inputs (see the 'as_output' caveat on 'matchesTxPattern').
resolvedInputOutputs :: Proto UtxoRpc.Tx -> [Proto UtxoRpc.TxOutput]
resolvedInputOutputs :: Proto Tx -> [Proto TxOutput]
resolvedInputOutputs Proto Tx
tx = (Proto TxInput -> Maybe (Proto TxOutput))
-> [Proto TxInput] -> [Proto TxOutput]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Proto TxInput
-> Getting
     (Maybe (Proto TxOutput)) (Proto TxInput) (Maybe (Proto TxOutput))
-> Maybe (Proto TxOutput)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto TxOutput)) (Proto TxInput) (Maybe (Proto TxOutput))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'asOutput" a) =>
LensLike' f s a
UtxoRpc.maybe'asOutput) (Proto Tx
tx Proto Tx
-> Getting [Proto TxInput] (Proto Tx) [Proto TxInput]
-> [Proto TxInput]
forall s a. s -> Getting a s a -> a
^. Getting [Proto TxInput] (Proto Tx) [Proto TxInput]
forall (f :: * -> *) s a.
(Functor f, HasField s "inputs" a) =>
LensLike' f s a
UtxoRpc.inputs)

-- | 'consumes': match any input (by its resolved output) that exhibits the pattern.
matchesConsumesPattern :: Proto UtxoRpc.Tx -> Proto UtxoRpc.TxOutputPattern -> Bool
matchesConsumesPattern :: Proto Tx -> Proto TxOutputPattern -> Bool
matchesConsumesPattern Proto Tx
tx Proto TxOutputPattern
pat = (Proto TxOutput -> Bool) -> [Proto TxOutput] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Proto TxOutputPattern -> Proto TxOutput -> Bool
matchesTxOutputPatternProto Proto TxOutputPattern
pat) (Proto Tx -> [Proto TxOutput]
resolvedInputOutputs Proto Tx
tx)

-- | 'produces': match any output that exhibits the pattern.
matchesProducesPattern :: Proto UtxoRpc.Tx -> Proto UtxoRpc.TxOutputPattern -> Bool
matchesProducesPattern :: Proto Tx -> Proto TxOutputPattern -> Bool
matchesProducesPattern Proto Tx
tx Proto TxOutputPattern
pat = (Proto TxOutput -> Bool) -> [Proto TxOutput] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Proto TxOutputPattern -> Proto TxOutput -> Bool
matchesTxOutputPatternProto Proto TxOutputPattern
pat) (Proto Tx
tx Proto Tx
-> Getting [Proto TxOutput] (Proto Tx) [Proto TxOutput]
-> [Proto TxOutput]
forall s a. s -> Getting a s a -> a
^. Getting [Proto TxOutput] (Proto Tx) [Proto TxOutput]
forall (f :: * -> *) s a.
(Functor f, HasField s "outputs" a) =>
LensLike' f s a
UtxoRpc.outputs)

-- | Check if a tx output (an input's resolved output, or an output proper) matches a 'TxOutputPattern'.
matchesTxOutputPatternProto :: Proto UtxoRpc.TxOutputPattern -> Proto UtxoRpc.TxOutput -> Bool
matchesTxOutputPatternProto :: Proto TxOutputPattern -> Proto TxOutput -> Bool
matchesTxOutputPatternProto Proto TxOutputPattern
pat Proto TxOutput
output =
  (Proto AddressPattern -> Bool)
-> Maybe (Proto AddressPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
    (\Proto AddressPattern
addressPat -> Proto AddressPattern -> ByteString -> Bool
matchesAddressPatternBytes Proto AddressPattern
addressPat (Proto TxOutput
output Proto TxOutput
-> Getting ByteString (Proto TxOutput) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto TxOutput) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "address" a) =>
LensLike' f s a
UtxoRpc.address))
    (Proto TxOutputPattern
pat Proto TxOutputPattern
-> Getting
     (Maybe (Proto AddressPattern))
     (Proto TxOutputPattern)
     (Maybe (Proto AddressPattern))
-> Maybe (Proto AddressPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto AddressPattern))
  (Proto TxOutputPattern)
  (Maybe (Proto AddressPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'address" a) =>
LensLike' f s a
UtxoRpc.maybe'address)
    Bool -> Bool -> Bool
&& (Proto AssetPattern -> Bool) -> Maybe (Proto AssetPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
      (\Proto AssetPattern
assetPat -> (Integer -> Bool)
-> Proto AssetPattern -> [Proto Multiasset] -> Bool
matchesAssetPatternProto (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) Proto AssetPattern
assetPat (Proto TxOutput
output Proto TxOutput
-> Getting [Proto Multiasset] (Proto TxOutput) [Proto Multiasset]
-> [Proto Multiasset]
forall s a. s -> Getting a s a -> a
^. Getting [Proto Multiasset] (Proto TxOutput) [Proto Multiasset]
forall (f :: * -> *) s a.
(Functor f, HasField s "assets" a) =>
LensLike' f s a
UtxoRpc.assets))
      (Proto TxOutputPattern
pat Proto TxOutputPattern
-> Getting
     (Maybe (Proto AssetPattern))
     (Proto TxOutputPattern)
     (Maybe (Proto AssetPattern))
-> Maybe (Proto AssetPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto AssetPattern))
  (Proto TxOutputPattern)
  (Maybe (Proto AssetPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'asset" a) =>
LensLike' f s a
UtxoRpc.maybe'asset)

-- | 'has_address': match any address appearing in the tx's outputs, resolved
-- inputs, resolved collateral inputs or collateral return.
matchesHasAddressPattern :: Proto UtxoRpc.Tx -> Proto UtxoRpc.AddressPattern -> Bool
matchesHasAddressPattern :: Proto Tx -> Proto AddressPattern -> Bool
matchesHasAddressPattern Proto Tx
tx Proto AddressPattern
pat = (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Proto AddressPattern -> ByteString -> Bool
matchesAddressPatternBytes Proto AddressPattern
pat) (Proto Tx -> [ByteString]
txAddresses Proto Tx
tx)

-- | Every address appearing anywhere in the tx; see 'matchesHasAddressPattern'.
txAddresses :: Proto UtxoRpc.Tx -> [ByteString]
txAddresses :: Proto Tx -> [ByteString]
txAddresses Proto Tx
tx =
  (Proto TxOutput -> ByteString) -> [Proto TxOutput] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Proto TxOutput
-> Getting ByteString (Proto TxOutput) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto TxOutput) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "address" a) =>
LensLike' f s a
UtxoRpc.address) ([Proto TxOutput] -> [ByteString])
-> [Proto TxOutput] -> [ByteString]
forall a b. (a -> b) -> a -> b
$
    Proto Tx -> [Proto TxOutput]
resolvedInputOutputs Proto Tx
tx
      [Proto TxOutput] -> [Proto TxOutput] -> [Proto TxOutput]
forall a. Semigroup a => a -> a -> a
<> Proto Tx
tx Proto Tx
-> Getting [Proto TxOutput] (Proto Tx) [Proto TxOutput]
-> [Proto TxOutput]
forall s a. s -> Getting a s a -> a
^. Getting [Proto TxOutput] (Proto Tx) [Proto TxOutput]
forall (f :: * -> *) s a.
(Functor f, HasField s "outputs" a) =>
LensLike' f s a
UtxoRpc.outputs
      [Proto TxOutput] -> [Proto TxOutput] -> [Proto TxOutput]
forall a. Semigroup a => a -> a -> a
<> (Proto TxInput -> Maybe (Proto TxOutput))
-> [Proto TxInput] -> [Proto TxOutput]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Proto TxInput
-> Getting
     (Maybe (Proto TxOutput)) (Proto TxInput) (Maybe (Proto TxOutput))
-> Maybe (Proto TxOutput)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto TxOutput)) (Proto TxInput) (Maybe (Proto TxOutput))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'asOutput" a) =>
LensLike' f s a
UtxoRpc.maybe'asOutput) (Proto Tx
tx Proto Tx
-> Getting [Proto TxInput] (Proto Tx) [Proto TxInput]
-> [Proto TxInput]
forall s a. s -> Getting a s a -> a
^. LensLike' (Const [Proto TxInput]) (Proto Tx) (Proto Collateral)
forall (f :: * -> *) s a.
(Functor f, HasField s "collateral" a) =>
LensLike' f s a
UtxoRpc.collateral LensLike' (Const [Proto TxInput]) (Proto Tx) (Proto Collateral)
-> (([Proto TxInput] -> Const [Proto TxInput] [Proto TxInput])
    -> Proto Collateral -> Const [Proto TxInput] (Proto Collateral))
-> Getting [Proto TxInput] (Proto Tx) [Proto TxInput]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto TxInput] -> Const [Proto TxInput] [Proto TxInput])
-> Proto Collateral -> Const [Proto TxInput] (Proto Collateral)
forall (f :: * -> *) s a.
(Functor f, HasField s "collateral" a) =>
LensLike' f s a
UtxoRpc.collateral)
      [Proto TxOutput] -> [Proto TxOutput] -> [Proto TxOutput]
forall a. Semigroup a => a -> a -> a
<> Maybe (Proto TxOutput) -> [Proto TxOutput]
forall a. Maybe a -> [a]
maybeToList (Proto Tx
tx Proto Tx
-> Getting
     (Maybe (Proto TxOutput)) (Proto Tx) (Maybe (Proto TxOutput))
-> Maybe (Proto TxOutput)
forall s a. s -> Getting a s a -> a
^. LensLike'
  (Const (Maybe (Proto TxOutput))) (Proto Tx) (Proto Collateral)
forall (f :: * -> *) s a.
(Functor f, HasField s "collateral" a) =>
LensLike' f s a
UtxoRpc.collateral LensLike'
  (Const (Maybe (Proto TxOutput))) (Proto Tx) (Proto Collateral)
-> ((Maybe (Proto TxOutput)
     -> Const (Maybe (Proto TxOutput)) (Maybe (Proto TxOutput)))
    -> Proto Collateral
    -> Const (Maybe (Proto TxOutput)) (Proto Collateral))
-> Getting
     (Maybe (Proto TxOutput)) (Proto Tx) (Maybe (Proto TxOutput))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Proto TxOutput)
 -> Const (Maybe (Proto TxOutput)) (Maybe (Proto TxOutput)))
-> Proto Collateral
-> Const (Maybe (Proto TxOutput)) (Proto Collateral)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'collateralReturn" a) =>
LensLike' f s a
UtxoRpc.maybe'collateralReturn)

-- | Check if raw address bytes match an 'AddressPattern'.
-- Mirrors 'matchesAddressPattern', but for proto-native tx data where addresses
-- are opaque bytes rather than parsed 'AddressInEra' values: the bytes are
-- parsed via 'deserialiseFromRawBytes' first. Unparseable bytes and Byron
-- addresses only support exact matching, same as 'matchesAddressPattern'.
matchesAddressPatternBytes :: Proto UtxoRpc.AddressPattern -> ByteString -> Bool
matchesAddressPatternBytes :: Proto AddressPattern -> ByteString -> Bool
matchesAddressPatternBytes Proto AddressPattern
pat ByteString
addressBytes =
  ByteString -> Maybe ByteString -> Bool
matchesFilter (Proto AddressPattern
pat Proto AddressPattern
-> Getting ByteString (Proto AddressPattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto AddressPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "exactAddress" a) =>
LensLike' f s a
UtxoRpc.exactAddress) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addressBytes)
    Bool -> Bool -> Bool
&& ByteString -> Maybe ByteString -> Bool
matchesFilter (Proto AddressPattern
pat Proto AddressPattern
-> Getting ByteString (Proto AddressPattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto AddressPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "paymentPart" a) =>
LensLike' f s a
UtxoRpc.paymentPart) Maybe ByteString
mPaymentCredentialBytes
    Bool -> Bool -> Bool
&& ByteString -> Maybe ByteString -> Bool
matchesFilter (Proto AddressPattern
pat Proto AddressPattern
-> Getting ByteString (Proto AddressPattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto AddressPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "delegationPart" a) =>
LensLike' f s a
UtxoRpc.delegationPart) Maybe ByteString
mStakeCredentialBytes
 where
  mShelleyAddress :: Maybe (Address ShelleyAddr)
mShelleyAddress = do
    AddressShelley shelley <-
      (SerialiseAsRawBytesError -> Maybe AddressAny)
-> (AddressAny -> Maybe AddressAny)
-> Either SerialiseAsRawBytesError AddressAny
-> Maybe AddressAny
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe AddressAny -> SerialiseAsRawBytesError -> Maybe AddressAny
forall a b. a -> b -> a
const Maybe AddressAny
forall a. Maybe a
Nothing) AddressAny -> Maybe AddressAny
forall a. a -> Maybe a
Just (Either SerialiseAsRawBytesError AddressAny -> Maybe AddressAny)
-> Either SerialiseAsRawBytesError AddressAny -> Maybe AddressAny
forall a b. (a -> b) -> a -> b
$ AsType AddressAny
-> ByteString -> Either SerialiseAsRawBytesError AddressAny
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType AddressAny
AsAddressAny ByteString
addressBytes
    pure shelley
  mPaymentCredentialBytes :: Maybe ByteString
mPaymentCredentialBytes =
    Maybe (Address ShelleyAddr)
mShelleyAddress Maybe (Address ShelleyAddr)
-> (Address ShelleyAddr -> ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(ShelleyAddress Network
_ Credential Payment
paymentCredential StakeReference
_) ->
      PaymentCredential -> ByteString
serialisePaymentCredential (PaymentCredential -> ByteString)
-> PaymentCredential -> ByteString
forall a b. (a -> b) -> a -> b
$ Credential Payment -> PaymentCredential
fromShelleyPaymentCredential Credential Payment
paymentCredential
  mStakeCredentialBytes :: Maybe ByteString
mStakeCredentialBytes = do
    ShelleyAddress _ _ stakeReference <- Maybe (Address ShelleyAddr)
mShelleyAddress
    StakeAddressByValue credential <- pure $ fromShelleyStakeReference stakeReference
    pure $ serialiseStakeCredential credential

-- | 'moves_asset': match any asset moved by the tx, i.e. present (with a
-- positive quantity) in a resolved input or an output.
matchesMovesAssetPattern :: Proto UtxoRpc.Tx -> Proto UtxoRpc.AssetPattern -> Bool
matchesMovesAssetPattern :: Proto Tx -> Proto AssetPattern -> Bool
matchesMovesAssetPattern Proto Tx
tx = do
  let movedAssets :: [Proto Multiasset]
movedAssets = (Proto TxOutput -> [Proto Multiasset])
-> [Proto TxOutput] -> [Proto Multiasset]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Proto TxOutput
-> Getting [Proto Multiasset] (Proto TxOutput) [Proto Multiasset]
-> [Proto Multiasset]
forall s a. s -> Getting a s a -> a
^. Getting [Proto Multiasset] (Proto TxOutput) [Proto Multiasset]
forall (f :: * -> *) s a.
(Functor f, HasField s "assets" a) =>
LensLike' f s a
UtxoRpc.assets) (Proto Tx -> [Proto TxOutput]
resolvedInputOutputs Proto Tx
tx [Proto TxOutput] -> [Proto TxOutput] -> [Proto TxOutput]
forall a. Semigroup a => a -> a -> a
<> Proto Tx
tx Proto Tx
-> Getting [Proto TxOutput] (Proto Tx) [Proto TxOutput]
-> [Proto TxOutput]
forall s a. s -> Getting a s a -> a
^. Getting [Proto TxOutput] (Proto Tx) [Proto TxOutput]
forall (f :: * -> *) s a.
(Functor f, HasField s "outputs" a) =>
LensLike' f s a
UtxoRpc.outputs)
  \Proto AssetPattern
pat -> (Integer -> Bool)
-> Proto AssetPattern -> [Proto Multiasset] -> Bool
matchesAssetPatternProto (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) Proto AssetPattern
pat [Proto Multiasset]
movedAssets

-- | 'mints_asset': match any asset minted or burned by the tx. Burns carry a
-- negative quantity, so (unlike 'moves_asset') zero is the only excluded value.
matchesMintsAssetPattern :: Proto UtxoRpc.Tx -> Proto UtxoRpc.AssetPattern -> Bool
matchesMintsAssetPattern :: Proto Tx -> Proto AssetPattern -> Bool
matchesMintsAssetPattern Proto Tx
tx Proto AssetPattern
pat = (Integer -> Bool)
-> Proto AssetPattern -> [Proto Multiasset] -> Bool
matchesAssetPatternProto (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0) Proto AssetPattern
pat (Proto Tx
tx Proto Tx
-> Getting [Proto Multiasset] (Proto Tx) [Proto Multiasset]
-> [Proto Multiasset]
forall s a. s -> Getting a s a -> a
^. Getting [Proto Multiasset] (Proto Tx) [Proto Multiasset]
forall (f :: * -> *) s a.
(Functor f, HasField s "mint" a) =>
LensLike' f s a
UtxoRpc.mint)

-- | Check if a policy\/asset-name pattern matches any asset entry across a
-- list of 'Multiasset' bundles. @quantityMatches@ selects which quantities
-- count, since 'moves_asset' and 'mints_asset' apply different sign checks.
-- A 'BigInt' that fails to decode is treated as no match.
matchesAssetPatternProto
  :: (Integer -> Bool)
  -> Proto UtxoRpc.AssetPattern
  -> [Proto UtxoRpc.Multiasset]
  -> Bool
matchesAssetPatternProto :: (Integer -> Bool)
-> Proto AssetPattern -> [Proto Multiasset] -> Bool
matchesAssetPatternProto Integer -> Bool
quantityMatches Proto AssetPattern
pat [Proto Multiasset]
multiassets =
  ((ByteString, Proto Asset) -> Bool)
-> [(ByteString, Proto Asset)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
    (ByteString, Proto Asset) -> Bool
matchesEntry
    [ (Proto Multiasset
multiasset Proto Multiasset
-> Getting ByteString (Proto Multiasset) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto Multiasset) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "policyId" a) =>
LensLike' f s a
UtxoRpc.policyId, Proto Asset
asset)
    | Proto Multiasset
multiasset <- [Proto Multiasset]
multiassets
    , Proto Asset
asset <- Proto Multiasset
multiasset Proto Multiasset
-> Getting [Proto Asset] (Proto Multiasset) [Proto Asset]
-> [Proto Asset]
forall s a. s -> Getting a s a -> a
^. Getting [Proto Asset] (Proto Multiasset) [Proto Asset]
forall (f :: * -> *) s a.
(Functor f, HasField s "assets" a) =>
LensLike' f s a
UtxoRpc.assets
    ]
 where
  patternPolicy :: ByteString
patternPolicy = Proto AssetPattern
pat Proto AssetPattern
-> Getting ByteString (Proto AssetPattern) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto AssetPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "policyId" a) =>
LensLike' f s a
UtxoRpc.policyId
  patternTokenName :: ByteString
patternTokenName = Proto AssetPattern
pat Proto AssetPattern
-> Getting ByteString (Proto AssetPattern) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto AssetPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "assetName" a) =>
LensLike' f s a
UtxoRpc.assetName
  matchesEntry :: (ByteString, Proto Asset) -> Bool
matchesEntry (ByteString
policy, Proto Asset
asset) =
    ByteString -> ByteString -> Bool
matchesRawField ByteString
patternPolicy ByteString
policy
      Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
matchesRawField ByteString
patternTokenName (Proto Asset
asset Proto Asset
-> Getting ByteString (Proto Asset) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto Asset) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "name" a) =>
LensLike' f s a
UtxoRpc.name)
      Bool -> Bool -> Bool
&& Bool -> (Integer -> Bool) -> Maybe Integer -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Integer -> Bool
quantityMatches (Proto BigInt -> Maybe Integer
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Proto BigInt -> m Integer
utxoRpcBigIntToInteger (Proto Asset
asset Proto Asset
-> Getting (Proto BigInt) (Proto Asset) (Proto BigInt)
-> Proto BigInt
forall s a. s -> Getting a s a -> a
^. Getting (Proto BigInt) (Proto Asset) (Proto BigInt)
forall (f :: * -> *) s a.
(Functor f, HasField s "quantity" a) =>
LensLike' f s a
UtxoRpc.quantity))

-- | 'has_certificate': match any certificate in the tx that exhibits the pattern.
matchesHasCertificatePattern :: Proto UtxoRpc.Tx -> Proto UtxoRpc.CertificatePattern -> Bool
matchesHasCertificatePattern :: Proto Tx -> Proto CertificatePattern -> Bool
matchesHasCertificatePattern Proto Tx
tx Proto CertificatePattern
pat = (Proto Certificate -> Bool) -> [Proto Certificate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Proto CertificatePattern -> Proto Certificate -> Bool
matchesCertificatePattern Proto CertificatePattern
pat) (Proto Tx
tx Proto Tx
-> Getting [Proto Certificate] (Proto Tx) [Proto Certificate]
-> [Proto Certificate]
forall s a. s -> Getting a s a -> a
^. Getting [Proto Certificate] (Proto Tx) [Proto Certificate]
forall (f :: * -> *) s a.
(Functor f, HasField s "certificates" a) =>
LensLike' f s a
UtxoRpc.certificates)

-- | Check if a certificate matches a 'CertificatePattern'.
-- The five discriminated branches (stake registration\/deregistration\/delegation,
-- pool registration\/retirement) only match the identically-shaped certificate -
-- the newer Conway certificate families (reg\/unreg\/vote-deleg, DRep, committee)
-- are only reachable through the three "any_*" wildcards below, which scan
-- every certificate variant that carries the relevant credential.
matchesCertificatePattern
  :: Proto UtxoRpc.CertificatePattern
  -> Proto UtxoRpc.Certificate
  -> Bool
matchesCertificatePattern :: Proto CertificatePattern -> Proto Certificate -> Bool
matchesCertificatePattern Proto CertificatePattern
pat Proto Certificate
cert =
  (Proto StakeCredential -> Bool)
-> Maybe (Proto StakeCredential) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto StakeCredential -> Maybe (Proto StakeCredential) -> Bool
`matchesExactCredential` Maybe (Proto StakeCredential)
mStakeRegistration) (Proto CertificatePattern
pat Proto CertificatePattern
-> Getting
     (Maybe (Proto StakeCredential))
     (Proto CertificatePattern)
     (Maybe (Proto StakeCredential))
-> Maybe (Proto StakeCredential)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto StakeCredential))
  (Proto CertificatePattern)
  (Maybe (Proto StakeCredential))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'stakeRegistration" a) =>
LensLike' f s a
UtxoRpc.maybe'stakeRegistration)
    Bool -> Bool -> Bool
&& (Proto StakeCredential -> Bool)
-> Maybe (Proto StakeCredential) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Proto StakeCredential -> Maybe (Proto StakeCredential) -> Bool
`matchesExactCredential` Maybe (Proto StakeCredential)
mStakeDeregistration) (Proto CertificatePattern
pat Proto CertificatePattern
-> Getting
     (Maybe (Proto StakeCredential))
     (Proto CertificatePattern)
     (Maybe (Proto StakeCredential))
-> Maybe (Proto StakeCredential)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto StakeCredential))
  (Proto CertificatePattern)
  (Maybe (Proto StakeCredential))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'stakeDeregistration" a) =>
LensLike' f s a
UtxoRpc.maybe'stakeDeregistration)
    Bool -> Bool -> Bool
&& (Proto StakeDelegationPattern -> Bool)
-> Maybe (Proto StakeDelegationPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Proto StakeDelegationPattern -> Bool
matchesStakeDelegationPattern (Proto CertificatePattern
pat Proto CertificatePattern
-> Getting
     (Maybe (Proto StakeDelegationPattern))
     (Proto CertificatePattern)
     (Maybe (Proto StakeDelegationPattern))
-> Maybe (Proto StakeDelegationPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto StakeDelegationPattern))
  (Proto CertificatePattern)
  (Maybe (Proto StakeDelegationPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'stakeDelegation" a) =>
LensLike' f s a
UtxoRpc.maybe'stakeDelegation)
    Bool -> Bool -> Bool
&& (Proto PoolRegistrationPattern -> Bool)
-> Maybe (Proto PoolRegistrationPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Proto PoolRegistrationPattern -> Bool
matchesPoolRegistrationPattern (Proto CertificatePattern
pat Proto CertificatePattern
-> Getting
     (Maybe (Proto PoolRegistrationPattern))
     (Proto CertificatePattern)
     (Maybe (Proto PoolRegistrationPattern))
-> Maybe (Proto PoolRegistrationPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto PoolRegistrationPattern))
  (Proto CertificatePattern)
  (Maybe (Proto PoolRegistrationPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'poolRegistration" a) =>
LensLike' f s a
UtxoRpc.maybe'poolRegistration)
    Bool -> Bool -> Bool
&& (Proto PoolRetirementPattern -> Bool)
-> Maybe (Proto PoolRetirementPattern) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Proto PoolRetirementPattern -> Bool
matchesPoolRetirementPattern (Proto CertificatePattern
pat Proto CertificatePattern
-> Getting
     (Maybe (Proto PoolRetirementPattern))
     (Proto CertificatePattern)
     (Maybe (Proto PoolRetirementPattern))
-> Maybe (Proto PoolRetirementPattern)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto PoolRetirementPattern))
  (Proto CertificatePattern)
  (Maybe (Proto PoolRetirementPattern))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'poolRetirement" a) =>
LensLike' f s a
UtxoRpc.maybe'poolRetirement)
    -- these three fields are oneof branches: empty means "this branch isn't set"
    Bool -> Bool -> Bool
&& (ByteString -> Bool) -> Maybe ByteString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
      ([Proto StakeCredential] -> ByteString -> Bool
matchesAnyStakeCredential (CertificateCredentials -> [Proto StakeCredential]
certStakeCredentials CertificateCredentials
credentials))
      (ByteString -> Maybe ByteString
nonEmptyField (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Proto CertificatePattern
pat Proto CertificatePattern
-> Getting ByteString (Proto CertificatePattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto CertificatePattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "anyStakeCredential" a) =>
LensLike' f s a
UtxoRpc.anyStakeCredential)
    Bool -> Bool -> Bool
&& (ByteString -> Bool) -> Maybe ByteString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
      ([ByteString] -> ByteString -> Bool
matchesAnyPoolKeyHash (CertificateCredentials -> [ByteString]
certPoolKeyHashes CertificateCredentials
credentials))
      (ByteString -> Maybe ByteString
nonEmptyField (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Proto CertificatePattern
pat Proto CertificatePattern
-> Getting ByteString (Proto CertificatePattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto CertificatePattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "anyPoolKeyhash" a) =>
LensLike' f s a
UtxoRpc.anyPoolKeyhash)
    Bool -> Bool -> Bool
&& (ByteString -> Bool) -> Maybe ByteString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([ByteString] -> ByteString -> Bool
matchesAnyDRep (CertificateCredentials -> [ByteString]
certDRepBytes CertificateCredentials
credentials)) (ByteString -> Maybe ByteString
nonEmptyField (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Proto CertificatePattern
pat Proto CertificatePattern
-> Getting ByteString (Proto CertificatePattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto CertificatePattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "anyDrep" a) =>
LensLike' f s a
UtxoRpc.anyDrep)
 where
  -- classified once, then read for all three any_* checks below
  credentials :: CertificateCredentials
credentials = Proto Certificate -> CertificateCredentials
certificateCredentials Proto Certificate
cert

  mStakeRegistration :: Maybe (Proto StakeCredential)
mStakeRegistration = Proto Certificate
cert Proto Certificate
-> Getting
     (Maybe (Proto StakeCredential))
     (Proto Certificate)
     (Maybe (Proto StakeCredential))
-> Maybe (Proto StakeCredential)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto StakeCredential))
  (Proto Certificate)
  (Maybe (Proto StakeCredential))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'stakeRegistration" a) =>
LensLike' f s a
UtxoRpc.maybe'stakeRegistration
  mStakeDeregistration :: Maybe (Proto StakeCredential)
mStakeDeregistration = Proto Certificate
cert Proto Certificate
-> Getting
     (Maybe (Proto StakeCredential))
     (Proto Certificate)
     (Maybe (Proto StakeCredential))
-> Maybe (Proto StakeCredential)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto StakeCredential))
  (Proto Certificate)
  (Maybe (Proto StakeCredential))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'stakeDeregistration" a) =>
LensLike' f s a
UtxoRpc.maybe'stakeDeregistration
  mStakeDelegation :: Maybe (Proto StakeDelegationCert)
mStakeDelegation = Proto Certificate
cert Proto Certificate
-> Getting
     (Maybe (Proto StakeDelegationCert))
     (Proto Certificate)
     (Maybe (Proto StakeDelegationCert))
-> Maybe (Proto StakeDelegationCert)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto StakeDelegationCert))
  (Proto Certificate)
  (Maybe (Proto StakeDelegationCert))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'stakeDelegation" a) =>
LensLike' f s a
UtxoRpc.maybe'stakeDelegation
  mPoolRegistration :: Maybe (Proto PoolRegistrationCert)
mPoolRegistration = Proto Certificate
cert Proto Certificate
-> Getting
     (Maybe (Proto PoolRegistrationCert))
     (Proto Certificate)
     (Maybe (Proto PoolRegistrationCert))
-> Maybe (Proto PoolRegistrationCert)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto PoolRegistrationCert))
  (Proto Certificate)
  (Maybe (Proto PoolRegistrationCert))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'poolRegistration" a) =>
LensLike' f s a
UtxoRpc.maybe'poolRegistration
  mPoolRetirement :: Maybe (Proto PoolRetirementCert)
mPoolRetirement = Proto Certificate
cert Proto Certificate
-> Getting
     (Maybe (Proto PoolRetirementCert))
     (Proto Certificate)
     (Maybe (Proto PoolRetirementCert))
-> Maybe (Proto PoolRetirementCert)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto PoolRetirementCert))
  (Proto Certificate)
  (Maybe (Proto PoolRetirementCert))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'poolRetirement" a) =>
LensLike' f s a
UtxoRpc.maybe'poolRetirement

  mDelegationStakeCredential :: Maybe (Proto StakeCredential)
mDelegationStakeCredential = Maybe (Proto StakeDelegationCert)
mStakeDelegation Maybe (Proto StakeDelegationCert)
-> (Proto StakeDelegationCert -> Proto StakeCredential)
-> Maybe (Proto StakeCredential)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Proto StakeDelegationCert
-> Getting
     (Proto StakeCredential)
     (Proto StakeDelegationCert)
     (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential)
  (Proto StakeDelegationCert)
  (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "stakeCredential" a) =>
LensLike' f s a
UtxoRpc.stakeCredential)
  mDelegationPoolKeyHash :: Maybe ByteString
mDelegationPoolKeyHash = Maybe (Proto StakeDelegationCert)
mStakeDelegation Maybe (Proto StakeDelegationCert)
-> (Proto StakeDelegationCert -> ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Proto StakeDelegationCert
-> Getting ByteString (Proto StakeDelegationCert) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto StakeDelegationCert) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "poolKeyhash" a) =>
LensLike' f s a
UtxoRpc.poolKeyhash)
  mOperatorKeyHash :: Maybe ByteString
mOperatorKeyHash = Maybe (Proto PoolRegistrationCert)
mPoolRegistration Maybe (Proto PoolRegistrationCert)
-> (Proto PoolRegistrationCert -> ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Proto PoolRegistrationCert
-> Getting ByteString (Proto PoolRegistrationCert) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto PoolRegistrationCert) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "operator" a) =>
LensLike' f s a
UtxoRpc.operator)
  mRetirementPoolKeyHash :: Maybe ByteString
mRetirementPoolKeyHash = Maybe (Proto PoolRetirementCert)
mPoolRetirement Maybe (Proto PoolRetirementCert)
-> (Proto PoolRetirementCert -> ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Proto PoolRetirementCert
-> Getting ByteString (Proto PoolRetirementCert) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto PoolRetirementCert) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "poolKeyhash" a) =>
LensLike' f s a
UtxoRpc.poolKeyhash)
  mRetirementEpoch :: Maybe Word64
mRetirementEpoch = Maybe (Proto PoolRetirementCert)
mPoolRetirement Maybe (Proto PoolRetirementCert)
-> (Proto PoolRetirementCert -> Word64) -> Maybe Word64
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Proto PoolRetirementCert
-> Getting Word64 (Proto PoolRetirementCert) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 (Proto PoolRetirementCert) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "epoch" a) =>
LensLike' f s a
UtxoRpc.epoch)

  matchesExactCredential :: Proto StakeCredential -> Maybe (Proto StakeCredential) -> Bool
matchesExactCredential Proto StakeCredential
expected Maybe (Proto StakeCredential)
mActual =
    (Proto StakeCredential -> ByteString
credentialBytes (Proto StakeCredential -> ByteString)
-> Maybe (Proto StakeCredential) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Proto StakeCredential)
mActual) Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Proto StakeCredential -> ByteString
credentialBytes Proto StakeCredential
expected)

  -- a set pattern branch also requires the certificate to be that variant, so
  -- the presence checks below still reject when every pattern field is empty
  matchesStakeDelegationPattern :: Proto StakeDelegationPattern -> Bool
matchesStakeDelegationPattern Proto StakeDelegationPattern
delegPat =
    Maybe (Proto StakeDelegationCert) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Proto StakeDelegationCert)
mStakeDelegation
      Bool -> Bool -> Bool
&& (Proto StakeCredential -> Bool)
-> Maybe (Proto StakeCredential) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
        (Proto StakeCredential -> Maybe (Proto StakeCredential) -> Bool
`matchesExactCredential` Maybe (Proto StakeCredential)
mDelegationStakeCredential)
        (Proto StakeDelegationPattern
delegPat Proto StakeDelegationPattern
-> Getting
     (Maybe (Proto StakeCredential))
     (Proto StakeDelegationPattern)
     (Maybe (Proto StakeCredential))
-> Maybe (Proto StakeCredential)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto StakeCredential))
  (Proto StakeDelegationPattern)
  (Maybe (Proto StakeCredential))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'stakeCredential" a) =>
LensLike' f s a
UtxoRpc.maybe'stakeCredential)
      Bool -> Bool -> Bool
&& ByteString -> Maybe ByteString -> Bool
matchesFilter (Proto StakeDelegationPattern
delegPat Proto StakeDelegationPattern
-> Getting ByteString (Proto StakeDelegationPattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto StakeDelegationPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "poolKeyhash" a) =>
LensLike' f s a
UtxoRpc.poolKeyhash) Maybe ByteString
mDelegationPoolKeyHash

  -- a 'PoolRegistrationCert' only carries one key hash ('operator'); the
  -- pattern's 'pool_keyhash' field is documented as derived from it
  matchesPoolRegistrationPattern :: Proto PoolRegistrationPattern -> Bool
matchesPoolRegistrationPattern Proto PoolRegistrationPattern
regPat =
    Maybe (Proto PoolRegistrationCert) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Proto PoolRegistrationCert)
mPoolRegistration
      Bool -> Bool -> Bool
&& ByteString -> Maybe ByteString -> Bool
matchesFilter (Proto PoolRegistrationPattern
regPat Proto PoolRegistrationPattern
-> Getting ByteString (Proto PoolRegistrationPattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto PoolRegistrationPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "operator" a) =>
LensLike' f s a
UtxoRpc.operator) Maybe ByteString
mOperatorKeyHash
      Bool -> Bool -> Bool
&& ByteString -> Maybe ByteString -> Bool
matchesFilter (Proto PoolRegistrationPattern
regPat Proto PoolRegistrationPattern
-> Getting ByteString (Proto PoolRegistrationPattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto PoolRegistrationPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "poolKeyhash" a) =>
LensLike' f s a
UtxoRpc.poolKeyhash) Maybe ByteString
mOperatorKeyHash

  matchesPoolRetirementPattern :: Proto PoolRetirementPattern -> Bool
matchesPoolRetirementPattern Proto PoolRetirementPattern
retirePat =
    Maybe (Proto PoolRetirementCert) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Proto PoolRetirementCert)
mPoolRetirement
      Bool -> Bool -> Bool
&& ByteString -> Maybe ByteString -> Bool
matchesFilter (Proto PoolRetirementPattern
retirePat Proto PoolRetirementPattern
-> Getting ByteString (Proto PoolRetirementPattern) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto PoolRetirementPattern) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "poolKeyhash" a) =>
LensLike' f s a
UtxoRpc.poolKeyhash) Maybe ByteString
mRetirementPoolKeyHash
      Bool -> Bool -> Bool
&& (Proto PoolRetirementPattern
retirePat Proto PoolRetirementPattern
-> Getting Word64 (Proto PoolRetirementPattern) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 (Proto PoolRetirementPattern) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "epoch" a) =>
LensLike' f s a
UtxoRpc.epoch Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
|| Maybe Word64
mRetirementEpoch Maybe Word64 -> Maybe Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Proto PoolRetirementPattern
retirePat Proto PoolRetirementPattern
-> Getting Word64 (Proto PoolRetirementPattern) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 (Proto PoolRetirementPattern) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "epoch" a) =>
LensLike' f s a
UtxoRpc.epoch))

-- | The bare key\/script hash bytes of a credential, regardless of which it is.
credentialBytes :: Proto UtxoRpc.StakeCredential -> ByteString
credentialBytes :: Proto StakeCredential -> ByteString
credentialBytes Proto StakeCredential
credential =
  ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe (Proto StakeCredential
credential Proto StakeCredential
-> Getting ByteString (Proto StakeCredential) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto StakeCredential) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptHash" a) =>
LensLike' f s a
UtxoRpc.scriptHash) (Proto StakeCredential
credential Proto StakeCredential
-> Getting
     (Maybe ByteString) (Proto StakeCredential) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe ByteString) (Proto StakeCredential) (Maybe ByteString)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'addrKeyHash" a) =>
LensLike' f s a
UtxoRpc.maybe'addrKeyHash)

-- | The addr-key\/script hash bytes of a 'DRep' vote target, or 'Nothing' for
-- an abstain\/no-confidence vote (which carries no hash).
voteDrepBytes :: Proto UtxoRpc.DRep -> Maybe ByteString
voteDrepBytes :: Proto DRep -> Maybe ByteString
voteDrepBytes Proto DRep
drep = Proto DRep
drep Proto DRep
-> Getting (Maybe ByteString) (Proto DRep) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto DRep) (Maybe ByteString)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'addrKeyHash" a) =>
LensLike' f s a
UtxoRpc.maybe'addrKeyHash Maybe ByteString -> Maybe ByteString -> Maybe ByteString
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Proto DRep
drep Proto DRep
-> Getting (Maybe ByteString) (Proto DRep) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto DRep) (Maybe ByteString)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'scriptHash" a) =>
LensLike' f s a
UtxoRpc.maybe'scriptHash

-- | Credentials a certificate is about, classified once per oneof variant.
-- Exhaustive match, no wildcard: a new certificate variant in the proto is a
-- compile error here, not a silently unmatched cert.
data CertificateCredentials = CertificateCredentials
  { CertificateCredentials -> [Proto StakeCredential]
certStakeCredentials :: [Proto UtxoRpc.StakeCredential]
  , CertificateCredentials -> [ByteString]
certPoolKeyHashes :: [ByteString]
  , CertificateCredentials -> [ByteString]
certDRepBytes :: [ByteString]
  }

certificateCredentials :: Proto UtxoRpc.Certificate -> CertificateCredentials
certificateCredentials :: Proto Certificate -> CertificateCredentials
certificateCredentials Proto Certificate
cert =
  case Proto Certificate
cert Proto Certificate
-> Getting
     (Maybe (Proto Certificate'Certificate))
     (Proto Certificate)
     (Maybe (Proto Certificate'Certificate))
-> Maybe (Proto Certificate'Certificate)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto Certificate'Certificate))
  (Proto Certificate)
  (Maybe (Proto Certificate'Certificate))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'certificate" a) =>
LensLike' f s a
UtxoRpc.maybe'certificate of
    Maybe (Proto Certificate'Certificate)
Nothing -> [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials [] [] []
    Just (Proto Certificate'Certificate
variant) -> case Certificate'Certificate
variant of
      UtxoRpc.Certificate'StakeRegistration StakeCredential
cred ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials [StakeCredential -> Proto StakeCredential
forall msg. msg -> Proto msg
Proto StakeCredential
cred] [] []
      UtxoRpc.Certificate'StakeDeregistration StakeCredential
cred ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials [StakeCredential -> Proto StakeCredential
forall msg. msg -> Proto msg
Proto StakeCredential
cred] [] []
      UtxoRpc.Certificate'StakeDelegation StakeDelegationCert
delegCert ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials
          [StakeDelegationCert -> Proto StakeDelegationCert
forall msg. msg -> Proto msg
Proto StakeDelegationCert
delegCert Proto StakeDelegationCert
-> Getting
     (Proto StakeCredential)
     (Proto StakeDelegationCert)
     (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential)
  (Proto StakeDelegationCert)
  (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "stakeCredential" a) =>
LensLike' f s a
UtxoRpc.stakeCredential]
          [StakeDelegationCert -> Proto StakeDelegationCert
forall msg. msg -> Proto msg
Proto StakeDelegationCert
delegCert Proto StakeDelegationCert
-> Getting ByteString (Proto StakeDelegationCert) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto StakeDelegationCert) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "poolKeyhash" a) =>
LensLike' f s a
UtxoRpc.poolKeyhash]
          []
      -- a 'PoolRegistrationCert' only carries one key hash ('operator'); the
      -- owners are deliberately excluded, matching 'matchesPoolRegistrationPattern'
      UtxoRpc.Certificate'PoolRegistration PoolRegistrationCert
regCert ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials [] [PoolRegistrationCert -> Proto PoolRegistrationCert
forall msg. msg -> Proto msg
Proto PoolRegistrationCert
regCert Proto PoolRegistrationCert
-> Getting ByteString (Proto PoolRegistrationCert) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto PoolRegistrationCert) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "operator" a) =>
LensLike' f s a
UtxoRpc.operator] []
      UtxoRpc.Certificate'PoolRetirement PoolRetirementCert
retireCert ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials [] [PoolRetirementCert -> Proto PoolRetirementCert
forall msg. msg -> Proto msg
Proto PoolRetirementCert
retireCert Proto PoolRetirementCert
-> Getting ByteString (Proto PoolRetirementCert) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto PoolRetirementCert) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "poolKeyhash" a) =>
LensLike' f s a
UtxoRpc.poolKeyhash] []
      -- delegates genesis keys; carries no stake\/pool\/drep credential
      UtxoRpc.Certificate'GenesisKeyDelegation GenesisKeyDelegationCert
_ ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials [] [] []
      -- the targets are the reward recipients; 'any_stake_credential' must reach them
      UtxoRpc.Certificate'MirCert MirCert
mirCert ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials
          ((Proto MirTarget
-> Getting
     (Proto StakeCredential) (Proto MirTarget) (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential) (Proto MirTarget) (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "stakeCredential" a) =>
LensLike' f s a
UtxoRpc.stakeCredential) (Proto MirTarget -> Proto StakeCredential)
-> [Proto MirTarget] -> [Proto StakeCredential]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MirCert -> Proto MirCert
forall msg. msg -> Proto msg
Proto MirCert
mirCert Proto MirCert
-> Getting [Proto MirTarget] (Proto MirCert) [Proto MirTarget]
-> [Proto MirTarget]
forall s a. s -> Getting a s a -> a
^. Getting [Proto MirTarget] (Proto MirCert) [Proto MirTarget]
forall (f :: * -> *) s a.
(Functor f, HasField s "to" a) =>
LensLike' f s a
UtxoRpc.to)
          []
          []
      UtxoRpc.Certificate'RegCert RegCert
regCert ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials [RegCert -> Proto RegCert
forall msg. msg -> Proto msg
Proto RegCert
regCert Proto RegCert
-> Getting
     (Proto StakeCredential) (Proto RegCert) (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential) (Proto RegCert) (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "stakeCredential" a) =>
LensLike' f s a
UtxoRpc.stakeCredential] [] []
      UtxoRpc.Certificate'UnregCert UnRegCert
unregCert ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials [UnRegCert -> Proto UnRegCert
forall msg. msg -> Proto msg
Proto UnRegCert
unregCert Proto UnRegCert
-> Getting
     (Proto StakeCredential) (Proto UnRegCert) (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential) (Proto UnRegCert) (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "stakeCredential" a) =>
LensLike' f s a
UtxoRpc.stakeCredential] [] []
      UtxoRpc.Certificate'VoteDelegCert VoteDelegCert
voteDelegCert ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials
          [VoteDelegCert -> Proto VoteDelegCert
forall msg. msg -> Proto msg
Proto VoteDelegCert
voteDelegCert Proto VoteDelegCert
-> Getting
     (Proto StakeCredential)
     (Proto VoteDelegCert)
     (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential)
  (Proto VoteDelegCert)
  (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "stakeCredential" a) =>
LensLike' f s a
UtxoRpc.stakeCredential]
          []
          (Maybe ByteString -> [ByteString]
forall a. Maybe a -> [a]
maybeToList (Maybe ByteString -> [ByteString])
-> (Proto DRep -> Maybe ByteString) -> Proto DRep -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto DRep -> Maybe ByteString
voteDrepBytes (Proto DRep -> [ByteString]) -> Proto DRep -> [ByteString]
forall a b. (a -> b) -> a -> b
$ VoteDelegCert -> Proto VoteDelegCert
forall msg. msg -> Proto msg
Proto VoteDelegCert
voteDelegCert Proto VoteDelegCert
-> Getting (Proto DRep) (Proto VoteDelegCert) (Proto DRep)
-> Proto DRep
forall s a. s -> Getting a s a -> a
^. Getting (Proto DRep) (Proto VoteDelegCert) (Proto DRep)
forall (f :: * -> *) s a.
(Functor f, HasField s "drep" a) =>
LensLike' f s a
UtxoRpc.drep)
      UtxoRpc.Certificate'StakeVoteDelegCert StakeVoteDelegCert
stakeVoteDelegCert ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials
          [StakeVoteDelegCert -> Proto StakeVoteDelegCert
forall msg. msg -> Proto msg
Proto StakeVoteDelegCert
stakeVoteDelegCert Proto StakeVoteDelegCert
-> Getting
     (Proto StakeCredential)
     (Proto StakeVoteDelegCert)
     (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential)
  (Proto StakeVoteDelegCert)
  (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "stakeCredential" a) =>
LensLike' f s a
UtxoRpc.stakeCredential]
          [StakeVoteDelegCert -> Proto StakeVoteDelegCert
forall msg. msg -> Proto msg
Proto StakeVoteDelegCert
stakeVoteDelegCert Proto StakeVoteDelegCert
-> Getting ByteString (Proto StakeVoteDelegCert) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto StakeVoteDelegCert) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "poolKeyhash" a) =>
LensLike' f s a
UtxoRpc.poolKeyhash]
          (Maybe ByteString -> [ByteString]
forall a. Maybe a -> [a]
maybeToList (Maybe ByteString -> [ByteString])
-> (Proto DRep -> Maybe ByteString) -> Proto DRep -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto DRep -> Maybe ByteString
voteDrepBytes (Proto DRep -> [ByteString]) -> Proto DRep -> [ByteString]
forall a b. (a -> b) -> a -> b
$ StakeVoteDelegCert -> Proto StakeVoteDelegCert
forall msg. msg -> Proto msg
Proto StakeVoteDelegCert
stakeVoteDelegCert Proto StakeVoteDelegCert
-> Getting (Proto DRep) (Proto StakeVoteDelegCert) (Proto DRep)
-> Proto DRep
forall s a. s -> Getting a s a -> a
^. Getting (Proto DRep) (Proto StakeVoteDelegCert) (Proto DRep)
forall (f :: * -> *) s a.
(Functor f, HasField s "drep" a) =>
LensLike' f s a
UtxoRpc.drep)
      UtxoRpc.Certificate'StakeRegDelegCert StakeRegDelegCert
stakeRegDelegCert ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials
          [StakeRegDelegCert -> Proto StakeRegDelegCert
forall msg. msg -> Proto msg
Proto StakeRegDelegCert
stakeRegDelegCert Proto StakeRegDelegCert
-> Getting
     (Proto StakeCredential)
     (Proto StakeRegDelegCert)
     (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential)
  (Proto StakeRegDelegCert)
  (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "stakeCredential" a) =>
LensLike' f s a
UtxoRpc.stakeCredential]
          [StakeRegDelegCert -> Proto StakeRegDelegCert
forall msg. msg -> Proto msg
Proto StakeRegDelegCert
stakeRegDelegCert Proto StakeRegDelegCert
-> Getting ByteString (Proto StakeRegDelegCert) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto StakeRegDelegCert) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "poolKeyhash" a) =>
LensLike' f s a
UtxoRpc.poolKeyhash]
          []
      UtxoRpc.Certificate'VoteRegDelegCert VoteRegDelegCert
voteRegDelegCert ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials
          [VoteRegDelegCert -> Proto VoteRegDelegCert
forall msg. msg -> Proto msg
Proto VoteRegDelegCert
voteRegDelegCert Proto VoteRegDelegCert
-> Getting
     (Proto StakeCredential)
     (Proto VoteRegDelegCert)
     (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential)
  (Proto VoteRegDelegCert)
  (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "stakeCredential" a) =>
LensLike' f s a
UtxoRpc.stakeCredential]
          []
          (Maybe ByteString -> [ByteString]
forall a. Maybe a -> [a]
maybeToList (Maybe ByteString -> [ByteString])
-> (Proto DRep -> Maybe ByteString) -> Proto DRep -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto DRep -> Maybe ByteString
voteDrepBytes (Proto DRep -> [ByteString]) -> Proto DRep -> [ByteString]
forall a b. (a -> b) -> a -> b
$ VoteRegDelegCert -> Proto VoteRegDelegCert
forall msg. msg -> Proto msg
Proto VoteRegDelegCert
voteRegDelegCert Proto VoteRegDelegCert
-> Getting (Proto DRep) (Proto VoteRegDelegCert) (Proto DRep)
-> Proto DRep
forall s a. s -> Getting a s a -> a
^. Getting (Proto DRep) (Proto VoteRegDelegCert) (Proto DRep)
forall (f :: * -> *) s a.
(Functor f, HasField s "drep" a) =>
LensLike' f s a
UtxoRpc.drep)
      UtxoRpc.Certificate'StakeVoteRegDelegCert StakeVoteRegDelegCert
stakeVoteRegDelegCert ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials
          [StakeVoteRegDelegCert -> Proto StakeVoteRegDelegCert
forall msg. msg -> Proto msg
Proto StakeVoteRegDelegCert
stakeVoteRegDelegCert Proto StakeVoteRegDelegCert
-> Getting
     (Proto StakeCredential)
     (Proto StakeVoteRegDelegCert)
     (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential)
  (Proto StakeVoteRegDelegCert)
  (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "stakeCredential" a) =>
LensLike' f s a
UtxoRpc.stakeCredential]
          [StakeVoteRegDelegCert -> Proto StakeVoteRegDelegCert
forall msg. msg -> Proto msg
Proto StakeVoteRegDelegCert
stakeVoteRegDelegCert Proto StakeVoteRegDelegCert
-> Getting ByteString (Proto StakeVoteRegDelegCert) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto StakeVoteRegDelegCert) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "poolKeyhash" a) =>
LensLike' f s a
UtxoRpc.poolKeyhash]
          (Maybe ByteString -> [ByteString]
forall a. Maybe a -> [a]
maybeToList (Maybe ByteString -> [ByteString])
-> (Proto DRep -> Maybe ByteString) -> Proto DRep -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto DRep -> Maybe ByteString
voteDrepBytes (Proto DRep -> [ByteString]) -> Proto DRep -> [ByteString]
forall a b. (a -> b) -> a -> b
$ StakeVoteRegDelegCert -> Proto StakeVoteRegDelegCert
forall msg. msg -> Proto msg
Proto StakeVoteRegDelegCert
stakeVoteRegDelegCert Proto StakeVoteRegDelegCert
-> Getting (Proto DRep) (Proto StakeVoteRegDelegCert) (Proto DRep)
-> Proto DRep
forall s a. s -> Getting a s a -> a
^. Getting (Proto DRep) (Proto StakeVoteRegDelegCert) (Proto DRep)
forall (f :: * -> *) s a.
(Functor f, HasField s "drep" a) =>
LensLike' f s a
UtxoRpc.drep)
      UtxoRpc.Certificate'AuthCommitteeHotCert AuthCommitteeHotCert
authCert ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials
          [ AuthCommitteeHotCert -> Proto AuthCommitteeHotCert
forall msg. msg -> Proto msg
Proto AuthCommitteeHotCert
authCert Proto AuthCommitteeHotCert
-> Getting
     (Proto StakeCredential)
     (Proto AuthCommitteeHotCert)
     (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential)
  (Proto AuthCommitteeHotCert)
  (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "committeeColdCredential" a) =>
LensLike' f s a
UtxoRpc.committeeColdCredential
          , AuthCommitteeHotCert -> Proto AuthCommitteeHotCert
forall msg. msg -> Proto msg
Proto AuthCommitteeHotCert
authCert Proto AuthCommitteeHotCert
-> Getting
     (Proto StakeCredential)
     (Proto AuthCommitteeHotCert)
     (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential)
  (Proto AuthCommitteeHotCert)
  (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "committeeHotCredential" a) =>
LensLike' f s a
UtxoRpc.committeeHotCredential
          ]
          []
          []
      UtxoRpc.Certificate'ResignCommitteeColdCert ResignCommitteeColdCert
resignCert ->
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials [ResignCommitteeColdCert -> Proto ResignCommitteeColdCert
forall msg. msg -> Proto msg
Proto ResignCommitteeColdCert
resignCert Proto ResignCommitteeColdCert
-> Getting
     (Proto StakeCredential)
     (Proto ResignCommitteeColdCert)
     (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential)
  (Proto ResignCommitteeColdCert)
  (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "committeeColdCredential" a) =>
LensLike' f s a
UtxoRpc.committeeColdCredential] [] []
      UtxoRpc.Certificate'RegDrepCert RegDRepCert
regDrepCert -> do
        let drepCredential :: Proto StakeCredential
drepCredential = RegDRepCert -> Proto RegDRepCert
forall msg. msg -> Proto msg
Proto RegDRepCert
regDrepCert Proto RegDRepCert
-> Getting
     (Proto StakeCredential) (Proto RegDRepCert) (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential) (Proto RegDRepCert) (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "drepCredential" a) =>
LensLike' f s a
UtxoRpc.drepCredential
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials [Proto StakeCredential
drepCredential] [] [Proto StakeCredential -> ByteString
credentialBytes Proto StakeCredential
drepCredential]
      UtxoRpc.Certificate'UnregDrepCert UnRegDRepCert
unregDrepCert -> do
        let drepCredential :: Proto StakeCredential
drepCredential = UnRegDRepCert -> Proto UnRegDRepCert
forall msg. msg -> Proto msg
Proto UnRegDRepCert
unregDrepCert Proto UnRegDRepCert
-> Getting
     (Proto StakeCredential)
     (Proto UnRegDRepCert)
     (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential)
  (Proto UnRegDRepCert)
  (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "drepCredential" a) =>
LensLike' f s a
UtxoRpc.drepCredential
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials [Proto StakeCredential
drepCredential] [] [Proto StakeCredential -> ByteString
credentialBytes Proto StakeCredential
drepCredential]
      UtxoRpc.Certificate'UpdateDrepCert UpdateDRepCert
updateDrepCert -> do
        let drepCredential :: Proto StakeCredential
drepCredential = UpdateDRepCert -> Proto UpdateDRepCert
forall msg. msg -> Proto msg
Proto UpdateDRepCert
updateDrepCert Proto UpdateDRepCert
-> Getting
     (Proto StakeCredential)
     (Proto UpdateDRepCert)
     (Proto StakeCredential)
-> Proto StakeCredential
forall s a. s -> Getting a s a -> a
^. Getting
  (Proto StakeCredential)
  (Proto UpdateDRepCert)
  (Proto StakeCredential)
forall (f :: * -> *) s a.
(Functor f, HasField s "drepCredential" a) =>
LensLike' f s a
UtxoRpc.drepCredential
        [Proto StakeCredential]
-> [ByteString] -> [ByteString] -> CertificateCredentials
CertificateCredentials [Proto StakeCredential
drepCredential] [] [Proto StakeCredential -> ByteString
credentialBytes Proto StakeCredential
drepCredential]

-- | Every stake-shaped credential embedded in a certificate; see 'certificateCredentials'.
certificateStakeCredentials :: Proto UtxoRpc.Certificate -> [Proto UtxoRpc.StakeCredential]
certificateStakeCredentials :: Proto Certificate -> [Proto StakeCredential]
certificateStakeCredentials = CertificateCredentials -> [Proto StakeCredential]
certStakeCredentials (CertificateCredentials -> [Proto StakeCredential])
-> (Proto Certificate -> CertificateCredentials)
-> Proto Certificate
-> [Proto StakeCredential]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto Certificate -> CertificateCredentials
certificateCredentials

matchesAnyStakeCredential :: [Proto UtxoRpc.StakeCredential] -> ByteString -> Bool
matchesAnyStakeCredential :: [Proto StakeCredential] -> ByteString -> Bool
matchesAnyStakeCredential [Proto StakeCredential]
stakeCredentials ByteString
bytes = (Proto StakeCredential -> Bool) -> [Proto StakeCredential] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bytes) (ByteString -> Bool)
-> (Proto StakeCredential -> ByteString)
-> Proto StakeCredential
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto StakeCredential -> ByteString
credentialBytes) [Proto StakeCredential]
stakeCredentials

-- | Every pool key hash embedded in a certificate; see 'certificateCredentials'.
certificatePoolKeyHashes :: Proto UtxoRpc.Certificate -> [ByteString]
certificatePoolKeyHashes :: Proto Certificate -> [ByteString]
certificatePoolKeyHashes = CertificateCredentials -> [ByteString]
certPoolKeyHashes (CertificateCredentials -> [ByteString])
-> (Proto Certificate -> CertificateCredentials)
-> Proto Certificate
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto Certificate -> CertificateCredentials
certificateCredentials

matchesAnyPoolKeyHash :: [ByteString] -> ByteString -> Bool
matchesAnyPoolKeyHash :: [ByteString] -> ByteString -> Bool
matchesAnyPoolKeyHash [ByteString]
poolKeyHashes ByteString
bytes = ByteString
bytes ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
poolKeyHashes

-- | Every DRep, identified by key\/script hash, embedded in a certificate; see 'certificateCredentials'.
certificateDRepBytes :: Proto UtxoRpc.Certificate -> [ByteString]
certificateDRepBytes :: Proto Certificate -> [ByteString]
certificateDRepBytes = CertificateCredentials -> [ByteString]
certDRepBytes (CertificateCredentials -> [ByteString])
-> (Proto Certificate -> CertificateCredentials)
-> Proto Certificate
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto Certificate -> CertificateCredentials
certificateCredentials

matchesAnyDRep :: [ByteString] -> ByteString -> Bool
matchesAnyDRep :: [ByteString] -> ByteString -> Bool
matchesAnyDRep [ByteString]
drepHashes ByteString
bytes = ByteString
bytes ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
drepHashes