module Hydra.Logging.MonitoringSpec where

import Hydra.Prelude
import Test.Hydra.Prelude

import Data.Set qualified as Set
import Data.Text qualified as Text
import Hydra.HeadLogic.State qualified as Head
import Hydra.Logging.Monitoring.Registry qualified as Registry
import Hydra.Node.State qualified as NodeState
import Hydra.Node.Stats qualified as Stats

import Control.Concurrent qualified as Concurrent
import Control.Concurrent.Class.MonadSTM (putTMVar, takeTMVar)
import Control.Exception qualified as Exception
import Control.Monad.Class.MonadAsync (cancel, waitCatch)
import Control.Tracer (emit)
import Control.Tracer.JSON (Tracer (..), nullTracer, traceWith)
import GHC.Conc (BlockReason (BlockedOnException), ThreadStatus (..), threadStatus)
import GHC.Stats (getRTSStatsEnabled)
import Hydra.API.APIServerLog qualified as API
import Hydra.API.ClientInput (ClientInput (NewTx))
import Hydra.API.ClientInput qualified as Client
import Hydra.API.HTTPServer (observeL1)
import Hydra.API.ServerOutput (ClientMessage (RejectedInputBecauseBroadcastStalled))
import Hydra.API.ServerOutput qualified as Output
import Hydra.HeadLogic (Input (ClientInput))
import Hydra.HeadLogic.Outcome (Effect (ClientEffect), Outcome (..), StateChanged (..))
import Hydra.HeadLogicSpec (inIdleState, inOpenState, receiveMessage, testSnapshot)
import Hydra.Ledger.Simple (SimpleTx)
import Hydra.Logging.Messages (HydraLog (APIServer, Network, Node))
import Hydra.Logging.Monitoring
import Hydra.Network (Host (Host), StallReason (..))
import Hydra.Network.Etcd qualified as Etcd
import Hydra.Network.Message (Message (ReqTx))
import Hydra.Node (HydraNodeLog (..))
import Hydra.Node.Network qualified as Network

import Network.HTTP.Req (GET (..), NoReqBody (..), bsResponse, defaultHttpConfig, http, port, req, responseBody, runReq, (/:))
import Test.Hydra.Ledger.Simple (aValidTx, utxoRefs)
import Test.Hydra.Tx.Fixture (alice, testHeadId)
import Test.Network.Ports (randomUnusedTCPPorts)

spec :: Spec
spec :: Spec
spec = do
  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"publishes one HELP and TYPE per family, including labelled families" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    (HydraLog SimpleTx -> IO ()
_, Registry
registry, IO ()
_) <- forall tx.
IsTx tx =>
Text -> IO (HydraLog tx -> IO (), Registry, IO ())
prepareRegistry @SimpleTx Text
"direct"
    [Text]
rows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
    let declarations :: Text -> [Text]
declarations Text
prefix = [Text
name | Text
line <- [Text]
rows, Text
prefix Text -> Text -> Bool
`Text.isPrefixOf` Text
line, Text
name <- Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
1 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
2 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.words Text
line]
        types :: [Text]
types = Text -> [Text]
declarations Text
"# TYPE "
        helps :: [Text]
