cardano-rpc | Add decoded PlutusData and NativeScript in proto definition

cardano-api/src/Cardano/Api/HasTypeProxy.hs

@@ -13,10 +13,12 @@ module Cardano.Api.HasTypeProxy
 where
 
 import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as BSL
 import Data.Kind (Constraint, Type)
 import Data.Proxy (Proxy (..))
 import Data.Typeable (Typeable)
 import Data.Word (Word16, Word8)
+import Numeric.Natural (Natural)
 
 class Typeable t => HasTypeProxy t where
   -- | A family of singleton types used in this API to indicate which type to
@@ -35,10 +37,18 @@ instance HasTypeProxy Word16 where
   data AsType Word16 = AsWord16
   proxyToAsType _ = AsWord16
 
+instance HasTypeProxy Natural where
+  data AsType Natural = AsNatural
+  proxyToAsType _ = AsNatural
+
 instance HasTypeProxy BS.ByteString where
   data AsType BS.ByteString = AsByteString
   proxyToAsType _ = AsByteString
 
+instance HasTypeProxy BSL.ByteString where
+  data AsType BSL.ByteString = AsByteStringLazy
+  proxyToAsType _ = AsByteStringLazy
+
 data FromSomeType (c :: Type -> Constraint) b where
   FromSomeType :: c a => AsType a -> (a -> b) -> FromSomeType c b
 

cardano-api/src/Cardano/Api/Serialise/Raw.hs

@@ -26,13 +26,16 @@ import Data.Bits (Bits (..))
 import Data.ByteString qualified as BS
 import Data.ByteString.Base16 qualified as Base16
 import Data.ByteString.Builder qualified as BSB
-import Data.ByteString.Char8 as BSC
+import Data.ByteString.Char8 (ByteString)
+import Data.ByteString.Char8 qualified as BSC
+import Data.ByteString.Lazy qualified as BSL
 import Data.Data (typeRep)
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
 import Data.Typeable (TypeRep, Typeable)
 import Data.Word (Word16, Word8)
+import Numeric.Natural (Natural)
 
 class (HasTypeProxy a, Typeable a) => SerialiseAsRawBytes a where
   serialiseToRawBytes :: a -> ByteString
@@ -60,10 +63,23 @@ instance SerialiseAsRawBytes Word16 where
       throwError . SerialiseAsRawBytesError $
         "Cannot decode Word16 from (hex): " <> BSC.unpack (Base16.encode bs)
 
+instance SerialiseAsRawBytes Natural where
+  serialiseToRawBytes 0 = BS.singleton 0x00
+  serialiseToRawBytes n = BS.toStrict . BSB.toLazyByteString $ go n mempty
+   where
+    go 0 acc = acc
+    go x acc = go (x `shiftR` 8) (BSB.word8 (fromIntegral (x .&. 0xFF)) <> acc)
+  deserialiseFromRawBytes AsNatural "\x00" = pure 0
+  deserialiseFromRawBytes AsNatural input = pure . Prelude.foldl' (\acc byte -> acc `shiftL` 8 .|. fromIntegral byte) 0 $ BS.unpack input
+
 instance SerialiseAsRawBytes BS.ByteString where
   serialiseToRawBytes = id
   deserialiseFromRawBytes AsByteString = pure
 
+instance SerialiseAsRawBytes BSL.ByteString where
+  serialiseToRawBytes = BSL.toStrict
+  deserialiseFromRawBytes AsByteStringLazy = pure . BSL.fromStrict
+
 serialiseToRawBytesHex :: SerialiseAsRawBytes a => a -> ByteString
 serialiseToRawBytesHex = Base16.encode . serialiseToRawBytes
 

cardano-api/src/Cardano/Api/Serialise/SerialiseUsing.hs

@@ -17,8 +17,10 @@ import Cardano.Api.Serialise.Json
 import Cardano.Api.Serialise.Raw
 
 import Data.Aeson.Types qualified as Aeson
+import Data.ByteString qualified as B
 import Data.Text.Encoding qualified as Text
 import Data.Typeable (tyConName, typeRep, typeRepTyCon)
+import Numeric (showBin)
 
 -- | For use with @deriving via@, to provide 'ToCBOR' and 'FromCBOR' instances,
 -- based on the 'SerialiseAsRawBytes' instance.
