Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add scripts to AuxiliaryData in query layer #1635

Merged
merged 3 commits into from
Jul 23, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 2 additions & 11 deletions src/Internal/Contract/QueryHandle.purs
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@ import Cardano.AsCbor (encodeCbor)
import Cardano.Types.Transaction (hash) as Transaction
import Contract.Log (logDebug')
import Control.Monad.Error.Class (throwError)
import Control.Monad.Except (ExceptT(ExceptT), runExceptT)
import Ctl.Internal.Contract.LogParams (LogParams)
import Ctl.Internal.Contract.QueryBackend (BlockfrostBackend, CtlBackend)
import Ctl.Internal.Contract.QueryHandle.Type (QueryHandle)
Expand Down Expand Up @@ -41,7 +40,7 @@ import Ctl.Internal.Service.Blockfrost
import Ctl.Internal.Service.Blockfrost as Blockfrost
import Ctl.Internal.Service.Error (ClientError(ClientOtherError))
import Data.Either (Either(Left, Right))
import Data.Maybe (Maybe(Just, Nothing), fromMaybe, isJust)
import Data.Maybe (fromMaybe, isJust)
import Data.Newtype (wrap)
import Effect.Aff (Aff)
import Effect.Exception (error)
Expand Down Expand Up @@ -101,15 +100,7 @@ queryHandleForBlockfrostBackend logParams backend =
, getOutputAddressesByTxHash: runBlockfrostServiceM' <<<
Blockfrost.getOutputAddressesByTxHash
, doesTxExist: runBlockfrostServiceM' <<< Blockfrost.doesTxExist
, getTxAuxiliaryData: \txHash -> runExceptT do
-- FIXME: check if Blockfrost also returns full aux data
metadata <- ExceptT $ runBlockfrostServiceM' $ Blockfrost.getTxMetadata
txHash
pure $ wrap
{ metadata: Just metadata
, nativeScripts: Nothing
, plutusScripts: Nothing
}
, getTxAuxiliaryData: runBlockfrostServiceM' <<< Blockfrost.getTxAuxiliaryData
, utxosAt: runBlockfrostServiceM' <<< Blockfrost.utxosAt
, getChainTip: runBlockfrostServiceM' Blockfrost.getChainTip
, getCurrentEpoch:
Expand Down
2 changes: 1 addition & 1 deletion src/Internal/QueryM/Kupo.purs
Original file line number Diff line number Diff line change
Expand Up @@ -457,7 +457,7 @@ unwrapKupoUtxoSlot :: KupoUtxoSlot -> Slot
unwrapKupoUtxoSlot (KupoUtxoSlot slot) = slot

--------------------------------------------------------------------------------
-- `getTxAuxiliaryData` reponse parsing
-- `getTxAuxiliaryData` response parsing
--------------------------------------------------------------------------------

newtype KupoAuxiliaryData = KupoAuxiliaryData (Maybe AuxiliaryData)
Expand Down
89 changes: 75 additions & 14 deletions src/Internal/Service/Blockfrost.purs
Original file line number Diff line number Diff line change
Expand Up @@ -49,6 +49,7 @@ module Ctl.Internal.Service.Blockfrost
, getScriptByHash
, getScriptInfo
, getSystemStart
, getTxAuxiliaryData
, getTxMetadata
, getUtxoByOref
, getValidatorHashDelegationsAndRewards
Expand Down Expand Up @@ -85,9 +86,10 @@ import Cardano.AsCbor (decodeCbor, encodeCbor)
import Cardano.Serialization.Lib (toBytes)
import Cardano.Types
( AssetClass(AssetClass)
, AuxiliaryData
, DataHash
, GeneralTransactionMetadata(GeneralTransactionMetadata)
, Language(PlutusV1, PlutusV2, PlutusV3)
, Language(PlutusV3, PlutusV2, PlutusV1)
, PlutusData
, PoolPubKeyHash
, RawBytes
Expand Down Expand Up @@ -128,6 +130,7 @@ import Cardano.Types.NativeScript
)
import Cardano.Types.NetworkId (NetworkId)
import Cardano.Types.OutputDatum (OutputDatum(OutputDatum, OutputDatumHash))
import Cardano.Types.PlutusScript (PlutusScript)
import Cardano.Types.PlutusScript as PlutusScript
import Cardano.Types.PoolPubKeyHash as PoolPubKeyHash
import Cardano.Types.RedeemerTag (RedeemerTag(Spend, Mint, Cert, Reward)) as RedeemerTag
Expand Down Expand Up @@ -201,6 +204,7 @@ import Ctl.Internal.Types.ProtocolParameters
import Ctl.Internal.Types.Rational (Rational, reduce)
import Ctl.Internal.Types.StakeValidatorHash (StakeValidatorHash)
import Ctl.Internal.Types.SystemStart (SystemStart(SystemStart))
import Data.Array (catMaybes)
import Data.Array (find, length) as Array
import Data.Bifunctor (lmap)
import Data.BigNumber (BigNumber, toFraction)
Expand Down Expand Up @@ -236,6 +240,7 @@ import Effect.Exception (error)
import Foreign.Object (Object)
import Foreign.Object as ForeignObject
import JS.BigInt (fromString, toNumber) as BigInt
import Prim.TypeError (class Warn, Text)

--------------------------------------------------------------------------------
-- BlockfrostServiceM
Expand Down Expand Up @@ -673,23 +678,79 @@ doesTxExist txHash = do
Left e -> Left e

--------------------------------------------------------------------------------
-- Get transaction metadata
--------------------------------------------------------------------------------
-- Get transaction auxiliary data
getTxAuxiliaryData
:: TransactionHash
-> BlockfrostServiceM (Either GetTxMetadataError AuxiliaryData)
getTxAuxiliaryData txHash = runExceptT do
metadata <- ExceptT $ getMetadata
scriptRefs <- ExceptT $ getTxScripts txHash
pure $ wrap
{ metadata: Just metadata
, nativeScripts: arrayToMaybe $ getNativeScripts scriptRefs
, plutusScripts: arrayToMaybe $ getPlutusScripts scriptRefs
}

where

getMetadata = do
response <- blockfrostGetRequest (TransactionMetadata txHash)
pure case unwrapBlockfrostMetadata <$> handleBlockfrostResponse response of
Left (ClientHttpResponseError (Affjax.StatusCode 404) _) ->
Left GetTxMetadataTxNotFoundError
Left e -> Left (GetTxMetadataClientError e)
Right metadata
| Map.isEmpty (unwrap metadata) ->
Left GetTxMetadataMetadataEmptyOrMissingError
| otherwise -> Right metadata

getNativeScripts :: Array ScriptRef -> Array NativeScript
getNativeScripts = catMaybes <<< map isNativeScript
where
isNativeScript (NativeScriptRef script) = Just script
isNativeScript (PlutusScriptRef _) = Nothing

getPlutusScripts :: Array ScriptRef -> Array PlutusScript
getPlutusScripts = catMaybes <<< map isPlutusScript
where
isPlutusScript (PlutusScriptRef script) = Just script
isPlutusScript (NativeScriptRef _) = Nothing

arrayToMaybe :: forall a. Array a -> Maybe (Array a)
arrayToMaybe [] = Nothing
arrayToMaybe xs = Just xs

getTxMetadata
:: TransactionHash
:: Warn
( Text
"deprecated: getTxMetadata. use Ctl.Internal.Service.Blockfrost.getTxAuxiliaryData"
)
=> TransactionHash
-> BlockfrostServiceM (Either GetTxMetadataError GeneralTransactionMetadata)
getTxMetadata txHash = do
response <- blockfrostGetRequest (TransactionMetadata txHash)
pure case unwrapBlockfrostMetadata <$> handleBlockfrostResponse response of
Left (ClientHttpResponseError (Affjax.StatusCode 404) _) ->
Left GetTxMetadataTxNotFoundError
Left e ->
Left (GetTxMetadataClientError e)
Right metadata
| Map.isEmpty (unwrap metadata) ->
Left GetTxMetadataMetadataEmptyOrMissingError
| otherwise -> Right metadata
eAuxData <- getTxAuxiliaryData txHash
pure $ case eAuxData of
Left err -> Left err
Right auxiliaryData -> case (unwrap auxiliaryData).metadata of
Nothing -> Left GetTxMetadataMetadataEmptyOrMissingError
Just metadata -> Right metadata

getTxScripts
:: TransactionHash
-> BlockfrostServiceM (Either GetTxMetadataError (Array ScriptRef))
getTxScripts txHash = runExceptT do
(blockfrostUtxoMap :: BlockfrostUtxosOfTransaction) <- ExceptT $
blockfrostGetRequest (UtxosOfTransaction txHash)
<#> lmap GetTxMetadataClientError <<< handle404AsMempty <<<
handleBlockfrostResponse
let
(scriptHashes :: Array ScriptHash) = catMaybes
$ map (_.scriptHash <<< unwrap <<< snd)
$ unwrap blockfrostUtxoMap
catMaybes <$> traverse (ExceptT <<< scriptByHash) scriptHashes

where
scriptByHash t = (lmap GetTxMetadataClientError) <$> getScriptByHash t

--------------------------------------------------------------------------------
-- Get current epoch information
Expand Down