helps = Text -> [Text]
declarations Text
"# HELP "
    [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
types Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Set Text -> Int
forall a. Set a -> Int
Set.size ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text]
types)
    [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort [Text]
helps [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort [Text]
types
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"# TYPE hydra_head_requested_tx_total counter"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_tx_confirmation_seconds_bucket{le=\"300.0\"} 0.0"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_tx_confirmation_time_ms_bucket{le=\"300000.0\"} 0.0"]

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"exposes only the approved protocol families and compatibility aliases" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    (HydraLog SimpleTx -> IO ()
_, Registry
registry, IO ()
_) <- forall tx.
IsTx tx =>
Text -> IO (HydraLog tx -> IO (), Registry, IO ())
prepareRegistry @SimpleTx Text
"direct"
    [Text]
rows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
    let families :: [Text]
families = [Text
name | Text
line <- [Text]
rows, Text
"# TYPE " Text -> Text -> Bool
`Text.isPrefixOf` Text
line, Text
name <- Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
1 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
2 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.words Text
line]
    [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort [Text]
families [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text]
protocolMetrics [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
canonicalAliases [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
additionalMetrics)

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does not count processing retries as new requests" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    (HydraLog SimpleTx -> IO ()
record, Registry
registry, IO ()
_) <- forall tx.
IsTx tx =>
Text -> IO (HydraLog tx -> IO (), Registry, IO ())
prepareRegistry @SimpleTx Text
"direct"
    let input :: HydraLog SimpleTx
input = HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Word64 -> Input SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> Input tx -> HydraNodeLog tx
BeginInput Party
alice Word64
7 (Message SimpleTx -> Input SimpleTx
forall tx. Message tx -> Input tx
receiveMessage (SimpleTx -> Message SimpleTx
forall tx. tx -> Message tx
ReqTx (SimpleTx -> Message SimpleTx) -> SimpleTx -> Message SimpleTx
forall a b. (a -> b) -> a -> b
$ Integer -> SimpleTx
aValidTx Integer
42))
    HydraLog SimpleTx -> IO ()
record HydraLog SimpleTx
input
    HydraLog SimpleTx -> IO ()
record HydraLog SimpleTx
input
    [Text]
rows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_requested_tx_total  1"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_requested_tx  1"]

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"records completed client processing attempts including retries" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    (HydraLog SimpleTx -> IO ()
record, Registry
registry, IO ()
_) <- forall tx.
IsTx tx =>
Text -> IO (HydraLog tx -> IO (), Registry, IO ())
prepareRegistry @SimpleTx Text
"direct"
    let input :: Input SimpleTx
input = ClientInput SimpleTx -> Input SimpleTx
forall tx. ClientInput tx -> Input tx
ClientInput (ClientInput SimpleTx -> Input SimpleTx)
-> ClientInput SimpleTx -> Input SimpleTx
forall a b. (a -> b) -> a -> b
$ SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx (SimpleTx -> ClientInput SimpleTx)
-> SimpleTx -> ClientInput SimpleTx
forall a b. (a -> b) -> a -> b
$ Integer -> SimpleTx
aValidTx Integer
42
    HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Word64 -> Input SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> Input tx -> HydraNodeLog tx
BeginInput Party
alice Word64
7 Input SimpleTx
input
    HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Word64 -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> HydraNodeLog tx
EndInput Party
alice Word64
7
    HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Word64 -> Input SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> Input tx -> HydraNodeLog tx
BeginInput Party
alice Word64
7 Input SimpleTx
input
    HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Word64 -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> HydraNodeLog tx
EndInput Party
alice Word64
7
    HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Word64 -> Input SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> Input tx -> HydraNodeLog tx
BeginInput Party
alice Word64
8 Input SimpleTx
input
    HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Word64 -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> HydraNodeLog tx
EndInput Party
alice Word64
8
    [Text]
rows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_inputs_total  3"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_node_input_processing_seconds_count{source=\"client\"} 3"]

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"counts transaction refusals without mixing in unrelated commands" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    (HydraLog SimpleTx -> IO ()
record, Registry
registry, IO ()
_) <- forall tx.
IsTx tx =>
Text -> IO (HydraLog tx -> IO (), Registry, IO ())
prepareRegistry @SimpleTx Text
"direct"
    let failedHead :: HeadState SimpleTx
failedHead = NodeState SimpleTx -> HeadState SimpleTx
forall tx. NodeState tx -> HeadState tx
NodeState.headState NodeState SimpleTx
inIdleState
        txInputs :: [ClientInput SimpleTx]
txInputs = [SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
Client.NewTx (SimpleTx -> ClientInput SimpleTx)
-> SimpleTx -> ClientInput SimpleTx
forall a b. (a -> b) -> a -> b
$ Integer -> SimpleTx
aValidTx Integer
42, SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
Client.Decommit (SimpleTx -> ClientInput SimpleTx)
-> SimpleTx -> ClientInput SimpleTx
forall a b. (a -> b) -> a -> b
$ Integer -> SimpleTx
aValidTx Integer
43]
        commands :: [Client.ClientInput SimpleTx]
        commands :: [ClientInput SimpleTx]
commands = [ClientInput SimpleTx
forall tx. ClientInput tx
Client.Close, ClientInput SimpleTx
forall tx. ClientInput tx
Client.Fanout]
        effects :: [Effect SimpleTx]
effects =
          [ClientMessage SimpleTx -> Effect SimpleTx
forall tx. ClientMessage tx -> Effect tx
ClientEffect (ClientMessage SimpleTx -> Effect SimpleTx)
-> ClientMessage SimpleTx -> Effect SimpleTx
forall a b. (a -> b) -> a -> b
$ ClientInput SimpleTx
-> HeadState SimpleTx -> ClientMessage SimpleTx
forall tx. ClientInput tx -> HeadState tx -> ClientMessage tx
Output.CommandFailed ClientInput SimpleTx
input HeadState SimpleTx
failedHead | ClientInput SimpleTx
input <- [ClientInput SimpleTx]
txInputs [ClientInput SimpleTx]
-> [ClientInput SimpleTx] -> [ClientInput SimpleTx]
forall a. Semigroup a => a -> a -> a
<> [ClientInput SimpleTx]
commands]
            [Effect SimpleTx] -> [Effect SimpleTx] -> [Effect SimpleTx]
forall a. Semigroup a => a -> a -> a
<> [ClientMessage SimpleTx -> Effect SimpleTx
forall tx. ClientMessage tx -> Effect tx
ClientEffect (ClientMessage SimpleTx -> Effect SimpleTx)
-> ClientMessage SimpleTx -> Effect SimpleTx
forall a b. (a -> b) -> a -> b
$ ClientInput SimpleTx -> NominalDiffTime -> ClientMessage SimpleTx
forall tx. ClientInput tx -> NominalDiffTime -> ClientMessage tx
Output.RejectedInputBecauseUnsynced ClientInput SimpleTx
input NominalDiffTime
1 | ClientInput SimpleTx
input <- [ClientInput SimpleTx]
txInputs [ClientInput SimpleTx]
-> [ClientInput SimpleTx] -> [ClientInput SimpleTx]
forall a. Semigroup a => a -> a -> a
<> [ClientInput SimpleTx]
commands]
    HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Outcome SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Outcome tx -> HydraNodeLog tx
LogicOutcome Party
alice ([StateChanged SimpleTx] -> [Effect SimpleTx] -> Outcome SimpleTx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [] [Effect SimpleTx]
effects)
    [Text]
rows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_transaction_outcomes_total{outcome=\"rejected_state\"} 2"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_transaction_outcomes_total{outcome=\"refused_unsynced\"} 2"]

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"groups network failures and ignores routine recovery events" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    (HydraLog SimpleTx -> IO ()
record, Registry
registry, IO ()
_) <- forall tx.
IsTx tx =>
Text -> IO (HydraLog tx -> IO (), Registry, IO ())
prepareRegistry @SimpleTx Text
"direct"
    let emitEvent :: EtcdLog -> IO ()
emitEvent = HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ())
-> (EtcdLog -> HydraLog SimpleTx) -> EtcdLog -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkLog -> HydraLog SimpleTx
forall tx. NetworkLog -> HydraLog tx
Network (NetworkLog -> HydraLog SimpleTx)
-> (EtcdLog -> NetworkLog) -> EtcdLog -> HydraLog SimpleTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EtcdLog -> NetworkLog
Network.Etcd
    (EtcdLog -> IO ()) -> [EtcdLog] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ EtcdLog -> IO ()
emitEvent [Int64 -> EtcdLog
Etcd.WatchMessagesFallbackTo Int64
1, Int64 -> Int64 -> EtcdLog
Etcd.BroadcastDeduped Int64
1 Int64
2]
    [Text]
initial <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
    let samples :: [Text]
samples = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
Text.isPrefixOf Text
"hydra_network_events_total{") [Text]
initial
    [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
samples Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Int
9
    [Text]
samples [Text] -> ([Text] -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Text -> Bool
Text.isSuffixOf Text
" 0")
    (EtcdLog -> IO ()) -> [EtcdLog] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
      EtcdLog -> IO ()
emitEvent
      [ Int64 -> EtcdLog
Etcd.LowLeaseTTL Int64
1
      , EtcdLog
Etcd.NoKeepAliveResponse
      , Text -> Text -> EtcdLog
Etcd.FailedToDecodeLog Text
"log" Text
"invalid"
      , Text -> Text -> Text -> EtcdLog
Etcd.FailedToDecodeValue Text
"key" Text
"value" Text
"invalid"
      , Text -> EtcdLog
Etcd.PersistentQueueLoadFailed Text
"invalid item"
      , Text -> EtcdLog
Etcd.PersistentQueueWriteFailed Text
"disk full"
      , Natural -> Text -> EtcdLog
Etcd.PersistentQueueDeleteFailed Natural
1 Text
"permission denied"
      , Text -> EtcdLog
Etcd.PersistentQueueStatFailed Text
"permission denied"
      ]
    [Text]
rows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_network_events_total{event=\"lease_warning\"} 2"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_network_events_total{event=\"decode_failure\"} 2"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_network_events_total{event=\"queue_storage_failure\"} 3"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_network_events_total{event=\"queue_stat_failure\"} 1"]

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"records failed chain posts before their error input is processed" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    (HydraLog SimpleTx -> IO ()
record, Registry
registry, IO ()
_) <- forall tx.
IsTx tx =>
Text -> IO (HydraLog tx -> IO (), Registry, IO ())
prepareRegistry @SimpleTx Text
"direct"
    HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Text -> HydraNodeLog SimpleTx
forall tx. Text -> HydraNodeLog tx
ChainPostStarted Text
"partial_fanout"
    HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> DiffTime -> HydraNodeLog SimpleTx
forall tx. Text -> Bool -> DiffTime -> HydraNodeLog tx
ChainPostFinished Text
"partial_fanout" Bool
False DiffTime
2
    [Text]
rows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_chain_operation_failures_total{backend=\"direct\",operation=\"partial_fanout\"} 1"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_chain_operations_inflight{backend=\"direct\",operation=\"partial_fanout\"} 0.0"]

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"keeps a blocked protocol post active while API drafts complete or fail" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    (HydraLog SimpleTx -> IO ()
record, Registry
registry, IO ()
_) <- forall tx.
IsTx tx =>
Text -> IO (HydraLog tx -> IO (), Registry, IO ())
prepareRegistry @SimpleTx Text
"direct"
    HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Text -> HydraNodeLog SimpleTx
forall tx. Text -> HydraNodeLog tx
ChainPostStarted Text
"increment"
    [Bool] -> (Bool -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Bool
True, Bool
False, Bool
True, Bool
False] ((Bool -> IO ()) -> IO ()) -> (Bool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Bool
successful -> do
      HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ APIServerLog -> HydraLog SimpleTx
forall tx. APIServerLog -> HydraLog tx
APIServer (APIServerLog -> HydraLog SimpleTx)
-> APIServerLog -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Text -> APIServerLog
API.APIL1Started Text
"draft_deposit"
      HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ APIServerLog -> HydraLog SimpleTx
forall tx. APIServerLog -> HydraLog tx
APIServer (APIServerLog -> HydraLog SimpleTx)
-> APIServerLog -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> DiffTime -> APIServerLog
API.APIL1Finished Text
"draft_deposit" Bool
successful DiffTime
1
    [Text]
rows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_chain_operations_inflight{backend=\"direct\",operation=\"increment\"} 1.0"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_chain_operation_seconds_count{backend=\"direct\",operation=\"increment\"} 0"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_chain_operations_inflight{backend=\"direct\",operation=\"draft_deposit\"} 0.0"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_chain_operation_seconds_count{backend=\"direct\",operation=\"draft_deposit\"} 4"]

  [(String, Bool, Text)] -> ((String, Bool, Text) -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String
"start", Bool
True, Text
"1"), (String
"completion", Bool
False, Text
"0")] (((String, Bool, Text) -> Spec) -> Spec)
-> ((String, Bool, Text) -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \(String
boundary, Bool
pauseOnStart, Text
failures) ->
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (String
"balances API L1 accounting when cancelled at " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
boundary) (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
3 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      (HydraLog SimpleTx -> IO ()
record, Registry
registry, IO ()
_) <- forall tx.
IsTx tx =>
Text -> IO (HydraLog tx -> IO (), Registry, IO ())
prepareRegistry @SimpleTx Text
"direct"
      TMVar ()
reached <- String -> IO (TMVar IO ())
forall (m :: * -> *) a.
MonadLabelledSTM m =>
String -> m (TMVar m a)
newLabelledEmptyTMVarIO String
"accounting-boundary-reached"
      TMVar ()
release <- String -> IO (TMVar IO ())
forall (m :: * -> *) a.
MonadLabelledSTM m =>
String -> m (TMVar m a)
newLabelledEmptyTMVarIO String
"release-accounting-boundary"
      TMVar ThreadId
thread <- String -> IO (TMVar IO ThreadId)
forall (m :: * -> *) a.
MonadLabelledSTM m =>
String -> m (TMVar m a)
newLabelledEmptyTMVarIO String
"operation-thread"
      let pause :: IO ()
pause = IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadMask m => m a -> m a
uninterruptibleMask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            STM IO () -> IO ()
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO () -> IO ()) -> STM IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar IO () -> () -> STM IO ()
forall a. TMVar IO a -> a -> STM IO ()
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m ()
putTMVar TMVar ()
TMVar IO ()
reached ()
            STM IO () -> IO ()
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO () -> IO ()) -> STM IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar IO () -> STM IO ()
forall a. TMVar IO a -> STM IO a
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m a
takeTMVar TMVar ()
TMVar IO ()
release
          tracer :: Tracer IO APIServerLog
tracer = TracerA IO APIServerLog () -> Tracer IO APIServerLog
forall (m :: * -> *) a. TracerA m a () -> Tracer m a
Tracer (TracerA IO APIServerLog () -> Tracer IO APIServerLog)
-> ((APIServerLog -> IO ()) -> TracerA IO APIServerLog ())
-> (APIServerLog -> IO ())
-> Tracer IO APIServerLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (APIServerLog -> IO ()) -> TracerA IO APIServerLog ()
forall (m :: * -> *) a.
Applicative m =>
(a -> m ()) -> TracerA m a ()
emit ((APIServerLog -> IO ()) -> Tracer IO APIServerLog)
-> (APIServerLog -> IO ()) -> Tracer IO APIServerLog
forall a b. (a -> b) -> a -> b
$ \APIServerLog
message -> case APIServerLog
message of
            API.APIL1Started{} -> do
              HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ APIServerLog -> HydraLog SimpleTx
forall tx. APIServerLog -> HydraLog tx
APIServer APIServerLog
message
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
pauseOnStart IO ()
pause
            API.APIL1Finished{} -> do
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
pauseOnStart IO ()
pause
              HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ APIServerLog -> HydraLog SimpleTx
forall tx. APIServerLog -> HydraLog tx
APIServer APIServerLog
message
            APIServerLog
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      (String, IO Bool) -> (Async IO Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b.
MonadAsync m =>
(String, m a) -> (Async m a -> m b) -> m b
withAsyncLabelled
        ( String
"observed-api-operation"
        , do
            IO ThreadId
Concurrent.myThreadId IO ThreadId -> (ThreadId -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> IO ()
STM IO () -> IO ()
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM () -> IO ()) -> (ThreadId -> STM ()) -> ThreadId -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMVar IO ThreadId -> ThreadId -> STM IO ()
forall a. TMVar IO a -> a -> STM IO ()
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m ()
putTMVar TMVar ThreadId
TMVar IO ThreadId
thread
            Tracer IO APIServerLog
-> Text -> (Bool -> Bool) -> IO Bool -> IO Bool
forall a.
Tracer IO APIServerLog -> Text -> (a -> Bool) -> IO a -> IO a
observeL1 Tracer IO APIServerLog
tracer Text
"submit" Bool -> Bool
forall a. a -> a
id (Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
        )
        ((Async IO Bool -> IO ()) -> IO ())
-> (Async IO Bool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async IO Bool
worker -> do
          ( do
              STM IO () -> IO ()
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO () -> IO ()) -> STM IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar IO () -> STM IO ()
forall a. TMVar IO a -> STM IO a
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m a
takeTMVar TMVar ()
TMVar IO ()
reached
              ThreadId
workerThread <- STM IO ThreadId -> IO ThreadId
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO ThreadId -> IO ThreadId) -> STM IO ThreadId -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ TMVar IO ThreadId -> STM IO ThreadId
forall a. TMVar IO a -> STM IO a
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m a
takeTMVar TMVar ThreadId
TMVar IO ThreadId
thread
              ThreadId
sender <- IO () -> IO ThreadId
Concurrent.forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ ThreadId -> AsyncException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
Concurrent.throwTo ThreadId
workerThread AsyncException
Exception.ThreadKilled
              -- Queue cancellation while the callback holds the boundary,
              -- then release it without relying on scheduling or a delay.
              let awaitCancellation :: IO ()
awaitCancellation =
                    ThreadId -> IO ThreadStatus
threadStatus ThreadId
sender IO ThreadStatus -> (ThreadStatus -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                      ThreadBlocked BlockReason
BlockedOnException -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                      ThreadStatus
ThreadFinished -> HasCallStack => String -> IO ()
String -> IO ()
expectationFailure String
"Cancellation was not queued"
                      ThreadStatus
ThreadDied -> HasCallStack => String -> IO ()
String -> IO ()
expectationFailure String
"Cancellation sender died"
                      ThreadStatus
_ -> IO ()
Concurrent.yield IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
awaitCancellation
              IO ()
awaitCancellation
            )
            IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` STM IO () -> IO ()
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TMVar IO () -> () -> STM IO ()
forall a. TMVar IO a -> a -> STM IO ()
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m ()
putTMVar TMVar ()
TMVar IO ()
release ())
          Either SomeException Bool
result <- Async IO Bool -> IO (Either SomeException Bool)
forall a. Async IO a -> IO (Either SomeException a)
forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> m (Either SomeException a)
waitCatch Async IO Bool
worker
          -- Completion may win the cancellation as the async worker returns;
          -- either outcome must leave exactly one completed operation.
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
pauseOnStart (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Either SomeException Bool
result Either SomeException Bool
-> (Either SomeException Bool -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` Either SomeException Bool -> Bool
forall a b. Either a b -> Bool
isLeft
      [Text]
rows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
      [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_chain_operations_inflight{backend=\"direct\",operation=\"submit\"} 0.0"]
      [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_chain_operation_seconds_count{backend=\"direct\",operation=\"submit\"} 1"]
      [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_chain_operation_failures_total{backend=\"direct\",operation=\"submit\"} " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
failures]

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"balances API L1 accounting when cancelled during the operation" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
3 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    (HydraLog SimpleTx -> IO ()
record, Registry
registry, IO ()
_) <- forall tx.
IsTx tx =>
Text -> IO (HydraLog tx -> IO (), Registry, IO ())
prepareRegistry @SimpleTx Text
"direct"
    TMVar ()
entered <- String -> IO (TMVar IO ())
forall (m :: * -> *) a.
MonadLabelledSTM m =>
String -> m (TMVar m a)
newLabelledEmptyTMVarIO String
"operation-entered"
    TMVar Bool
blocked <- String -> IO (TMVar IO Bool)
forall (m :: * -> *) a.
MonadLabelledSTM m =>
String -> m (TMVar m a)
newLabelledEmptyTMVarIO String
"blocked-operation"
    let tracer :: Tracer IO APIServerLog
tracer = TracerA IO APIServerLog () -> Tracer IO APIServerLog
forall (m :: * -> *) a. TracerA m a () -> Tracer m a
Tracer (TracerA IO APIServerLog () -> Tracer IO APIServerLog)
-> ((APIServerLog -> IO ()) -> TracerA IO APIServerLog ())
-> (APIServerLog -> IO ())
-> Tracer IO APIServerLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (APIServerLog -> IO ()) -> TracerA IO APIServerLog ()
forall (m :: * -> *) a.
Applicative m =>
(a -> m ()) -> TracerA m a ()
emit ((APIServerLog -> IO ()) -> Tracer IO APIServerLog)
-> (APIServerLog -> IO ()) -> Tracer IO APIServerLog
forall a b. (a -> b) -> a -> b
$ HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ())
-> (APIServerLog -> HydraLog SimpleTx) -> APIServerLog -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APIServerLog -> HydraLog SimpleTx
forall tx. APIServerLog -> HydraLog tx
APIServer
        action :: IO Bool
action = STM IO () -> IO ()
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TMVar IO () -> () -> STM IO ()
forall a. TMVar IO a -> a -> STM IO ()
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m ()
putTMVar TMVar ()
TMVar IO ()
entered ()) IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> STM IO Bool -> IO Bool
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TMVar IO Bool -> STM IO Bool
forall a. TMVar IO a -> STM IO a
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m a
takeTMVar TMVar Bool
TMVar IO Bool
blocked)
    (String, IO Bool) -> (Async IO Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b.
MonadAsync m =>
(String, m a) -> (Async m a -> m b) -> m b
withAsyncLabelled (String
"blocked-api-operation", Tracer IO APIServerLog
-> Text -> (Bool -> Bool) -> IO Bool -> IO Bool
forall a.
Tracer IO APIServerLog -> Text -> (a -> Bool) -> IO a -> IO a
observeL1 Tracer IO APIServerLog
tracer Text
"submit" Bool -> Bool
forall a. a -> a
id IO Bool
action) ((Async IO Bool -> IO ()) -> IO ())
-> (Async IO Bool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async IO Bool
worker -> do
      STM IO () -> IO ()
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO () -> IO ()) -> STM IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar IO () -> STM IO ()
forall a. TMVar IO a -> STM IO a
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m a
takeTMVar TMVar ()
TMVar IO ()
entered
      Async IO Bool -> IO ()
forall a. Async IO a -> IO ()
forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel Async IO Bool
worker
    [Text]
rows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_chain_operations_inflight{backend=\"direct\",operation=\"submit\"} 0.0"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_chain_operation_seconds_count{backend=\"direct\",operation=\"submit\"} 1"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_chain_operation_failures_total{backend=\"direct\",operation=\"submit\"} 1"]

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does not recount a repeated snapshot adoption" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    (HydraLog SimpleTx -> IO ()
record, Registry
registry, IO ()
_) <- forall tx.
IsTx tx =>
Text -> IO (HydraLog tx -> IO (), Registry, IO ())
prepareRegistry @SimpleTx Text
"direct"
    let snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
IsTx tx =>
SnapshotNumber
-> SnapshotVersion -> [tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
1 SnapshotVersion
0 [Integer -> SimpleTx
aValidTx Integer
42] ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1])
    Int -> IO () -> IO ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Outcome SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Outcome tx -> HydraNodeLog tx
LogicOutcome Party
alice ([StateChanged SimpleTx] -> [Effect SimpleTx] -> Outcome SimpleTx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [HeadId
-> Maybe (Snapshot SimpleTx)
-> MultiSignature (Snapshot SimpleTx)
-> StateChanged SimpleTx
forall tx.
HeadId
-> Maybe (Snapshot tx)
-> MultiSignature (Snapshot tx)
-> StateChanged tx
SnapshotConfirmed HeadId
testHeadId (Snapshot SimpleTx -> Maybe (Snapshot SimpleTx)
forall a. a -> Maybe a
Just Snapshot SimpleTx
snapshot) MultiSignature (Snapshot SimpleTx)
forall a. Monoid a => a
mempty] [])
    [Text]
rows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_confirmed_tx_total  1"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_snapshots_total{source=\"adopted\"} 1"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_snapshot_confirmation_seconds_count  0"]

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"restores an in-flight snapshot's contents without fabricating its latency" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    (HydraLog SimpleTx -> IO ()
record, Registry
registry, IO ()
_) <- forall tx.
IsTx tx =>
Text -> IO (HydraLog tx -> IO (), Registry, IO ())
prepareRegistry @SimpleTx Text
"direct"
    let snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
IsTx tx =>
SnapshotNumber
-> SnapshotVersion -> [tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
1 SnapshotVersion
0 [Integer -> SimpleTx
aValidTx Integer
42] ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1])
        initial :: NodeState SimpleTx
initial = [Party] -> NodeState SimpleTx
inOpenState [Party
alice]
        restored :: NodeState SimpleTx
restored = case NodeState SimpleTx -> HeadState SimpleTx
forall tx. NodeState tx -> HeadState tx
NodeState.headState NodeState SimpleTx
initial of
          Head.Open open :: OpenState SimpleTx
open@Head.OpenState{$sel:coordinatedHeadState:OpenState :: forall tx. OpenState tx -> CoordinatedHeadState tx
coordinatedHeadState = CoordinatedHeadState SimpleTx
coordinated} ->
            NodeState SimpleTx
initial{NodeState.headState = Head.Open open{Head.coordinatedHeadState = coordinated{Head.seenSnapshot = Head.mkSeenSnapshot snapshot mempty}}}
          HeadState SimpleTx
_ -> NodeState SimpleTx
initial
    HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Last Word64 -> NodeState SimpleTx -> HydraNodeLog SimpleTx
forall tx. Last Word64 -> NodeState tx -> HydraNodeLog tx
LoadedState Last Word64
forall a. Monoid a => a
mempty NodeState SimpleTx
restored
    HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ NodeStats -> HydraNodeLog SimpleTx
forall tx. NodeStats -> HydraNodeLog tx
NodeHealth (NodeStats -> HydraNodeLog SimpleTx)
-> NodeStats -> HydraNodeLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Natural -> Int -> NodeState SimpleTx -> NodeStats
forall tx. IsTx tx => Natural -> Int -> NodeState tx -> NodeStats
Stats.nodeStats Natural
0 Int
0 NodeState SimpleTx
restored
    [Text]
restoredRows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
    [Text]
restoredRows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_snapshot_inflight  1.0"]
    [Text]
restoredRows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_snapshot_missing_signatures  1.0"]
    HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Outcome SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Outcome tx -> HydraNodeLog tx
LogicOutcome Party
alice ([StateChanged SimpleTx] -> [Effect SimpleTx] -> Outcome SimpleTx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [HeadId
-> Maybe (Snapshot SimpleTx)
-> MultiSignature (Snapshot SimpleTx)
-> StateChanged SimpleTx
forall tx.
HeadId
-> Maybe (Snapshot tx)
-> MultiSignature (Snapshot tx)
-> StateChanged tx
SnapshotConfirmed HeadId
testHeadId Maybe (Snapshot SimpleTx)
forall a. Maybe a
Nothing MultiSignature (Snapshot SimpleTx)
forall a. Monoid a => a
mempty] [])
    [Text]
rows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_confirmed_tx_total  1"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_snapshot_confirmation_seconds_count  0"]
    [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_tx_confirmation_seconds_count  0"]

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"clears timing entries on a dropped request and local-state reset" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    let input :: Input SimpleTx
input = Message SimpleTx -> Input SimpleTx
forall tx. Message tx -> Input tx
receiveMessage (SimpleTx -> Message SimpleTx
forall tx. tx -> Message tx
ReqTx (SimpleTx -> Message SimpleTx) -> SimpleTx -> Message SimpleTx
forall a b. (a -> b) -> a -> b
$ Integer -> SimpleTx
aValidTx Integer
42)
        snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
IsTx tx =>
SnapshotNumber
-> SnapshotVersion -> [tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
1 SnapshotVersion
0 [Integer -> SimpleTx
aValidTx Integer
42] ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1])
    [HydraLog SimpleTx] -> (HydraLog SimpleTx -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
      [ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Word64 -> Input SimpleTx -> HydraNodeLog SimpleTx
forall tx. Word64 -> Input tx -> HydraNodeLog tx
DroppedFromQueue Word64
1 Input SimpleTx
input
      , HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Outcome SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Outcome tx -> HydraNodeLog tx
LogicOutcome Party
alice ([StateChanged SimpleTx] -> [Effect SimpleTx] -> Outcome SimpleTx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [HeadId -> SnapshotNumber -> StateChanged SimpleTx
forall tx. HeadId -> SnapshotNumber -> StateChanged tx
LocalStateCleared HeadId
testHeadId SnapshotNumber
0] [])
      ]
      ((HydraLog SimpleTx -> IO ()) -> IO ())
-> (HydraLog SimpleTx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraLog SimpleTx
discard -> do
        (HydraLog SimpleTx -> IO ()
record, Registry
registry, IO ()
_) <- forall tx.
IsTx tx =>
Text -> IO (HydraLog tx -> IO (), Registry, IO ())
prepareRegistry @SimpleTx Text
"direct"
        HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Word64 -> Input SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> Input tx -> HydraNodeLog tx
BeginInput Party
alice Word64
1 Input SimpleTx
input
        HydraLog SimpleTx -> IO ()
record HydraLog SimpleTx
discard
        HydraLog SimpleTx -> IO ()
record (HydraLog SimpleTx -> IO ()) -> HydraLog SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Outcome SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Outcome tx -> HydraNodeLog tx
LogicOutcome Party
alice ([StateChanged SimpleTx] -> [Effect SimpleTx] -> Outcome SimpleTx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [HeadId
-> Maybe (Snapshot SimpleTx)
-> MultiSignature (Snapshot SimpleTx)
-> StateChanged SimpleTx
forall tx.
HeadId
-> Maybe (Snapshot tx)
-> MultiSignature (Snapshot tx)
-> StateChanged tx
SnapshotConfirmed HeadId
testHeadId (Snapshot SimpleTx -> Maybe (Snapshot SimpleTx)
forall a. a -> Maybe a
Just Snapshot SimpleTx
snapshot) MultiSignature (Snapshot SimpleTx)
forall a. Monoid a => a
mempty] [])
        [Text]
rows <- Text -> [Text]
Text.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO ByteString
Registry.sample Registry
registry
        [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_confirmed_tx_total  1"]
        [Text]
rows [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_tx_confirmation_seconds_count  0"]

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"records snapshot round and tx confirmation times on the normal signing path" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
3 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [Int
p] <- Int -> IO [Int]
randomUnusedTCPPorts Int
1
      Maybe PortNumber
-> Tracer IO (HydraLog SimpleTx)
-> (Tracer IO (HydraLog SimpleTx) -> IO ())
-> IO ()
forall tx a.
IsTx tx =>
Maybe PortNumber
-> Tracer IO (HydraLog tx)
-> (Tracer IO (HydraLog tx) -> IO a)
-> IO a
withMonitoring (PortNumber -> Maybe PortNumber
forall a. a -> Maybe a
Just (PortNumber -> Maybe PortNumber) -> PortNumber -> Maybe PortNumber
forall a b. (a -> b) -> a -> b
$ Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p) Tracer IO (HydraLog SimpleTx)
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer ((Tracer IO (HydraLog SimpleTx) -> IO ()) -> IO ())
-> (Tracer IO (HydraLog SimpleTx) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Tracer IO (HydraLog SimpleTx)
tracer -> do
        let tx :: SimpleTx
tx = Integer -> SimpleTx
aValidTx Integer
42
            snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
IsTx tx =>
SnapshotNumber
-> SnapshotVersion -> [tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
1 SnapshotVersion
1 [SimpleTx
tx] ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1])
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Word64 -> Input SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> Input tx -> HydraNodeLog tx
BeginInput Party
alice Word64
0 (Message SimpleTx -> Input SimpleTx
forall tx. Message tx -> Input tx
receiveMessage (SimpleTx -> Message SimpleTx
forall tx. tx -> Message tx
ReqTx SimpleTx
tx)))
        DiffTime -> IO ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
0.1
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Outcome SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Outcome tx -> HydraNodeLog tx
LogicOutcome Party
alice ([StateChanged SimpleTx] -> [Effect SimpleTx] -> Outcome SimpleTx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [Snapshot SimpleTx
-> Seq SimpleTx
-> Maybe (TxIdType SimpleTx)
-> StateChanged SimpleTx
forall tx.
Snapshot tx -> Seq tx -> Maybe (TxIdType tx) -> StateChanged tx
SnapshotRequested Snapshot SimpleTx
snapshot Seq SimpleTx
forall a. Monoid a => a
mempty Maybe Integer
Maybe (TxIdType SimpleTx)
forall a. Maybe a
Nothing] [Effect SimpleTx]
forall a. Monoid a => a
mempty))
        DiffTime -> IO ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
0.1
        -- The normal signing path confirms without a snapshot in the event
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Outcome SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Outcome tx -> HydraNodeLog tx
LogicOutcome Party
alice ([StateChanged SimpleTx] -> [Effect SimpleTx] -> Outcome SimpleTx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [HeadId
-> Maybe (Snapshot SimpleTx)
-> MultiSignature (Snapshot SimpleTx)
-> StateChanged SimpleTx
forall tx.
HeadId
-> Maybe (Snapshot tx)
-> MultiSignature (Snapshot tx)
-> StateChanged tx
SnapshotConfirmed HeadId
testHeadId Maybe (Snapshot SimpleTx)
forall a. Maybe a
Nothing MultiSignature (Snapshot SimpleTx)
forall a. Monoid a => a
mempty] [Effect SimpleTx]
forall a. Monoid a => a
mempty))

        [Text]
metrics <- Text -> [Text]
Text.lines (Text -> [Text]) -> IO Text -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Text
scrapeMetrics Int
p

        [Text]
metrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_confirmed_tx  1"]
        [Text]
metrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_snapshot_confirmation_time_ms_bucket{le=\"1000.0\"} 1.0"]
        [Text]
metrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_tx_confirmation_time_ms_bucket{le=\"1000.0\"} 1.0"]

  -- These names are a public interface: Prometheus scrapes them, and several
  -- are referenced by the dashboards under demo/grafana, so dropping or
  -- renaming one breaks operators without breaking any other test. All are
  -- registered when monitoring starts, so a scrape carries every one of them
  -- before anything has been observed.
  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"keeps existing metric families registered at startup" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
10 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [Int
p] <- Int -> IO [Int]
randomUnusedTCPPorts Int
1
      Maybe PortNumber
-> Tracer IO (HydraLog SimpleTx)
-> (Tracer IO (HydraLog SimpleTx) -> IO ())
-> IO ()
forall tx a.
IsTx tx =>
Maybe PortNumber
-> Tracer IO (HydraLog tx)
-> (Tracer IO (HydraLog tx) -> IO a)
-> IO a
withMonitoring (PortNumber -> Maybe PortNumber
forall a. a -> Maybe a
Just (PortNumber -> Maybe PortNumber) -> PortNumber -> Maybe PortNumber
forall a b. (a -> b) -> a -> b
$ Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p) Tracer IO (HydraLog SimpleTx)
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer ((Tracer IO (HydraLog SimpleTx) -> IO ()) -> IO ())
-> (Tracer IO (HydraLog SimpleTx) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Tracer IO (HydraLog SimpleTx)
_ :: Tracer IO (HydraLog SimpleTx)) -> do
        [Text]
scraped <- Text -> [Text]
scrapedMetricNames (Text -> [Text]) -> IO Text -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Text
scrapeMetrics Int
p
        (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` [Text]
scraped) [Text]
protocolMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` []
        -- The RTS metrics are registered only when the process runs with
        -- '+RTS -T', which this suite does not, so they are expected absent
        -- here and present anywhere that does.
        Bool
rtsEnabled <- IO Bool
getRTSStatsEnabled
        (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text]
scraped) [Text]
rtsMetrics
          [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` (if Bool
rtsEnabled then [Text]
rtsMetrics else [])

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"reports a stalled broadcast, its backlog and what it refused" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    -- The metrics an operator diagnosing GHSA-3mmr-q43p-g6p2 reads: whether
    -- the hand-off is stalled, how much it holds and for how long, and how
    -- many client inputs that cost.
    NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
3 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [Int
p] <- Int -> IO [Int]
randomUnusedTCPPorts Int
1
      Maybe PortNumber
-> Tracer IO (HydraLog SimpleTx)
-> (Tracer IO (HydraLog SimpleTx) -> IO ())
-> IO ()
forall tx a.
IsTx tx =>
Maybe PortNumber
-> Tracer IO (HydraLog tx)
-> (Tracer IO (HydraLog tx) -> IO a)
-> IO a
withMonitoring (PortNumber -> Maybe PortNumber
forall a. a -> Maybe a
Just (PortNumber -> Maybe PortNumber) -> PortNumber -> Maybe PortNumber
forall a b. (a -> b) -> a -> b
$ Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p) Tracer IO (HydraLog SimpleTx)
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer ((Tracer IO (HydraLog SimpleTx) -> IO ()) -> IO ())
-> (Tracer IO (HydraLog SimpleTx) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Tracer IO (HydraLog SimpleTx)
tracer -> do
        let scrape :: IO [Text]
scrape = Text -> [Text]
Text.lines (Text -> [Text]) -> IO Text -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Text
scrapeMetrics Int
p

        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Natural -> DiffTime -> HydraNodeLog SimpleTx
forall tx. Natural -> DiffTime -> HydraNodeLog tx
BroadcastBacklog Natural
7 DiffTime
4)
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Maybe StallReason -> HydraNodeLog SimpleTx
forall tx. Maybe StallReason -> HydraNodeLog tx
BroadcastHealth (StallReason -> Maybe StallReason
forall a. a -> Maybe a
Just StallReason
NoProgress))
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraLog SimpleTx -> IO ())
-> (Outcome SimpleTx -> HydraLog SimpleTx)
-> Outcome SimpleTx
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> (Outcome SimpleTx -> HydraNodeLog SimpleTx)
-> Outcome SimpleTx
-> HydraLog SimpleTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Party -> Outcome SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Outcome tx -> HydraNodeLog tx
LogicOutcome Party
alice (Outcome SimpleTx -> IO ()) -> Outcome SimpleTx -> IO ()
forall a b. (a -> b) -> a -> b
$
          [StateChanged SimpleTx] -> [Effect SimpleTx] -> Outcome SimpleTx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [StateChanged SimpleTx]
forall a. Monoid a => a
mempty [ClientMessage SimpleTx -> Effect SimpleTx
forall tx. ClientMessage tx -> Effect tx
ClientEffect (ClientInput SimpleTx
-> Natural -> StallReason -> ClientMessage SimpleTx
forall tx.
ClientInput tx -> Natural -> StallReason -> ClientMessage tx
RejectedInputBecauseBroadcastStalled (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx (Integer -> SimpleTx
aValidTx Integer
42)) Natural
7 StallReason
NoProgress)]

        [Text]
stalledMetrics <- IO [Text]
scrape
        [Text]
stalledMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_broadcast_stalled  1.0"]
        [Text]
stalledMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_pending_broadcasts  7.0"]
        [Text]
stalledMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_broadcast_no_progress_seconds  4.0"]
        [Text]
stalledMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_inputs_refused_broadcast_stalled  1"]
        -- Which of the two conditions it is, so an operator can tell an
        -- unreachable network from one merely being outrun (review: vrom911).
        [Text]
stalledMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_broadcast_stalled_no_progress  1.0"]
        [Text]
stalledMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_broadcast_stalled_backlog_full  0.0"]

        -- The other cause must move the other gauge, and only that one.
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Maybe StallReason -> HydraNodeLog SimpleTx
forall tx. Maybe StallReason -> HydraNodeLog tx
BroadcastHealth (StallReason -> Maybe StallReason
forall a. a -> Maybe a
Just StallReason
BacklogFull))
        [Text]
backlogMetrics <- IO [Text]
scrape
        [Text]
backlogMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_broadcast_stalled  1.0"]
        [Text]
backlogMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_broadcast_stalled_no_progress  0.0"]
        [Text]
backlogMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_broadcast_stalled_backlog_full  1.0"]

        -- Draining again must take them all back down, or a cleared stall
        -- looks like a current one forever.
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Natural -> DiffTime -> HydraNodeLog SimpleTx
forall tx. Natural -> DiffTime -> HydraNodeLog tx
BroadcastBacklog Natural
0 DiffTime
0)
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Maybe StallReason -> HydraNodeLog SimpleTx
forall tx. Maybe StallReason -> HydraNodeLog tx
BroadcastHealth Maybe StallReason
forall a. Maybe a
Nothing)

        [Text]
resumedMetrics <- IO [Text]
scrape
        [Text]
resumedMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_broadcast_stalled  0.0"]
        [Text]
resumedMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_broadcast_stalled_no_progress  0.0"]
        [Text]
resumedMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_broadcast_stalled_backlog_full  0.0"]
        [Text]
resumedMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_pending_broadcasts  0.0"]
        [Text]
resumedMetrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_broadcast_no_progress_seconds  0.0"]

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"provides prometheus metrics from traces" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
3 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [Int
p] <- Int -> IO [Int]
randomUnusedTCPPorts Int
1
      Maybe PortNumber
-> Tracer IO (HydraLog SimpleTx)
-> (Tracer IO (HydraLog SimpleTx) -> IO ())
-> IO ()
forall tx a.
IsTx tx =>
Maybe PortNumber
-> Tracer IO (HydraLog tx)
-> (Tracer IO (HydraLog tx) -> IO a)
-> IO a
withMonitoring (PortNumber -> Maybe PortNumber
forall a. a -> Maybe a
Just (PortNumber -> Maybe PortNumber) -> PortNumber -> Maybe PortNumber
forall a b. (a -> b) -> a -> b
$ Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p) Tracer IO (HydraLog SimpleTx)
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer ((Tracer IO (HydraLog SimpleTx) -> IO ()) -> IO ())
-> (Tracer IO (HydraLog SimpleTx) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Tracer IO (HydraLog SimpleTx)
tracer -> do
        let tx1 :: SimpleTx
tx1 = Integer -> SimpleTx
aValidTx Integer
42
        let tx2 :: SimpleTx
tx2 = Integer -> SimpleTx
aValidTx Integer
43
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Word64 -> Input SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> Input tx -> HydraNodeLog tx
BeginInput Party
alice Word64
0 (Message SimpleTx -> Input SimpleTx
forall tx. Message tx -> Input tx
receiveMessage (SimpleTx -> Message SimpleTx
forall tx. tx -> Message tx
ReqTx SimpleTx
tx1)))
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Word64 -> Input SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> Input tx -> HydraNodeLog tx
BeginInput Party
alice Word64
1 (Message SimpleTx -> Input SimpleTx
forall tx. Message tx -> Input tx
receiveMessage (SimpleTx -> Message SimpleTx
forall tx. tx -> Message tx
ReqTx SimpleTx
tx2)))
        DiffTime -> IO ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
0.1
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Outcome SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Outcome tx -> HydraNodeLog tx
LogicOutcome Party
alice ([StateChanged SimpleTx] -> [Effect SimpleTx] -> Outcome SimpleTx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [HeadId
-> Maybe (Snapshot SimpleTx)
-> MultiSignature (Snapshot SimpleTx)
-> StateChanged SimpleTx
forall tx.
HeadId
-> Maybe (Snapshot tx)
-> MultiSignature (Snapshot tx)
-> StateChanged tx
SnapshotConfirmed HeadId
testHeadId (Snapshot SimpleTx -> Maybe (Snapshot SimpleTx)
forall a. a -> Maybe a
Just (SnapshotNumber
-> SnapshotVersion
-> [SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
IsTx tx =>
SnapshotNumber
-> SnapshotVersion -> [tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
1 SnapshotVersion
1 [SimpleTx
tx2, SimpleTx
tx1] ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1]))) MultiSignature (Snapshot SimpleTx)
forall a. Monoid a => a
mempty] [Effect SimpleTx]
forall a. Monoid a => a
mempty))
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Outcome SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Outcome tx -> HydraNodeLog tx
LogicOutcome Party
alice ([StateChanged SimpleTx] -> [Effect SimpleTx] -> Outcome SimpleTx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [Host -> StateChanged SimpleTx
forall tx. Host -> StateChanged tx
PeerConnected (Text -> PortNumber -> Host
Host Text
"a" PortNumber
1)] [Effect SimpleTx]
forall a. Monoid a => a
mempty))
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Outcome SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Outcome tx -> HydraNodeLog tx
LogicOutcome Party
alice ([StateChanged SimpleTx] -> [Effect SimpleTx] -> Outcome SimpleTx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [Host -> StateChanged SimpleTx
forall tx. Host -> StateChanged tx
PeerConnected (Text -> PortNumber -> Host
Host Text
"b" PortNumber
2)] [Effect SimpleTx]
forall a. Monoid a => a
mempty))
        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Outcome SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Outcome tx -> HydraNodeLog tx
LogicOutcome Party
alice ([StateChanged SimpleTx] -> [Effect SimpleTx] -> Outcome SimpleTx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [Host -> StateChanged SimpleTx
forall tx. Host -> StateChanged tx
PeerDisconnected (Text -> PortNumber -> Host
Host Text
"b" PortNumber
2)] [Effect SimpleTx]
forall a. Monoid a => a
mempty))

        [Text]
metrics <- Text -> [Text]
Text.lines (Text -> [Text]) -> IO Text -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Text
scrapeMetrics Int
p

        [Text]
metrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_confirmed_tx  2"]
        [Text]
metrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_peers_connected  1.0"]
        [Text]
metrics [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_tx_confirmation_time_ms_bucket{le=\"1000.0\"} 2.0"]

        Tracer IO (HydraLog SimpleTx) -> HydraLog SimpleTx -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall tx. HydraNodeLog tx -> HydraLog tx
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx
forall a b. (a -> b) -> a -> b
$ Party -> Outcome SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Outcome tx -> HydraNodeLog tx
LogicOutcome Party
alice ([StateChanged SimpleTx] -> [Effect SimpleTx] -> Outcome SimpleTx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [StateChanged SimpleTx
forall tx. StateChanged tx
NetworkDisconnected] [Effect SimpleTx]
forall a. Monoid a => a
mempty))

        [Text]
m <- Text -> [Text]
Text.lines (Text -> [Text]) -> IO Text -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Text
scrapeMetrics Int
p

        [Text]
m [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Text
"hydra_head_peers_connected  0.0"]

-- | The metrics 'withMonitoring' always registers.
protocolMetrics :: [Text]
protocolMetrics :: [Text]
protocolMetrics =
  [ Text
"hydra_head_inputs"
  , Text
"hydra_head_requested_tx"
  , Text
"hydra_head_confirmed_tx"
  , Text
"hydra_head_tx_confirmation_time_ms"
  , Text
"hydra_head_snapshot_confirmation_time_ms"
  , Text
"hydra_head_peers_connected"
  , Text
"hydra_chain_drift_seconds"
  , Text
"hydra_chain_last_block_timestamp_seconds"
  , Text
"hydra_head_broadcast_stalled"
  , Text
"hydra_head_broadcast_stalled_no_progress"
  , Text
"hydra_head_broadcast_stalled_backlog_full"
  , Text
"hydra_head_pending_broadcasts"
  , Text
"hydra_head_broadcast_no_progress_seconds"
  , Text
"hydra_head_inputs_refused_broadcast_stalled"
  ]

-- | Canonical names corresponding to the six compatibility aliases above.
canonicalAliases :: [Text]
canonicalAliases :: [Text]
canonicalAliases =
  [ Text
"hydra_head_inputs_total"
  , Text
"hydra_head_requested_tx_total"
  , Text
"hydra_head_confirmed_tx_total"
  , Text
"hydra_head_tx_confirmation_seconds"
  , Text
"hydra_head_snapshot_confirmation_seconds"
  , Text
"hydra_head_inputs_refused_broadcast_stalled_total"
  ]

-- | The additions approved for the public metrics interface.
additionalMetrics :: [Text]
additionalMetrics :: [Text]
additionalMetrics =
  [ Text
"hydra_chain_backend_last_block_timestamp_seconds"
  , Text
"hydra_chain_blockfrost_rate_limits_total"
  , Text
"hydra_chain_blockfrost_retries_total"
  , Text
"hydra_chain_operation_failures_total"
  , Text
"hydra_chain_operation_seconds"
  , Text
"hydra_chain_operations_inflight"
  , Text
"hydra_chain_rollback_slots"
  , Text
"hydra_head_confirmed_snapshot_number"
  , Text
"hydra_head_decommit_state"
  , Text
"hydra_head_fanout_mode"
  , Text
"hydra_head_fanout_remaining_outputs"
  , Text
"hydra_head_outstanding_transactions"
  , Text
"hydra_head_pending_deposits"
  , Text
"hydra_head_phase"
  , Text
"hydra_head_snapshot_inflight"
  , Text
"hydra_head_snapshot_missing_signatures"
  , Text
"hydra_head_snapshots_total"
  , Text
"hydra_head_transaction_outcomes_total"
  , Text
"hydra_monitoring_timing_evictions_total"
  , Text
"hydra_network_connected"
  , Text
"hydra_network_events_total"
  , Text
"hydra_network_persistent_queue_depth"
  , Text
"hydra_network_persistent_queue_oldest_age_seconds"
  , Text
"hydra_network_put_seconds"
  , Text
"hydra_node_input_drops_total"
  , Text
"hydra_node_input_processing_seconds"
  , Text
"hydra_node_input_queue_depth"
  , Text
"hydra_node_input_queue_wait_seconds"
  , Text
"hydra_node_input_waits_total"
  , Text
"hydra_node_parked_inputs"
  , Text
"hydra_node_synced"
  , Text
"hydra_persistence_queue_depth"
  , Text
"hydra_persistence_write_inflight"
  , Text
"hydra_persistence_write_seconds"
  ]

-- | Registered only when the RTS collects statistics, see 'registerRtsMetrics'.
rtsMetrics :: [Text]
rtsMetrics :: [Text]
rtsMetrics =
  [ Text
"hydra_rts_allocated_bytes"
  , Text
"hydra_rts_mutator_cpu_seconds"
  , Text
"hydra_rts_gc_cpu_seconds"
  , Text
"hydra_rts_max_live_bytes"
  , Text
"hydra_rts_cumulative_live_bytes"
  , Text
"hydra_rts_major_gcs"
  ]

-- | The metric names a scrape actually exposes: the identifier starting each
-- sample line, with the suffixes Prometheus appends to a histogram removed.
--
-- Matching whole names rather than substrings is the point: renaming a counter
-- to, say, @hydra_head_inputs_total@ has to be caught, and the old name is a
-- prefix of the new one.
scrapedMetricNames :: Text -> [Text]
scrapedMetricNames :: Text -> [Text]
scrapedMetricNames Text
body =
  [Text] -> [Text]
forall a. Ord a => [a] -> [a]
ordNub
    [ Text -> Text
stripHistogramSuffix Text
ident
    | Text
line <- Text -> [Text]
Text.lines Text
body
    , Bool -> Bool
not (Text
"#" Text -> Text -> Bool
`Text.isPrefixOf` Text
line)
    , let ident :: Text
ident = (Char -> Bool) -> Text -> Text
Text.takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'{') Text
line
    , Bool -> Bool
not (Text -> Bool
Text.null Text
ident)
    ]
 where
  stripHistogramSuffix :: Text -> Text
stripHistogramSuffix Text
name =
    Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
name (Maybe Text -> Text)
-> ([Maybe Text] -> Maybe Text) -> [Maybe Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Text] -> Maybe Text
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe Text] -> Text) -> [Maybe Text] -> Text
forall a b. (a -> b) -> a -> b
$
      [Text -> Text -> Maybe Text
Text.stripSuffix Text
suffix Text
name | Text
suffix <- [Text
"_bucket", Text
"_sum", Text
"_count"]]

-- | Retry transient HTTP errors while scraping test endpoints. A scrape can
-- arrive before the socket is listening.
scrapeMetrics :: Int -> IO Text
scrapeMetrics :: Int -> IO Text
scrapeMetrics Int
p = Int -> IO Text
go (Int
100 :: Int)
 where
  go :: Int -> IO Text
go Int
n =
    IO Text -> IO (Either SomeException Text)
forall e a. Exception e => IO a -> IO (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try IO Text
scrape IO (Either SomeException Text)
-> (Either SomeException Text -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right Text
body -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
body
      Left (SomeException
e :: SomeException)
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> SomeException -> IO Text
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO SomeException
e
        | Bool
otherwise -> DiffTime -> IO ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
0.05 IO () -> IO Text -> IO Text
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Text
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

  scrape :: IO Text
scrape =
    ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8
      (ByteString -> Text)
-> (BsResponse -> ByteString) -> BsResponse -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BsResponse -> ByteString
BsResponse -> HttpResponseBody BsResponse
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody
      (BsResponse -> Text) -> IO BsResponse -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq @IO HttpConfig
defaultHttpConfig (GET
-> Url 'Http
-> NoReqBody
-> Proxy BsResponse
-> Option 'Http
-> Req BsResponse
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req GET
GET (Text -> Url 'Http
http Text
"127.0.0.1" Url 'Http -> Text -> Url 'Http
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"metrics") NoReqBody
NoReqBody Proxy BsResponse
bsResponse (Int -> Option 'Http
forall (scheme :: Scheme). Int -> Option scheme
port Int
p))