{-# 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 -- close client
    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