{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Rpc.Server.Internal.UtxoRpc.Type.TxOutput
  ( policyAssetsToUtxoRpcMultiassets
  , txOutToUtxoRpcTxOutput
  , utxoRpcTxOutputToTxOut
  , txoRefUtxoRpcToTxIn
  , utxoToUtxoRpcAnyUtxoData
  , txInTxOutToAnyUtxoData
  , anyUtxoDataUtxoRpcToUtxo
  )
where

import Cardano.Api.Era
import Cardano.Api.Error
import Cardano.Api.Experimental.Era
import Cardano.Api.HasTypeProxy
import Cardano.Api.Ledger qualified as L
import Cardano.Api.Plutus
import Cardano.Api.Serialise.Cbor
import Cardano.Api.Serialise.Raw
import Cardano.Api.Tx
import Cardano.Api.Value
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as U5c
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
import Cardano.Rpc.Server.Internal.Orphans ()
import Cardano.Rpc.Server.Internal.UtxoRpc.Type.BigInt
import Cardano.Rpc.Server.Internal.UtxoRpc.Type.PlutusData
import Cardano.Rpc.Server.Internal.UtxoRpc.Type.Script

import Cardano.Binary qualified as CBOR

import RIO hiding (toList)

import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Char8 qualified as BSC
import Data.ProtoLens (defMessage)
import GHC.IsList
import Network.GRPC.Spec

utxoToUtxoRpcAnyUtxoData :: forall era. IsEra era => UTxO era -> [Proto UtxoRpc.AnyUtxoData]
utxoToUtxoRpcAnyUtxoData :: forall era. IsEra era => UTxO era -> [Proto AnyUtxoData]
utxoToUtxoRpcAnyUtxoData = ((TxIn, TxOut CtxUTxO era) -> Proto AnyUtxoData)
-> [(TxIn, TxOut CtxUTxO era)] -> [Proto AnyUtxoData]
forall a b. (a -> b) -> [a] -> [b]
map ((TxIn -> TxOut CtxUTxO era -> Proto AnyUtxoData)
-> (TxIn, TxOut CtxUTxO era) -> Proto AnyUtxoData
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxIn -> TxOut CtxUTxO era -> Proto AnyUtxoData
forall era.
IsEra era =>
TxIn -> TxOut CtxUTxO era -> Proto AnyUtxoData
txInTxOutToAnyUtxoData) ([(TxIn, TxOut CtxUTxO era)] -> [Proto AnyUtxoData])
-> (UTxO era -> [(TxIn, TxOut CtxUTxO era)])
-> UTxO era
-> [Proto AnyUtxoData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO era -> [(TxIn, TxOut CtxUTxO era)]
UTxO era -> [Item (UTxO era)]
forall l. IsList l => l -> [Item l]
toList

txInTxOutToAnyUtxoData
  :: forall era. IsEra era => TxIn -> TxOut CtxUTxO era -> Proto UtxoRpc.AnyUtxoData
txInTxOutToAnyUtxoData :: forall era.
IsEra era =>
TxIn -> TxOut CtxUTxO era -> Proto AnyUtxoData
txInTxOutToAnyUtxoData TxIn
txIn TxOut CtxUTxO era
txOut = do
  let era :: Era era
era = forall era. IsEra era => Era era
useEra @era
      txOutCbor :: ByteString
txOutCbor =
        Era era -> (EraCommonConstraints era => ByteString) -> ByteString
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => ByteString) -> ByteString)
-> (EraCommonConstraints era => ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$
          TxOut (LedgerEra era) -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize' (TxOut (LedgerEra era) -> ByteString)
-> TxOut (LedgerEra era) -> ByteString
forall a b. (a -> b) -> a -> b
$
            ShelleyBasedEra era -> TxOut CtxUTxO era -> TxOut (LedgerEra era)
forall era ledgerera.
(HasCallStack, ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era -> TxOut CtxUTxO era -> TxOut ledgerera
toShelleyTxOut (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era) TxOut CtxUTxO era
txOut
  Proto AnyUtxoData
forall msg. Message msg => msg
defMessage
    Proto AnyUtxoData
-> (Proto AnyUtxoData -> Proto AnyUtxoData) -> Proto AnyUtxoData
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto AnyUtxoData) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "nativeBytes" a) =>
LensLike' f s a
U5c.nativeBytes LensLike' Identity (Proto AnyUtxoData) ByteString
-> ByteString -> Proto AnyUtxoData -> Proto AnyUtxoData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
txOutCbor
    Proto AnyUtxoData
