Add a tighter type for IsUtxoResponse

plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs

@@ -9,6 +9,7 @@ module Plutus.ChainIndex.Api
   ( API
   , FromHashAPI
   , FullAPI
+  , IsUtxoResponse(..)
   , SwaggerAPI
   , UtxoAtAddressRequest(..)
   , UtxoWithCurrencyRequest(..)
@@ -113,12 +114,19 @@ data UtxoWithCurrencyRequest = UtxoWithCurrencyRequest
     }
     deriving (Show, Eq, Generic, FromJSON, ToJSON, OpenApi.ToSchema)
 
+-- | Response type for the is-utxo endpoint.
+data IsUtxoResponse = IsUtxoResponse
+    { currentTip :: Tip
+    , isUtxo     :: Bool
+    }
+    deriving (Show, Eq, Generic, FromJSON, ToJSON, OpenApi.ToSchema)
+
 type API
     = "healthcheck" :> Description "Is the server alive?" :> Get '[JSON] NoContent
     :<|> "from-hash" :> FromHashAPI
     :<|> "tx-out" :> Description "Get a transaction output from its reference." :> ReqBody '[JSON] TxOutRef :> Post '[JSON] ChainIndexTxOut
     :<|> "tx" :> Description "Get a transaction from its id." :> ReqBody '[JSON] TxId :> Post '[JSON] ChainIndexTx
-    :<|> "is-utxo" :> Description "Check if the reference is an UTxO." :> ReqBody '[JSON] TxOutRef :> Post '[JSON] (Tip, Bool)
+    :<|> "is-utxo" :> Description "Check if the reference is an UTxO." :> ReqBody '[JSON] TxOutRef :> Post '[JSON] IsUtxoResponse
     :<|> "utxo-at-address" :> Description "Get all UTxOs at an address." :> ReqBody '[JSON] UtxoAtAddressRequest :> Post '[JSON] (Tip, Page TxOutRef)
     :<|> "utxo-with-currency" :> Description "Get all UTxOs with a currency." :> ReqBody '[JSON] UtxoWithCurrencyRequest :> Post '[JSON] (Tip, Page TxOutRef)
     :<|> "tip" :> Description "Get the current synced tip." :> Get '[JSON] Tip

plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs

@@ -30,7 +30,7 @@ import Ledger (Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, Red
                StakeValidatorHash, TxId, Validator, ValidatorHash)
 import Ledger.Tx (ChainIndexTxOut, TxOutRef)
 import Network.HTTP.Types.Status (Status (..))
