-- | Head lifecycle shared by benchmarks and scripted demonstrations.
module Hydra.Cluster.HeadLifecycle where

import Hydra.Prelude

import Cardano.Api.UTxO qualified as UTxO
import CardanoNode (HydraNodeLog, runBackend)
import Control.Lens ((^..), (^?))
import Control.Tracer.JSON (Tracer)
import Data.Aeson ((.=))
import Data.Aeson.Lens (key, members, _JSON)
import Data.Aeson.Types (parseMaybe)
import Data.Set qualified as Set
import Hydra.Cardano.Api (UTxO, lovelaceToValue)
import Hydra.Chain.Backend (ChainBackend (..))
import Hydra.Cluster.Faucet (FaucetLog (..), seedFromFaucet)
import Hydra.Cluster.Util (Timing (..), depositTimeout)
import Hydra.Generator (ClientDataset (..), Dataset (..))
import Hydra.Options (ChainBackendOptions)
import Hydra.Tx (HeadId, txId)
import Hydra.Tx.Crypto (getVerificationKey, signTx)
import HydraNode (HydraClient, getSnapshotUTxO, input, output, requestCommitTx, send, waitFor, waitForAllMatch, waitMatch)
import Test.Hydra.Prelude (shouldBe)

-- | Fund the dataset and node fuel, optionally reserving incremental deposits.
fundDataset :: ChainBackendOptions -> Dataset -> Bool -> Tracer IO FaucetLog -> IO [UTxO]
fundDataset :: ChainBackendOptions
-> Dataset -> Bool -> Tracer IO FaucetLog -> IO [UTxO]
fundDataset ChainBackendOptions
opts Dataset{Tx
fundingTransaction :: Tx
fundingTransaction :: Dataset -> Tx
fundingTransaction, [Secret (SigningKey PaymentKey)]
hydraNodeKeys :: [Secret (SigningKey PaymentKey)]
hydraNodeKeys :: Dataset -> [Secret (SigningKey PaymentKey)]
hydraNodeKeys, [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets :: Dataset -> [ClientDataset]
clientDatasets} Bool
incremental Tracer IO FaucetLog
tracer = do
  ChainBackendOptions
-> (forall {m :: * -> *}.
    (ChainBackend m, MonadIO m, MonadThrow m, MonadCatch m) =>
    m ())
-> IO ()
forall a.
ChainBackendOptions
-> (forall (m :: * -> *).
    (ChainBackend m, MonadIO m, MonadThrow m, MonadCatch m) =>
    m a)
-> IO a
runBackend ChainBackendOptions
opts ((forall {m :: * -> *}.
  (ChainBackend m, MonadIO m, MonadThrow m, MonadCatch m) =>
  m ())
 -> IO ())
-> (forall {m :: * -> *}.
    (ChainBackend m, MonadIO m, MonadThrow m, MonadCatch m) =>
    m ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ Tx -> m ()
forall (m :: * -> *). ChainBackend m => Tx -> m ()
submitTransaction Tx
fundingTransaction
  [Secret (SigningKey PaymentKey)]
-> (Secret (SigningKey PaymentKey) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Secret (SigningKey PaymentKey)]
hydraNodeKeys ((Secret (SigningKey PaymentKey) -> IO ()) -> IO ())
-> (Secret (SigningKey PaymentKey) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Secret (SigningKey PaymentKey)
sk -> do
    let vk :: VerificationKey PaymentKey
vk = Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey Secret (SigningKey PaymentKey)
sk
    IO UTxO -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO UTxO -> IO ()) -> IO UTxO -> IO ()
forall a b. (a -> b) -> a -> b
$ ChainBackendOptions
-> (forall (m :: * -> *).
    (ChainBackend m, MonadIO m, MonadThrow m, MonadCatch m) =>
    m UTxO)
-> IO UTxO
forall a.
ChainBackendOptions
-> (forall (m :: * -> *).
    (ChainBackend m, MonadIO m, MonadThrow m, MonadCatch m) =>
    m a)
-> IO a
runBackend ChainBackendOptions
opts (Tx -> VerificationKey PaymentKey -> m UTxO
forall (m :: * -> *).
ChainBackend m =>
Tx -> VerificationKey PaymentKey -> m UTxO
awaitTransaction Tx
fundingTransaction VerificationKey PaymentKey
vk)
    IO UTxO -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO UTxO -> IO ()) -> IO UTxO -> IO ()
forall a b. (a -> b) -> a -> b
$ ChainBackendOptions
-> VerificationKey PaymentKey
-> Value
-> Tracer IO FaucetLog
-> IO UTxO
seedFromFaucet ChainBackendOptions
opts VerificationKey PaymentKey
vk (Lovelace -> Value
lovelaceToValue Lovelace
100_000_000) Tracer IO FaucetLog
tracer
  if Bool
incremental
    then [ClientDataset] -> (ClientDataset -> IO UTxO) -> IO [UTxO]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ClientDataset]
