diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +# 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) * Allow servant `0.20` [#41](https://github.com/blockfrost/blockfrost-haskell/pull/41) diff --git a/blockfrost-api.cabal b/blockfrost-api.cabal --- a/blockfrost-api.cabal +++ b/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 diff --git a/src/Blockfrost/API/Cardano/Utils.hs b/src/Blockfrost/API/Cardano/Utils.hs --- a/src/Blockfrost/API/Cardano/Utils.hs +++ b/src/Blockfrost/API/Cardano/Utils.hs @@ -8,6 +8,7 @@ import Data.Text import Servant.API import Servant.API.Generic +import Servant.Docs (DocCapture (..), ToCapture (..)) import Blockfrost.Types.Cardano.Utils import Blockfrost.Types.Shared.CBOR @@ -23,7 +24,7 @@ :> "xpub" :> Capture "xpub" Text :> Capture "role" Integer - :> Capture "Index" Integer + :> Capture "index" Integer :> Get '[JSON] DerivedAddress , _txEvaluate @@ -48,3 +49,12 @@ :> Post '[JSON] TxEval } deriving (Generic) + +instance ToCapture (Capture "role" Integer) where + toCapture _ = DocCapture "role" "Account role" + +instance ToCapture (Capture "index" Integer) where + toCapture _ = DocCapture "index" "Address index" + +instance ToCapture (Capture "xpub" Text) where + toCapture _ = DocCapture "xpub" "Hexadecimal xpub" diff --git a/src/Blockfrost/Lens.hs b/src/Blockfrost/Lens.hs --- a/src/Blockfrost/Lens.hs +++ b/src/Blockfrost/Lens.hs @@ -19,8 +19,10 @@ makeFields ''AccountRegistration makeFields ''AccountWithdrawal makeFields ''AccountMir +makeFields ''AddressAssociatedTotal makeLensesWith blockfrostFieldRules ''AddressInfo +makeLensesWith blockfrostFieldRules ''AddressInfoExtended makeFields ''AddressDetails makeFields ''AddressUtxo makeFields ''AddressTransaction @@ -32,6 +34,7 @@ makeFields ''AssetHistory makeFields ''AssetTransaction makeFields ''AssetAddress +makeFields ''MetadataMediaFile makeFields ''Block @@ -53,6 +56,7 @@ makeFieldsNoPrefix ''NetworkEraBound makeFieldsNoPrefix ''NetworkEraParameters +makeFields ''Pool makeFields ''PoolEpoch makeFields ''PoolInfo makeFields ''PoolHistory @@ -77,6 +81,12 @@ makeFields ''TransactionMetaCBOR makeFields ''TransactionRedeemer +makeFields ''DerivedAddress +makeFields ''TxEval +makeFields ''TxEvalValidator +makeFields ''TxEvalBudget +makeFields ''TxEvalInput + makeLensesWith blockfrostFieldRules ''IPFSAdd makeLensesWith blockfrostFieldRules ''IPFSPinChange makeLensesWith blockfrostFieldRules ''IPFSPin @@ -88,3 +98,4 @@ -- * Shared makeFields ''BlockIndex makePrisms ''Amount +makePrisms ''AmountExtended diff --git a/src/Blockfrost/Types/Cardano/Utils.hs b/src/Blockfrost/Types/Cardano/Utils.hs --- a/src/Blockfrost/Types/Cardano/Utils.hs +++ b/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 @@ , _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/src/Blockfrost/Types/Shared/ValidationPurpose.hs b/src/Blockfrost/Types/Shared/ValidationPurpose.hs --- a/src/Blockfrost/Types/Shared/ValidationPurpose.hs +++ b/src/Blockfrost/Types/Shared/ValidationPurpose.hs @@ -10,7 +10,7 @@ -- | 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/test/Cardano/Utils.hs b/test/Cardano/Utils.hs --- a/test/Cardano/Utils.hs +++ b/test/Cardano/Utils.hs @@ -31,7 +31,7 @@ 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 @@ 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" - ] - } - } - }, - { - "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" - ] - } + "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 } - } - ] + ] + } }, - "id": null + "reflection": "st" } |]