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