Skip to content

Commit 4caaa17

Browse files
carbolymercarbolymer
committed
txout roundtrip test wip
1 parent aad6c75 commit 4caaa17

File tree

3 files changed

+85
-42
lines changed

3 files changed

+85
-42
lines changed

‎cardano-rpc/cardano-rpc.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -132,3 +132,4 @@ test-suite cardano-rpc-test
132132
build-tool-depends: tasty-discover:tasty-discover
133133
other-modules:
134134
Test.Cardano.Rpc.ProtocolParameters
135+
Test.Cardano.Rpc.TxOutput

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

Lines changed: 71 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,8 @@
1313
module Cardano.Rpc.Server.Internal.UtxoRpc.Type
1414
( utxoRpcPParamsToProtocolParams
1515
, utxoToUtxoRpcAnyUtxoData
16+
, txOutToUtxoRpcTxOutput
17+
, utxoRpcTxOutputToTxOut
1618
, protocolParamsToUtxoRpcPParams
1719
, simpleScriptToUtxoRpcNativeScript
1820
, mkChainPointMsg
@@ -22,7 +24,6 @@ where
2224
import Cardano.Api (SerialiseAsCBOR (serialiseToCBOR), ToCBOR (..))
2325
import Cardano.Api.Address
2426
import Cardano.Api.Block
25-
import Cardano.Api.Block (SlotNo (..))
2627
import Cardano.Api.Era
2728
import Cardano.Api.Error
2829
import Cardano.Api.Experimental.Era
@@ -50,6 +51,7 @@ import RIO hiding (toList)
5051
import Data.ByteString.Short qualified as SBS
5152
import Data.Default
5253
import Data.ProtoLens (defMessage)
54+
import Data.Text qualified as T
5355
import Data.Text.Encoding qualified as T
5456
import GHC.IsList
5557
import Network.GRPC.Spec
@@ -268,6 +270,18 @@ referenceScriptToUtxoRpcScript (ReferenceScript _ (ScriptInAnyLang _ script)) =
268270
defMessage & #plutusV2 .~ serialiseToRawBytes ps
269271
PlutusScript PlutusScriptV3 ps ->
270272
defMessage & #plutusV3 .~ serialiseToRawBytes ps
273+
PlutusScript PlutusScriptV4 ps ->
274+
defMessage & #plutusV4 .~ serialiseToRawBytes ps
275+
276+
utxoRpcScriptToReferenceScript :: Proto UtxoRpc.Script -> ReferenceScript era
277+
utxoRpcScriptToReferenceScript protoScript
278+
| protoScript ^. #maybe'script . to isNothing = ReferenceScriptNone
279+
| protoScript ^. #maybe'native . to isJust = undefined
280+
| protoScript ^. #maybe'plutusV1 . to isJust = undefined
281+
| protoScript ^. #maybe'plutusV2 . to isJust = undefined
282+
| protoScript ^. #maybe'plutusV3 . to isJust = undefined
283+
| protoScript ^. #maybe'plutusV4 . to isJust = undefined
284+
| otherwise = error "ERROR"
271285

272286
scriptDataToUtxoRpcPlutusData :: ScriptData -> Proto UtxoRpc.PlutusData
273287
scriptDataToUtxoRpcPlutusData = \case
@@ -305,45 +319,62 @@ scriptDataToUtxoRpcPlutusData = \case
305319

306320
utxoToUtxoRpcAnyUtxoData :: forall era. IsCardanoEra era => UTxO era -> [Proto UtxoRpc.AnyUtxoData]
307321
utxoToUtxoRpcAnyUtxoData utxo =
308-
toList utxo <&> \(txIn, TxOut addressInEra txOutValue datum script) -> do
309-
let multiAsset =
310-
fromList $
311-
toList (valueToPolicyAssets $ txOutValueToValue txOutValue) <&> \(pId, policyAssets) -> do
312-
let assets =
313-
toList policyAssets <&> \(assetName, Quantity qty) -> do
314-
defMessage
315-
& #name .~ serialiseToRawBytes assetName
316-
-- we don't have access to info if the coin was minted in the transaction,
317-
-- maybe we should add it later
318-
& #maybe'mintCoin .~ Nothing
319-
& #outputCoin .~ fromIntegral qty
320-
defMessage
321-
& #policyId .~ serialiseToRawBytes pId
322-
& #assets .~ assets
323-
datumRpc = case datum of
324-
TxOutDatumNone ->
325-
defMessage
326-
TxOutDatumHash _ scriptDataHash ->
327-
defMessage
328-
& #hash .~ serialiseToRawBytes scriptDataHash
329-
& #maybe'payload .~ Nothing -- we don't have it
330-
& #originalCbor .~ mempty -- we don't have it
331-
TxOutDatumInline _ hashableScriptData ->
332-
defMessage
333-
& #hash .~ serialiseToRawBytes (hashScriptDataBytes hashableScriptData)
334-
& #payload .~ scriptDataToUtxoRpcPlutusData (getScriptData hashableScriptData)
335-
& #originalCbor .~ getOriginalScriptDataBytes hashableScriptData
336-
337-
protoTxOut =
338-
defMessage
339-
-- TODO we don't have serialiseToRawBytes for AddressInEra, so perhaps this is wrong, because 'address'
340-
-- has type bytes, but we're putting text there
341-
& #address .~ T.encodeUtf8 (cardanoEraConstraints (cardanoEra @era) $ serialiseAddress addressInEra)
342-
& #coin .~ fromIntegral (L.unCoin (txOutValueToLovelace txOutValue))
343-
& #assets .~ multiAsset
344-
& #datum .~ datumRpc
345-
& #script .~ referenceScriptToUtxoRpcScript script
322+
toList utxo <&> \(txIn, txOut) -> do
346323
defMessage
347324
& #nativeBytes .~ "" -- TODO where to get that from? run cbor serialisation of utxos list?
348325
& #txoRef .~ inject txIn
349-
& #cardano .~ protoTxOut
326+
& #cardano .~ (txOutToUtxoRpcTxOutput txOut)
327+
328+
txOutToUtxoRpcTxOutput
329+
:: forall era. IsCardanoEra era => TxOut CtxUTxO era -> Proto UtxoRpc.TxOutput
330+
txOutToUtxoRpcTxOutput (TxOut addressInEra txOutValue datum script) = do
331+
let multiAsset =
332+
fromList $
333+
toList (valueToPolicyAssets $ txOutValueToValue txOutValue) <&> \(pId, policyAssets) -> do
334+
let assets =
335+
toList policyAssets <&> \(assetName, Quantity qty) -> do
336+
defMessage
337+
& #name .~ serialiseToRawBytes assetName
338+
-- we don't have access to info if the coin was minted in the transaction,
339+
-- maybe we should add it later
340+
& #maybe'mintCoin .~ Nothing
341+
& #outputCoin .~ fromIntegral qty
342+
defMessage
343+
& #policyId .~ serialiseToRawBytes pId
344+
& #assets .~ assets
345+
datumRpc = case datum of
346+
TxOutDatumNone ->
347+
defMessage
348+
TxOutDatumHash _ scriptDataHash ->
349+
defMessage
350+
& #hash .~ serialiseToRawBytes scriptDataHash
351+
& #maybe'payload .~ Nothing -- we don't have it
352+
& #originalCbor .~ mempty -- we don't have it
353+
TxOutDatumInline _ hashableScriptData ->
354+
defMessage
355+
& #hash .~ serialiseToRawBytes (hashScriptDataBytes hashableScriptData)
356+
& #payload .~ scriptDataToUtxoRpcPlutusData (getScriptData hashableScriptData)
357+
& #originalCbor .~ getOriginalScriptDataBytes hashableScriptData
358+
359+
defMessage
360+
-- TODO we don't have serialiseToRawBytes for AddressInEra, so perhaps this is wrong, because 'address'
361+
-- has type bytes, but we're putting text there
362+
& #address .~ T.encodeUtf8 (cardanoEraConstraints (cardanoEra @era) $ serialiseAddress addressInEra)
363+
& #coin .~ fromIntegral (L.unCoin (txOutValueToLovelace txOutValue))
364+
& #assets .~ multiAsset
365+
& #datum .~ datumRpc
366+
& #script .~ referenceScriptToUtxoRpcScript script
367+
368+
utxoRpcTxOutputToTxOut
369+
:: forall era. IsShelleyBasedEra era => Proto UtxoRpc.TxOutput -> Either String (TxOut CtxUTxO era)
370+
utxoRpcTxOutputToTxOut txOutput = do
371+
addrUtf8 <- T.decodeUtf8' (txOutput ^. #address) ?!& (show . prettyError)
372+
address <-
373+
deserialiseAddress (AsAddress AsShelleyAddr) addrUtf8
374+
?! ("Cannot decode address: " <> T.unpack addrUtf8)
375+
pure $
376+
TxOut
377+
(AddressInEra (ShelleyAddressInEra (shelleyBasedEra @era)) address)
378+
undefined
379+
undefined
380+
undefined

‎cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/TxOutput.hs‎

Lines changed: 13 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -22,12 +22,23 @@ import Data.Map.Strict qualified as M
2222
import Data.Ratio
2323
import GHC.IsList
2424

25-
import Test.Gen.Cardano.Api.Typed (genValidProtocolParameters)
25+
import Test.Gen.Cardano.Api.Typed
26+
( genTxOutTxContext
27+
, genTxOutUTxOContext
28+
, genValidProtocolParameters
29+
)
2630

2731
import Hedgehog
2832
import Hedgehog qualified as H
2933

3034
-- | Test if protocol parameters roundtrip between ledger and proto representation
3135
hprop_roundtrip_tx_output :: Property
3236
hprop_roundtrip_tx_output = H.property $ do
33-
pure ()
37+
let era = ConwayEra
38+
39+
txOut <- forAll $ genTxOutUTxOContext (convert era)
40+
41+
H.tripping
42+
txOut
43+
txOutToUtxoRpcTxOutput
44+
(utxoRpcTxOutputToTxOut)

0 commit comments

Comments
 (0)