From b8634b5575961831560c0ff50268e85887f1b61d Mon Sep 17 00:00:00 2001 From: Joseph Young Date: Tue, 27 Dec 2022 22:51:43 +0000 Subject: [PATCH] Implement getTxMetadata and isTxConfirmed for Blockfrost, add basic test --- src/Internal/Contract/QueryHandle.purs | 23 +++- src/Internal/Deserialization/FromBytes.purs | 4 + src/Internal/QueryM.purs | 9 +- src/Internal/QueryM/Kupo.purs | 6 +- src/Internal/Service/Blockfrost.purs | 119 +++++++++++++++++++ test/Blockfrost.purs | 124 ++++++++++++++++++++ 6 files changed, 276 insertions(+), 9 deletions(-) create mode 100644 src/Internal/Service/Blockfrost.purs create mode 100644 test/Blockfrost.purs diff --git a/src/Internal/Contract/QueryHandle.purs b/src/Internal/Contract/QueryHandle.purs index 800cce67d6..1a04da7072 100644 --- a/src/Internal/Contract/QueryHandle.purs +++ b/src/Internal/Contract/QueryHandle.purs @@ -46,6 +46,10 @@ import Ctl.Internal.QueryM.Ogmios (SubmitTxR(SubmitTxSuccess), TxEvaluationR) import Ctl.Internal.Serialization (convertTransaction, toBytes) as Serialization import Ctl.Internal.Serialization.Address (Address) import Ctl.Internal.Serialization.Hash (ScriptHash) +import Ctl.Internal.Service.Blockfrost + ( getTxMetadata + , isTxConfirmed + ) as Blockfrost import Ctl.Internal.Types.Chain as Chain import Ctl.Internal.Types.Datum (DataHash, Datum) import Ctl.Internal.Types.Transaction (TransactionHash, TransactionInput) @@ -115,5 +119,20 @@ queryHandleForCtlBackend contractEnv backend = queryHandleForBlockfrostBackend :: ContractEnv -> BlockfrostBackend -> QueryHandle -queryHandleForBlockfrostBackend = undefined - +queryHandleForBlockfrostBackend _ backend = + { getDatumByHash: undefined + , getScriptByHash: undefined + , getUtxoByOref: undefined + , isTxConfirmed: runBlockfrost backend Nothing <<< Blockfrost.isTxConfirmed -- TODO Just + , getTxMetadata: runBlockfrost backend Nothing <<< Blockfrost.getTxMetadata -- TODO Just + , utxosAt: undefined + , getChainTip: undefined + , getCurrentEpoch: undefined + , submitTx: undefined + , evaluateTx: undefined + , getEraSummaries: undefined + } + where + runBlockfrost :: forall (a :: Type). _ -> _ -> (_ -> _ -> Aff a) -> Aff a + runBlockfrost { blockfrostConfig } mbApiKey action = action blockfrostConfig + mbApiKey diff --git a/src/Internal/Deserialization/FromBytes.purs b/src/Internal/Deserialization/FromBytes.purs index f46989185e..64619dbfbb 100644 --- a/src/Internal/Deserialization/FromBytes.purs +++ b/src/Internal/Deserialization/FromBytes.purs @@ -33,6 +33,7 @@ import Ctl.Internal.Serialization.Types , Transaction , TransactionBody , TransactionHash + , TransactionMetadatum , TransactionOutput , TransactionUnspentOutput , TransactionWitnessSet @@ -72,6 +73,9 @@ instance FromBytes Ed25519Signature where instance FromBytes GeneralTransactionMetadata where fromBytes' = fromBytesImpl "GeneralTransactionMetadata" +instance FromBytes TransactionMetadatum where + fromBytes' = fromBytesImpl "TransactionMetadatum" + instance FromBytes GenesisDelegateHash where fromBytes' = fromBytesImpl "GenesisDelegateHash" diff --git a/src/Internal/QueryM.purs b/src/Internal/QueryM.purs index 578eeee7b8..d789473d4b 100644 --- a/src/Internal/QueryM.purs +++ b/src/Internal/QueryM.purs @@ -385,7 +385,7 @@ mempoolSnapshotHasTxAff ogmiosWs logger ms = data ClientError = ClientHttpError Affjax.Error - | ClientHttpResponseError String + | ClientHttpResponseError Affjax.StatusCode.StatusCode String | ClientDecodeJsonError String JsonDecodeError | ClientEncodingError String | ClientOtherError String @@ -396,8 +396,10 @@ instance Show ClientError where "(ClientHttpError " <> Affjax.printError err <> ")" - show (ClientHttpResponseError err) = + show (ClientHttpResponseError statusCode err) = "(ClientHttpResponseError " + <> show statusCode + <> " " <> show err <> ")" show (ClientDecodeJsonError jsonStr err) = @@ -428,7 +430,8 @@ handleAffjaxResponse (Left affjaxError) = handleAffjaxResponse (Right { status: Affjax.StatusCode.StatusCode statusCode, body }) | statusCode < 200 || statusCode > 299 = - Left (ClientHttpResponseError body) + Left + (ClientHttpResponseError (Affjax.StatusCode.StatusCode statusCode) body) | otherwise = body # lmap (ClientDecodeJsonError body) <<< (decodeAeson <=< parseJsonStringToAeson) diff --git a/src/Internal/QueryM/Kupo.purs b/src/Internal/QueryM/Kupo.purs index 44c618b0c3..accb477d9b 100644 --- a/src/Internal/QueryM/Kupo.purs +++ b/src/Internal/QueryM/Kupo.purs @@ -66,7 +66,7 @@ import Ctl.Internal.Serialization.Address import Ctl.Internal.Serialization.Hash (ScriptHash, scriptHashToBytes) import Ctl.Internal.Types.BigNum (toString) as BigNum import Ctl.Internal.Types.ByteArray (ByteArray, byteArrayToHex, hexToByteArray) -import Ctl.Internal.Types.CborBytes (hexToCborBytes) +import Ctl.Internal.Types.CborBytes (CborBytes, hexToCborBytes) import Ctl.Internal.Types.Datum (DataHash(DataHash), Datum) import Ctl.Internal.Types.OutputDatum ( OutputDatum(NoOutputDatum, OutputDatumHash, OutputDatum) @@ -434,9 +434,7 @@ instance Show KupoMetadata where instance DecodeAeson KupoMetadata where decodeAeson = decodeAeson >=> case _ of - [ { raw } :: { raw :: String } ] -> do - cbor <- flip note (hexToCborBytes raw) $ - TypeMismatch "Hexadecimal String" + [ { raw: cbor } :: { raw :: CborBytes } ] -> do metadata <- flip note (fromBytes cbor) $ TypeMismatch "Hexadecimal encoded Metadata" pure $ KupoMetadata $ Just $ convertGeneralTransactionMetadata metadata diff --git a/src/Internal/Service/Blockfrost.purs b/src/Internal/Service/Blockfrost.purs new file mode 100644 index 0000000000..cc5cc9e3a3 --- /dev/null +++ b/src/Internal/Service/Blockfrost.purs @@ -0,0 +1,119 @@ +module Ctl.Internal.Service.Blockfrost + ( isTxConfirmed + , getTxMetadata + ) where + +import Prelude + +import Aeson + ( class DecodeAeson + , Aeson + , JsonDecodeError(TypeMismatch) + , decodeAeson + ) +import Affjax (Error, Response, URL, defaultRequest, request) as Affjax +import Affjax.RequestHeader (RequestHeader(RequestHeader)) as Affjax +import Affjax.ResponseFormat as Affjax.ResponseFormat +import Affjax.StatusCode (StatusCode(StatusCode)) as Affjax +import Ctl.Internal.Deserialization.FromBytes (fromBytes) +import Ctl.Internal.Deserialization.Transaction + ( convertGeneralTransactionMetadata + ) +import Ctl.Internal.QueryM + ( ClientError(ClientHttpResponseError) + , handleAffjaxResponse + ) +import Ctl.Internal.QueryM.ServerConfig (ServerConfig, mkHttpUrl) +import Ctl.Internal.Types.ByteArray (byteArrayToHex) +import Ctl.Internal.Types.CborBytes (CborBytes) +import Ctl.Internal.Types.Transaction (TransactionHash) +import Ctl.Internal.Types.TransactionMetadata + ( GeneralTransactionMetadata(GeneralTransactionMetadata) + ) +import Data.Either (Either(Left, Right), note) +import Data.Foldable (foldMap) +import Data.Generic.Rep (class Generic) +import Data.HTTP.Method (Method(GET)) +import Data.Map as Map +import Data.Maybe (Maybe(Just, Nothing)) +import Data.Newtype (unwrap) +import Data.Show.Generic (genericShow) +import Data.Traversable (for) +import Effect.Aff (Aff) + +isTxConfirmed + :: TransactionHash + -> ServerConfig + -> Maybe String + -> Aff (Either ClientError Boolean) +isTxConfirmed txHash config mbApiKey = do + response :: Either ClientError Aeson <- handleAffjaxResponse <$> request + pure case response of + Right _ -> Right true + Left (ClientHttpResponseError (Affjax.StatusCode 404) _) -> Right false + Left e -> Left e + where + request :: Aff (Either Affjax.Error (Affjax.Response String)) + request = Affjax.request $ Affjax.defaultRequest + { method = Left GET + , url = mkHttpUrl config <> endpoint + , responseFormat = Affjax.ResponseFormat.string + , headers = + flip foldMap mbApiKey \apiKey -> + [ Affjax.RequestHeader "project_id" apiKey ] + } + + endpoint :: Affjax.URL + endpoint = "/txs/" <> byteArrayToHex (unwrap txHash) + +getTxMetadata + :: TransactionHash + -> ServerConfig + -> Maybe String + -> Aff (Either ClientError (Maybe GeneralTransactionMetadata)) +getTxMetadata txHash config mbApiKey = do + response :: Either ClientError _ <- handleAffjaxResponse <$> request + pure case response of + Right metadata -> Right $ Just $ unwrapBlockfrostMetadata metadata + Left (ClientHttpResponseError (Affjax.StatusCode 404) _) -> Right Nothing + Left e -> Left e + where + request :: Aff (Either Affjax.Error (Affjax.Response String)) + request = Affjax.request $ Affjax.defaultRequest + { method = Left GET + , url = mkHttpUrl config <> endpoint + , responseFormat = Affjax.ResponseFormat.string + , headers = + flip foldMap mbApiKey \apiKey -> + [ Affjax.RequestHeader "project_id" apiKey ] + } + + endpoint :: Affjax.URL + endpoint = "/txs/" <> byteArrayToHex (unwrap txHash) <> "/metadata/cbor" + +-------------------------------------------------------------------------------- +-- `getTxMetadata` reponse parsing +-------------------------------------------------------------------------------- + +newtype BlockfrostMetadata = BlockfrostMetadata + GeneralTransactionMetadata + +derive instance Generic BlockfrostMetadata _ +derive instance Eq BlockfrostMetadata + +instance Show BlockfrostMetadata where + show = genericShow + +instance DecodeAeson BlockfrostMetadata where + decodeAeson = decodeAeson >=> + \(metadatas :: Array { metadata :: CborBytes }) -> do + metadatas' <- for metadatas \{ metadata } -> do + map (unwrap <<< convertGeneralTransactionMetadata) <$> flip note + (fromBytes metadata) $ + TypeMismatch "Hexadecimal encoded Metadata" + + pure $ BlockfrostMetadata $ GeneralTransactionMetadata $ Map.unions + metadatas' + +unwrapBlockfrostMetadata :: BlockfrostMetadata -> GeneralTransactionMetadata +unwrapBlockfrostMetadata (BlockfrostMetadata metadata) = metadata diff --git a/test/Blockfrost.purs b/test/Blockfrost.purs new file mode 100644 index 0000000000..60cf638a3e --- /dev/null +++ b/test/Blockfrost.purs @@ -0,0 +1,124 @@ +module Test.Ctl.Blockfrost where + +import Prelude + +import Contract.Metadata + ( GeneralTransactionMetadata(GeneralTransactionMetadata) + , TransactionMetadatum(Text) + , TransactionMetadatumLabel(TransactionMetadatumLabel) + ) +import Contract.Prim.ByteArray (hexToByteArrayUnsafe) +import Contract.Test.Mote (TestPlanM, interpretWithConfig) +import Contract.Test.Utils (exitCode, interruptOnSignal) +import Contract.Transaction (TransactionHash(TransactionHash)) +import Ctl.Internal.Service.Blockfrost (getTxMetadata, isTxConfirmed) +import Data.BigInt as BigInt +import Data.Either (Either(Right), hush) +import Data.Map as Map +import Data.Maybe (Maybe(Just, Nothing), fromJust) +import Data.Posix.Signal (Signal(SIGINT)) +import Data.Time.Duration (Milliseconds(Milliseconds)) +import Data.Tuple.Nested ((/\)) +import Data.UInt as UInt +import Effect (Effect) +import Effect.Aff (Aff, cancelWith, effectCanceler, launchAff) +import Effect.Class.Console (log) +import Mote (group, test) +import Partial.Unsafe (unsafePartial) +import Test.Spec.Assertions (shouldEqual) +import Test.Spec.Runner (defaultConfig) + +-- Run with `spago test --main Test.Ctl.Blockfrost` +main :: Effect Unit +main = interruptOnSignal SIGINT =<< launchAff do + flip cancelWith (effectCanceler (exitCode 1)) do + interpretWithConfig + defaultConfig { timeout = Just $ Milliseconds 450_000.0, exit = true } + testPlan + +fixture1 :: { hash :: TransactionHash, metadata :: GeneralTransactionMetadata } +fixture1 = + { hash: TransactionHash $ hexToByteArrayUnsafe + "7a2aff2b7f92f6f8ec3fb2135301c7bfc36fea1489a3ca37fd6066f3155c46ff" + , metadata: + GeneralTransactionMetadata $ Map.fromFoldable $ + ( \(label /\ text) -> + TransactionMetadatumLabel + (unsafePartial $ fromJust $ BigInt.fromString label) /\ Text text + ) + <$> + [ "30" /\ "5" + , "50" /\ + "d8799f581c11185d006a64f24e9cf6da987589cd0b166718d3680e63985db370" + , "51" /\ + "3d9fd8799fd8799fd8799f581c70e60f3b5ea7153e0acc7a803e4401d44b8ed1" + , "52" /\ + "bae1c7baaad1a62a72ffd8799fd8799fd8799f581c1e78aae7c90cc36d624f7b" + , "53" /\ + "3bb6d86b52696dc84e490f343eba89005fffffffffa140d8799f00a1401a000f" + , "54" /\ + "32a0ffffd8799fd8799fd8799f581c11185d006a64f24e9cf6da987589cd0b16" + , "55" /\ + "6718d3680e63985db3703dffd8799fd8799fd8799f581cac7d463e54c43d994b" + , "56" /\ + "66d1512d5fb315c7563ae43c37610cd07977c7ffffffffa1581c4e5205e5df36" + , "57" /\ + "8030e9f814c2258c01f50c62375c55b07fbcc076c181d8799f01a0ffffffff,d" + , "58" /\ + "8799f581c11185d006a64f24e9cf6da987589cd0b166718d3680e63985db3703" + , "59" /\ + "d9fd8799fd8799fd8799f581c70e60f3b5ea7153e0acc7a803e4401d44b8ed1b" + , "60" /\ + "ae1c7baaad1a62a72ffd8799fd8799fd8799f581c1e78aae7c90cc36d624f7b3" + , "61" /\ + "bb6d86b52696dc84e490f343eba89005fffffffffa140d8799f00a1401a000f3" + , "62" /\ + "2a0ffffd8799fd8799fd8799f581c11185d006a64f24e9cf6da987589cd0b166" + , "63" /\ + "718d3680e63985db3703dffd8799fd8799fd8799f581cac7d463e54c43d994b6" + , "64" /\ + "6d1512d5fb315c7563ae43c37610cd07977c7ffffffffa1581c4e5205e5df368" + , "65" /\ + "030e9f814c2258c01f50c62375c55b07fbcc076c181d8799f01a0ffffffff,d8" + , "66" /\ + "799f581c11185d006a64f24e9cf6da987589cd0b166718d3680e63985db3703d" + , "67" /\ + "9fd8799fd8799fd8799f581c70e60f3b5ea7153e0acc7a803e4401d44b8ed1ba" + , "68" /\ + "e1c7baaad1a62a72ffd8799fd8799fd8799f581c1e78aae7c90cc36d624f7b3b" + , "69" /\ + "b6d86b52696dc84e490f343eba89005fffffffffa140d8799f00a1401a000f32" + , "70" /\ + "a0ffffd8799fd8799fd8799f581c11185d006a64f24e9cf6da987589cd0b1667" + , "71" /\ + "18d3680e63985db3703dffd8799fd8799fd8799f581cac7d463e54c43d994b66" + , "72" /\ + "d1512d5fb315c7563ae43c37610cd07977c7ffffffffa1581c4e5205e5df3680" + , "73" /\ + "30e9f814c2258c01f50c62375c55b07fbcc076c181d8799f01a0ffffffff," + , "75" /\ + "4e5205e5df368030e9f814c2258c01f50c62375c55b07fbcc076c181::00" + , "76" /\ + "4e5205e5df368030e9f814c2258c01f50c62375c55b07fbcc076c181::01" + , "77" /\ + "4e5205e5df368030e9f814c2258c01f50c62375c55b07fbcc076c181::02" + ] + } + +config = + { host: "cardano-preview.blockfrost.io" + , port: UInt.fromInt 443 + , secure: true + , path: Just "/api/v0" + } + +apiKey = Just ?help + +testPlan :: TestPlanM (Aff Unit) Unit +testPlan = group "Blockfrost" do + test "getTxMetadata success" do + metadata <- getTxMetadata fixture1.hash config apiKey + (hush metadata) `shouldEqual` (Just (Just fixture1.metadata)) + test "isTxConfirmed success" do + confirmed <- isTxConfirmed fixture1.hash config apiKey + (hush confirmed) `shouldEqual` (Just true)