{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Periodic.Server.Client
( ClientT
, handleSessionT
) where
import Control.Monad (unless, when)
import Control.Monad.Trans.Class (lift)
import Data.Binary (encode)
import Data.Byteable (toBytes)
import qualified Data.ByteString.Char8 as B (intercalate)
import Data.ByteString.Lazy (toStrict)
import Metro.Class (Transport)
import Metro.Conn (fromConn)
import qualified Metro.Conn as Conn
import Metro.Session (env, getSessionEnv1, receive,
send)
import Periodic.IOList (delete, elem, insert)
import Periodic.Node
import Periodic.Server.Persist (Persist)
import Periodic.Server.Scheduler
import Periodic.Server.Types
import qualified Periodic.Types.ClientCommand as CC
import Periodic.Types.Internal (ConfigKey (..))
import Periodic.Types.Job (getFuncName, initJob)
import Periodic.Types.Packet (getPacketData, packetRES)
import qualified Periodic.Types.WorkerCommand as WC
import Prelude hiding (elem)
import System.Log.Logger (errorM)
import UnliftIO
type ClientT db tp m = NodeT ClientConfig Command tp (SchedT db tp m)
handleClientSessionT
:: (MonadUnliftIO m, Persist db, Transport tp)
=> CC.ClientCommand -> SessionT ClientConfig Command tp (SchedT db tp m) ()
handleClientSessionT :: ClientCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
handleClientSessionT (CC.SubmitJob job :: Job
job) = do
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ Job -> SchedT db tp m ()
forall (m :: * -> *) db tp.
(MonadIO m, Persist db) =>
Job -> SchedT db tp m ()
pushJob Job
job
Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES ServerCommand
Success
handleClientSessionT (CC.RunJob job :: Job
job) = do
Maybe ByteString
preR <- SchedT db tp m (Maybe ByteString)
-> SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
(Maybe ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m (Maybe ByteString)
-> SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
(Maybe ByteString))
-> SchedT db tp m (Maybe ByteString)
-> SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
(Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Job -> SchedT db tp m (Maybe ByteString)
forall (m :: * -> *) db tp.
MonadIO m =>
Job -> SchedT db tp m (Maybe ByteString)
lookupPrevResult Job
job
case Maybe ByteString
preR of
Just v :: ByteString
v -> Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES (ServerCommand -> Packet ServerCommand)
-> ServerCommand -> Packet ServerCommand
forall a b. (a -> b) -> a -> b
$ ByteString -> ServerCommand
Data ByteString
v
Nothing -> do
Bool
c <- SchedT db tp m Bool
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m Bool
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Bool)
-> (FuncName -> SchedT db tp m Bool)
-> FuncName
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncName -> SchedT db tp m Bool
forall (m :: * -> *) db tp.
MonadIO m =>
FuncName -> SchedT db tp m Bool
canRun (FuncName
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Bool)
-> FuncName
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Bool
forall a b. (a -> b) -> a -> b
$ Job -> FuncName
getFuncName Job
job
if Bool
c then do
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ Job -> SchedT db tp m ()
forall (m :: * -> *) db tp. MonadIO m => Job -> SchedT db tp m ()
prepareWait Job
job
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ Job -> SchedT db tp m ()
forall (m :: * -> *) db tp.
(MonadIO m, Persist db) =>
Job -> SchedT db tp m ()
pushJob Job
job
TVar Bool
state <- ConnT tp (SchedT db tp m) (TVar Bool)
-> SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
(TVar Bool)
forall (m :: * -> (* -> *) -> * -> *) (n :: * -> *) tp a.
(FromConn m, Monad n) =>
ConnT tp n a -> m tp n a
fromConn ConnT tp (SchedT db tp m) (TVar Bool)
forall (m :: * -> *) tp. Monad m => ConnT tp m (TVar Bool)
Conn.statusTVar
ByteString
w <- SchedT db tp m ByteString
-> SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ByteString
-> SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
ByteString)
-> SchedT db tp m ByteString
-> SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
ByteString
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Job -> SchedT db tp m ByteString
forall (m :: * -> *) db tp.
MonadIO m =>
TVar Bool -> Job -> SchedT db tp m ByteString
waitResult TVar Bool
state Job
job
Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> (ServerCommand -> Packet ServerCommand)
-> ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES (ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ServerCommand
Data ByteString
w
else Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES ServerCommand
NoWorker
handleClientSessionT CC.Status = do
[ByteString]
stats <- SchedT db tp m [ByteString]
-> SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
[ByteString]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m [ByteString]
-> SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
[ByteString])
-> SchedT db tp m [ByteString]
-> SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
[ByteString]
forall a b. (a -> b) -> a -> b
$ (FuncStat -> ByteString) -> [FuncStat] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map FuncStat -> ByteString
forall a. Byteable a => a -> ByteString
toBytes ([FuncStat] -> [ByteString])
-> SchedT db tp m [FuncStat] -> SchedT db tp m [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchedT db tp m [FuncStat]
forall (m :: * -> *) db tp.
(MonadIO m, Persist db) =>
SchedT db tp m [FuncStat]
status
Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> (ByteString -> Packet ServerCommand)
-> ByteString
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES (ServerCommand -> Packet ServerCommand)
-> (ByteString -> ServerCommand)
-> ByteString
-> Packet ServerCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ServerCommand
Data (ByteString
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> ByteString
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
B.intercalate "\n" [ByteString]
stats
handleClientSessionT CC.Ping = Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES ServerCommand
Pong
handleClientSessionT (CC.DropFunc fn :: FuncName
fn) = do
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ FuncName -> SchedT db tp m ()
forall (m :: * -> *) db tp.
(MonadUnliftIO m, Persist db) =>
FuncName -> SchedT db tp m ()
dropFunc FuncName
fn
Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES ServerCommand
Success
handleClientSessionT (CC.RemoveJob fn :: FuncName
fn jn :: JobName
jn) = do
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ Job -> SchedT db tp m ()
forall (m :: * -> *) db tp.
(MonadIO m, Persist db) =>
Job -> SchedT db tp m ()
removeJob (Job -> SchedT db tp m ()) -> Job -> SchedT db tp m ()
forall a b. (a -> b) -> a -> b
$ FuncName -> JobName -> Job
initJob FuncName
fn JobName
jn
Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES ServerCommand
Success
handleClientSessionT CC.Shutdown = SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SchedT db tp m ()
forall (m :: * -> *) db tp. MonadUnliftIO m => SchedT db tp m ()
shutdown
handleClientSessionT (CC.ConfigGet (ConfigKey key :: String
key)) = do
Int
v <- SchedT db tp m Int
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m Int
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Int)
-> SchedT db tp m Int
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Int
forall a b. (a -> b) -> a -> b
$ String -> SchedT db tp m Int
forall (m :: * -> *) db tp.
(MonadIO m, Persist db) =>
String -> SchedT db tp m Int
getConfigInt String
key
Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES (ServerCommand -> Packet ServerCommand)
-> ServerCommand -> Packet ServerCommand
forall a b. (a -> b) -> a -> b
$ Int -> ServerCommand
Config Int
v
handleClientSessionT (CC.ConfigSet (ConfigKey key :: String
key) v :: Int
v) = do
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> SchedT db tp m ()
forall (m :: * -> *) db tp.
(MonadIO m, Persist db) =>
String -> Int -> SchedT db tp m ()
setConfigInt String
key Int
v
Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES ServerCommand
Success
handleClientSessionT CC.Dump = Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
(Packet ServerCommand)
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SchedT db tp m (Packet ServerCommand)
-> SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
(Packet ServerCommand)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES (ServerCommand -> Packet ServerCommand)
-> ([Job] -> ServerCommand) -> [Job] -> Packet ServerCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ServerCommand
Data (ByteString -> ServerCommand)
-> ([Job] -> ByteString) -> [Job] -> ServerCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> ([Job] -> ByteString) -> [Job] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Job] -> ByteString
forall a. Binary a => a -> ByteString
encode ([Job] -> Packet ServerCommand)
-> SchedT db tp m [Job] -> SchedT db tp m (Packet ServerCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchedT db tp m [Job]
forall (m :: * -> *) db tp.
(MonadIO m, Persist db) =>
SchedT db tp m [Job]
dumpJob)
handleClientSessionT (CC.Load jobs :: [Job]
jobs) = do
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ (Job -> SchedT db tp m ()) -> [Job] -> SchedT db tp m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Job -> SchedT db tp m ()
forall (m :: * -> *) db tp.
(MonadIO m, Persist db) =>
Job -> SchedT db tp m ()
pushJob [Job]
jobs
Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES ServerCommand
Success
handleWorkerSessionT
:: (MonadUnliftIO m, Persist db, Transport tp)
=> ClientConfig -> WC.WorkerCommand -> SessionT ClientConfig Command tp (SchedT db tp m) ()
handleWorkerSessionT :: ClientConfig
-> WorkerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
handleWorkerSessionT ClientConfig {..} WC.GrabJob = do
SessionEnv1 ClientConfig Nid Msgid (Packet Command) tp
env0 <- SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
(SessionEnv1 ClientConfig Nid Msgid (Packet Command) tp)
forall (m :: * -> *) tp u nid k rpkt.
(Monad m, Transport tp) =>
SessionT u nid k rpkt tp m (SessionEnv1 u nid k rpkt tp)
getSessionEnv1
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ IOList FuncName
-> IOList JobHandle
-> SessionEnv1 ClientConfig Nid Msgid (Packet Command) tp
-> SchedT db tp m ()
forall (m :: * -> *) tp db.
MonadIO m =>
IOList FuncName
-> IOList JobHandle -> CSEnv tp -> SchedT db tp m ()
pushGrab IOList FuncName
wFuncList IOList JobHandle
wJobQueue SessionEnv1 ClientConfig Nid Msgid (Packet Command) tp
env0
handleWorkerSessionT ClientConfig {..} (WC.WorkDone jh :: JobHandle
jh w :: ByteString
w) = do
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ JobHandle -> ByteString -> SchedT db tp m ()
forall (m :: * -> *) db tp.
(MonadUnliftIO m, Persist db) =>
JobHandle -> ByteString -> SchedT db tp m ()
doneJob JobHandle
jh ByteString
w
IOList JobHandle
-> JobHandle
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a (m :: * -> *). (Eq a, MonadIO m) => IOList a -> a -> m ()
delete IOList JobHandle
wJobQueue JobHandle
jh
handleWorkerSessionT ClientConfig {..} (WC.WorkFail jh :: JobHandle
jh) = do
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ JobHandle -> SchedT db tp m ()
forall (m :: * -> *) db tp.
(MonadUnliftIO m, Persist db) =>
JobHandle -> SchedT db tp m ()
failJob JobHandle
jh
IOList JobHandle
-> JobHandle
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a (m :: * -> *). (Eq a, MonadIO m) => IOList a -> a -> m ()
delete IOList JobHandle
wJobQueue JobHandle
jh
handleWorkerSessionT ClientConfig {..} (WC.SchedLater jh :: JobHandle
jh l :: Int64
l s :: Int
s) = do
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ JobHandle -> Int64 -> Int -> SchedT db tp m ()
forall (m :: * -> *) db tp.
(MonadUnliftIO m, Persist db) =>
JobHandle -> Int64 -> Int -> SchedT db tp m ()
schedLaterJob JobHandle
jh Int64
l Int
s
IOList JobHandle
-> JobHandle
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a (m :: * -> *). (Eq a, MonadIO m) => IOList a -> a -> m ()
delete IOList JobHandle
wJobQueue JobHandle
jh
handleWorkerSessionT ClientConfig {..} WC.Sleep = Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES ServerCommand
Noop
handleWorkerSessionT ClientConfig {..} WC.Ping = Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES ServerCommand
Pong
handleWorkerSessionT ClientConfig {..} (WC.CanDo fn :: FuncName
fn) = do
Bool
has <- IOList FuncName
-> FuncName
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Bool
forall a (m :: * -> *).
(Eq a, MonadIO m) =>
IOList a -> a -> m Bool
elem IOList FuncName
wFuncList FuncName
fn
Bool
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
has (SessionT ClientConfig Command tp (SchedT db tp m) ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ do
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ FuncName -> SchedT db tp m ()
forall (m :: * -> *) db tp.
(MonadIO m, Persist db) =>
FuncName -> SchedT db tp m ()
addFunc FuncName
fn
IOList FuncName
-> FuncName -> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) a. MonadIO m => IOList a -> a -> m ()
insert IOList FuncName
wFuncList FuncName
fn
handleWorkerSessionT ClientConfig {..} (WC.CantDo fn :: FuncName
fn) = do
Bool
has <- IOList FuncName
-> FuncName
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Bool
forall a (m :: * -> *).
(Eq a, MonadIO m) =>
IOList a -> a -> m Bool
elem IOList FuncName
wFuncList FuncName
fn
Bool
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
has (SessionT ClientConfig Command tp (SchedT db tp m) ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ do
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ FuncName -> SchedT db tp m ()
forall (m :: * -> *) db tp.
(MonadIO m, Persist db) =>
FuncName -> SchedT db tp m ()
removeFunc FuncName
fn
IOList FuncName
-> FuncName -> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a (m :: * -> *). (Eq a, MonadIO m) => IOList a -> a -> m ()
delete IOList FuncName
wFuncList FuncName
fn
handleWorkerSessionT ClientConfig {..} (WC.Broadcast fn :: FuncName
fn) = do
Bool
has <- IOList FuncName
-> FuncName
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Bool
forall a (m :: * -> *).
(Eq a, MonadIO m) =>
IOList a -> a -> m Bool
elem IOList FuncName
wFuncList FuncName
fn
Bool
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
has (SessionT ClientConfig Command tp (SchedT db tp m) ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ do
SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ FuncName -> Bool -> SchedT db tp m ()
forall (m :: * -> *) db tp.
(MonadIO m, Persist db) =>
FuncName -> Bool -> SchedT db tp m ()
broadcastFunc FuncName
fn Bool
True
IOList FuncName
-> FuncName -> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) a. MonadIO m => IOList a -> a -> m ()
insert IOList FuncName
wFuncList FuncName
fn
handleWorkerSessionT _ (WC.Acquire n :: LockName
n c :: Int
c jh :: JobHandle
jh) = do
Bool
r <- SchedT db tp m Bool
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m Bool
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Bool)
-> SchedT db tp m Bool
-> SessionT
ClientConfig Nid Msgid (Packet Command) tp (SchedT db tp m) Bool
forall a b. (a -> b) -> a -> b
$ LockName -> Int -> JobHandle -> SchedT db tp m Bool
forall (m :: * -> *) db tp.
(MonadUnliftIO m, Persist db) =>
LockName -> Int -> JobHandle -> SchedT db tp m Bool
acquireLock LockName
n Int
c JobHandle
jh
Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
SetPacketId k spkt) =>
spkt -> SessionT u nid k rpkt tp m ()
send (Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> Packet ServerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ ServerCommand -> Packet ServerCommand
forall a. a -> Packet a
packetRES (ServerCommand -> Packet ServerCommand)
-> ServerCommand -> Packet ServerCommand
forall a b. (a -> b) -> a -> b
$ Bool -> ServerCommand
Acquired Bool
r
handleWorkerSessionT _ (WC.Release n :: LockName
n jh :: JobHandle
jh) = SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> SchedT db tp m ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ LockName -> JobHandle -> SchedT db tp m ()
forall (m :: * -> *) db tp.
(MonadUnliftIO m, Persist db) =>
LockName -> JobHandle -> SchedT db tp m ()
releaseLock LockName
n JobHandle
jh
handleSessionT
:: (MonadUnliftIO m, Persist db, Transport tp)
=> SessionT ClientConfig Command tp (SchedT db tp m) ()
handleSessionT :: SessionT ClientConfig Command tp (SchedT db tp m) ()
handleSessionT = do
Maybe (Packet Command)
mcmd <- SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
(Maybe (Packet Command))
forall (m :: * -> *) tp u nid k rpkt.
(MonadIO m, Transport tp) =>
SessionT u nid k rpkt tp m (Maybe rpkt)
receive
case Maybe (Packet Command)
mcmd of
Nothing -> do
IO () -> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SessionT ClientConfig Command tp (SchedT db tp m) ())
-> IO () -> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
errorM "Periodic.Server.Client" "Client error"
ConnT tp (SchedT db tp m) ()
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> (* -> *) -> * -> *) (n :: * -> *) tp a.
(FromConn m, Monad n) =>
ConnT tp n a -> m tp n a
fromConn ConnT tp (SchedT db tp m) ()
forall (m :: * -> *) tp. (MonadIO m, Transport tp) => ConnT tp m ()
Conn.close
Just pkt :: Packet Command
pkt ->
case Packet Command -> Command
forall a. Packet a -> a
getPacketData Packet Command
pkt of
CC cmd :: ClientCommand
cmd -> ClientCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) db tp.
(MonadUnliftIO m, Persist db, Transport tp) =>
ClientCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
handleClientSessionT ClientCommand
cmd
WC cmd :: WorkerCommand
cmd -> do
ClientConfig
env0 <- SessionT
ClientConfig
Nid
Msgid
(Packet Command)
tp
(SchedT db tp m)
ClientConfig
forall (m :: * -> *) u nid k rpkt tp.
Monad m =>
SessionT u nid k rpkt tp m u
env
ClientConfig
-> WorkerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
forall (m :: * -> *) db tp.
(MonadUnliftIO m, Persist db, Transport tp) =>
ClientConfig
-> WorkerCommand
-> SessionT ClientConfig Command tp (SchedT db tp m) ()
handleWorkerSessionT ClientConfig
env0 WorkerCommand
cmd