@@ -39,6 +41,10 @@ instance SerialiseAsRawBytes a => FromCBOR (UsingRawBytes a) where
     ttoken = proxyToAsType (Proxy :: Proxy a)
     tname = (tyConName . typeRepTyCon . typeRep) (Proxy :: Proxy a)
 
+-- | Prints the representation in binary format, quoted
+instance SerialiseAsRawBytes a => Show (UsingRawBytes a) where
+  showsPrec _ (UsingRawBytes x) = showChar '"' . mconcat (map showBin . B.unpack $ serialiseToRawBytes x) . showChar '"'
+
 -- | For use with @deriving via@, to provide instances for any\/all of 'Show',
 -- 'ToJSON', 'FromJSON', 'ToJSONKey', FromJSONKey' using a hex
 -- encoding, based on the 'SerialiseAsRawBytes' instance.

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

@@ -16,9 +16,9 @@ message AddressArray {
   repeated bytes items = 1;
 }
 
-// TODO u5c: replaced plutus_data with just bytes
 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
 }
 
@@ -38,11 +38,78 @@ message MultiAsset {
   repeated Asset assets = 2; // List of custom assets.
 }
 
+// Represents a native script in Cardano.
+message NativeScript {
+  oneof native_script {
+    bytes script_pubkey = 1; // Script based on an address key hash.
+    NativeScriptList script_all = 2; // Script that requires all nested scripts to be satisfied.
+    NativeScriptList script_any = 3; // Script that requires any of the nested scripts to be satisfied.
+    ScriptNOfK script_n_of_k = 4; // Script that requires k out of n nested scripts to be satisfied.
+    uint64 invalid_before = 5; // Slot number before which the script is invalid.
+    uint64 invalid_hereafter = 6; // Slot number after which the script is invalid.
+  }
+}
+
+// Represents a list of native scripts.
+message NativeScriptList {
+  repeated NativeScript items = 1; // List of native scripts.
+}
+
+// Represents a "k out of n" native script.
+message ScriptNOfK {
+  uint32 k = 1; // The number of required satisfied scripts.
+  repeated NativeScript scripts = 2; // List of native scripts.
+}
+
+// Represents a constructor for Plutus data in Cardano.
+message Constr {
+  uint32 tag = 1;
+  uint64 any_constructor = 2;
+  repeated PlutusData fields = 3;
+}
+
+// Represents a big integer for Plutus data in Cardano.
+message BigInt {
+  oneof big_int {
+    int64 int = 1 [jstype = JS_STRING];
+    bytes big_u_int = 2;
+    bytes big_n_int = 3;
+  }
+}
+
+
+// Represents a key-value pair for Plutus data in Cardano.
+message PlutusDataPair {
+  PlutusData key = 1; // Key of the pair.
+  PlutusData value = 2; // Value of the pair.
+}
+
+// Represents a Plutus data item in Cardano.
+message PlutusData {
+  oneof plutus_data {
+    Constr constr = 2; // Constructor.
+    PlutusDataMap map = 3; // Map of Plutus data.
+    BigInt big_int = 4; // Big integer.
+    bytes bounded_bytes = 5; // Bounded bytes.
+    PlutusDataArray array = 6; // Array of Plutus data.
+  }
+}
+
+// Represents a map of Plutus data in Cardano.
+message PlutusDataMap {
+  repeated PlutusDataPair pairs = 1; // List of key-value pairs.
+}
+
+// Represents an array of Plutus data in Cardano.
+message PlutusDataArray {
+  repeated PlutusData items = 1; // List of Plutus data items.
+}
+
+
 // Represents a script in Cardano.
