mirror of https://github.com/voidlizard/hbs2
46 lines
999 B
Haskell
46 lines
999 B
Haskell
module Watchdogs (runRpcWatchDog) where
|
|
|
|
import HBS2.Prelude
|
|
import HBS2.Misc.PrettyStuff
|
|
import HBS2.Peer.RPC.API.Peer
|
|
import HBS2.Peer.RPC.Client.Unix
|
|
|
|
import PeerTypes
|
|
|
|
import Control.Concurrent (ThreadId)
|
|
import Control.Monad.Trans.Cont
|
|
|
|
import UnliftIO
|
|
|
|
|
|
data WState =
|
|
WIdle | WCall Int
|
|
|
|
runRpcWatchDog :: MonadIO m => ThreadId -> FilePath -> m ()
|
|
runRpcWatchDog peer soname = do
|
|
liftIO $ flip runContT pure do
|
|
|
|
ContT $ bracket none $ const $ do
|
|
err "bracket in runRpcWatchDog"
|
|
|
|
api <- ContT $ withRPC2 @PeerAPI soname
|
|
|
|
flip fix WIdle $ \next -> \case
|
|
|
|
WIdle -> do
|
|
pause @'Seconds 10
|
|
next (WCall 0)
|
|
|
|
WCall n | n > 2 -> do
|
|
err $ red "RpcWatchDog fired"
|
|
throwTo peer GoAgainException
|
|
|
|
WCall n -> do
|
|
debug $ "RpcWatchDog" <+> pretty n
|
|
liftIO (callRpcWaitMay @RpcPoke (TimeoutSec 2) api ()) >>= \case
|
|
Just _ -> next WIdle
|
|
Nothing -> next (WCall (succ n))
|
|
|
|
|
|
|