module Hydra.Logging.MonitoringSpec where

import Hydra.Prelude
import Test.Hydra.Prelude

import Data.Text qualified as Text
import Hydra.API.ServerOutput (ServerOutput (SnapshotConfirmed))
import Hydra.HeadLogic (Effect (ClientEffect))
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 (BeginEffect, BeginInput))
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 Any)
-> (Tracer IO (HydraLog SimpleTx Any) -> IO ())
-> IO ()
forall (m :: * -> *) tx net.
(MonadIO m, MonadAsync m, IsTx tx, MonadMonotonicTime m) =>
Maybe PortNumber
-> Tracer m (HydraLog tx net)
-> (Tracer m (HydraLog tx net) -> 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 Any)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer ((Tracer IO (HydraLog SimpleTx Any) -> IO ()) -> IO ())
-> (Tracer IO (HydraLog SimpleTx Any) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Tracer IO (HydraLog SimpleTx Any)
tracer -> do
        let tx1 :: SimpleTx
tx1 = Integer -> SimpleTx
aValidTx Integer
42
        let tx2 :: SimpleTx
tx2 = Integer -> SimpleTx
aValidTx Integer
43
        Tracer IO (HydraLog SimpleTx Any) -> HydraLog SimpleTx Any -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx Any)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx Any
forall tx net. HydraNodeLog tx -> HydraLog tx net
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx Any)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx Any
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 Any) -> HydraLog SimpleTx Any -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx Any)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx Any
forall tx net. HydraNodeLog tx -> HydraLog tx net
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx Any)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx Any
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 Any) -> HydraLog SimpleTx Any -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog SimpleTx Any)
tracer (HydraNodeLog SimpleTx -> HydraLog SimpleTx Any
forall tx net. HydraNodeLog tx -> HydraLog tx net
Node (HydraNodeLog SimpleTx -> HydraLog SimpleTx Any)
-> HydraNodeLog SimpleTx -> HydraLog SimpleTx Any
forall a b. (a -> b) -> a -> b
$ Party
-> Word64 -> Word32 -> Effect SimpleTx -> HydraNodeLog SimpleTx
forall tx.
Party -> Word64 -> Word32 -> Effect tx -> HydraNodeLog tx
BeginEffect Party
alice Word64
0 Word32
0 (ServerOutput SimpleTx -> Effect SimpleTx
forall tx. ServerOutput tx -> Effect tx
ClientEffect (HeadId
-> Snapshot SimpleTx
-> MultiSignature (Snapshot SimpleTx)
-> ServerOutput SimpleTx
forall tx.
HeadId
-> Snapshot tx -> MultiSignature (Snapshot tx) -> ServerOutput 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)))

        [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"]