From dd88b66329778f4ce65f7eeec00b29372aa53056 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Mon, 13 May 2024 20:53:48 +0530 Subject: [PATCH 01/13] feat: update kupo provider to support `spentAt` field of response Related to #297. --- src/GeniusYield/Providers/Kupo.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/GeniusYield/Providers/Kupo.hs b/src/GeniusYield/Providers/Kupo.hs index eed0d5fe..588f10c0 100644 --- a/src/GeniusYield/Providers/Kupo.hs +++ b/src/GeniusYield/Providers/Kupo.hs @@ -177,6 +177,7 @@ data KupoUtxo = KupoUtxo , datumType :: !(Maybe KupoDatumType) , scriptHash :: !(Maybe GYScriptHash) , createdAt :: !KupoCreatedAt + , spentAt :: !KupoCreatedAt } deriving stock (Show, Eq, Ord, Generic) deriving (FromJSON) via CustomJSON '[FieldLabelModifier '[CamelToSnake]] KupoUtxo From ed29f48b7c775698b0163b010ce444a6880d793f Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Wed, 15 May 2024 16:35:10 +0530 Subject: [PATCH 02/13] feat: add order query parameter for kupo Related to #297. --- src/GeniusYield/Providers/Kupo.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/GeniusYield/Providers/Kupo.hs b/src/GeniusYield/Providers/Kupo.hs index 588f10c0..4fafd2f9 100644 --- a/src/GeniusYield/Providers/Kupo.hs +++ b/src/GeniusYield/Providers/Kupo.hs @@ -54,10 +54,12 @@ import Servant.API (Capture, Get, Header, Headers (getResponse), JSON, QueryFlag, QueryParam, ResponseHeader (Header), + ToHttpApiData, lookupResponseHeader, type (:<|>) (..), (:>)) import Servant.Client (ClientEnv, ClientError, ClientM, client, runClientM) +import Web.HttpApiData (ToHttpApiData (..)) -- $setup -- >>> import qualified Data.Aeson as Aeson @@ -184,7 +186,14 @@ data KupoUtxo = KupoUtxo findDatumByHash :: GYDatumHash -> ClientM KupoDatum findScriptByHash :: GYScriptHash -> ClientM KupoScript -fetchUtxosByPattern :: Pattern -> Bool -> Maybe Text -> Maybe Text -> ClientM (Headers '[Header "X-Most-Recent-Checkpoint" Word64] [KupoUtxo]) +fetchUtxosByPattern :: Pattern -> Bool -> Maybe KupoOrder -> Maybe Text -> Maybe Text -> ClientM (Headers '[Header "X-Most-Recent-Checkpoint" Word64] [KupoUtxo]) + +data KupoOrder = KOMostRecentFirst | KOOldestFirst + deriving stock (Show, Eq, Ord, Enum, Bounded) + +instance ToHttpApiData KupoOrder where + toUrlPiece KOMostRecentFirst = "most-recent-first" + toUrlPiece KOOldestFirst = "oldest-first" type KupoApi = "datums" @@ -196,6 +205,7 @@ type KupoApi = :<|> "matches" :> Capture "pattern" Pattern :> QueryFlag "unspent" + :> QueryParam "order" KupoOrder :> QueryParam "policy_id" Text :> QueryParam "asset_name" Text :> Get '[JSON] (Headers '[Header "X-Most-Recent-Checkpoint" Word64] [KupoUtxo]) From 1317d43fdd653d35c19d0786bf9ae0aceb53f1a9 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Wed, 15 May 2024 18:32:14 +0530 Subject: [PATCH 03/13] feat: update to kupo provider for including order, expose `slotFromWord64` Related to #297 --- src/GeniusYield/Providers/Kupo.hs | 8 ++++---- src/GeniusYield/Types/Slot.hs | 11 +++++------ 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/src/GeniusYield/Providers/Kupo.hs b/src/GeniusYield/Providers/Kupo.hs index 4fafd2f9..acd9b19c 100644 --- a/src/GeniusYield/Providers/Kupo.hs +++ b/src/GeniusYield/Providers/Kupo.hs @@ -232,7 +232,7 @@ kupoLookupScript env sh = do kupoUtxosAtAddress :: KupoApiEnv -> GYAddress -> Maybe GYAssetClass -> IO GYUTxOs kupoUtxosAtAddress env addr mAssetClass = do let extractedAssetClass = extractAssetClass mAssetClass - commonRequestPart = fetchUtxosByPattern (addressToText addr) True + commonRequestPart = fetchUtxosByPattern (addressToText addr) True Nothing addrUtxos <- handleKupoError locationIdent <=< runKupoClient env $ case extractedAssetClass of @@ -247,7 +247,7 @@ kupoUtxoAtTxOutRef env oref = do let (txId, utxoIdx) = txOutRefToTuple' oref utxo <- handleKupoError locationIdent <=< runKupoClient env $ - fetchUtxosByPattern (Text.pack (show utxoIdx) <> "@" <> txId) True Nothing Nothing + fetchUtxosByPattern (Text.pack (show utxoIdx) <> "@" <> txId) True Nothing Nothing Nothing listToMaybe <$> traverse (transformUtxo env) (getResponse utxo) where locationIdent = "UtxoByRef" @@ -255,7 +255,7 @@ kupoUtxoAtTxOutRef env oref = do kupoUtxosAtPaymentCredential :: KupoApiEnv -> GYPaymentCredential -> Maybe GYAssetClass -> IO GYUTxOs kupoUtxosAtPaymentCredential env cred mAssetClass = do let extractedAssetClass = extractAssetClass mAssetClass - commonRequestPart = fetchUtxosByPattern (paymentCredentialToHexText cred <> "/*") True + commonRequestPart = fetchUtxosByPattern (paymentCredentialToHexText cred <> "/*") True Nothing credUtxos <- handleKupoError locationIdent <=< runKupoClient env $ case extractedAssetClass of @@ -317,7 +317,7 @@ kupoAwaitTxConfirmed env p@GYAwaitTxParameters{..} txId = go 0 | otherwise = do utxos <- handleKupoError locationIdent <=< runKupoClient env $ - fetchUtxosByPattern (Text.pack $ "*@" <> show txId) False Nothing Nothing -- We don't require for only @unspent@. Kupo with @--prune-utxo@ option would still keep spent UTxOs until their spent record is truly immutable (see Kupo docs for more details). + fetchUtxosByPattern (Text.pack $ "*@" <> show txId) False Nothing Nothing Nothing -- We don't require for only @unspent@. Kupo with @--prune-utxo@ option would still keep spent UTxOs until their spent record is truly immutable (see Kupo docs for more details). case listToMaybe (getResponse utxos) of Nothing -> threadDelay checkInterval >> go (attempt + 1) Just u -> do diff --git a/src/GeniusYield/Types/Slot.hs b/src/GeniusYield/Types/Slot.hs index a8b321c8..01704639 100644 --- a/src/GeniusYield/Types/Slot.hs +++ b/src/GeniusYield/Types/Slot.hs @@ -8,6 +8,7 @@ Stability : develop -} module GeniusYield.Types.Slot ( GYSlot, + slotFromWord64, slotToApi, slotFromApi, advanceSlot, @@ -21,21 +22,19 @@ import Data.Word (Word64) import GeniusYield.Imports import qualified Cardano.Api as Api -import qualified Data.Aeson.Types as Aeson import qualified Data.Swagger as Swagger import qualified Text.Printf as Printf newtype GYSlot = GYSlot Word64 deriving (Show, Read, Eq, Ord) - deriving newtype (Swagger.ToParamSchema, Swagger.ToSchema) + deriving newtype (Swagger.ToParamSchema, Swagger.ToSchema, ToJSON, FromJSON) + +slotFromWord64 :: Word64 -> GYSlot +slotFromWord64 = GYSlot instance Printf.PrintfArg GYSlot where formatArg (GYSlot n) = Printf.formatArg (show n) -instance ToJSON GYSlot where - toEncoding (GYSlot n) = Aeson.toEncoding n - toJSON (GYSlot n) = Aeson.toJSON n - slotToApi :: GYSlot -> Api.SlotNo slotToApi = coerce From d1739f76ce1e2748c2250dde6dec3d0d21f0134d Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Wed, 15 May 2024 20:01:42 +0530 Subject: [PATCH 04/13] feat: use `GYSlot` for slotNo in Kupo provider Related to #297. --- src/GeniusYield/Providers/Kupo.hs | 16 +++++++++------- src/GeniusYield/Types/Slot.hs | 3 ++- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/src/GeniusYield/Providers/Kupo.hs b/src/GeniusYield/Providers/Kupo.hs index acd9b19c..a8e628ff 100644 --- a/src/GeniusYield/Providers/Kupo.hs +++ b/src/GeniusYield/Providers/Kupo.hs @@ -23,7 +23,6 @@ import Data.Aeson (Value (Null), withObject, (.:)) import Data.Char (toLower) import Data.Maybe (listToMaybe) import qualified Data.Text as Text -import Data.Word (Word64) import Deriving.Aeson import GeniusYield.Imports import GeniusYield.Providers.Common (datumFromCBOR, extractAssetClass, @@ -50,6 +49,7 @@ import GeniusYield.Types (GYAddress, GYAddressBech32, txOutRefToTuple', utxosFromList, valueFromLovelace) import qualified GeniusYield.Types as GYTypes (PlutusVersion (..)) +import GeniusYield.Types.Slot (GYSlot, unsafeAdvanceSlot) import Servant.API (Capture, Get, Header, Headers (getResponse), JSON, QueryFlag, QueryParam, @@ -165,7 +165,7 @@ data KupoDatumType = Hash | Inline deriving (FromJSON) via CustomJSON '[ConstructorTagModifier '[LowerFirst]] KupoDatumType newtype KupoCreatedAt = KupoCreatedAt - { slotNo :: Word64 + { slotNo :: GYSlot } deriving stock (Show, Eq, Ord, Generic) deriving (FromJSON) via CustomJSON '[FieldLabelModifier '[CamelToSnake]] KupoCreatedAt @@ -184,9 +184,11 @@ data KupoUtxo = KupoUtxo deriving stock (Show, Eq, Ord, Generic) deriving (FromJSON) via CustomJSON '[FieldLabelModifier '[CamelToSnake]] KupoUtxo +type MostRecentCheckpointHeader = Header "X-Most-Recent-Checkpoint" GYSlot + findDatumByHash :: GYDatumHash -> ClientM KupoDatum findScriptByHash :: GYScriptHash -> ClientM KupoScript -fetchUtxosByPattern :: Pattern -> Bool -> Maybe KupoOrder -> Maybe Text -> Maybe Text -> ClientM (Headers '[Header "X-Most-Recent-Checkpoint" Word64] [KupoUtxo]) +fetchUtxosByPattern :: Pattern -> Bool -> Maybe KupoOrder -> Maybe Text -> Maybe Text -> ClientM (Headers '[MostRecentCheckpointHeader] [KupoUtxo]) data KupoOrder = KOMostRecentFirst | KOOldestFirst deriving stock (Show, Eq, Ord, Enum, Bounded) @@ -208,7 +210,7 @@ type KupoApi = :> QueryParam "order" KupoOrder :> QueryParam "policy_id" Text :> QueryParam "asset_name" Text - :> Get '[JSON] (Headers '[Header "X-Most-Recent-Checkpoint" Word64] [KupoUtxo]) + :> Get '[JSON] (Headers '[MostRecentCheckpointHeader] [KupoUtxo]) findDatumByHash :<|> findScriptByHash :<|> fetchUtxosByPattern = client @KupoApi Proxy @@ -321,9 +323,9 @@ kupoAwaitTxConfirmed env p@GYAwaitTxParameters{..} txId = go 0 case listToMaybe (getResponse utxos) of Nothing -> threadDelay checkInterval >> go (attempt + 1) Just u -> do - let slotsToWait = 3 * confirmations * 20 -- Ouroboros Praos guarantees that there are at least @k@ blocks in a window of @3k / f@ slots where @f@ is the active slot coefficient, which is @0.05@ for Mainnet, Preprod & Preview. - case (lookupResponseHeader utxos :: ResponseHeader "X-Most-Recent-Checkpoint" Word64) of - Header slotOfCurrentBlock -> unless (slotNo (createdAt u) + slotsToWait <= slotOfCurrentBlock) $ threadDelay checkInterval >> go (attempt + 1) + let slotsToWait :: Natural = 3 * fromIntegral confirmations * 20 -- Ouroboros Praos guarantees that there are at least @k@ blocks in a window of @3k / f@ slots where @f@ is the active slot coefficient, which is @0.05@ for Mainnet, Preprod & Preview. + case (lookupResponseHeader utxos :: ResponseHeader "X-Most-Recent-Checkpoint" GYSlot) of + Header slotOfCurrentBlock -> unless (let s = unsafeAdvanceSlot (slotNo (createdAt u)) slotsToWait in s <= slotOfCurrentBlock) $ threadDelay checkInterval >> go (attempt + 1) -- @Word64@ wraps back to zero in case of overflow, so it's safe. _ -> handleKupoAbsurdResponse locationIdent "Header 'X-Most-Recent-Checkpoint' isn't seen in response" where diff --git a/src/GeniusYield/Types/Slot.hs b/src/GeniusYield/Types/Slot.hs index 01704639..5b7f3265 100644 --- a/src/GeniusYield/Types/Slot.hs +++ b/src/GeniusYield/Types/Slot.hs @@ -24,10 +24,11 @@ import GeniusYield.Imports import qualified Cardano.Api as Api import qualified Data.Swagger as Swagger import qualified Text.Printf as Printf +import Web.HttpApiData (FromHttpApiData, ToHttpApiData) newtype GYSlot = GYSlot Word64 deriving (Show, Read, Eq, Ord) - deriving newtype (Swagger.ToParamSchema, Swagger.ToSchema, ToJSON, FromJSON) + deriving newtype (Swagger.ToParamSchema, Swagger.ToSchema, ToJSON, FromJSON, ToHttpApiData, FromHttpApiData) slotFromWord64 :: Word64 -> GYSlot slotFromWord64 = GYSlot From 810f017612a0478223d9ac87474dd79bef13898b Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Wed, 15 May 2024 20:14:17 +0530 Subject: [PATCH 05/13] feat: export `KupoUtxo` Related to #297. --- src/GeniusYield/Providers/Kupo.hs | 1 + src/GeniusYield/Types/SlotConfig.hs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/GeniusYield/Providers/Kupo.hs b/src/GeniusYield/Providers/Kupo.hs index a8e628ff..50a43f1d 100644 --- a/src/GeniusYield/Providers/Kupo.hs +++ b/src/GeniusYield/Providers/Kupo.hs @@ -12,6 +12,7 @@ module GeniusYield.Providers.Kupo ( newKupoApiEnv, kupoLookupDatum, kupoLookupScript, + KupoUtxo (..), kupoQueryUtxo, kupoAwaitTxConfirmed ) where diff --git a/src/GeniusYield/Types/SlotConfig.hs b/src/GeniusYield/Types/SlotConfig.hs index 2606ef0f..25318685 100644 --- a/src/GeniusYield/Types/SlotConfig.hs +++ b/src/GeniusYield/Types/SlotConfig.hs @@ -57,7 +57,7 @@ The slot <-> conversion operations also mimic (but consolidate) the behavior of 'Ouroboros.wallClockToSlot' query interpretations. The rationale behind this is simply that 'Api.EraHistory' (which contains the interpreter) is much too overcomplicated -for this simple task. The design simplifaction here should allow easy construction of "simple" slot configs for testing +for this simple task. The design simplification here should allow easy construction of "simple" slot configs for testing and similar. == IMPORTANT == From 986667501da8517ae0c3b7f594e6980058fd77bd Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Wed, 15 May 2024 20:16:04 +0530 Subject: [PATCH 06/13] feat: export kupo client functions Related to #297 --- src/GeniusYield/Providers/Kupo.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/GeniusYield/Providers/Kupo.hs b/src/GeniusYield/Providers/Kupo.hs index 50a43f1d..fd1a3bd8 100644 --- a/src/GeniusYield/Providers/Kupo.hs +++ b/src/GeniusYield/Providers/Kupo.hs @@ -14,7 +14,10 @@ module GeniusYield.Providers.Kupo ( kupoLookupScript, KupoUtxo (..), kupoQueryUtxo, - kupoAwaitTxConfirmed + kupoAwaitTxConfirmed, + findDatumByHash, + findScriptByHash, + fetchUtxosByPattern, ) where import qualified Cardano.Api as Api From caafa88e3aa194133a33bb0d82ec0a865ebcf763 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Wed, 15 May 2024 20:24:42 +0530 Subject: [PATCH 07/13] feat: export `KupoOrder` Related to #297. --- src/GeniusYield/Providers/Kupo.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/GeniusYield/Providers/Kupo.hs b/src/GeniusYield/Providers/Kupo.hs index fd1a3bd8..928d6f1f 100644 --- a/src/GeniusYield/Providers/Kupo.hs +++ b/src/GeniusYield/Providers/Kupo.hs @@ -13,6 +13,7 @@ module GeniusYield.Providers.Kupo ( kupoLookupDatum, kupoLookupScript, KupoUtxo (..), + KupoOrder (..), kupoQueryUtxo, kupoAwaitTxConfirmed, findDatumByHash, From d2fb53cea6973402b0aed9d7910fdb4ffeeabbfd Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Wed, 15 May 2024 20:28:17 +0530 Subject: [PATCH 08/13] feat: add `created_after` and `created_before` query params to kupo client Related to #297. --- src/GeniusYield/Providers/Kupo.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/GeniusYield/Providers/Kupo.hs b/src/GeniusYield/Providers/Kupo.hs index 928d6f1f..76c0ebcb 100644 --- a/src/GeniusYield/Providers/Kupo.hs +++ b/src/GeniusYield/Providers/Kupo.hs @@ -193,7 +193,7 @@ type MostRecentCheckpointHeader = Header "X-Most-Recent-Checkpoint" GYSlot findDatumByHash :: GYDatumHash -> ClientM KupoDatum findScriptByHash :: GYScriptHash -> ClientM KupoScript -fetchUtxosByPattern :: Pattern -> Bool -> Maybe KupoOrder -> Maybe Text -> Maybe Text -> ClientM (Headers '[MostRecentCheckpointHeader] [KupoUtxo]) +fetchUtxosByPattern :: Pattern -> Bool -> Maybe KupoOrder -> Maybe GYSlot -> Maybe GYSlot -> Maybe Text -> Maybe Text -> ClientM (Headers '[MostRecentCheckpointHeader] [KupoUtxo]) data KupoOrder = KOMostRecentFirst | KOOldestFirst deriving stock (Show, Eq, Ord, Enum, Bounded) @@ -213,6 +213,8 @@ type KupoApi = :> Capture "pattern" Pattern :> QueryFlag "unspent" :> QueryParam "order" KupoOrder + :> QueryParam "created_after" GYSlot + :> QueryParam "created_before" GYSlot :> QueryParam "policy_id" Text :> QueryParam "asset_name" Text :> Get '[JSON] (Headers '[MostRecentCheckpointHeader] [KupoUtxo]) @@ -239,7 +241,7 @@ kupoLookupScript env sh = do kupoUtxosAtAddress :: KupoApiEnv -> GYAddress -> Maybe GYAssetClass -> IO GYUTxOs kupoUtxosAtAddress env addr mAssetClass = do let extractedAssetClass = extractAssetClass mAssetClass - commonRequestPart = fetchUtxosByPattern (addressToText addr) True Nothing + commonRequestPart = fetchUtxosByPattern (addressToText addr) True Nothing Nothing Nothing addrUtxos <- handleKupoError locationIdent <=< runKupoClient env $ case extractedAssetClass of @@ -254,7 +256,7 @@ kupoUtxoAtTxOutRef env oref = do let (txId, utxoIdx) = txOutRefToTuple' oref utxo <- handleKupoError locationIdent <=< runKupoClient env $ - fetchUtxosByPattern (Text.pack (show utxoIdx) <> "@" <> txId) True Nothing Nothing Nothing + fetchUtxosByPattern (Text.pack (show utxoIdx) <> "@" <> txId) True Nothing Nothing Nothing Nothing Nothing listToMaybe <$> traverse (transformUtxo env) (getResponse utxo) where locationIdent = "UtxoByRef" @@ -262,7 +264,7 @@ kupoUtxoAtTxOutRef env oref = do kupoUtxosAtPaymentCredential :: KupoApiEnv -> GYPaymentCredential -> Maybe GYAssetClass -> IO GYUTxOs kupoUtxosAtPaymentCredential env cred mAssetClass = do let extractedAssetClass = extractAssetClass mAssetClass - commonRequestPart = fetchUtxosByPattern (paymentCredentialToHexText cred <> "/*") True Nothing + commonRequestPart = fetchUtxosByPattern (paymentCredentialToHexText cred <> "/*") True Nothing Nothing Nothing credUtxos <- handleKupoError locationIdent <=< runKupoClient env $ case extractedAssetClass of @@ -324,7 +326,7 @@ kupoAwaitTxConfirmed env p@GYAwaitTxParameters{..} txId = go 0 | otherwise = do utxos <- handleKupoError locationIdent <=< runKupoClient env $ - fetchUtxosByPattern (Text.pack $ "*@" <> show txId) False Nothing Nothing Nothing -- We don't require for only @unspent@. Kupo with @--prune-utxo@ option would still keep spent UTxOs until their spent record is truly immutable (see Kupo docs for more details). + fetchUtxosByPattern (Text.pack $ "*@" <> show txId) False Nothing Nothing Nothing Nothing Nothing -- We don't require for only @unspent@. Kupo with @--prune-utxo@ option would still keep spent UTxOs until their spent record is truly immutable (see Kupo docs for more details). case listToMaybe (getResponse utxos) of Nothing -> threadDelay checkInterval >> go (attempt + 1) Just u -> do From b6dbe77f94875577f76d72c7ae8365c7e1c421c5 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Wed, 15 May 2024 20:37:07 +0530 Subject: [PATCH 09/13] feat: export `runKupoClient` Related to #297. --- src/GeniusYield/Providers/Kupo.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/GeniusYield/Providers/Kupo.hs b/src/GeniusYield/Providers/Kupo.hs index 76c0ebcb..cf74eca3 100644 --- a/src/GeniusYield/Providers/Kupo.hs +++ b/src/GeniusYield/Providers/Kupo.hs @@ -10,6 +10,7 @@ Stability : develop module GeniusYield.Providers.Kupo ( KupoApiEnv, newKupoApiEnv, + runKupoClient, kupoLookupDatum, kupoLookupScript, KupoUtxo (..), From 979e2c6d04619a3dcd85330245aeede52bc8318e Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Wed, 15 May 2024 20:44:28 +0530 Subject: [PATCH 10/13] fix: make `spentAt` optional for Kupo client Related to #297. --- src/GeniusYield/Providers/Kupo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GeniusYield/Providers/Kupo.hs b/src/GeniusYield/Providers/Kupo.hs index cf74eca3..e980d4d5 100644 --- a/src/GeniusYield/Providers/Kupo.hs +++ b/src/GeniusYield/Providers/Kupo.hs @@ -185,7 +185,7 @@ data KupoUtxo = KupoUtxo , datumType :: !(Maybe KupoDatumType) , scriptHash :: !(Maybe GYScriptHash) , createdAt :: !KupoCreatedAt - , spentAt :: !KupoCreatedAt + , spentAt :: !(Maybe KupoCreatedAt) } deriving stock (Show, Eq, Ord, Generic) deriving (FromJSON) via CustomJSON '[FieldLabelModifier '[CamelToSnake]] KupoUtxo From d798908abee597d9fab77492808070bce3921c77 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Thu, 16 May 2024 12:21:48 +0530 Subject: [PATCH 11/13] feat: export more types & utilities from Kupo provider Related to #297. --- src/GeniusYield/Providers/Kupo.hs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/src/GeniusYield/Providers/Kupo.hs b/src/GeniusYield/Providers/Kupo.hs index e980d4d5..2e522082 100644 --- a/src/GeniusYield/Providers/Kupo.hs +++ b/src/GeniusYield/Providers/Kupo.hs @@ -10,16 +10,26 @@ Stability : develop module GeniusYield.Providers.Kupo ( KupoApiEnv, newKupoApiEnv, + KupoProviderException (..), + handleKupoError, + handleKupoAbsurdResponse, runKupoClient, + KupoDatum (..), + KupoScriptLanguage (..), + KupoScript (..), + KupoValue (..), + KupoDatumType (..), + KupoCreatedAt (..), + KupoUtxo (..), + findDatumByHash, + findScriptByHash, + fetchUtxosByPattern, kupoLookupDatum, kupoLookupScript, - KupoUtxo (..), KupoOrder (..), kupoQueryUtxo, + transformUtxo, kupoAwaitTxConfirmed, - findDatumByHash, - findScriptByHash, - fetchUtxosByPattern, ) where import qualified Cardano.Api as Api From d4acb11c580385676e751d057bf8eedf55a24fd7 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Thu, 16 May 2024 12:44:25 +0530 Subject: [PATCH 12/13] feat: add `utxoDatumResolver` and export it Related to #297. --- src/GeniusYield/Types/Providers.hs | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/GeniusYield/Types/Providers.hs b/src/GeniusYield/Types/Providers.hs index da0f31f4..836264fa 100644 --- a/src/GeniusYield/Types/Providers.hs +++ b/src/GeniusYield/Types/Providers.hs @@ -55,6 +55,8 @@ module GeniusYield.Types.Providers , gyQueryUtxoAtAddressesDefault , gyQueryUtxoAtPaymentCredentialsDefault , gyQueryUtxosAtTxOutRefsDefault + , utxosDatumResolver + , utxoDatumResolver -- * Logging , GYLog (..) , gyLog @@ -490,15 +492,19 @@ gyQueryUtxosAtPaymentCredWithDatumsDefault utxosAtPaymentCredFun lookupDatumFun utxosWithoutDatumResolutions <- utxosAtPaymentCredFun cred mAssetClass utxosDatumResolver utxosWithoutDatumResolutions lookupDatumFun --- | Append UTxO information with their fetched datum. +-- | Append UTxOs information with their fetched datum. utxosDatumResolver :: Monad m => GYUTxOs -> (GYDatumHash -> m (Maybe GYDatum)) -> m [(GYUTxO, Maybe GYDatum)] utxosDatumResolver utxos lookupDatumFun = do let utxosWithoutDatumResolutions = utxosToList utxos - forM utxosWithoutDatumResolutions $ \utxo -> do - case utxoOutDatum utxo of - GYOutDatumNone -> return (utxo, Nothing) - GYOutDatumInline d -> return (utxo, Just d) - GYOutDatumHash h -> (utxo, ) <$> lookupDatumFun h + forM utxosWithoutDatumResolutions $ utxoDatumResolver lookupDatumFun + +-- | Append UTxO information with their fetched datum. +utxoDatumResolver :: Monad m => (GYDatumHash -> m (Maybe GYDatum)) -> GYUTxO -> m (GYUTxO, Maybe GYDatum) +utxoDatumResolver lookupDatumFun utxo = do + case utxoOutDatum utxo of + GYOutDatumNone -> return (utxo, Nothing) + GYOutDatumInline d -> return (utxo, Just d) + GYOutDatumHash h -> (utxo, ) <$> lookupDatumFun h -- | Lookup UTxOs at zero or more 'GYTxOutRef' with their datums. This is a default implementation using `utxosAtTxOutRefs` and `lookupDatum`. gyQueryUtxosAtTxOutRefsWithDatumsDefault :: Monad m => ([GYTxOutRef] -> m GYUTxOs) -> (GYDatumHash -> m (Maybe GYDatum)) -> [GYTxOutRef] -> m [(GYUTxO, Maybe GYDatum)] From f337b22205bf13b429c65a84d66fe0fc1495d743 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Mon, 20 May 2024 17:04:53 +0530 Subject: [PATCH 13/13] fix: use underscores inplace of hyphen for order query parameter in kupo Related to #297. --- src/GeniusYield/Providers/Kupo.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/GeniusYield/Providers/Kupo.hs b/src/GeniusYield/Providers/Kupo.hs index 2e522082..184d542d 100644 --- a/src/GeniusYield/Providers/Kupo.hs +++ b/src/GeniusYield/Providers/Kupo.hs @@ -210,8 +210,8 @@ data KupoOrder = KOMostRecentFirst | KOOldestFirst deriving stock (Show, Eq, Ord, Enum, Bounded) instance ToHttpApiData KupoOrder where - toUrlPiece KOMostRecentFirst = "most-recent-first" - toUrlPiece KOOldestFirst = "oldest-first" + toUrlPiece KOMostRecentFirst = "most_recent_first" + toUrlPiece KOOldestFirst = "oldest_first" type KupoApi = "datums"