-> (Proto AnyUtxoData -> Proto AnyUtxoData) -> Proto AnyUtxoData
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto AnyUtxoData) (Proto TxoRef)
forall (f :: * -> *) s a.
(Functor f, HasField s "txoRef" a) =>
LensLike' f s a
U5c.txoRef LensLike' Identity (Proto AnyUtxoData) (Proto TxoRef)
-> Proto TxoRef -> Proto AnyUtxoData -> Proto AnyUtxoData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxIn -> Proto TxoRef
forall t s. Inject t s => t -> s
inject TxIn
txIn
    Proto AnyUtxoData
-> (Proto AnyUtxoData -> Proto AnyUtxoData) -> Proto AnyUtxoData
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto AnyUtxoData) (Proto TxOutput)
forall (f :: * -> *) s a.
(Functor f, HasField s "cardano" a) =>
LensLike' f s a
U5c.cardano LensLike' Identity (Proto AnyUtxoData) (Proto TxOutput)
-> Proto TxOutput -> Proto AnyUtxoData -> Proto AnyUtxoData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShelleyBasedEra era -> TxOut CtxUTxO era -> Proto TxOutput
forall era.
ShelleyBasedEra era -> TxOut CtxUTxO era -> Proto TxOutput
txOutToUtxoRpcTxOutput (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era) TxOut CtxUTxO era
txOut

anyUtxoDataUtxoRpcToUtxo
  :: forall era m
   . HasCallStack
  => MonadThrow m
  => Era era
  -> [Proto UtxoRpc.AnyUtxoData]
  -> m (UTxO era)
anyUtxoDataUtxoRpcToUtxo :: forall era (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Era era -> [Proto AnyUtxoData] -> m (UTxO era)
anyUtxoDataUtxoRpcToUtxo Era era
era = ([(TxIn, TxOut CtxUTxO era)] -> UTxO era)
-> m [(TxIn, TxOut CtxUTxO era)] -> m (UTxO era)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(TxIn, TxOut CtxUTxO era)] -> UTxO era
[Item (UTxO era)] -> UTxO era
forall l. IsList l => [Item l] -> l
fromList (m [(TxIn, TxOut CtxUTxO era)] -> m (UTxO era))
-> ([Proto AnyUtxoData] -> m [(TxIn, TxOut CtxUTxO era)])
-> [Proto AnyUtxoData]
-> m (UTxO era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(TxIn, TxOut CtxUTxO era)]
 -> Proto AnyUtxoData -> m [(TxIn, TxOut CtxUTxO era)])
-> [(TxIn, TxOut CtxUTxO era)]
-> [Proto AnyUtxoData]
-> m [(TxIn, TxOut CtxUTxO era)]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [(TxIn, TxOut CtxUTxO era)]
-> Proto AnyUtxoData -> m [(TxIn, TxOut CtxUTxO era)]
f [(TxIn, TxOut CtxUTxO era)]
forall a. Monoid a => a
mempty
 where
  f
    :: [(TxIn, TxOut CtxUTxO era)]
    -> Proto UtxoRpc.AnyUtxoData
    -> m [(TxIn, TxOut CtxUTxO era)]
  f :: [(TxIn, TxOut CtxUTxO era)]
-> Proto AnyUtxoData -> m [(TxIn, TxOut CtxUTxO era)]
f [(TxIn, TxOut CtxUTxO era)]
acc Proto AnyUtxoData
e = do
    txOut <- Era era
-> (EraCommonConstraints era => m (TxOut CtxUTxO era))
-> m (TxOut CtxUTxO era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => m (TxOut CtxUTxO era))
 -> m (TxOut CtxUTxO era))