clientDatasets ((ClientDataset -> IO UTxO) -> IO [UTxO])
-> (ClientDataset -> IO UTxO) -> IO [UTxO]
forall a b. (a -> b) -> a -> b
$ \ClientDataset{Secret (SigningKey PaymentKey)
paymentKey :: Secret (SigningKey PaymentKey)
paymentKey :: ClientDataset -> Secret (SigningKey PaymentKey)
paymentKey} ->
      ChainBackendOptions
-> VerificationKey PaymentKey
-> Value
-> Tracer IO FaucetLog
-> IO UTxO
seedFromFaucet ChainBackendOptions
opts (Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey Secret (SigningKey PaymentKey)
paymentKey) (Lovelace -> Value
lovelaceToValue Lovelace
10_000_000) Tracer IO FaucetLog
tracer
    else [UTxO] -> IO [UTxO]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Open an empty Head and wait for every dataset deposit to settle everywhere.
openHead :: Timing -> ChainBackendOptions -> [ClientDataset] -> NonEmpty HydraClient -> IO HeadId
openHead :: Timing
-> ChainBackendOptions
-> [ClientDataset]
-> NonEmpty HydraClient
-> IO HeadId
openHead timing :: Timing
timing@Timing{NominalDiffTime
blockTime :: NominalDiffTime
$sel:blockTime:Timing :: Timing -> NominalDiffTime
blockTime} ChainBackendOptions
opts [ClientDataset]
datasets NonEmpty HydraClient
nodes = do
  let leader :: HydraClient
leader = NonEmpty HydraClient -> HydraClient
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty HydraClient
nodes
      clients :: [HydraClient]
clients = NonEmpty HydraClient -> [HydraClient]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty HydraClient
nodes
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([HydraClient] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HydraClient]
clients Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [ClientDataset] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClientDataset]
datasets) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"One client dataset is required per participant"
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
"Initializing Head"
  HydraClient -> Value -> IO ()
send HydraClient
leader (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
  HeadId
headId <- NominalDiffTime
-> [HydraClient] -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (NominalDiffTime
60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
5 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient]
clients ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsOpen"
    Value
v Value -> Getting (First HeadId) Value HeadId -> Maybe HeadId
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" ((Value -> Const (First HeadId) Value)
 -> Value -> Const (First HeadId) Value)
-> Getting (First HeadId) Value HeadId
-> Getting (First HeadId) Value HeadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First HeadId) Value HeadId
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
forall a b. (FromJSON a, ToJSON b) => Prism Value Value a b
Prism Value Value HeadId HeadId
_JSON
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
"Depositing initialUTxO from datasets"
  [Tx]
deposits <- [(HydraClient, ClientDataset)]
-> ((HydraClient, ClientDataset) -> IO Tx) -> IO [Tx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([HydraClient] -> [ClientDataset] -> [(HydraClient, ClientDataset)]
forall a b. [a] -> [b] -> [(a, b)]
zip [HydraClient]
clients [ClientDataset]
datasets) (((HydraClient, ClientDataset) -> IO Tx) -> IO [Tx])
-> ((HydraClient, ClientDataset) -> IO Tx) -> IO [Tx]
forall a b. (a -> b) -> a -> b
$ \(HydraClient
client, ClientDataset{UTxO
initialUTxO :: UTxO
initialUTxO :: ClientDataset -> UTxO
initialUTxO, Secret (SigningKey PaymentKey)
paymentKey :: ClientDataset -> Secret (SigningKey PaymentKey)
paymentKey :: Secret (SigningKey PaymentKey)
paymentKey}) -> do
    Tx
tx <- Secret (SigningKey PaymentKey) -> Tx -> Tx
forall s. CanSignTx s => s -> Tx -> Tx
signTx Secret (SigningKey PaymentKey)
paymentKey (Tx -> Tx) -> IO Tx -> IO Tx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HydraClient -> UTxO -> IO Tx
requestCommitTx HydraClient
client UTxO
initialUTxO
    ChainBackendOptions
-> (forall {m :: * -> *}.
    (ChainBackend m, MonadIO m, MonadThrow m, MonadCatch m) =>
    m ())
-> IO ()
forall a.
ChainBackendOptions
-> (forall (m :: * -> *).
    (ChainBackend m, MonadIO m, MonadThrow m, MonadCatch m) =>
    m a)
-> IO a
runBackend ChainBackendOptions
opts ((forall {m :: * -> *}.
  (ChainBackend m, MonadIO m, MonadThrow m, MonadCatch m) =>
  m ())
 -> IO ())
-> (forall {m :: * -> *}.
    (ChainBackend m, MonadIO m, MonadThrow m, MonadCatch m) =>
    m ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ Tx -> m ()
forall (m :: * -> *). ChainBackend m => Tx -> m ()
submitTransaction Tx
tx
    Tx -> IO Tx
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx
tx
  [TxId]
observed <- Int -> IO TxId -> IO [TxId]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ([Tx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx]
deposits) (IO TxId -> IO [TxId]) -> IO TxId -> IO [TxId]
forall a b. (a -> b) -> a -> b
$
    NominalDiffTime
-> [HydraClient] -> (Value -> Maybe TxId) -> IO TxId
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (Timing -> NominalDiffTime
depositTimeout Timing
timing NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([HydraClient] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HydraClient]
clients) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
30) [HydraClient]
clients ((Value -> Maybe TxId) -> IO TxId)
-> (Value -> Maybe TxId) -> IO TxId
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"CommitFinalized"
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (HeadId -> Value
forall a. ToJSON a => a -> Value
toJSON HeadId
headId)
      Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"depositTxId" Maybe Value -> (Value -> Maybe TxId) -> Maybe TxId
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser TxId) -> Value -> Maybe TxId
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser TxId
forall a. FromJSON a => Value -> Parser a
parseJSON
  [TxId] -> Set TxId
