module Hydra.Logging.MonitoringSpec where import Hydra.Prelude import Test.Hydra.Prelude import Data.Text qualified as Text import Hydra.HeadLogic.Outcome (Outcome (..), StateChanged (..)) import Hydra.HeadLogicSpec (receiveMessage, testSnapshot) import Hydra.Ledger.Simple (aValidTx, utxoRefs) import Hydra.Logging (nullTracer, traceWith) import Hydra.Logging.Messages (HydraLog (Node)) import Hydra.Logging.Monitoring import Hydra.Network.Message (Message (ReqTx)) import Hydra.Node (HydraNodeLog (..)) import Network.HTTP.Req (GET (..), NoReqBody (..), bsResponse, defaultHttpConfig, http, port, req, responseBody, runReq, (/:)) import Test.Hydra.Tx.Fixture (alice, testHeadId) import Test.Network.Ports (randomUnusedTCPPorts) spec :: Spec spec :: Spec spec = 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 (m :: * -> *) tx. (MonadIO m, MonadAsync m, IsTx tx, MonadMonotonicTime m) => Maybe PortNumber -> Tracer m (HydraLog tx) -> (Tracer m (HydraLog tx) -> m ()) -> m () 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. Applicative 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. 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. 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. 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 -> Snapshot SimpleTx -> MultiSignature (Snapshot SimpleTx) -> StateChanged SimpleTx forall tx. HeadId -> Snapshot tx -> MultiSignature (Snapshot tx) -> StateChanged tx SnapshotConfirmed HeadId testHeadId (SnapshotNumber -> SnapshotVersion -> [SimpleTx] -> UTxOType SimpleTx -> Snapshot SimpleTx forall tx. Monoid (UTxOType 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)) [Text] metrics <- Text -> [Text] Text.lines (Text -> [Text]) -> (BsResponse -> Text) -> BsResponse -> [Text] forall b c a. (b -> c) -> (a -> b) -> a -> c . 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 "localhost" 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)) [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_tx_confirmation_time_ms_bucket{le=\"1000.0\"} 2.0"]