-> (EraCommonConstraints era => m (TxOut CtxUTxO era))
-> m (TxOut CtxUTxO era)
forall a b. (a -> b) -> a -> b
$ Proto TxOutput -> m (TxOut CtxUTxO era)
forall era (m :: * -> *).
(HasCallStack, MonadThrow m, IsEra era) =>
Proto TxOutput -> m (TxOut CtxUTxO era)
utxoRpcTxOutputToTxOut (Proto TxOutput -> m (TxOut CtxUTxO era))
-> Proto TxOutput -> m (TxOut CtxUTxO era)
forall a b. (a -> b) -> a -> b
$ Proto AnyUtxoData
e Proto AnyUtxoData
-> Getting (Proto TxOutput) (Proto AnyUtxoData) (Proto TxOutput)
-> Proto TxOutput
forall s a. s -> Getting a s a -> a
^. Getting (Proto TxOutput) (Proto AnyUtxoData) (Proto TxOutput)
forall (f :: * -> *) s a.
(Functor f, HasField s "cardano" a) =>
LensLike' f s a
U5c.cardano
    txIn <- txoRefUtxoRpcToTxIn $ e ^. U5c.txoRef
    pure $ (txIn, txOut) : acc

txoRefUtxoRpcToTxIn
  :: forall m
   . HasCallStack
  => MonadThrow m
  => Proto UtxoRpc.TxoRef
  -> m TxIn
txoRefUtxoRpcToTxIn :: forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Proto TxoRef -> m TxIn
txoRefUtxoRpcToTxIn Proto TxoRef
txoRef = do
  txId' <-
    Either SerialiseAsRawBytesError TxId -> m TxId
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (Either SerialiseAsRawBytesError TxId -> m TxId)
-> Either SerialiseAsRawBytesError TxId -> m TxId
forall a b. (a -> b) -> a -> b
$
      AsType TxId -> ByteString -> Either SerialiseAsRawBytesError TxId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType TxId
forall t. HasTypeProxy t => AsType t
asType (ByteString -> Either SerialiseAsRawBytesError TxId)
-> ByteString -> Either SerialiseAsRawBytesError TxId
forall a b. (a -> b) -> a -> b
$
        Proto TxoRef
txoRef Proto TxoRef
-> Getting ByteString (Proto TxoRef) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto TxoRef) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "hash" a) =>
LensLike' f s a
U5c.hash
  pure $ TxIn txId' (TxIx . fromIntegral $ txoRef ^. U5c.index)

-- | Convert per-policy asset bundles to UTxO RPC 'UtxoRpc.Multiasset' messages.
policyAssetsToUtxoRpcMultiassets :: Map PolicyId PolicyAssets -> [Proto UtxoRpc.Multiasset]
policyAssetsToUtxoRpcMultiassets :: Map PolicyId PolicyAssets -> [Proto Multiasset]
policyAssetsToUtxoRpcMultiassets Map PolicyId PolicyAssets
policyAssetsMap =
  Map PolicyId PolicyAssets -> [Item (Map PolicyId PolicyAssets)]
forall l. IsList l => l -> [Item l]
toList Map PolicyId PolicyAssets
policyAssetsMap [(PolicyId, PolicyAssets)]
-> ((PolicyId, PolicyAssets) -> Proto Multiasset)
-> [Proto Multiasset]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(PolicyId
pId, PolicyAssets
policyAssets) -> do
    let assets :: [Proto Asset]
assets =
          PolicyAssets -> [Item PolicyAssets]
forall l. IsList l => l -> [Item l]
toList PolicyAssets
policyAssets [(AssetName, Quantity)]
-> ((AssetName, Quantity) -> Proto Asset) -> [Proto Asset]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(AssetName
assetName, Quantity Integer
qty) -> do
            Proto Asset
