{-# LANGUAGE OverloadedStrings #-}

module Periodic.Trans.Client
  ( ClientT
  , ClientEnv
  , open
  , close
  , runClientT

  , ping
  , submitJob_
  , submitJob
  , runJob_
  , runJob
  , removeJob
  , dropFunc
  , status
  , configGet
  , configSet
  , load
  , dump
  , shutdown
  ) where

import           Control.Monad                (forever, void)
import           Data.Binary                  (decode)
import           Data.ByteString              (ByteString)
import           Data.ByteString.Lazy         (fromStrict)
import           Metro.Class                  (Transport, TransportConfig)
import           Metro.Conn                   (initConnEnv, runConnT)
import qualified Metro.Conn                   as Conn
import           Metro.Node                   (NodeMode (..), SessionMode (..),
                                               initEnv1, request,
                                               setDefaultSessionTimeout,
                                               setNodeMode, setSessionMode,
                                               startNodeT, withSessionT)
import           Metro.Session                (send)
import           Periodic.Node
import           Periodic.Trans.BaseClient
import           Periodic.Types               (ClientType (TypeClient),
                                               getClientType, getResult,
                                               packetREQ, regPacketREQ)
import           Periodic.Types.ClientCommand
import           Periodic.Types.Internal      (ConfigKey (..))
import           Periodic.Types.Job
import           Periodic.Types.ServerCommand
import           UnliftIO
import           UnliftIO.Concurrent          (threadDelay)

type ClientEnv = BaseClientEnv ()
type ClientT = BaseClientT ()

runClientT :: Monad m => ClientEnv tp -> ClientT tp m a -> m a
runClientT :: ClientEnv tp -> ClientT tp m a -> m a
runClientT = ClientEnv tp -> ClientT tp m a -> m a
forall (m :: * -> *) u rpkt tp a.
Monad m =>
NodeEnv u rpkt tp -> NodeT u rpkt tp m a -> m a
runNodeT

open
  :: (MonadUnliftIO m, Transport tp)
  => TransportConfig tp -> m (ClientEnv tp)
open :: TransportConfig tp -> m (ClientEnv tp)
open config :: TransportConfig tp
config = do
  ConnEnv tp
connEnv <- TransportConfig tp -> m (ConnEnv tp)
forall (m :: * -> *) tp.
(MonadIO m, Transport tp) =>
TransportConfig tp -> m (ConnEnv tp)
initConnEnv TransportConfig tp
config
  RegPacket ServerCommand
r <- ConnEnv tp
-> ConnT tp m (RegPacket ServerCommand)
-> m (RegPacket ServerCommand)
forall tp (m :: * -> *) a. ConnEnv tp -> ConnT tp m a -> m a
runConnT ConnEnv tp
connEnv (ConnT tp m (RegPacket ServerCommand)
 -> m (RegPacket ServerCommand))
-> ConnT tp m (RegPacket ServerCommand)
-> m (RegPacket ServerCommand)
forall a b. (a -> b) -> a -> b
$ do
    RegPacket ClientType -> ConnT tp m ()
forall (m :: * -> *) tp pkt.
(MonadUnliftIO m, Transport tp, SendPacket pkt) =>
pkt -> ConnT tp m ()
Conn.send (RegPacket ClientType -> ConnT tp m ())
-> RegPacket ClientType -> ConnT tp m ()
forall a b. (a -> b) -> a -> b
$ ClientType -> RegPacket ClientType
forall a. a -> RegPacket a
regPacketREQ ClientType
TypeClient
    ConnT tp m (RegPacket ServerCommand)
forall (m :: * -> *) tp pkt.
(MonadUnliftIO m, Transport tp, RecvPacket pkt) =>
ConnT tp m pkt
Conn.receive

  let nid :: ByteString
nid = case RegPacket ServerCommand -> ServerCommand
forall a. RegPacket a -> a
getClientType RegPacket ServerCommand
r of
              Data v :: ByteString
v -> ByteString
v
              _      -> ""

  ClientEnv tp
clientEnv <- (NodeEnv () Nid Msgid (Packet ServerCommand)
 -> NodeEnv () Nid Msgid (Packet ServerCommand))
-> ConnEnv tp -> () -> Nid -> IO Msgid -> m (ClientEnv tp)
forall (m :: * -> *) u nid k rpkt tp.
MonadIO m =>
(NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt)
-> ConnEnv tp -> u -> nid -> IO k -> m (NodeEnv1 u nid k rpkt tp)
initEnv1 NodeEnv () Nid Msgid (Packet ServerCommand)
-> NodeEnv () Nid Msgid (Packet ServerCommand)
forall u nid k rpkt. NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
mapEnv ConnEnv tp
connEnv () (ByteString -> Nid
Nid ByteString
nid) IO Msgid
sessionGen

  ClientEnv tp -> ClientT tp m () -> m ()
forall (m :: * -> *) tp a.
Monad m =>
ClientEnv tp -> ClientT tp m a -> m a
runClientT ClientEnv tp
clientEnv (ClientT tp m () -> m ()) -> ClientT tp m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    NodeT () Nid Msgid (Packet ServerCommand) tp m (Async Any)
-> ClientT tp m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (NodeT () Nid Msgid (Packet ServerCommand) tp m (Async Any)
 -> ClientT tp m ())
-> (NodeT () Nid Msgid (Packet ServerCommand) tp m Any
    -> NodeT () Nid Msgid (Packet ServerCommand) tp m (Async Any))
-> NodeT () Nid Msgid (Packet ServerCommand) tp m Any
-> ClientT tp m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT () Nid Msgid (Packet ServerCommand) tp m Any
-> NodeT () Nid Msgid (Packet ServerCommand) tp m (Async Any)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (NodeT () Nid Msgid (Packet ServerCommand) tp m Any
 -> ClientT tp m ())
-> NodeT () Nid Msgid (Packet ServerCommand) tp m Any
-> ClientT tp m ()
forall a b. (a -> b) -> a -> b
$ ClientT tp m ()
-> NodeT () Nid Msgid (Packet ServerCommand) tp m Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (ClientT tp m ()
 -> NodeT () Nid Msgid (Packet ServerCommand) tp m Any)
-> ClientT tp m ()
-> NodeT () Nid Msgid (Packet ServerCommand) tp m Any
forall a b. (a -> b) -> a -> b
$ do
      Int -> ClientT tp m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int -> ClientT tp m ()) -> Int -> ClientT tp m ()
