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