forall msg. Message msg => msg
defMessage
              Proto Asset -> (Proto Asset -> Proto Asset) -> Proto Asset
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Asset) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "name" a) =>
LensLike' f s a
U5c.name LensLike' Identity (Proto Asset) ByteString
-> ByteString -> Proto Asset -> Proto Asset
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AssetName -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes AssetName
assetName
              -- we don't have access to info if the coin was minted in the transaction,
              -- maybe we should add it later
              -- & U5c.maybe'mintCoin .~ Nothing
              Proto Asset -> (Proto Asset -> Proto Asset) -> Proto Asset
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Asset) (Proto BigInt)
forall (f :: * -> *) s a.
(Functor f, HasField s "quantity" a) =>
LensLike' f s a
U5c.quantity LensLike' Identity (Proto Asset) (Proto BigInt)
-> Proto BigInt -> Proto Asset -> Proto Asset
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Proto BigInt
forall t s. Inject t s => t -> s
inject Integer
qty
    Proto Multiasset
forall msg. Message msg => msg
defMessage
      Proto Multiasset
-> (Proto Multiasset -> Proto Multiasset) -> Proto Multiasset
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Multiasset) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "policyId" a) =>
LensLike' f s a
U5c.policyId LensLike' Identity (Proto Multiasset) ByteString
-> ByteString -> Proto Multiasset -> Proto Multiasset
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PolicyId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes PolicyId
pId
      Proto Multiasset
-> (Proto Multiasset -> Proto Multiasset) -> Proto Multiasset
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Multiasset) [Proto Asset]
forall (f :: * -> *) s a.
(Functor f, HasField s "assets" a) =>
LensLike' f s a
U5c.assets LensLike' Identity (Proto Multiasset) [Proto Asset]
-> [Proto Asset] -> Proto Multiasset -> Proto Multiasset
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Proto Asset]
assets

txOutToUtxoRpcTxOutput
  :: ShelleyBasedEra era
  -> TxOut CtxUTxO era
  -> Proto UtxoRpc.TxOutput
txOutToUtxoRpcTxOutput :: forall era.
ShelleyBasedEra era -> TxOut CtxUTxO era -> Proto TxOutput
txOutToUtxoRpcTxOutput ShelleyBasedEra era
sbe (TxOut AddressInEra era
addressInEra TxOutValue era
txOutValue TxOutDatum CtxUTxO era
datum ReferenceScript era
script) = do
  let multiAsset :: [Proto Multiasset]
multiAsset = Map PolicyId PolicyAssets -> [Proto Multiasset]
policyAssetsToUtxoRpcMultiassets (Map PolicyId PolicyAssets -> [Proto Multiasset])
-> (Value -> Map PolicyId PolicyAssets)
-> Value
-> [Proto Multiasset]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Map PolicyId PolicyAssets
valueToPolicyAssets (Value -> [Proto Multiasset]) -> Value -> [Proto Multiasset]
forall a b. (a -> b) -> a -> b
$ TxOutValue era -> Value
forall era. TxOutValue era -> Value
txOutValueToValue TxOutValue era
txOutValue
      datumRpc :: Maybe (Proto Datum)
datumRpc = case TxOutDatum CtxUTxO era
datum of
        TxOutDatum CtxUTxO era
TxOutDatumNone ->
          Maybe (Proto Datum)
forall a. Maybe a
Nothing
        TxOutDatumHash AlonzoEraOnwards era
_ Hash ScriptData
scriptDataHash ->
          Proto Datum -> Maybe (Proto Datum)
forall a. a -> Maybe a
Just (Proto Datum -> Maybe (Proto Datum))
-> Proto Datum -> Maybe (Proto Datum)
forall a b. (a -> b) -> a -> b
$
            Proto Datum
forall msg. Message msg => msg
defMessage
              Proto Datum -> (Proto Datum -> Proto Datum) -> Proto Datum
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Datum) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "hash" a) =>
LensLike' f s a
U5c.hash LensLike' Identity (Proto Datum) ByteString
-> ByteString -> Proto Datum -> Proto Datum
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Hash ScriptData -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes Hash ScriptData
scriptDataHash
              Proto Datum -> (Proto Datum -> Proto Datum) -> Proto Datum
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Datum) (Maybe (Proto PlutusData))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'payload" a) =>
LensLike' f s a
U5c.maybe'payload LensLike' Identity (Proto Datum) (Maybe (Proto PlutusData))
-> Maybe (Proto PlutusData) -> Proto Datum -> Proto Datum
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Proto PlutusData)
forall a. Maybe a
Nothing -- we don't have it
              Proto Datum -> (Proto Datum -> Proto Datum) -> Proto Datum
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Datum) (Maybe ByteString)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'originalCbor" a) =>
LensLike' f s a
U5c.maybe'originalCbor LensLike' Identity (Proto Datum) (Maybe ByteString)
-> Maybe ByteString -> Proto Datum -> Proto Datum
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ByteString
forall a. Maybe a
Nothing
        TxOutDatumInline BabbageEraOnwards era