-// TODO u5c: removed native script representation
 message Script {
   oneof script {
-    bytes native = 1; // Native script.
+    NativeScript native = 1; // Native script.
     bytes plutus_v1 = 2; // Plutus V1 script.
     bytes plutus_v2 = 3; // Plutus V2 script.
     bytes plutus_v3 = 4; // Plutus V3 script.

cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedLists #-}
@@ -8,16 +9,18 @@
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-module Cardano.Rpc.Server.Internal.Orphans () where
+module Cardano.Rpc.Server.Internal.Orphans where
 
+import Cardano.Api (SerialiseAsCBOR (serialiseToCBOR), ToCBOR (..))
 import Cardano.Api.Address
+import Cardano.Api.Block (SlotNo (..))
 import Cardano.Api.Era
 import Cardano.Api.Error
 import Cardano.Api.Ledger qualified as L
 import Cardano.Api.Plutus
 import Cardano.Api.Pretty
-import Cardano.Api.Serialise.Cbor
 import Cardano.Api.Serialise.Raw
+import Cardano.Api.Serialise.SerialiseUsing
 import Cardano.Api.Tx
 import Cardano.Api.Value
 import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
@@ -29,6 +32,7 @@
 
 import RIO hiding (toList)
 
+import Data.ByteString qualified as B
 import Data.Default
 import Data.Map.Strict qualified as M
 import Data.ProtoLens (defMessage)
@@ -74,62 +78,6 @@
       & #hash .~ serialiseToRawBytes txId'
       & #index .~ fromIntegral txIx
 
-instance Inject (ReferenceScript era) (Proto UtxoRpc.Script) where
-  inject ReferenceScriptNone = defMessage
-  inject (ReferenceScript _ (ScriptInAnyLang _ script)) =
-    case script of
-      SimpleScript _ ->
-        defMessage & #native .~ serialiseToCBOR script
-      PlutusScript PlutusScriptV1 ps ->
-        defMessage & #plutusV1 .~ serialiseToRawBytes ps
-      PlutusScript PlutusScriptV2 ps ->
-        defMessage & #plutusV2 .~ serialiseToRawBytes ps
-      PlutusScript PlutusScriptV3 ps ->
-        defMessage & #plutusV3 .~ serialiseToRawBytes ps
-
-instance IsCardanoEra era => Inject (UTxO era) [Proto UtxoRpc.AnyUtxoData] where
-  inject utxo =
-    toList utxo <&> \(txIn, TxOut addressInEra txOutValue datum script) -> do
-      let multiAsset =
-            fromList $
-              toList (valueToPolicyAssets $ txOutValueToValue txOutValue) <&> \(pId, policyAssets) -> do
-                let assets =
-                      toList policyAssets <&> \(assetName, Quantity qty) -> do
-                        defMessage
-                          & #name .~ serialiseToRawBytes assetName
-                          -- we don't have access to info it the coin was minted in the transaction,
-                          -- maybe we should add it later
-                          & #maybe'mintCoin .~ Nothing
-                          & #outputCoin .~ fromIntegral qty
-                defMessage
-                  & #policyId .~ serialiseToRawBytes pId
-                  & #assets .~ assets
-          datumRpc = case datum of
-            TxOutDatumNone ->
-              defMessage
-            TxOutDatumHash _ scriptDataHash ->
-              defMessage
-                & #hash .~ serialiseToRawBytes scriptDataHash
-                & #originalCbor .~ mempty -- we don't have it
-            TxOutDatumInline _ hashableScriptData ->
-              defMessage
-                & #hash .~ serialiseToRawBytes (hashScriptDataBytes hashableScriptData)
-                & #originalCbor .~ getOriginalScriptDataBytes hashableScriptData
-
-          protoTxOut =
-            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)
-              & #coin .~ fromIntegral (L.unCoin (txOutValueToLovelace txOutValue))
-              & #assets .~ multiAsset
-              & #datum .~ datumRpc
-              & #script .~ inject script
-      defMessage
-        & #nativeBytes .~ "" -- TODO where to get that from? run cbor serialisation of utxos list?
-        & #txoRef .~ inject txIn
-        & #cardano .~ protoTxOut
-
 instance L.ConwayEraPParams lera => Inject (L.PParams lera) (Proto UtxoRpc.PParams) where
   inject pparams = do
     let pparamsCostModels :: Map L.Language [Int64] =

cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Query.hs

@@ -83,7 +83,7 @@ readUtxosMethod req = do
   pure $
     defMessage
       & #ledgerTip .~ mkChainPointMsg chainPoint blockNo
-      & #items .~ cardanoEraConstraints era (inject utxo)
+      & #items .~ cardanoEraConstraints era (utxoToUtxoRpcAnyUtxoData utxo)
  where
   txoRefToTxIn :: MonadRpc e m => Proto UtxoRpc.TxoRef -> m TxIn
   txoRefToTxIn r = do