-import Plutus.ChainIndex.Api (API, UtxoAtAddressRequest (UtxoAtAddressRequest),
+import Plutus.ChainIndex.Api (API, IsUtxoResponse, UtxoAtAddressRequest (UtxoAtAddressRequest),
                               UtxoWithCurrencyRequest (UtxoWithCurrencyRequest))
 import Plutus.ChainIndex.Effects (ChainIndexQueryEffect (..))
 import Plutus.ChainIndex.Tx (ChainIndexTx)
@@ -51,7 +51,7 @@ getRedeemer :: RedeemerHash -> ClientM Redeemer
 
 getTxOut :: TxOutRef -> ClientM ChainIndexTxOut
 getTx :: TxId -> ClientM ChainIndexTx
-getIsUtxo :: TxOutRef -> ClientM (Tip, Bool)
+getIsUtxo :: TxOutRef -> ClientM IsUtxoResponse
 getUtxoSetAtAddress :: UtxoAtAddressRequest -> ClientM (Tip, Page TxOutRef)
 getUtxoSetWithCurrency :: UtxoWithCurrencyRequest -> ClientM (Tip, Page TxOutRef)
 getTip :: ClientM Tip

plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs

@@ -32,6 +32,7 @@ import Ledger (AssetClass, Datum, DatumHash, MintingPolicy, MintingPolicyHash, R
                StakeValidatorHash, TxId, Validator, ValidatorHash)
 import Ledger.Credential (Credential)
 import Ledger.Tx (ChainIndexTxOut, TxOutRef)
+import Plutus.ChainIndex.Api (IsUtxoResponse)
 import Plutus.ChainIndex.Tx (ChainIndexTx)
 import Plutus.ChainIndex.Types (BlockProcessOption, Diagnostics, Point, Tip)
 
@@ -59,7 +60,7 @@ data ChainIndexQueryEffect r where
     TxFromTxId :: TxId -> ChainIndexQueryEffect (Maybe ChainIndexTx)
 
     -- | Whether a tx output is part of the UTXO set
-    UtxoSetMembership :: TxOutRef -> ChainIndexQueryEffect (Tip, Bool)
+    UtxoSetMembership :: TxOutRef -> ChainIndexQueryEffect IsUtxoResponse
 
     -- | Unspent outputs located at addresses with the given credential.
     UtxoSetAtAddress :: PageQuery TxOutRef -> Credential -> ChainIndexQueryEffect (Tip, Page TxOutRef)

plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs

@@ -35,6 +35,7 @@ import Ledger (Address (addressCredential), ChainIndexTxOut (..), MintingPolicy
                StakeValidatorHash (StakeValidatorHash), TxId, TxOut (txOutAddress), TxOutRef (..),
                Validator (Validator), ValidatorHash (ValidatorHash), txOutDatumHash, txOutValue)
 import Ledger.Scripts (ScriptHash (ScriptHash))
+import Plutus.ChainIndex.Api (IsUtxoResponse (..))
 import Plutus.ChainIndex.ChainIndexError (ChainIndexError (..))
 import Plutus.ChainIndex.ChainIndexLog (ChainIndexLog (..))
 import Plutus.ChainIndex.Effects (ChainIndexControlEffect (..), ChainIndexQueryEffect (..))
@@ -124,7 +125,7 @@ handleQuery = \case
         utxo <- gets (utxoState . view utxoIndex)
         case tip utxo of
             TipAtGenesis -> throwError QueryFailedNoTip
-            tp           -> pure (tp, TxUtxoBalance.isUnspentOutput r utxo)
+            tp           -> pure (IsUtxoResponse tp (TxUtxoBalance.isUnspentOutput r utxo))
     UtxoSetAtAddress pageQuery cred -> do
         state <- get
         let outRefs = view (diskState . addressMap . at cred) state

plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs

@@ -47,6 +47,7 @@ import Database.Beam.Schema.Tables (zipTables)
 import Database.Beam.Sqlite (Sqlite)
 import Ledger (Address (..), ChainIndexTxOut (..), Datum, DatumHash (..), TxId (..), TxOut (..), TxOutRef (..))
 import Ledger.Value (AssetClass (AssetClass), flattenValue)
+import Plutus.ChainIndex.Api (IsUtxoResponse (..))
 import Plutus.ChainIndex.ChainIndexError (ChainIndexError (..))
 import Plutus.ChainIndex.ChainIndexLog (ChainIndexLog (..))
 import Plutus.ChainIndex.Compatibility (toCardanoPoint)
@@ -87,7 +88,7 @@ handleQuery = \case
         utxoState <- gets @ChainIndexState UtxoState.utxoState
         case UtxoState.tip utxoState of
             TipAtGenesis -> throwError QueryFailedNoTip
-            tp           -> pure (tp, TxUtxoBalance.isUnspentOutput r utxoState)
+            tp           -> pure (IsUtxoResponse tp (TxUtxoBalance.isUnspentOutput r utxoState))
     UtxoSetAtAddress pageQuery cred -> getUtxoSetAtAddress pageQuery cred
     UtxoSetWithCurrency pageQuery assetClass ->
       getUtxoSetWithCurrency pageQuery assetClass

plutus-chain-index-core/test/Plutus/ChainIndex/Emulator/HandlersSpec.hs

@@ -22,6 +22,7 @@ import Generators qualified as Gen
 import Ledger (outValue)
 import Plutus.ChainIndex (ChainIndexLog, Page (pageItems), PageQuery (PageQuery), appendBlock, txFromTxId,
                           utxoSetMembership, utxoSetWithCurrency)
+import Plutus.ChainIndex.Api (IsUtxoResponse (..))
 import Plutus.ChainIndex.ChainIndexError (ChainIndexError)
 import Plutus.ChainIndex.Effects (ChainIndexControlEffect, ChainIndexQueryEffect)
 import Plutus.ChainIndex.Emulator.Handlers (ChainIndexEmulatorState, handleControl, handleQuery)
@@ -141,7 +142,7 @@ doNotStoreTxs = property $ do
     utxosStored <- traverse utxoSetMembership (S.toList (view Gen.txgsUtxoSet state))
     pure (tx, concat utxosFromAddr, utxosStored)
   case result of
-    Right (Nothing, [], utxosStored) -> Hedgehog.assert $ and (snd <$> utxosStored)
+    Right (Nothing, [], utxosStored) -> Hedgehog.assert $ and (isUtxo <$> utxosStored)
     _                                -> Hedgehog.assert False
 
 -- | Run an emulated chain index effect against a starting state

plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs

@@ -25,6 +25,7 @@ import Hedgehog (Property, assert, forAll, property, (===))
 import Ledger (outValue)
 import Plutus.ChainIndex (Page (pageItems), PageQuery (PageQuery), RunRequirements (..), appendBlock, citxOutputs,
                           runChainIndexEffects, txFromTxId, utxoSetMembership, utxoSetWithCurrency)
+import Plutus.ChainIndex.Api (IsUtxoResponse (..))
 import Plutus.ChainIndex.ChainIndexError (ChainIndexError (..))
 import Plutus.ChainIndex.DbSchema (checkedSqliteDb)
 import Plutus.ChainIndex.Effects (ChainIndexControlEffect, ChainIndexQueryEffect)
@@ -154,7 +155,7 @@ doNotStoreTxs = property $ do
       utxosStored <- traverse utxoSetMembership (S.toList (view Gen.txgsUtxoSet state))
       pure (tx, concat utxosFromAddr, utxosStored)
   case result of
-    Right (Nothing, [], utxosStored) -> Hedgehog.assert $ and (snd <$> utxosStored)
+    Right (Nothing, [], utxosStored) -> Hedgehog.assert $ and (isUtxo <$> utxosStored)
     _                                -> Hedgehog.assert False
 
 -- | Run a chain index action against a SQLite connection.

plutus-contract/src/Plutus/Contract/Effects.hs

@@ -92,6 +92,7 @@ import Ledger.Time (POSIXTime, POSIXTimeRange)
 import Ledger.TimeSlot (SlotConversionError)
 import Ledger.Tx (CardanoTx, ChainIndexTxOut, getCardanoTxId)
 import Plutus.ChainIndex (Page (pageItems), PageQuery)
+import Plutus.ChainIndex.Api (IsUtxoResponse (..))
 import Plutus.ChainIndex.Tx (ChainIndexTx (_citxTxId))
 import Plutus.ChainIndex.Types (Tip, TxOutStatus, TxStatus)
 import Prettyprinter (Pretty (pretty), hsep, indent, viaShow, vsep, (<+>))
@@ -257,7 +258,7 @@ data ChainIndexResponse =
   | TxOutRefResponse (Maybe ChainIndexTxOut)
   | RedeemerHashResponse (Maybe Redeemer)
   | TxIdResponse (Maybe ChainIndexTx)
-  | UtxoSetMembershipResponse (Tip, Bool)
+  | UtxoSetMembershipResponse IsUtxoResponse
   | UtxoSetAtResponse (Tip, Page TxOutRef)
   | UtxoSetWithCurrencyResponse (Tip, Page TxOutRef)
   | GetTipResponse Tip
@@ -273,7 +274,7 @@ instance Pretty ChainIndexResponse where
         RedeemerHashResponse r -> "Chain index redeemer from hash response:" <+> pretty r
         TxOutRefResponse t -> "Chain index utxo from utxo ref response:" <+> pretty t
         TxIdResponse t -> "Chain index tx from tx id response:" <+> pretty (_citxTxId <$> t)
-        UtxoSetMembershipResponse (tip, b) ->
+        UtxoSetMembershipResponse (IsUtxoResponse tip b) ->
                 "Chain index response whether tx output ref is part of the UTxO set:"
             <+> pretty b
             <+> "with tip"

plutus-contract/src/Plutus/Contract/Request.hs

@@ -125,6 +125,7 @@ import Plutus.Contract.Schema (Input, Output)
 import Wallet.Types (ContractInstanceId, EndpointDescription (..), EndpointValue (..))
 
 import Plutus.ChainIndex (ChainIndexTx, Page (nextPageQuery, pageItems), PageQuery, txOutRefs)
+import Plutus.ChainIndex.Api (IsUtxoResponse)
 import Plutus.ChainIndex.Types (RollbackState (Unknown), Tip, TxOutStatus, TxStatus)
 import Plutus.Contract.Resumable (prompt)
 import Plutus.Contract.Types (AsContractError (_ConstraintResolutionError, _OtherError, _ResumableError, _WalletError),
@@ -336,7 +337,7 @@ utxoRefMembership ::
     ( AsContractError e
     )
     => TxOutRef
-    -> Contract w s e (Tip, Bool)
+    -> Contract w s e IsUtxoResponse
 utxoRefMembership ref = do
   cir <- pabReq (ChainIndexQueryReq $ E.UtxoSetMembership ref) E._ChainIndexQueryResp
   case cir of