{-# LANGUAGE OverloadedStrings #-}

module Periodic.Trans.BaseClient
  ( BaseClientT
  , BaseClientEnv
  , getClientEnv
  , close
  , runBaseClientT

  , ping
  , submitJob_
  , submitJob
  , runJob_
  , runJob
  , checkHealth
  ) where

import           Control.Monad                (unless)
import           Data.ByteString              (ByteString)
import           Data.Int                     (Int64)
import           Data.Maybe                   (fromMaybe)
import           Metro.Class                  (Transport)
import           Metro.Node                   (getEnv1, request, stopNodeT)
import           Metro.Utils                  (getEpochTime)
import           Periodic.Node
import           Periodic.Types               (getResult, packetREQ)
import           Periodic.Types.ClientCommand
import           Periodic.Types.Job
import           Periodic.Types.ServerCommand
import           UnliftIO

type BaseClientEnv u = NodeEnv u ServerCommand
type BaseClientT u = NodeT u ServerCommand

runBaseClientT :: Monad m => BaseClientEnv u tp -> BaseClientT u tp m a -> m a
runBaseClientT :: BaseClientEnv u tp -> BaseClientT u tp m a -> m a
runBaseClientT = BaseClientEnv u tp -> BaseClientT u 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

close :: (MonadUnliftIO m, Transport tp) => BaseClientT u tp m ()
close :: BaseClientT u tp m ()
close = BaseClientT u tp m ()
forall (m :: * -> *) tp u nid k rpkt.
(MonadIO m, Transport tp) =>
NodeT u nid k rpkt tp m ()
stopNodeT

ping :: (MonadUnliftIO m, Transport tp) => BaseClientT u tp m Bool
ping :: BaseClientT u tp m Bool
ping = Bool
-> (ServerCommand -> Bool) -> Maybe (Packet ServerCommand) -> Bool
forall a b. a -> (b -> a) -> Maybe (Packet b) -> a
getResult Bool
False ServerCommand -> Bool
isPong (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 ClientCommand
Ping)

submitJob_ :: (MonadUnliftIO m, Transport tp) => Job -> BaseClientT u tp m Bool
submitJob_ :: Job -> BaseClientT u tp m Bool
submitJob_ j :: Job
j = 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
SubmitJob Job
j))

submitJob
  :: (MonadUnliftIO m, Transport tp)
  => FuncName -> JobName -> Maybe Workload -> Maybe Int64 -> BaseClientT u tp m Bool
submitJob :: FuncName
-> JobName
-> Maybe Workload
-> Maybe Int64
-> BaseClientT u tp m Bool
submitJob fn :: FuncName
fn jn :: JobName
jn w :: Maybe Workload
w later :: Maybe Int64
later = do
  Int64
schedAt <- (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe 0 Maybe Int64
later) (Int64 -> Int64)
-> NodeT u Nid Msgid (Packet ServerCommand) tp m Int64
-> NodeT u Nid Msgid (Packet ServerCommand) tp m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeT u Nid Msgid (Packet ServerCommand) tp m Int64
forall (m :: * -> *). MonadIO m => m Int64
getEpochTime
  Job -> BaseClientT u tp m Bool
forall (m :: * -> *) tp u.
(MonadUnliftIO m, Transport tp) =>
Job -> BaseClientT u tp m Bool
submitJob_ (Job -> BaseClientT u tp m Bool) -> Job -> BaseClientT u tp m Bool
forall a b. (a -> b) -> a -> b
$ Int64 -> Job -> Job
setSchedAt Int64
schedAt (Job -> Job) -> Job -> Job
forall a b. (a -> b) -> a -> b
$ Workload -> Job -> Job
setWorkload (Workload -> Maybe Workload -> Workload
forall a. a -> Maybe a -> a
fromMaybe "" Maybe Workload
w) (Job -> Job) -> Job -> Job
forall a b. (a -> b) -> a -> b
$ FuncName -> JobName -> Job
initJob FuncName
fn JobName
jn