forall a b. (a -> b) -> a -> b
$ 100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000
      ClientT tp m ()
forall (m :: * -> *) tp u.
(MonadUnliftIO m, Transport tp) =>
BaseClientT u tp m ()
checkHealth

    NodeT () Nid Msgid (Packet ServerCommand) tp m (Async ())
-> ClientT tp m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (NodeT () Nid Msgid (Packet ServerCommand) tp m (Async ())
 -> ClientT tp m ())
-> NodeT () Nid Msgid (Packet ServerCommand) tp m (Async ())
-> ClientT tp m ()
forall a b. (a -> b) -> a -> b
$ ClientT tp m ()
-> NodeT () Nid Msgid (Packet ServerCommand) tp m (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (ClientT tp m ()
 -> NodeT () Nid Msgid (Packet ServerCommand) tp m (Async ()))
-> ClientT tp m ()
-> NodeT () Nid Msgid (Packet ServerCommand) tp m (Async ())
forall a b. (a -> b) -> a -> b
$ SessionT () Nid Msgid (Packet ServerCommand) tp m ()
-> ClientT tp m ()
forall (m :: * -> *) tp rpkt k u nid.
(MonadUnliftIO m, Transport tp, RecvPacket rpkt,
 GetPacketId k rpkt, Eq k, Hashable k) =>
SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m ()
startNodeT SessionT () Nid Msgid (Packet ServerCommand) tp m ()
forall (m :: * -> *) u rpkt tp.
MonadIO m =>
SessionT u rpkt tp m ()
defaultSessionHandler
  ClientEnv tp -> m (ClientEnv tp)
forall (m :: * -> *) a. Monad m => a -> m a
return ClientEnv tp
clientEnv

  where mapEnv :: NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
mapEnv =
          NodeMode -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
forall u nid k rpkt.
NodeMode -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
setNodeMode NodeMode
Multi
          (NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt)
-> (NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt)
-> NodeEnv u nid k rpkt
-> NodeEnv u nid k rpkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionMode -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
forall u nid k rpkt.
SessionMode -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
setSessionMode SessionMode
SingleAction
          (NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt)
-> (NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt)
-> NodeEnv u nid k rpkt
-> NodeEnv u nid k rpkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
forall u nid k rpkt.
Int64 -> NodeEnv u nid k rpkt -> NodeEnv u nid k rpkt
setDefaultSessionTimeout 100

dropFunc
  :: (MonadUnliftIO m, Transport tp)
  => FuncName -> BaseClientT u tp m Bool
dropFunc :: FuncName -> BaseClientT u tp m Bool
dropFunc func :: FuncName
func = Bool
-> (ServerCommand -> Bool) -> Maybe (Packet ServerCommand) -> Bool
forall a b. a -> (b -> a) -> Maybe (Packet b) -> a
getResult Bool
False ServerCommand -> Bool
isSuccess (Maybe (Packet ServerCommand) -> Bool)
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
-> BaseClientT u tp m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
-> Packet ClientCommand
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
 SetPacketId k spkt, Eq k, Hashable k) =>