forall a. Ord a => [a] -> Set a
Set.fromList [TxId]
observed Set TxId -> Set TxId -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` [TxId] -> Set TxId
forall a. Ord a => [a] -> Set a
Set.fromList (Tx -> TxId
Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId (Tx -> TxId) -> [Tx] -> [TxId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx]
deposits)
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
"HeadIsOpen with deposits finalized"
  HeadId -> IO HeadId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeadId
headId

-- | Return the observed contestation deadline, allowing reporting before fanout.
closeHead :: Timing -> HeadId -> HydraClient -> IO UTCTime
closeHead :: Timing -> HeadId -> HydraClient -> IO UTCTime
closeHead Timing{NominalDiffTime
$sel:blockTime:Timing :: Timing -> NominalDiffTime
blockTime :: NominalDiffTime
blockTime} HeadId
headId HydraClient
leader = do
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
"Closing the Head"
  HydraClient -> Value -> IO ()
send HydraClient
leader (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Close" []
  NominalDiffTime
-> HydraClient -> (Value -> Maybe UTCTime) -> IO UTCTime
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
leader ((Value -> Maybe UTCTime) -> IO UTCTime)
-> (Value -> Maybe UTCTime) -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsClosed"
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (HeadId -> Value
forall a. ToJSON a => a -> Value
toJSON HeadId
headId)
    Value
v Value -> Getting (First UTCTime) Value UTCTime -> Maybe UTCTime
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"contestationDeadline" ((Value -> Const (First UTCTime) Value)
 -> Value -> Const (First UTCTime) Value)
-> Getting (First UTCTime) Value UTCTime
-> Getting (First UTCTime) Value UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First UTCTime) Value UTCTime
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
forall a b. (FromJSON a, ToJSON b) => Prism Value Value a b
Prism Value Value UTCTime UTCTime
_JSON

-- | Wait for the deadline and require successful finalization. Callers decide
-- whether a failure is fatal (scenarios) or belongs in a benchmark report.
fanoutHead :: Tracer IO HydraNodeLog -> UTCTime -> HeadId -> HydraClient -> IO Int
fanoutHead :: Tracer IO HydraNodeLog
-> UTCTime -> HeadId -> HydraClient -> IO Int
fanoutHead Tracer IO HydraNodeLog
tracer UTCTime
deadline HeadId
headId HydraClient
leader = do
  NominalDiffTime
remaining <- UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
deadline (UTCTime -> NominalDiffTime) -> IO UTCTime -> IO NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
  HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
tracer (NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
max NominalDiffTime
0 NominalDiffTime
remaining NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
3) [HydraClient
leader] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
    Text -> [Pair] -> Value
output Text
"ReadyToFanout" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
"Finalizing the Head"
  Int
headSize <- UTxO -> Int
forall era. UTxO era -> Int
UTxO.size (UTxO -> Int) -> IO UTxO -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HydraClient -> IO UTxO
getSnapshotUTxO HydraClient
leader
  HydraClient -> Value -> IO ()
send HydraClient
leader (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Fanout" []
  NominalDiffTime -> HydraClient -> (Value -> Maybe Int) -> IO Int
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> NominalDiffTime) -> Int -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
headSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) HydraClient
leader ((Value -> Maybe Int) -> IO Int) -> (Value -> Maybe Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsFinalized"
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (HeadId -> Value
forall a. ToJSON a => a -> Value
toJSON HeadId
headId)
    Value
finalized <- Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"finalizedUTxO"
    Int -> Maybe Int
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Value
finalized Value -> Getting (Endo [Value]) Value Value -> [Value]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Value]) Value Value
forall t. AsValue t => IndexedTraversal' Key t Value
IndexedTraversal' Key Value Value
members)