diff --git a/hydra-cluster/test/Test/Hydra/Cluster/HydraClientSpec.hs b/hydra-cluster/test/Test/Hydra/Cluster/HydraClientSpec.hs index 4a624dab5c1..1bc31629483 100644 --- a/hydra-cluster/test/Test/Hydra/Cluster/HydraClientSpec.hs +++ b/hydra-cluster/test/Test/Hydra/Cluster/HydraClientSpec.hs @@ -16,7 +16,7 @@ import CardanoNode ( ) import Control.Lens ((^?)) import Data.Aeson (Value (..), (.=)) -import Data.Aeson.Lens (key) +import Data.Aeson.Lens (atKey, key) import Data.Set qualified as Set import Data.Text qualified as Text import Hydra.Cardano.Api hiding (Value, cardanoEra, queryGenesisParameters) @@ -65,6 +65,10 @@ spec = around (showLogsOnFailure "HydraClientSpec") $ do failAfter 60 $ withTempDir "hydra-client" $ \tmpDir -> filterConfirmedUTxOByWrongAddressScenario tracer tmpDir + it "should filter ALL in confirmed UTxO when given an address but using snapshot exclusion option" $ \tracer -> do + failAfter 60 $ + withTempDir "hydra-client" $ \tmpDir -> + filterConfirmedUTxOByAddressWithExclusionScenario tracer tmpDir filterConfirmedUTxOByAddressScenario :: Tracer IO EndToEndLog -> FilePath -> IO () filterConfirmedUTxOByAddressScenario tracer tmpDir = do @@ -135,6 +139,20 @@ filterConfirmedUTxOByWrongAddressScenario tracer tmpDir = do utxo <- v ^? key "snapshot" . key "utxo" guard $ utxo == toJSON (mempty :: Map TxIn Value) +filterConfirmedUTxOByAddressWithExclusionScenario :: Tracer IO EndToEndLog -> FilePath -> IO () +filterConfirmedUTxOByAddressWithExclusionScenario tracer tmpDir = do + scenarioSetup tracer tmpDir $ \node nodes hydraTracer -> do + (expectedSnapshotNumber, (aliceExternalVk, _)) <- prepareScenario node nodes tracer + let [n1, _, _] = toList nodes + + runScenario hydraTracer n1 (textAddrOf aliceExternalVk <> "&snapshot-utxo=no") $ \con -> do + waitMatch 3 con $ \v -> do + guard $ v ^? key "tag" == Just "SnapshotConfirmed" + snapshotNumber <- v ^? key "snapshot" . key "number" + guard $ snapshotNumber == toJSON expectedSnapshotNumber + utxo <- v ^? key "snapshot" . atKey "utxo" + guard $ isNothing utxo + -- * Helpers unwrapAddress :: AddressInEra -> Text unwrapAddress = \case diff --git a/hydra-node/src/Hydra/API/ServerOutput.hs b/hydra-node/src/Hydra/API/ServerOutput.hs index 51a9df145c0..b3517e11bd4 100644 --- a/hydra-node/src/Hydra/API/ServerOutput.hs +++ b/hydra-node/src/Hydra/API/ServerOutput.hs @@ -252,7 +252,7 @@ prepareServerOutput ServerOutputConfig{utxoInSnapshot, addressInSnapshot} respon SnapshotConfirmed{} -> encodedResponse & handleUtxoInclusion (key "snapshot" . atKey "utxo" .~ Nothing) - & handleAddressInclusion (\addr -> key "snapshot" . key "utxo" %~ filterEntries addr) + & handleAddressInclusion (\addr -> key "snapshot" . atKey "utxo" %~ filterEntries addr) GetUTxOResponse{} -> encodedResponse InvalidInput{} -> encodedResponse Greetings{} -> encodedResponse @@ -278,7 +278,7 @@ prepareServerOutput ServerOutputConfig{utxoInSnapshot, addressInSnapshot} respon WithoutAddressedUTxO -> bs filterEntries addr = \case - Object utxoMap -> Object $ KeyMap.filter matchingAddress utxoMap + Just (Object utxoMap) -> Just . Object $ KeyMap.filter matchingAddress utxoMap other -> other where matchingAddress obj =