runJob_ :: (MonadUnliftIO m, Transport tp) => Job -> BaseClientT u tp m (Maybe ByteString)
runJob_ :: Job -> BaseClientT u tp m (Maybe ByteString)
runJob_ j :: Job
j =  Maybe ByteString
-> (ServerCommand -> Maybe ByteString)
-> Maybe (Packet ServerCommand)
-> Maybe ByteString
forall a b. a -> (b -> a) -> Maybe (Packet b) -> a
getResult Maybe ByteString
forall a. Maybe a
Nothing ServerCommand -> Maybe ByteString
getData (Maybe (Packet ServerCommand) -> Maybe ByteString)
-> NodeT
     u
     Nid
     Msgid
     (Packet ServerCommand)
     tp
     m
     (Maybe (Packet ServerCommand))
-> BaseClientT u tp m (Maybe 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 -> Packet ClientCommand)
-> (Job -> ClientCommand) -> Job -> Packet ClientCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Job -> ClientCommand
RunJob (Job -> Packet ClientCommand) -> Job -> Packet ClientCommand
forall a b. (a -> b) -> a -> b
$ Int64 -> Job -> Job
setSchedAt 0 Job
j)
  where getData :: ServerCommand -> Maybe ByteString
        getData :: ServerCommand -> Maybe ByteString
getData (Data bs :: ByteString
bs) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs
        getData _         = Maybe ByteString
forall a. Maybe a
Nothing

runJob
  :: (MonadUnliftIO m, Transport tp)
  => FuncName -> JobName -> Maybe Workload -> BaseClientT u tp m (Maybe ByteString)
runJob :: FuncName
-> JobName
-> Maybe Workload
-> BaseClientT u tp m (Maybe ByteString)
runJob fn :: FuncName
fn jn :: JobName
jn w :: Maybe Workload
w = do
  Int64
schedAt <- NodeT u Nid Msgid (Packet ServerCommand) tp m Int64
forall (m :: * -> *). MonadIO m => m Int64
getEpochTime
  Job -> BaseClientT u tp m (Maybe ByteString)
forall (m :: * -> *) tp u.
(MonadUnliftIO m, Transport tp) =>
Job -> BaseClientT u tp m (Maybe ByteString)
runJob_ (Job -> BaseClientT u tp m (Maybe ByteString))
-> Job -> BaseClientT u tp m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Int64 -> Job -> Job
setSchedAt Int64
schedAt (Job -> Job) -> Job -> Job
forall a b. (a -> b) -> a -> b
$ Workload -> Job -> Job
setWorkload (Workload -> Maybe Workload -> Workload
forall a. a -> Maybe a -> a
fromMaybe "" Maybe Workload
w) (Job -> Job) -> Job -> Job
forall a b. (a -> b) -> a -> b
$ FuncName -> JobName -> Job
initJob FuncName
fn JobName
jn

checkHealth :: (MonadUnliftIO m, Transport tp) => BaseClientT u tp m ()
checkHealth :: BaseClientT u tp m ()
checkHealth = do
  Maybe Bool
ret <- Int
-> NodeT u Nid Msgid (Packet ServerCommand) tp m Bool
-> NodeT u Nid Msgid (Packet ServerCommand) tp m (Maybe Bool)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout 10000000 NodeT u Nid Msgid (Packet ServerCommand) tp m Bool
forall (m :: * -> *) tp u.
(MonadUnliftIO m, Transport tp) =>
BaseClientT u tp m Bool
ping
  case Maybe Bool
ret of
    Nothing -> BaseClientT u tp m ()
forall (m :: * -> *) tp u.
(MonadUnliftIO m, Transport tp) =>
BaseClientT u tp m ()
close
    Just r :: Bool
r  -> Bool -> BaseClientT u tp m () -> BaseClientT u tp m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
r BaseClientT u tp m ()
forall (m :: * -> *) tp u.
(MonadUnliftIO m, Transport tp) =>
BaseClientT u tp m ()
close

getClientEnv :: (Monad m, Transport tp) => BaseClientT u tp m (BaseClientEnv u tp)
getClientEnv :: BaseClientT u tp m (BaseClientEnv u tp)
getClientEnv = BaseClientT u tp m (BaseClientEnv u tp)
forall (m :: * -> *) tp u nid k rpkt.
(Monad m, Transport tp) =>
NodeT u nid k rpkt tp m (NodeEnv1 u nid k rpkt tp)
getEnv1