implement datum roundtrip

Author: carbolymer

cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano.hs

@@ -18,8 +18,8 @@ message AddressArray {
 
 message Datum {
   bytes hash = 1; // Hash of this datum as seen on-chain
-  PlutusData payload = 2; // Parsed Plutus data payload
-  bytes original_cbor = 3; // Original cbor-encoded data as seen on-chain
+  optional PlutusData payload = 2; // Parsed Plutus data payload
+  optional bytes original_cbor = 3; // Original cbor-encoded data as seen on-chain
 }
 
 // Represents a custom asset in the Cardano blockchain.

cardano-rpc/gen/Proto/Utxorpc/V1alpha/Cardano/Cardano_Fields.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cardano.Rpc.Server.Internal.UtxoRpc.Query
   ( readParamsMethod
@@ -16,6 +17,7 @@ module Cardano.Rpc.Server.Internal.UtxoRpc.Query
 where
 
 import Cardano.Api
+import Cardano.Api.Experimental.Era
 import Cardano.Api.Parser.Text qualified as P
 import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
 import Cardano.Rpc.Server.Internal.Error
@@ -71,19 +73,19 @@ readUtxosMethod req = do
 
   nodeConnInfo <- grab
   AnyCardanoEra era <- liftIO . throwExceptT $ determineEra nodeConnInfo
-  eon <- forEraInEon era (error "Minimum Shelley era required") pure
+  eon <- forEraInEon @Era era (error "Minimum Conway era required") pure
 
   let target = VolatileTip
   (utxo, chainPoint, blockNo) <- liftIO . (throwEither =<<) $ executeLocalStateQueryExpr nodeConnInfo target $ do
-    utxo <- throwEither =<< throwEither =<< queryUtxo eon utxoFilter
+    utxo <- throwEither =<< throwEither =<< queryUtxo (convert eon) utxoFilter
     chainPoint <- throwEither =<< queryChainPoint
     blockNo <- throwEither =<< queryChainBlockNo
     pure (utxo, chainPoint, blockNo)
 
   pure $
     defMessage
       & #ledgerTip .~ mkChainPointMsg chainPoint blockNo
-      & #items .~ cardanoEraConstraints era (utxoToUtxoRpcAnyUtxoData utxo)
+      & #items .~ obtainCommonConstraints eon (utxoToUtxoRpcAnyUtxoData utxo)
  where
   txoRefToTxIn :: MonadRpc e m => Proto UtxoRpc.TxoRef -> m TxIn
   txoRefToTxIn r = do

cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto

@@ -328,7 +328,7 @@ scriptDataToUtxoRpcPlutusData = \case
             & #fields .~ map scriptDataToUtxoRpcPlutusData args
     defMessage & #constr .~ constr
 
-utxoToUtxoRpcAnyUtxoData :: forall era. IsCardanoEra era => UTxO era -> [Proto UtxoRpc.AnyUtxoData]
+utxoToUtxoRpcAnyUtxoData :: forall era. IsEra era => UTxO era -> [Proto UtxoRpc.AnyUtxoData]
 utxoToUtxoRpcAnyUtxoData utxo =
   toList utxo <&> \(txIn, txOut) -> do
     defMessage
@@ -337,7 +337,7 @@ utxoToUtxoRpcAnyUtxoData utxo =
       & #cardano .~ (txOutToUtxoRpcTxOutput txOut)
 
 txOutToUtxoRpcTxOutput
-  :: forall era. IsCardanoEra era => TxOut CtxUTxO era -> Proto UtxoRpc.TxOutput
+  :: forall era. IsEra era => TxOut CtxUTxO era -> Proto UtxoRpc.TxOutput
 txOutToUtxoRpcTxOutput (TxOut addressInEra txOutValue datum script) = do
   let multiAsset =
         fromList $
@@ -363,29 +363,39 @@ txOutToUtxoRpcTxOutput (TxOut addressInEra txOutValue datum script) = do
             & #originalCbor .~ mempty -- we don't have it
         TxOutDatumInline _ hashableScriptData ->
           defMessage
-            & #hash .~ serialiseToRawBytes (hashScriptDataBytes hashableScriptData)
+            & #hash .~ serialiseToCBOR hashableScriptData
             & #payload .~ scriptDataToUtxoRpcPlutusData (getScriptData hashableScriptData)
             & #originalCbor .~ getOriginalScriptDataBytes hashableScriptData
 
   defMessage
     -- TODO we don't have serialiseToRawBytes for AddressInEra, so perhaps this is wrong, because 'address'
     -- has type bytes, but we're putting text there
-    & #address .~ T.encodeUtf8 (cardanoEraConstraints (cardanoEra @era) $ serialiseAddress addressInEra)
+    & #address .~ T.encodeUtf8 (obtainCommonConstraints (useEra @era) $ serialiseAddress addressInEra)
     & #coin .~ fromIntegral (L.unCoin (txOutValueToLovelace txOutValue))
     & #assets .~ multiAsset
     & #datum .~ datumRpc
     & #script .~ referenceScriptToUtxoRpcScript script
 
 utxoRpcTxOutputToTxOut
-  :: forall era. IsShelleyBasedEra era => Proto UtxoRpc.TxOutput -> Either String (TxOut CtxUTxO era)
+  :: forall era. IsEra era => Proto UtxoRpc.TxOutput -> Either String (TxOut CtxUTxO era)
 utxoRpcTxOutputToTxOut txOutput = do
+  let era = useEra @era
   addrUtf8 <- T.decodeUtf8' (txOutput ^. #address) ?!& displayError
   address <-
     deserialiseAddress (AsAddress AsShelleyAddr) addrUtf8
       ?! ("Cannot decode address: " <> T.unpack addrUtf8)
+  datum <-
+    case txOutput ^. #maybe'datum of
+      Just datumRpc ->
+        case datumRpc ^. #maybe'originalCbor of
+          Just cbor ->
+            TxOutDatumInline (convert era) <$> deserialiseFromCBOR asType cbor ?!& displayError
+          Nothing ->
+            TxOutDatumHash (convert era) <$> deserialiseFromRawBytes asType (datumRpc ^. #hash) ?!& displayError
+      Nothing -> pure TxOutDatumNone
   pure $
     TxOut
-      (AddressInEra (ShelleyAddressInEra (shelleyBasedEra @era)) address)
-      undefined
+      (AddressInEra (ShelleyAddressInEra (convert era)) address)
       undefined
+      datum
       undefined