_ HashableScriptData
hashableScriptData ->
          Proto Datum -> Maybe (Proto Datum)
forall a. a -> Maybe a
Just (Proto Datum -> Maybe (Proto Datum))
-> Proto Datum -> Maybe (Proto Datum)
forall a b. (a -> b) -> a -> b
$
            Proto Datum
forall msg. Message msg => msg
defMessage
              Proto Datum -> (Proto Datum -> Proto Datum) -> Proto Datum
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Datum) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "hash" a) =>
LensLike' f s a
U5c.hash LensLike' Identity (Proto Datum) ByteString
-> ByteString -> Proto Datum -> Proto Datum
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Hash ScriptData -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes (HashableScriptData -> Hash ScriptData
hashScriptDataBytes HashableScriptData
hashableScriptData)
              Proto Datum -> (Proto Datum -> Proto Datum) -> Proto Datum
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Datum) (Proto PlutusData)
forall (f :: * -> *) s a.
(Functor f, HasField s "payload" a) =>
LensLike' f s a
U5c.payload LensLike' Identity (Proto Datum) (Proto PlutusData)
-> Proto PlutusData -> Proto Datum -> Proto Datum
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScriptData -> Proto PlutusData
scriptDataToUtxoRpcPlutusData (HashableScriptData -> ScriptData
getScriptData HashableScriptData
hashableScriptData)
              Proto Datum -> (Proto Datum -> Proto Datum) -> Proto Datum
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Datum) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "originalCbor" a) =>
LensLike' f s a
U5c.originalCbor LensLike' Identity (Proto Datum) ByteString
-> ByteString -> Proto Datum -> Proto Datum
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HashableScriptData -> ByteString
getOriginalScriptDataBytes HashableScriptData
hashableScriptData

  Proto TxOutput
forall msg. Message msg => msg
defMessage
    Proto TxOutput
-> (Proto TxOutput -> Proto TxOutput) -> Proto TxOutput
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto TxOutput) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "address" a) =>
LensLike' f s a
U5c.address LensLike' Identity (Proto TxOutput) ByteString
-> ByteString -> Proto TxOutput -> Proto TxOutput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe (AddressInEra era -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes AddressInEra era
addressInEra)
    Proto TxOutput
-> (Proto TxOutput -> Proto TxOutput) -> Proto TxOutput
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto TxOutput) (Proto BigInt)
forall (f :: * -> *) s a.
(Functor f, HasField s "coin" a) =>
LensLike' f s a
U5c.coin LensLike' Identity (Proto TxOutput) (Proto BigInt)
-> Proto BigInt -> Proto TxOutput -> Proto TxOutput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Proto BigInt
forall t s. Inject t s => t -> s
inject (Coin -> Integer
L.unCoin (TxOutValue era -> Coin
forall era. TxOutValue era -> Coin
txOutValueToLovelace TxOutValue era
txOutValue))
    Proto TxOutput
-> (Proto TxOutput -> Proto TxOutput) -> Proto TxOutput
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto TxOutput) [Proto Multiasset]
forall (f :: * -> *) s a.
(Functor f, HasField s "assets" a) =>
LensLike' f s a
U5c.assets LensLike' Identity (Proto TxOutput) [Proto Multiasset]
-> [Proto Multiasset] -> Proto TxOutput -> Proto TxOutput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Proto Multiasset]
multiAsset
    Proto TxOutput
-> (Proto TxOutput -> Proto TxOutput) -> Proto TxOutput
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto TxOutput) (Maybe (Proto Datum))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'datum" a) =>
LensLike' f s a
U5c.maybe'datum LensLike' Identity (Proto TxOutput) (Maybe (Proto Datum))
-> Maybe (Proto Datum) -> Proto TxOutput -> Proto TxOutput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Proto Datum)
datumRpc
    Proto TxOutput