Maybe Int64 -> spkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
request Maybe Int64
forall a. Maybe a
Nothing (ClientCommand -> Packet ClientCommand
forall a. a -> Packet a
packetREQ (FuncName -> ClientCommand
DropFunc FuncName
func))

removeJob
  :: (MonadUnliftIO m, Transport tp)
  => FuncName -> JobName -> BaseClientT u tp m Bool
removeJob :: FuncName -> JobName -> BaseClientT u tp m Bool
removeJob f :: FuncName
f n :: JobName
n = Bool
-> (ServerCommand -> Bool) -> Maybe (Packet ServerCommand) -> Bool
forall a b. a -> (b -> a) -> Maybe (Packet b) -> a
getResult Bool
False ServerCommand -> Bool
isSuccess (Maybe (Packet ServerCommand) -> Bool)
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
-> BaseClientT u tp m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
-> Packet ClientCommand
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
 SetPacketId k spkt, Eq k, Hashable k) =>
Maybe Int64 -> spkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
request Maybe Int64
forall a. Maybe a
Nothing (ClientCommand -> Packet ClientCommand
forall a. a -> Packet a
packetREQ (FuncName -> JobName -> ClientCommand
RemoveJob FuncName
f JobName
n))

status
  :: (MonadUnliftIO m, Transport tp)
  => BaseClientT u tp m ByteString
status :: BaseClientT u tp m ByteString
status = ByteString
-> (ServerCommand -> ByteString)
-> Maybe (Packet ServerCommand)
-> ByteString
forall a b. a -> (b -> a) -> Maybe (Packet b) -> a
getResult "" ServerCommand -> ByteString
getRaw (Maybe (Packet ServerCommand) -> ByteString)
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
-> BaseClientT u tp m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
-> Packet ClientCommand
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
 SetPacketId k spkt, Eq k, Hashable k) =>
Maybe Int64 -> spkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
request Maybe Int64
forall a. Maybe a
Nothing (ClientCommand -> Packet ClientCommand
forall a. a -> Packet a
packetREQ ClientCommand
Status)
  where getRaw :: ServerCommand -> ByteString
        getRaw :: ServerCommand -> ByteString
getRaw (Data bs :: ByteString
bs) = ByteString
bs
        getRaw _         = ""

configGet
  :: (MonadUnliftIO m, Transport tp)
  => String -> BaseClientT u tp m Int
configGet :: String -> BaseClientT u tp m Int
configGet k :: String
k = Int
-> (ServerCommand -> Int) -> Maybe (Packet ServerCommand) -> Int
forall a b. a -> (b -> a) -> Maybe (Packet b) -> a
getResult 0 ServerCommand -> Int
getV (Maybe (Packet ServerCommand) -> Int)
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
-> BaseClientT u tp m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
-> Packet ClientCommand
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
 SetPacketId k spkt, Eq k, Hashable k) =>
Maybe Int64 -> spkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
request Maybe Int64
forall a. Maybe a
Nothing (ClientCommand -> Packet ClientCommand
forall a. a -> Packet a
packetREQ (ConfigKey -> ClientCommand
ConfigGet (String -> ConfigKey
ConfigKey String
k)))
  where getV :: ServerCommand -> Int
        getV :: ServerCommand -> Int
getV (Config v :: Int
v) = Int
v
        getV _          = 0

configSet
  :: (MonadUnliftIO m, Transport tp)
  => String -> Int -> BaseClientT u tp m Bool
