From 52539891d09e9f0ab5faf3fcdf4b6f2ccd1ea4dd Mon Sep 17 00:00:00 2001 From: sorki Date: Fri, 16 Feb 2024 11:15:19 +0100 Subject: [PATCH 1/3] api: fix handling of ogmios v5 txEvaluate response Closes #51 --- blockfrost-api/CHANGELOG.md | 8 +- blockfrost-api/src/Blockfrost/Lens.hs | 2 +- .../src/Blockfrost/Types/Cardano/Utils.hs | 159 +++++++++++++----- .../Types/Shared/ValidationPurpose.hs | 2 +- blockfrost-api/test/Cardano/Utils.hs | 131 ++++----------- 5 files changed, 167 insertions(+), 135 deletions(-) diff --git a/blockfrost-api/CHANGELOG.md b/blockfrost-api/CHANGELOG.md index 029c28e..3d1eace 100644 --- a/blockfrost-api/CHANGELOG.md +++ b/blockfrost-api/CHANGELOG.md @@ -1,4 +1,10 @@ -# Version [next](https://github.com/blockfrost/blockfrost-haskell/compare/api-0.9.0.0...master) (2024-mm-dd) +# Version [0.10.0.0](https://github.com/blockfrost/blockfrost-haskell/compare/api-0.9.0.0...api-0.10.0.0) (2024-02-16) + +* Fixed + * Handling of Ogmios v5 `txEvaluate` response [#52](https://github.com/blockfrost/blockfrost-haskell/pull/52) + `TxEvalResult` is no more and instead we add `TxEvalValidator` + and `TxEvalFailure`. `TxEval` newtype now has a single `result` field + of type `Either TxEvalFailure (Map TxEvalValidator TxEvalBudget)` # Version [0.9.0.0](https://github.com/blockfrost/blockfrost-haskell/compare/api-0.8.1.0...api-0.9.0.0) (2023-12-18) diff --git a/blockfrost-api/src/Blockfrost/Lens.hs b/blockfrost-api/src/Blockfrost/Lens.hs index e6b0ef9..83fb688 100644 --- a/blockfrost-api/src/Blockfrost/Lens.hs +++ b/blockfrost-api/src/Blockfrost/Lens.hs @@ -83,8 +83,8 @@ makeFields ''TransactionRedeemer makeFields ''DerivedAddress makeFields ''TxEval +makeFields ''TxEvalValidator makeFields ''TxEvalBudget -makeFields ''TxEvalResult makeFields ''TxEvalInput makeLensesWith blockfrostFieldRules ''IPFSAdd diff --git a/blockfrost-api/src/Blockfrost/Types/Cardano/Utils.hs b/blockfrost-api/src/Blockfrost/Types/Cardano/Utils.hs index 2ad8e20..b7d290c 100644 --- a/blockfrost-api/src/Blockfrost/Types/Cardano/Utils.hs +++ b/blockfrost-api/src/Blockfrost/Types/Cardano/Utils.hs @@ -4,29 +4,38 @@ module Blockfrost.Types.Cardano.Utils ( DerivedAddress (..) , TxEval (..) + , TxEvalValidator (..) , TxEvalBudget (..) - , TxEvalResult (..) , evalSample - , resultSample , TxEvalInput (..) ) where import Data.Aeson ( FromJSON (..) + , FromJSONKey (..) , ToJSON (..) + , ToJSONKey (..) , Value (Array) , object , withObject + , withText , (.:) , (.:?) , (.=) ) +import Data.Aeson.Types (FromJSONKeyFunction(..), Parser) import Blockfrost.Types.Shared.CBOR (CBORString(..)) +import Blockfrost.Types.Shared.ValidationPurpose (ValidationPurpose(..)) import Data.Text (Text) +import Data.Map (Map) import Deriving.Aeson import Servant.Docs (ToSample (..), singleSample) +import qualified Data.Aeson.Types import qualified Data.Char +import qualified Data.Text +import qualified Data.Map.Strict +import qualified Text.Read -- | Derived Shelley address data DerivedAddress = DerivedAddress @@ -48,68 +57,142 @@ instance ToSample DerivedAddress where , _derivedAddressAddress = "addr1q90sqnljxky88s0jsnps48jd872p7znzwym0jpzqnax6qs5nfrlkaatu28n0qzmqh7f2cpksxhpc9jefx3wrl0a2wu8q5amen7" } +-- * TxEval + +data TxEvalValidator = TxEvalValidator + { _txEvalValidatorPurpose :: ValidationPurpose + , _txEvalValidatorIndex :: Int + } + deriving stock (Eq, Ord, Show, Generic) + +instance ToJSON TxEvalValidator where + toJSON = toJSON . mkOgmiosValidator + +instance ToJSONKey TxEvalValidator where + toJSONKey = Data.Aeson.Types.toJSONKeyText mkOgmiosValidator + +mkOgmiosValidator + :: TxEvalValidator + -> Text +mkOgmiosValidator TxEvalValidator{..} = + ( toOgmiosPurpose _txEvalValidatorPurpose + <> ":" + <> Data.Text.pack (show _txEvalValidatorIndex) + ) +instance FromJSON TxEvalValidator where + parseJSON = + withText + "TxEvalValidator" + parseOgmiosValidator + +instance FromJSONKey TxEvalValidator where + fromJSONKey = FromJSONKeyTextParser parseOgmiosValidator + +parseOgmiosValidator + :: Text + -> Parser TxEvalValidator +parseOgmiosValidator = + (\case + [purpose, index] -> + case fromOgmiosPurpose purpose of + Right p -> + case Text.Read.readMaybe (Data.Text.unpack index) of + Nothing -> fail $ "Expecting numeric index, got " <> (Data.Text.unpack index) + Just idx -> pure $ TxEvalValidator p idx + Left e -> + fail e + x -> fail $ "Expecting [purpose, index], got " <> show x + . Data.Text.splitOn ":" + ) + +toOgmiosPurpose + :: ValidationPurpose + -> Text +toOgmiosPurpose Spend = "spend" +toOgmiosPurpose Mint = "mint" +toOgmiosPurpose Cert = "publish" +toOgmiosPurpose Reward = "withdraw" + +fromOgmiosPurpose + :: Text + -> Either String ValidationPurpose +fromOgmiosPurpose "spend" = Right Spend +fromOgmiosPurpose "mint" = Right Mint +fromOgmiosPurpose "publish" = Right Cert +fromOgmiosPurpose "withdraw" = Right Reward +fromOgmiosPurpose x = + Left + $ "Don't know how to handle Ogmios validation purpose: " + <> Data.Text.unpack x + +validatorSample :: TxEvalValidator +validatorSample = + TxEvalValidator + { _txEvalValidatorPurpose = Spend + , _txEvalValidatorIndex = 0 + } + +instance ToSample TxEvalValidator where + toSamples = pure $ singleSample validatorSample + data TxEvalBudget = TxEvalBudget { _txEvalBudgetMemory :: Integer -- ^ Memory budget - , _txEvalBudgetCPU :: Integer -- ^ CPU budget + , _txEvalBudgetSteps :: Integer -- ^ CPU budget } deriving stock (Show, Eq, Generic) deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier '[StripPrefix "_txEvalBudget", CamelToSnake]] TxEvalBudget -instance ToSample TxEvalBudget where - toSamples = pure $ singleSample - TxEvalBudget - { _txEvalBudgetMemory = 1700 - , _txEvalBudgetCPU = 476468 +budgetSample :: TxEvalBudget +budgetSample = + TxEvalBudget + { _txEvalBudgetMemory = 1765011 + , _txEvalBudgetSteps = 503871230 } --- | Transaction evaluation result -data TxEvalResult = TxEvalResult - { _txEvalResultValidator :: Text -- ^ Redeemer pointer - , _txEvalResultBudget :: TxEvalBudget -- ^ Budget - } +instance ToSample TxEvalBudget where + toSamples = pure $ singleSample budgetSample + +data TxEvalFailure = TxEvalFailure Value deriving stock (Show, Eq, Generic) deriving (FromJSON, ToJSON) - via CustomJSON '[FieldLabelModifier '[StripPrefix "_txEvalResult", CamelToSnake]] TxEvalResult - -resultSample :: TxEvalResult -resultSample = - TxEvalResult - { _txEvalResultValidator = "spend:0" - , _txEvalResultBudget = - TxEvalBudget - { _txEvalBudgetMemory = 1700 - , _txEvalBudgetCPU = 476468 - } - } - -instance ToSample TxEvalResult where - toSamples = pure $ singleSample resultSample -- | Transaction evaluation result wrapper -newtype TxEval = TxEval { _txEvalResult :: [TxEvalResult] } +newtype TxEval = TxEval + { _txEvalResult :: + Either + TxEvalFailure + (Map + TxEvalValidator + TxEvalBudget) + } deriving stock (Show, Eq, Generic) instance ToJSON TxEval where toJSON TxEval{..} = object - [ "jsonrpc" .= ("2.0" :: Text) - , "method" .= ("evaluateTransaction" :: Text) + [ "type" .= ("jsonwsp/response" :: Text) + , "version" .= ("1.0" :: Text) + , "servicename" .= ("ogmios" :: Text) + , "methodname" .= ("EvaluateTx" :: Text) , "result" .= toJSON _txEvalResult ] instance FromJSON TxEval where parseJSON = withObject "txEval" $ \o -> do - (mErr :: Maybe Value) <- o .:? "error" - case mErr of - Just err -> fail $ show err - Nothing -> pure () - r <- o .: "result" - TxEval <$> parseJSON r + mEvalResult <- r .:? "EvaluationResult" + case mEvalResult of + Nothing -> TxEval . Left . TxEvalFailure <$> r .: "EvaluationFailure" + Just evalRes -> TxEval . Right <$> parseJSON evalRes evalSample :: TxEval -evalSample = TxEval (pure resultSample) +evalSample = + TxEval + $ Right + (Data.Map.Strict.fromList + [(validatorSample, budgetSample)] + ) instance ToSample TxEval where toSamples = pure $ singleSample evalSample diff --git a/blockfrost-api/src/Blockfrost/Types/Shared/ValidationPurpose.hs b/blockfrost-api/src/Blockfrost/Types/Shared/ValidationPurpose.hs index cab4397..cc18dc5 100644 --- a/blockfrost-api/src/Blockfrost/Types/Shared/ValidationPurpose.hs +++ b/blockfrost-api/src/Blockfrost/Types/Shared/ValidationPurpose.hs @@ -10,7 +10,7 @@ import Blockfrost.Types.Shared.Opts -- | Validation purpose data ValidationPurpose = Spend | Mint | Cert | Reward - deriving stock (Show, Eq, Generic) + deriving stock (Eq, Ord, Show, Generic) deriving (FromJSON, ToJSON) via CustomJSON '[ConstructorTagModifier '[ToLower]] ValidationPurpose diff --git a/blockfrost-api/test/Cardano/Utils.hs b/blockfrost-api/test/Cardano/Utils.hs index 0905073..4989c00 100644 --- a/blockfrost-api/test/Cardano/Utils.hs +++ b/blockfrost-api/test/Cardano/Utils.hs @@ -31,7 +31,7 @@ spec_scripts = do it "fails to parse tx eval error" $ do eitherDecode txEvalErrorSample `shouldSatisfy` - (Data.Either.isLeft :: Either String TxEval -> Bool) + (Data.Either.isLeft . _txEvalResult . Data.Either.fromRight undefined) it "parses tx eval input sample" $ do eitherDecode txEvalInputSample @@ -57,111 +57,54 @@ derivedAddressExpected = txEvalSample = [r| { - "jsonrpc": "2.0", - "method": "evaluateTransaction", - "result": [{ - "validator": "spend:0", - "budget": { - "memory": 1700, - "cpu": 476468 + "type": "jsonwsp/response", + "version": "1.0", + "servicename": "ogmios", + "methodname": "EvaluateTx", + "result": { + "EvaluationResult": { + "spend:0": { + "memory": 1765011, + "steps": 503871230 + } } - }] + }, + "reflection": { + "id": "3e7eace0-a3d2-4020-aecb-c5b6e7910568" + } } |] txEvalExpected = evalSample -- Stolen from --- https://github.com/CardanoSolutions/ogmios/blob/master/server/test/vectors/EvaluateTransactionResponse/000.json +-- https://github.com/CardanoSolutions/ogmios/blob/v5.6.0/server/test/vectors/TxSubmission/Response/EvaluateTx/099.json -- Mozilla Public License 2.0 txEvalErrorSample = [r| { - "jsonrpc": "2.0", - "method": "evaluateTransaction", - "error": { - "code": 3010, - "message": "Some scripts of the transactions terminated with error(s).", - "data": [ - { - "validator": "spend:4", - "error": { - "code": 3011, - "message": "An associated script witness is missing. Indeed, any script used in a transaction (when spending, minting, withdrawing or publishing certificates) must be provided in full with the transaction. Scripts must therefore be added either to the witness set or provided as a reference inputs should you use Plutus V2+ and a format from Babbage and beyond.", - "data": { - "missingScripts": [ - "certificate:3" - ] - } - } - }, - { - "validator": "mint:0", - "error": { - "code": 3011, - "message": "An associated script witness is missing. Indeed, any script used in a transaction (when spending, minting, withdrawing or publishing certificates) must be provided in full with the transaction. Scripts must therefore be added either to the witness set or provided as a reference inputs should you use Plutus V2+ and a format from Babbage and beyond.", - "data": { - "missingScripts": [ - "certificate:11" - ] - } - } - }, - { - "validator": "mint:3", - "error": { - "code": 3011, - "message": "An associated script witness is missing. Indeed, any script used in a transaction (when spending, minting, withdrawing or publishing certificates) must be provided in full with the transaction. Scripts must therefore be added either to the witness set or provided as a reference inputs should you use Plutus V2+ and a format from Babbage and beyond.", - "data": { - "missingScripts": [ - "withdrawal:7" - ] - } - } - }, - { - "validator": "mint:7", - "error": { - "code": 3011, - "message": "An associated script witness is missing. Indeed, any script used in a transaction (when spending, minting, withdrawing or publishing certificates) must be provided in full with the transaction. Scripts must therefore be added either to the witness set or provided as a reference inputs should you use Plutus V2+ and a format from Babbage and beyond.", - "data": { - "missingScripts": [ - "mint:4" - ] - } + "type": "jsonwsp/response", + "version": "1.0", + "servicename": "ogmios", + "methodname": "EvaluateTx", + "result": { + "EvaluationFailure": { + "AdditionalUtxoOverlap": [ + { + "txId": "ae85d245a3d00bfde01f59f3c4fe0b4bfae1cb37e9cf91929eadcea4985711de", + "index": 2 + }, + { + "txId": "e88bd757ad5b9bedf372d8d3f0cf6c962a469db61a265f6418e1ffed86da29ec", + "index": 0 + }, + { + "txId": "e88bd757ad5b9bedf372d8d3f0cf6c962a469db61a265f6418e1ffed86da29ec", + "index": 2 } - }, - { - "validator": "mint:11", - "error": { - "code": 3117, - "message": "The transaction contains unknown UTxO references as inputs. This can happen if the inputs you're trying to spend have already been spent, or if you've simply referred to non-existing UTxO altogether. The field 'data.unknownOutputReferences' indicates all unknown inputs.", - "data": { - "unknownOutputReferences": [ - { - "transaction": { - "id": "a10897006ca78f6ce87fc6e2b139d92a896de01d62fe01f4fd0eccc6a10075c1" - }, - "index": 14 - } - ] - } - } - }, - { - "validator": "certificate:2", - "error": { - "code": 3011, - "message": "An associated script witness is missing. Indeed, any script used in a transaction (when spending, minting, withdrawing or publishing certificates) must be provided in full with the transaction. Scripts must therefore be added either to the witness set or provided as a reference inputs should you use Plutus V2+ and a format from Babbage and beyond.", - "data": { - "missingScripts": [ - "withdrawal:2" - ] - } - } - } - ] + ] + } }, - "id": null + "reflection": "st" } |] From cc7b8a04712d47751f7599a2334879a6750a2a48 Mon Sep 17 00:00:00 2001 From: sorki Date: Fri, 16 Feb 2024 11:16:24 +0100 Subject: [PATCH 2/3] client: fix evaluteTx -> txEvaluate typo in CHANGELOG --- blockfrost-client/CHANGELOG.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/blockfrost-client/CHANGELOG.md b/blockfrost-client/CHANGELOG.md index 553d9f5..c575ea1 100644 --- a/blockfrost-client/CHANGELOG.md +++ b/blockfrost-client/CHANGELOG.md @@ -13,8 +13,8 @@ * `listPoolsExtended` for `/pools/extended` * `/utils` API * `deriveShelleyAddress` for `/utils/addresses/xpub/:xpub/:role/:index` - * `evaluateTx` for `/utils/txs/evaluate` endpoint - * `evaluateTxUTXOs` for `/utils/txs/evaluate/utxos` endpoint + * `txEvaluate` for `/utils/txs/evaluate` endpoint + * `txEvaluateUTXOs` for `/utils/txs/evaluate/utxos` endpoint # Version [0.7.1.1](https://github.com/blockfrost/blockfrost-haskell/compare/v0.7.1.0...client-0.7.1.1) (2023-01-10) From bd3f41d41c7ed0d798b815406b297c5c140513b7 Mon Sep 17 00:00:00 2001 From: sorki Date: Fri, 16 Feb 2024 11:17:16 +0100 Subject: [PATCH 3/3] api: Release 0.10.0.0 --- blockfrost-api/blockfrost-api.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/blockfrost-api/blockfrost-api.cabal b/blockfrost-api/blockfrost-api.cabal index 1566d08..ec1c689 100644 --- a/blockfrost-api/blockfrost-api.cabal +++ b/blockfrost-api/blockfrost-api.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: blockfrost-api -version: 0.9.0.0 +version: 0.10.0.0 synopsis: API definitions for blockfrost.io description: Core types and Servant API description homepage: https://github.com/blockfrost/blockfrost-haskell