-> (Proto TxOutput -> Proto TxOutput) -> Proto TxOutput
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto TxOutput) (Proto Script)
forall (f :: * -> *) s a.
(Functor f, HasField s "script" a) =>
LensLike' f s a
U5c.script LensLike' Identity (Proto TxOutput) (Proto Script)
-> Proto Script -> Proto TxOutput -> Proto TxOutput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ReferenceScript era -> Proto Script
forall era. ReferenceScript era -> Proto Script
referenceScriptToUtxoRpcScript ReferenceScript era
script

utxoRpcTxOutputToTxOut
  :: forall era m
   . HasCallStack
  => MonadThrow m
  => IsEra era
  => Proto UtxoRpc.TxOutput
  -> m (TxOut CtxUTxO era)
utxoRpcTxOutputToTxOut :: forall era (m :: * -> *).
(HasCallStack, MonadThrow m, IsEra era) =>
Proto TxOutput -> m (TxOut CtxUTxO era)
utxoRpcTxOutputToTxOut Proto TxOutput
txOutput = do
  let era :: Era era
era = forall era. IsEra era => Era era
useEra @era
  let addressBytes :: ByteString
addressBytes = Proto TxOutput
txOutput 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
U5c.address
      annotateError :: SerialiseAsRawBytesError -> SerialiseAsRawBytesError
annotateError (SerialiseAsRawBytesError String
msg) =
        String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError (String -> SerialiseAsRawBytesError)
-> String -> SerialiseAsRawBytesError
forall a b. (a -> b) -> a -> b
$
          String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", address (hex): " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
BSC.unpack (ByteString -> ByteString
Base16.encode ByteString
addressBytes)
  address <-
    Era era
-> (EraCommonConstraints era => m (AddressInEra era))
-> m (AddressInEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => m (AddressInEra era))
 -> m (AddressInEra era))
-> (EraCommonConstraints era => m (AddressInEra era))
-> m (AddressInEra era)
forall a b. (a -> b) -> a -> b
$
      Either SerialiseAsRawBytesError (AddressInEra era)
-> m (AddressInEra era)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (Either SerialiseAsRawBytesError (AddressInEra era)
 -> m (AddressInEra era))
-> Either SerialiseAsRawBytesError (AddressInEra era)
-> m (AddressInEra era)
forall a b. (a -> b) -> a -> b
$
        (SerialiseAsRawBytesError -> SerialiseAsRawBytesError)
-> Either SerialiseAsRawBytesError (AddressInEra era)
-> Either SerialiseAsRawBytesError (AddressInEra era)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SerialiseAsRawBytesError -> SerialiseAsRawBytesError
annotateError (Either SerialiseAsRawBytesError (AddressInEra era)
 -> Either SerialiseAsRawBytesError (AddressInEra era))
-> Either SerialiseAsRawBytesError (AddressInEra era)
-> Either SerialiseAsRawBytesError (AddressInEra era)
forall a b. (a -> b) -> a -> b
$
          AsType (AddressInEra era)
-> ByteString -> Either SerialiseAsRawBytesError (AddressInEra era)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType (AddressInEra era)
forall t. HasTypeProxy t => AsType t
asType ByteString
addressBytes
  datum <-
    case txOutput ^. U5c.maybe'datum of
      Just Proto Datum
datumRpc ->
        case Proto Datum
datumRpc Proto Datum
-> Getting (Maybe ByteString) (Proto Datum) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto Datum) (Maybe ByteString)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'originalCbor" a) =>
LensLike' f s a
U5c.maybe'originalCbor of
          Just ByteString
cbor ->
            Either DecoderError (TxOutDatum CtxUTxO era)
-> m (TxOutDatum CtxUTxO era)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (Either DecoderError (TxOutDatum CtxUTxO era)
 -> m (TxOutDatum CtxUTxO era))
-> Either DecoderError (TxOutDatum CtxUTxO era)
-> m (TxOutDatum CtxUTxO era)
forall a b. (a -> b) -> a -> b
$
              BabbageEraOnwards era
