mirror of https://github.com/voidlizard/hbs2
hbs2-peer do reset command
This commit is contained in:
parent
0b1773afbf
commit
b2a48c6625
|
@ -143,10 +143,6 @@ import Graphics.Vty.Platform.Unix qualified as Vty
|
||||||
|
|
||||||
import Control.Concurrent.Async (ExceptionInLinkedThread(..))
|
import Control.Concurrent.Async (ExceptionInLinkedThread(..))
|
||||||
|
|
||||||
data GoAgainException = GoAgainException
|
|
||||||
deriving (Eq,Ord,Show,Typeable)
|
|
||||||
|
|
||||||
instance Exception GoAgainException
|
|
||||||
|
|
||||||
-- TODO: write-workers-to-config
|
-- TODO: write-workers-to-config
|
||||||
defStorageThreads :: Integral a => a
|
defStorageThreads :: Integral a => a
|
||||||
|
@ -1354,7 +1350,8 @@ runPeer opts = respawnOnError opts $ do
|
||||||
setProbe rpcmsg rpcProbe
|
setProbe rpcmsg rpcProbe
|
||||||
addProbe rpcProbe
|
addProbe rpcProbe
|
||||||
|
|
||||||
let rpcctx = RPC2Context { rpcConfig = fromPeerConfig conf
|
let rpcctx = RPC2Context { rpcSelf = myself
|
||||||
|
, rpcConfig = fromPeerConfig conf
|
||||||
, rpcMessaging = rpcmsg
|
, rpcMessaging = rpcmsg
|
||||||
, rpcTCP = tcp
|
, rpcTCP = tcp
|
||||||
, rpcPokeAnswer = pokeAnsw
|
, rpcPokeAnswer = pokeAnsw
|
||||||
|
|
|
@ -65,6 +65,11 @@ import UnliftIO
|
||||||
|
|
||||||
import Streaming.Prelude qualified as S
|
import Streaming.Prelude qualified as S
|
||||||
|
|
||||||
|
data GoAgainException = GoAgainException
|
||||||
|
deriving (Eq,Ord,Show,Typeable)
|
||||||
|
|
||||||
|
instance Exception GoAgainException
|
||||||
|
|
||||||
data PeerInfo e =
|
data PeerInfo e =
|
||||||
PeerInfo
|
PeerInfo
|
||||||
{ _peerBurst :: TVar Int
|
{ _peerBurst :: TVar Int
|
||||||
|
|
|
@ -79,7 +79,7 @@ import Streaming.Prelude qualified as S
|
||||||
instance (e ~ L4Proto, MonadUnliftIO m, HasRpcContext PeerAPI RPC2Context m) => HandleMethod m RpcRunScript where
|
instance (e ~ L4Proto, MonadUnliftIO m, HasRpcContext PeerAPI RPC2Context m) => HandleMethod m RpcRunScript where
|
||||||
handleMethod top = do
|
handleMethod top = do
|
||||||
|
|
||||||
co <- getRpcContext @PeerAPI
|
co@RPC2Context{..} <- getRpcContext @PeerAPI
|
||||||
|
|
||||||
let cli = parseTop top & fromRight mempty
|
let cli = parseTop top & fromRight mempty
|
||||||
|
|
||||||
|
@ -218,6 +218,11 @@ instance (e ~ L4Proto, MonadUnliftIO m, HasRpcContext PeerAPI RPC2Context m) =>
|
||||||
_ -> do
|
_ -> do
|
||||||
pure nil
|
pure nil
|
||||||
|
|
||||||
|
|
||||||
|
entry $ bindMatch "reset" $ const do
|
||||||
|
throwTo rpcSelf GoAgainException
|
||||||
|
pure $ mkSym "reset"
|
||||||
|
|
||||||
entry $ bindMatch "peer-info" $ const do
|
entry $ bindMatch "peer-info" $ const do
|
||||||
|
|
||||||
now <- getTimeCoarse
|
now <- getTimeCoarse
|
||||||
|
|
|
@ -25,13 +25,15 @@ import Data.Config.Suckless.Parse
|
||||||
import Data.Kind
|
import Data.Kind
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
import Control.Concurrent (ThreadId)
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import UnliftIO
|
import UnliftIO
|
||||||
import HBS2.Prelude (asyncLinked)
|
import HBS2.Prelude (asyncLinked)
|
||||||
|
|
||||||
data RPC2Context =
|
data RPC2Context =
|
||||||
RPC2Context
|
RPC2Context
|
||||||
{ rpcConfig :: [Syntax C]
|
{ rpcSelf :: ThreadId
|
||||||
|
, rpcConfig :: [Syntax C]
|
||||||
, rpcMessaging :: MessagingUnix
|
, rpcMessaging :: MessagingUnix
|
||||||
, rpcTCP :: Maybe MessagingTCP
|
, rpcTCP :: Maybe MessagingTCP
|
||||||
, rpcPokeAnswer :: String
|
, rpcPokeAnswer :: String
|
||||||
|
|
Loading…
Reference in New Issue