configSet :: String -> Int -> BaseClientT u tp m Bool
configSet k :: String
k v :: Int
v = Bool
-> (ServerCommand -> Bool) -> Maybe (Packet ServerCommand) -> Bool
forall a b. a -> (b -> a) -> Maybe (Packet b) -> a
getResult Bool
False ServerCommand -> Bool
isSuccess (Maybe (Packet ServerCommand) -> Bool)
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
-> BaseClientT u tp m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
-> Packet ClientCommand
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
 SetPacketId k spkt, Eq k, Hashable k) =>
Maybe Int64 -> spkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
request Maybe Int64
forall a. Maybe a
Nothing (ClientCommand -> Packet ClientCommand
forall a. a -> Packet a
packetREQ (ConfigKey -> Int -> ClientCommand
ConfigSet (String -> ConfigKey
ConfigKey String
k) Int
v))

load :: (MonadUnliftIO m, Transport tp) => [Job] -> BaseClientT u tp m Bool
load :: [Job] -> BaseClientT u tp m Bool
load jobs :: [Job]
jobs = Bool
-> (ServerCommand -> Bool) -> Maybe (Packet ServerCommand) -> Bool
forall a b. a -> (b -> a) -> Maybe (Packet b) -> a
getResult Bool
False ServerCommand -> Bool
isSuccess (Maybe (Packet ServerCommand) -> Bool)
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
-> BaseClientT u tp m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
-> Packet ClientCommand
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
 SetPacketId k spkt, Eq k, Hashable k) =>
Maybe Int64 -> spkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
request Maybe Int64
forall a. Maybe a
Nothing (ClientCommand -> Packet ClientCommand
forall a. a -> Packet a
packetREQ ([Job] -> ClientCommand
Load [Job]
jobs))

dump :: (MonadUnliftIO m, Transport tp) => BaseClientT u tp m [Job]
dump :: BaseClientT u tp m [Job]
dump = [Job]
-> (ServerCommand -> [Job])
-> Maybe (Packet ServerCommand)
-> [Job]
forall a b. a -> (b -> a) -> Maybe (Packet b) -> a
getResult [] ServerCommand -> [Job]
getV (Maybe (Packet ServerCommand) -> [Job])
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
-> BaseClientT u tp m [Job]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
-> Packet ClientCommand
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
forall (m :: * -> *) tp spkt k u nid rpkt.
(MonadUnliftIO m, Transport tp, SendPacket spkt,
 SetPacketId k spkt, Eq k, Hashable k) =>
Maybe Int64 -> spkt -> NodeT u nid k rpkt tp m (Maybe rpkt)
request Maybe Int64
forall a. Maybe a
Nothing (ClientCommand -> Packet ClientCommand
forall a. a -> Packet a
packetREQ ClientCommand
Dump)
  where getV :: ServerCommand -> [Job]
        getV :: ServerCommand -> [Job]
getV (Data bs :: ByteString
bs) = ByteString -> [Job]
forall a. Binary a => ByteString -> a
decode (ByteString -> [Job]) -> ByteString -> [Job]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromStrict ByteString
bs
        getV _         = []

shutdown :: (MonadUnliftIO m, Transport tp) => BaseClientT u tp m ()
shutdown :: BaseClientT u tp m ()
shutdown = Maybe Int64
-> SessionT u Nid Msgid (Packet ServerCommand) tp m ()
-> BaseClientT u tp m ()
forall (m :: * -> *) k u nid rpkt tp a.
(MonadUnliftIO m, Eq k, Hashable k) =>
Maybe Int64
-> SessionT u nid k rpkt tp m a -> NodeT u nid k rpkt tp m a
withSessionT Maybe Int64
forall a. Maybe a
Nothing (SessionT u Nid Msgid (Packet ServerCommand) tp m ()
 -> BaseClientT u tp m ())
-> SessionT u Nid Msgid (Packet ServerCommand) tp m ()
-> BaseClientT u tp m ()
forall a b. (a -> b) -> a -> b
$ Packet ClientCommand
-> SessionT u Nid Msgid (Packet ServerCommand) 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 ClientCommand
 -> SessionT u Nid Msgid (Packet ServerCommand) tp m ())
-> Packet ClientCommand
-> SessionT u Nid Msgid (Packet ServerCommand) tp m ()
forall a b. (a -> b) -> a -> b
$ ClientCommand -> Packet ClientCommand
forall a. a -> Packet a
packetREQ ClientCommand
Shutdown