-> HashableScriptData -> TxOutDatum CtxUTxO era
forall era ctx.
BabbageEraOnwards era -> HashableScriptData -> TxOutDatum ctx era
TxOutDatumInline (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era)
                (HashableScriptData -> TxOutDatum CtxUTxO era)
-> Either DecoderError HashableScriptData
-> Either DecoderError (TxOutDatum CtxUTxO era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType HashableScriptData
-> ByteString -> Either DecoderError HashableScriptData
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType HashableScriptData
forall t. HasTypeProxy t => AsType t
asType ByteString
cbor
          Maybe ByteString
Nothing ->
            Either SerialiseAsRawBytesError (TxOutDatum CtxUTxO era)
-> m (TxOutDatum CtxUTxO era)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (Either SerialiseAsRawBytesError (TxOutDatum CtxUTxO era)
 -> m (TxOutDatum CtxUTxO era))
-> Either SerialiseAsRawBytesError (TxOutDatum CtxUTxO era)
-> m (TxOutDatum CtxUTxO era)
forall a b. (a -> b) -> a -> b
$
              AlonzoEraOnwards era -> Hash ScriptData -> TxOutDatum CtxUTxO era
forall era ctx.
AlonzoEraOnwards era -> Hash ScriptData -> TxOutDatum ctx era
TxOutDatumHash (Era era -> AlonzoEraOnwards era
forall era. Era era -> AlonzoEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era)
                (Hash ScriptData -> TxOutDatum CtxUTxO era)
-> Either SerialiseAsRawBytesError (Hash ScriptData)
-> Either SerialiseAsRawBytesError (TxOutDatum CtxUTxO era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (Hash ScriptData)
-> ByteString -> Either SerialiseAsRawBytesError (Hash ScriptData)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType (Hash ScriptData)
forall t. HasTypeProxy t => AsType t
asType (Proto Datum
datumRpc Proto Datum
-> Getting ByteString (Proto Datum) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto Datum) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "hash" a) =>
LensLike' f s a
U5c.hash)
      Maybe (Proto Datum)
Nothing -> TxOutDatum CtxUTxO era -> m (TxOutDatum CtxUTxO era)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxOutDatum CtxUTxO era
forall ctx era. TxOutDatum ctx era
TxOutDatumNone
  referenceScript <- utxoRpcScriptToReferenceScript (txOutput ^. U5c.script)
  coinValue <- lovelaceToValue . L.Coin <$> txOutput ^. U5c.coin . to utxoRpcBigIntToInteger
  multiAssetValue <- fmap (fromList @Value . join) . forM (txOutput ^. U5c.assets) $ \Proto Multiasset
policyAssets -> do
    pId <-
      Either SerialiseAsRawBytesError PolicyId -> m PolicyId
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (Either SerialiseAsRawBytesError PolicyId -> m PolicyId)
-> Either SerialiseAsRawBytesError PolicyId -> m PolicyId
forall a b. (a -> b) -> a -> b
$ AsType PolicyId
-> ByteString -> Either SerialiseAsRawBytesError PolicyId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType PolicyId
AsPolicyId (Proto Multiasset
policyAssets 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
U5c.policyId)
    forM (policyAssets ^. U5c.assets) $ \Proto Asset
asset -> do
      assetName <-
        Either SerialiseAsRawBytesError AssetName -> m AssetName
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (Either SerialiseAsRawBytesError AssetName -> m AssetName)
-> Either SerialiseAsRawBytesError AssetName -> m AssetName
forall a b. (a -> b) -> a -> b
$
          AsType AssetName
-> ByteString -> Either SerialiseAsRawBytesError AssetName
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType AssetName
AsAssetName (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
U5c.name)
      coin <- Quantity <$> asset ^. U5c.quantity . to utxoRpcBigIntToInteger
      pure (AssetId pId assetName, coin)
  pure $
    TxOut
      address
      ( obtainCommonConstraints era $
          TxOutValueShelleyBased (convert era) (toMaryValue $ coinValue <> multiAssetValue)
      )
      datum
      referenceScript