From 37aa71b7bac7c5b5a21b5b242d9ace447eb3f05f Mon Sep 17 00:00:00 2001 From: Calum Sieppert Date: Mon, 4 Jul 2022 15:00:49 -0600 Subject: [PATCH 1/6] Use batched datum fetching --- flake.lock | 8 ++++---- src/Seabug/Contract/MarketPlaceListNft.purs | 8 +++++--- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/flake.lock b/flake.lock index 4776a6b..620c74b 100644 --- a/flake.lock +++ b/flake.lock @@ -549,17 +549,17 @@ "servant-purescript": "servant-purescript" }, "locked": { - "lastModified": 1654207766, - "narHash": "sha256-HeN/bCFrR/Epc6NTx5GO6UmEXACdtrLHt6p4VCFI2xE=", + "lastModified": 1654586193, + "narHash": "sha256-eunqLMnBekc4vmc5b1IsZlOYvJ9PuLVMKWKwZBwxJ6E=", "owner": "Plutonomicon", "repo": "cardano-transaction-lib", - "rev": "5c7e3dd0d6c001df1d7c8e7b675e1d79530dbdff", + "rev": "a8aabb842ecc1e287d4a60ea4f4c6cff6fbfeea7", "type": "github" }, "original": { "owner": "Plutonomicon", "repo": "cardano-transaction-lib", - "rev": "5c7e3dd0d6c001df1d7c8e7b675e1d79530dbdff", + "rev": "a8aabb842ecc1e287d4a60ea4f4c6cff6fbfeea7", "type": "github" } }, diff --git a/src/Seabug/Contract/MarketPlaceListNft.purs b/src/Seabug/Contract/MarketPlaceListNft.purs index 9afafe0..1e3c721 100644 --- a/src/Seabug/Contract/MarketPlaceListNft.purs +++ b/src/Seabug/Contract/MarketPlaceListNft.purs @@ -8,7 +8,7 @@ import Contract.Prelude import Contract.Address (getNetworkId, typedValidatorEnterpriseAddress) import Contract.Monad (Contract, liftContractE, liftedM) -import Contract.PlutusData (fromData, getDatumByHash) +import Contract.PlutusData (fromData, getDatumsByHashes) import Contract.Transaction ( TransactionInput , TransactionOutput(TransactionOutput) @@ -17,7 +17,7 @@ import Contract.Utxos (utxosAt) import Contract.Value (valueOf) import Control.Alternative (guard) import Control.Monad.Maybe.Trans (MaybeT(MaybeT), runMaybeT) -import Data.Array (catMaybes) +import Data.Array (catMaybes, mapMaybe) import Data.Map as Map import Seabug.MarketPlace (marketplaceValidator) import Seabug.Metadata (FullSeabugMetadata, getFullSeabugMetadata) @@ -46,11 +46,13 @@ marketPlaceListNft = do scriptUtxos <- Map.toUnfoldable <<< unwrap <$> liftedM "marketPlaceListNft: Cannot get script Utxos" (utxosAt (unwrap scriptAddr).address) + datums <- getDatumsByHashes + $ mapMaybe (snd >>> unwrap >>> _.dataHash) scriptUtxos withMetadata <- for scriptUtxos $ \(input /\ output@(TransactionOutput out)) -> runMaybeT $ do datumHash <- MaybeT $ pure $ out.dataHash - plutusData <- MaybeT $ getDatumByHash datumHash + plutusData <- MaybeT $ pure $ Map.lookup datumHash datums MarketplaceDatum { getMarketplaceDatum: curr /\ name } <- MaybeT $ pure $ fromData $ unwrap plutusData guard $ valueOf out.amount curr name == one From 46b6ff23d8b6dfa8c12010c5b0273140778f42d6 Mon Sep 17 00:00:00 2001 From: Calum Sieppert Date: Mon, 4 Jul 2022 15:35:47 -0600 Subject: [PATCH 2/6] Parallelize metadata fetching from blockfrost --- spago.dhall | 3 +- src/Seabug/Contract/MarketPlaceListNft.purs | 8 +++- src/Seabug/Metadata.purs | 41 +++++++++++---------- 3 files changed, 29 insertions(+), 23 deletions(-) diff --git a/spago.dhall b/spago.dhall index 93f9b10..38e2e34 100644 --- a/spago.dhall +++ b/spago.dhall @@ -11,7 +11,6 @@ You can edit this file as you like. , "argonaut" , "argonaut-codecs" , "arrays" - , "monad-logger" , "bifunctors" , "bigints" , "cardano-transaction-lib" @@ -21,8 +20,10 @@ You can edit this file as you like. , "exceptions" , "http-methods" , "maybe" + , "monad-logger" , "newtype" , "ordered-collections" + , "parallel" , "partial" , "prelude" , "transformers" diff --git a/src/Seabug/Contract/MarketPlaceListNft.purs b/src/Seabug/Contract/MarketPlaceListNft.purs index 1e3c721..d0b484b 100644 --- a/src/Seabug/Contract/MarketPlaceListNft.purs +++ b/src/Seabug/Contract/MarketPlaceListNft.purs @@ -17,6 +17,8 @@ import Contract.Utxos (utxosAt) import Contract.Value (valueOf) import Control.Alternative (guard) import Control.Monad.Maybe.Trans (MaybeT(MaybeT), runMaybeT) +import Control.Monad.Reader (asks) +import Control.Parallel (parTraverse) import Data.Array (catMaybes, mapMaybe) import Data.Map as Map import Seabug.MarketPlace (marketplaceValidator) @@ -38,6 +40,7 @@ marketPlaceListNft marketPlaceListNft = do marketplaceValidator' <- unwrap <$> liftContractE marketplaceValidator networkId <- getNetworkId + projectId <- asks $ unwrap >>> _.projectId scriptAddr <- liftedM "marketPlaceListNft: Cannot convert validator hash to address" $ pure @@ -48,7 +51,7 @@ marketPlaceListNft = do (utxosAt (unwrap scriptAddr).address) datums <- getDatumsByHashes $ mapMaybe (snd >>> unwrap >>> _.dataHash) scriptUtxos - withMetadata <- for scriptUtxos $ + withMetadata <- liftAff $ (flip parTraverse) scriptUtxos $ \(input /\ output@(TransactionOutput out)) -> runMaybeT $ do datumHash <- MaybeT $ pure $ out.dataHash @@ -56,6 +59,7 @@ marketPlaceListNft = do MarketplaceDatum { getMarketplaceDatum: curr /\ name } <- MaybeT $ pure $ fromData $ unwrap plutusData guard $ valueOf out.amount curr name == one - metadata <- MaybeT $ map hush $ getFullSeabugMetadata $ curr /\ name + metadata <- MaybeT $ map hush $ + getFullSeabugMetadata (curr /\ name) projectId pure { input, output, metadata } pure $ catMaybes withMetadata diff --git a/src/Seabug/Metadata.purs b/src/Seabug/Metadata.purs index ccb0961..5c28b41 100644 --- a/src/Seabug/Metadata.purs +++ b/src/Seabug/Metadata.purs @@ -11,7 +11,6 @@ import Affjax as Affjax import Affjax.RequestHeader as Affjax.RequestHeader import Affjax.ResponseFormat as Affjax.ResponseFormat import Cardano.Types.Value as Cardano.Types.Value -import Contract.Monad (Contract) import Contract.Prim.ByteArray (byteArrayToHex) import Contract.Transaction ( ClientError(ClientHttpError, ClientDecodeJsonError) @@ -25,19 +24,17 @@ import Contract.Value ) import Control.Alternative (guard) import Control.Monad.Except.Trans (ExceptT(ExceptT), except, runExceptT) +import Control.Monad.Reader (ReaderT, runReaderT) import Control.Monad.Reader.Trans (asks) import Control.Monad.Trans.Class (lift) import Data.Argonaut as Argonaut import Data.Bifunctor (bimap, lmap) import Data.Function (on) import Data.HTTP.Method (Method(GET)) -import Data.Newtype (unwrap) import Metadata.Seabug (SeabugMetadata(SeabugMetadata)) import Partial.Unsafe (unsafePartial) import Types.CborBytes (cborBytesToByteArray) -import Debug (traceM) - type Hash = String type FullSeabugMetadata = @@ -45,20 +42,25 @@ type FullSeabugMetadata = , ipfsHash :: Hash } +type BlockfrostFetch a = ExceptT ClientError + (ReaderT { projectId :: String } Aff) + a + getFullSeabugMetadata - :: forall (r :: Row Type) - . CurrencySymbol /\ TokenName - -> Contract (projectId :: String | r) (Either ClientError FullSeabugMetadata) -getFullSeabugMetadata a@(currSym /\ _) = runExceptT $ do - seabugMetadata <- getMintingTxSeabugMetadata currSym =<< getMintingTxHash a - log $ show seabugMetadata - ipfsHash <- getIpfsHash seabugMetadata - pure { seabugMetadata, ipfsHash } + :: CurrencySymbol /\ TokenName + -> String + -> Aff (Either ClientError FullSeabugMetadata) +getFullSeabugMetadata a@(currSym /\ _) projectId = + flip runReaderT { projectId } <<< runExceptT $ do + seabugMetadata <- getMintingTxSeabugMetadata currSym =<< + getMintingTxHash + a + ipfsHash <- getIpfsHash seabugMetadata + pure { seabugMetadata, ipfsHash } getIpfsHash - :: forall (r :: Row Type) - . SeabugMetadata - -> ExceptT ClientError (Contract (projectId :: String | r)) Hash + :: SeabugMetadata + -> BlockfrostFetch Hash getIpfsHash (SeabugMetadata { collectionNftCS, collectionNftTN }) = do except <<< (decodeField "image" <=< decodeFieldJson "onchain_metadata") =<< mkGetRequest ("assets/" <> mkAsset curr collectionNftTN) @@ -71,7 +73,7 @@ getMintingTxSeabugMetadata :: forall (r :: Row Type) . CurrencySymbol -> Hash - -> ExceptT ClientError (Contract (projectId :: String | r)) SeabugMetadata + -> BlockfrostFetch SeabugMetadata getMintingTxSeabugMetadata currSym txHash = do res <- mkGetRequest $ "txs/" <> txHash <> "/metadata" ms <- except @@ -98,7 +100,7 @@ getMintingTxSeabugMetadata currSym txHash = do getMintingTxHash :: forall (r :: Row Type) . CurrencySymbol /\ TokenName - -> ExceptT ClientError (Contract (projectId :: String | r)) Hash + -> BlockfrostFetch Hash getMintingTxHash a = except <<< decodeFieldJson "initial_mint_tx_hash" =<< mkGetRequest ("assets/" <> uncurry mkAsset a) @@ -115,7 +117,6 @@ decodeField -> Aeson.Aeson -> Either ClientError a decodeField field = do - traceM $ show field lmap ClientDecodeJsonError <<< ( Aeson.decodeAeson <=< Aeson.caseAesonObject @@ -134,9 +135,9 @@ decodeFieldJson field = decodeField field <<< Aeson.jsonToAeson mkGetRequest :: forall (r :: Row Type) . String - -> ExceptT ClientError (Contract (projectId :: String | r)) Argonaut.Json + -> BlockfrostFetch Argonaut.Json mkGetRequest path = do - projectId <- lift $ asks $ _.projectId <<< unwrap + projectId <- lift $ asks $ _.projectId let req :: Affjax.Request Argonaut.Json req = Affjax.defaultRequest From 3a18d29cf5b524699ba6590c56789fa8fdaec714 Mon Sep 17 00:00:00 2001 From: Calum Sieppert Date: Wed, 6 Jul 2022 08:59:23 -0600 Subject: [PATCH 3/6] Remove unnecessary json parsing and refactor blockfrost errors --- src/Seabug/Metadata.purs | 67 +++++++++++++++++++++++----------------- 1 file changed, 38 insertions(+), 29 deletions(-) diff --git a/src/Seabug/Metadata.purs b/src/Seabug/Metadata.purs index 5c28b41..2197253 100644 --- a/src/Seabug/Metadata.purs +++ b/src/Seabug/Metadata.purs @@ -1,5 +1,6 @@ module Seabug.Metadata - ( FullSeabugMetadata + ( BlockfrostFetchError(..) + , FullSeabugMetadata , Hash , getFullSeabugMetadata ) where @@ -7,14 +8,12 @@ module Seabug.Metadata import Contract.Prelude import Aeson as Aeson +import Affjax (printError) import Affjax as Affjax import Affjax.RequestHeader as Affjax.RequestHeader import Affjax.ResponseFormat as Affjax.ResponseFormat import Cardano.Types.Value as Cardano.Types.Value import Contract.Prim.ByteArray (byteArrayToHex) -import Contract.Transaction - ( ClientError(ClientHttpError, ClientDecodeJsonError) - ) import Contract.Value ( CurrencySymbol , TokenName @@ -23,12 +22,13 @@ import Contract.Value , mkCurrencySymbol ) import Control.Alternative (guard) +import Control.Monad.Error.Class (throwError) import Control.Monad.Except.Trans (ExceptT(ExceptT), except, runExceptT) import Control.Monad.Reader (ReaderT, runReaderT) import Control.Monad.Reader.Trans (asks) import Control.Monad.Trans.Class (lift) import Data.Argonaut as Argonaut -import Data.Bifunctor (bimap, lmap) +import Data.Bifunctor (lmap) import Data.Function (on) import Data.HTTP.Method (Method(GET)) import Metadata.Seabug (SeabugMetadata(SeabugMetadata)) @@ -42,19 +42,27 @@ type FullSeabugMetadata = , ipfsHash :: Hash } -type BlockfrostFetch a = ExceptT ClientError +data BlockfrostFetchError + = BlockfrostRateLimit + | BlockfrostOtherError String + +derive instance Generic BlockfrostFetchError _ + +instance Show BlockfrostFetchError where + show = genericShow + +type BlockfrostFetch a = ExceptT BlockfrostFetchError (ReaderT { projectId :: String } Aff) a getFullSeabugMetadata :: CurrencySymbol /\ TokenName -> String - -> Aff (Either ClientError FullSeabugMetadata) + -> Aff (Either BlockfrostFetchError FullSeabugMetadata) getFullSeabugMetadata a@(currSym /\ _) projectId = flip runReaderT { projectId } <<< runExceptT $ do - seabugMetadata <- getMintingTxSeabugMetadata currSym =<< - getMintingTxHash - a + seabugMetadata <- + getMintingTxSeabugMetadata currSym =<< getMintingTxHash a ipfsHash <- getIpfsHash seabugMetadata pure { seabugMetadata, ipfsHash } @@ -62,7 +70,7 @@ getIpfsHash :: SeabugMetadata -> BlockfrostFetch Hash getIpfsHash (SeabugMetadata { collectionNftCS, collectionNftTN }) = do - except <<< (decodeField "image" <=< decodeFieldJson "onchain_metadata") + except <<< (decodeField "image" <=< decodeField "onchain_metadata") =<< mkGetRequest ("assets/" <> mkAsset curr collectionNftTN) where curr :: CurrencySymbol @@ -77,13 +85,13 @@ getMintingTxSeabugMetadata getMintingTxSeabugMetadata currSym txHash = do res <- mkGetRequest $ "txs/" <> txHash <> "/metadata" ms <- except - $ lmap ClientDecodeJsonError + $ lmap (BlockfrostOtherError <<< show) $ Aeson.caseAesonArray (Left (Argonaut.TypeMismatch "Expected array of objects")) Right - (Aeson.jsonToAeson res) + res except - $ note (ClientDecodeJsonError (Argonaut.UnexpectedValue res)) + $ note (BlockfrostOtherError ("Unexpected JSON: " <> show res)) $ findSeabugMetadata ms where findSeabugMetadata :: Array Aeson.Aeson -> Maybe SeabugMetadata @@ -102,7 +110,7 @@ getMintingTxHash . CurrencySymbol /\ TokenName -> BlockfrostFetch Hash getMintingTxHash a = - except <<< decodeFieldJson "initial_mint_tx_hash" + except <<< decodeField "initial_mint_tx_hash" =<< mkGetRequest ("assets/" <> uncurry mkAsset a) mkAsset :: CurrencySymbol -> TokenName -> String @@ -115,40 +123,41 @@ decodeField . Aeson.DecodeAeson a => String -> Aeson.Aeson - -> Either ClientError a + -> Either BlockfrostFetchError a decodeField field = do - lmap ClientDecodeJsonError <<< + lmap (BlockfrostOtherError <<< show) <<< ( Aeson.decodeAeson <=< Aeson.caseAesonObject (Left (Argonaut.TypeMismatch "Expected Object")) (flip Aeson.getField field) ) -decodeFieldJson - :: forall (a :: Type) - . Aeson.DecodeAeson a - => String - -> Argonaut.Json - -> Either ClientError a -decodeFieldJson field = decodeField field <<< Aeson.jsonToAeson - mkGetRequest :: forall (r :: Row Type) . String - -> BlockfrostFetch Argonaut.Json + -> BlockfrostFetch Aeson.Aeson mkGetRequest path = do projectId <- lift $ asks $ _.projectId let - req :: Affjax.Request Argonaut.Json + req :: Affjax.Request String req = Affjax.defaultRequest { url = mkUrl - , responseFormat = Affjax.ResponseFormat.json + , responseFormat = Affjax.ResponseFormat.string , method = Left GET , headers = [ Affjax.RequestHeader.RequestHeader "project_id" projectId ] } - ExceptT $ liftAff $ Affjax.request req <#> bimap ClientHttpError _.body + res <- ExceptT $ liftAff $ do + r <- Affjax.request req <#> lmap (BlockfrostOtherError <<< printError) + case r of + Left e -> log $ show e + Right _ -> pure unit + pure r + when (unwrap res.status == 429) $ throwError $ BlockfrostRateLimit + except $ + lmap (BlockfrostOtherError <<< (("Error parsing JSON: " <> _) <<< show)) + (Aeson.parseJsonStringToAeson res.body) where mkUrl :: String mkUrl = "https://cardano-testnet.blockfrost.io/api/v0/" <> path From dabfb1bb21051aed90a9da7cded24008b81a4580 Mon Sep 17 00:00:00 2001 From: Calum Sieppert Date: Wed, 6 Jul 2022 09:00:26 -0600 Subject: [PATCH 4/6] Implement basic blockfrost rate limit handling --- spago.dhall | 1 + src/Seabug/Contract/MarketPlaceListNft.purs | 4 +-- src/Seabug/Metadata.purs | 29 +++++++++++++++++++++ 3 files changed, 32 insertions(+), 2 deletions(-) diff --git a/spago.dhall b/spago.dhall index 38e2e34..c9db337 100644 --- a/spago.dhall +++ b/spago.dhall @@ -26,6 +26,7 @@ You can edit this file as you like. , "parallel" , "partial" , "prelude" + , "random" , "transformers" , "tuples" , "uint" diff --git a/src/Seabug/Contract/MarketPlaceListNft.purs b/src/Seabug/Contract/MarketPlaceListNft.purs index d0b484b..168cce5 100644 --- a/src/Seabug/Contract/MarketPlaceListNft.purs +++ b/src/Seabug/Contract/MarketPlaceListNft.purs @@ -22,7 +22,7 @@ import Control.Parallel (parTraverse) import Data.Array (catMaybes, mapMaybe) import Data.Map as Map import Seabug.MarketPlace (marketplaceValidator) -import Seabug.Metadata (FullSeabugMetadata, getFullSeabugMetadata) +import Seabug.Metadata (FullSeabugMetadata, getFullSeabugMetadataWithBackoff) import Seabug.Types (MarketplaceDatum(MarketplaceDatum)) type ListNftResult = @@ -60,6 +60,6 @@ marketPlaceListNft = do MaybeT $ pure $ fromData $ unwrap plutusData guard $ valueOf out.amount curr name == one metadata <- MaybeT $ map hush $ - getFullSeabugMetadata (curr /\ name) projectId + getFullSeabugMetadataWithBackoff (curr /\ name) projectId pure { input, output, metadata } pure $ catMaybes withMetadata diff --git a/src/Seabug/Metadata.purs b/src/Seabug/Metadata.purs index 2197253..84becb2 100644 --- a/src/Seabug/Metadata.purs +++ b/src/Seabug/Metadata.purs @@ -3,6 +3,7 @@ module Seabug.Metadata , FullSeabugMetadata , Hash , getFullSeabugMetadata + , getFullSeabugMetadataWithBackoff ) where import Contract.Prelude @@ -31,6 +32,8 @@ import Data.Argonaut as Argonaut import Data.Bifunctor (lmap) import Data.Function (on) import Data.HTTP.Method (Method(GET)) +import Effect.Aff (delay) +import Effect.Random (randomRange) import Metadata.Seabug (SeabugMetadata(SeabugMetadata)) import Partial.Unsafe (unsafePartial) import Types.CborBytes (cborBytesToByteArray) @@ -55,6 +58,32 @@ type BlockfrostFetch a = ExceptT BlockfrostFetchError (ReaderT { projectId :: String } Aff) a +-- | Tries to get the metadata for the given asset using +-- | Blockfrost. If the rate limit is hit, retries after a random +-- | delay, up to 5 times. Uses a very simple back-off mechanism. +-- | Instead of relying on this, refactor so the rate limit isn't hit. +getFullSeabugMetadataWithBackoff + :: CurrencySymbol /\ TokenName + -> String + -> Aff (Either BlockfrostFetchError FullSeabugMetadata) +getFullSeabugMetadataWithBackoff asset projectId = go 1.0 + where + go n = do + r <- getFullSeabugMetadata asset projectId + case r of + Left BlockfrostRateLimit + | n < 5.0 -> do + let n' = n + 1.0 + log "Blockfrost rate limit hit, backing off" + -- Wait a random amount of time in the range of [1, 3 * + -- (attempt + 1)) seconds, this is just a heuristic based + -- on my testing + delay <<< wrap <<< (_ * 1000.0) =<< + (liftEffect $ randomRange 1.0 (3.0 * n')) + log $ "Retrying, attempt " <> show n' + go n' + _ -> pure r + getFullSeabugMetadata :: CurrencySymbol /\ TokenName -> String From c5188321798966fdd3088f3649f21680b8b1161a Mon Sep 17 00:00:00 2001 From: Calum Sieppert Date: Wed, 6 Jul 2022 09:27:52 -0600 Subject: [PATCH 5/6] Auto-formatting changes --- src/Seabug/Contract/MarketPlaceBuy.purs | 4 ++-- src/Seabug/Seabug.purs | 6 +++++- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/src/Seabug/Contract/MarketPlaceBuy.purs b/src/Seabug/Contract/MarketPlaceBuy.purs index 19f4180..69aebcb 100644 --- a/src/Seabug/Contract/MarketPlaceBuy.purs +++ b/src/Seabug/Contract/MarketPlaceBuy.purs @@ -131,8 +131,8 @@ mkMarketplaceTx (NftData nftData) = do newName <- liftedM "marketplaceBuy: Cannot hash new token" $ mkTokenName newNft log $ "curr: " <> show curr - log $ "oldName: " <> show oldName - log $ "newName: " <> show newName + log $ "oldName: " <> show oldName + log $ "newName: " <> show newName let oldNftValue = Value.singleton curr oldName $ negate one newNftValue = Value.singleton curr newName one diff --git a/src/Seabug/Seabug.purs b/src/Seabug/Seabug.purs index f10ce17..c09e8b3 100644 --- a/src/Seabug/Seabug.purs +++ b/src/Seabug/Seabug.purs @@ -9,7 +9,11 @@ import Control.Promise (Promise, fromAff) import Data.Maybe (Maybe) import Effect (Effect) import QueryM (callNami) -import Seabug.CallContract (callMarketPlaceBuy, callMarketPlaceBuyTest, callMarketPlaceListNft) +import Seabug.CallContract + ( callMarketPlaceBuy + , callMarketPlaceBuyTest + , callMarketPlaceListNft + ) import Serialization.Types (Value) import Wallet (Wallet(..), mkNamiWalletAff) From c5fb3aa04cb63772e907f2f8d6f8b29632ad1ae1 Mon Sep 17 00:00:00 2001 From: Calum Sieppert Date: Wed, 6 Jul 2022 12:35:23 -0600 Subject: [PATCH 6/6] Small refactor --- src/Seabug/Contract/MarketPlaceListNft.purs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Seabug/Contract/MarketPlaceListNft.purs b/src/Seabug/Contract/MarketPlaceListNft.purs index 168cce5..43734b7 100644 --- a/src/Seabug/Contract/MarketPlaceListNft.purs +++ b/src/Seabug/Contract/MarketPlaceListNft.purs @@ -54,10 +54,10 @@ marketPlaceListNft = do withMetadata <- liftAff $ (flip parTraverse) scriptUtxos $ \(input /\ output@(TransactionOutput out)) -> runMaybeT $ do - datumHash <- MaybeT $ pure $ out.dataHash - plutusData <- MaybeT $ pure $ Map.lookup datumHash datums MarketplaceDatum { getMarketplaceDatum: curr /\ name } <- - MaybeT $ pure $ fromData $ unwrap plutusData + MaybeT $ pure $ (fromData <<< unwrap) + =<< (_ `Map.lookup` datums) + =<< out.dataHash guard $ valueOf out.amount curr name == one metadata <- MaybeT $ map hush $ getFullSeabugMetadataWithBackoff (curr /\ name) projectId