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

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

import Cardano.Api.Address
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.ProtoLens (defMessage)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
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)

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 =
        [Item [Proto Multiasset]] -> [Proto Multiasset]
forall l. IsList l => [Item l] -> l
fromList ([Item [Proto Multiasset]] -> [Proto Multiasset])
-> [Item [Proto Multiasset]] -> [Proto Multiasset]
forall a b. (a -> b) -> a -> b
$
          Map PolicyId PolicyAssets -> [Item (Map PolicyId PolicyAssets)]
forall l. IsList l => l -> [Item l]
toList (Value -> Map PolicyId PolicyAssets
valueToPolicyAssets (Value -> Map PolicyId PolicyAssets)
-> Value -> Map PolicyId PolicyAssets
forall a b. (a -> b) -> a -> b
$ TxOutValue era -> Value
forall era. TxOutValue era -> Value
txOutValueToValue TxOutValue era
txOutValue) [(PolicyId, PolicyAssets)]
-> ((PolicyId, PolicyAssets) -> Item [Proto Multiasset])
-> [Item [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
            Item [Proto Multiasset]
forall msg. Message msg => msg
defMessage
              Item [Proto Multiasset]
-> (Item [Proto Multiasset] -> Item [Proto Multiasset])
-> Item [Proto Multiasset]
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Item [Proto Multiasset]) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "policyId" a) =>
LensLike' f s a
U5c.policyId LensLike' Identity (Item [Proto Multiasset]) ByteString
-> ByteString -> Item [Proto Multiasset] -> Item [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
              Item [Proto Multiasset]
-> (Item [Proto Multiasset] -> Item [Proto Multiasset])
-> Item [Proto Multiasset]
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Item [Proto Multiasset]) [Proto Asset]
forall (f :: * -> *) s a.
(Functor f, HasField s "assets" a) =>
LensLike' f s a
U5c.assets LensLike' Identity (Item [Proto Multiasset]) [Proto Asset]
-> [Proto Asset]
-> Item [Proto Multiasset]
-> Item [Proto Multiasset]
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Proto Asset]
assets
      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
.~ HashableScriptData -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR 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
.~ Text -> ByteString
T.encodeUtf8 (ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Text) -> Text
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => Text) -> Text)
-> (ShelleyBasedEraConstraints era => Text) -> Text
forall a b. (a -> b) -> a -> b
$ AddressInEra era -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress 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
  addrUtf8 <- Either UnicodeException Text -> m Text
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (Either UnicodeException Text -> m Text)
-> Either UnicodeException Text -> m Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
T.decodeUtf8' (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)
  address <-
    maybe (throwM . stringException $ "Cannot decode address: " <> T.unpack addrUtf8) pure $
      obtainCommonConstraints era $
        deserialiseAddress asType addrUtf8
  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