-- | Support for the @TRACK@ command (Enterprise only)
--
-- <https://github.com/contribsys/faktory/wiki/Ent-Tracking>
module Faktory.Ent.Tracking
  ( CustomTrack (..)
  , tracked
  , trackPerform
  , JobDetails (..)
  , JobState (..)
  , trackGet
  , trackGetHush
  , SetJobDetails (..)
  , trackSet
  ) where

import Faktory.Prelude

import Control.Error.Util (hush)
import Data.Aeson
import Data.Aeson.Casing
import qualified Data.ByteString.Lazy.Char8 as BSL8
import Data.Maybe (fromMaybe)
import Data.Time (UTCTime)
import Faktory.Client (commandJSON, commandOK)
import Faktory.Job (JobId, JobOptions, custom, perform)
import Faktory.JobState (JobState (..))
import Faktory.Producer
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)

newtype CustomTrack = CustomTrack
  { CustomTrack -> Int
track :: Int
  }
  deriving stock (forall x. Rep CustomTrack x -> CustomTrack
forall x. CustomTrack -> Rep CustomTrack x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CustomTrack x -> CustomTrack
$cfrom :: forall x. CustomTrack -> Rep CustomTrack x
Generic)
  deriving anyclass ([CustomTrack] -> Encoding
[CustomTrack] -> Value
CustomTrack -> Encoding
CustomTrack -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CustomTrack] -> Encoding
$ctoEncodingList :: [CustomTrack] -> Encoding
toJSONList :: [CustomTrack] -> Value
$ctoJSONList :: [CustomTrack] -> Value
toEncoding :: CustomTrack -> Encoding
$ctoEncoding :: CustomTrack -> Encoding
toJSON :: CustomTrack -> Value
$ctoJSON :: CustomTrack -> Value
ToJSON)

tracked :: JobOptions
tracked :: JobOptions
tracked = forall a. ToJSON a => a -> JobOptions
custom (Int -> CustomTrack
CustomTrack Int
1)

-- | 'perform', but adding @{ custom: { track: 1 } }@
--
-- Equivalent to:
--
-- @
-- 'perform' ('custom' $ 'CustomTrack' 1)
-- @
trackPerform
  :: (HasCallStack, ToJSON arg) => JobOptions -> Producer -> arg -> IO JobId
trackPerform :: forall arg.
(HasCallStack, ToJSON arg) =>
JobOptions -> Producer -> arg -> IO JobId
trackPerform JobOptions
options = forall arg.
(HasCallStack, ToJSON arg) =>
JobOptions -> Producer -> arg -> IO JobId
perform (JobOptions
options forall a. Semigroup a => a -> a -> a
<> forall a. ToJSON a => a -> JobOptions
custom (Int -> CustomTrack
CustomTrack Int
1))
{-# DEPRECATED trackPerform "Use ‘perform (options <> tracked)’ instead" #-}

data JobDetails = JobDetails
  { JobDetails -> JobId
jdJid :: JobId
  , JobDetails -> Maybe Int
jdPercent :: Maybe Int
  , JobDetails -> Maybe Text
jdDesc :: Maybe Text
  , JobDetails -> JobState
jdState :: JobState
  , JobDetails -> Maybe UTCTime
jdUpdatedAt :: Maybe UTCTime
  }
  deriving stock (forall x. Rep JobDetails x -> JobDetails
forall x. JobDetails -> Rep JobDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JobDetails x -> JobDetails
$cfrom :: forall x. JobDetails -> Rep JobDetails x
Generic)

instance FromJSON JobDetails where
  parseJSON :: Value -> Parser JobDetails
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON forall a b. (a -> b) -> a -> b
$ (JobId -> JobId) -> Options
aesonPrefix JobId -> JobId
snakeCase

unknownJobDetails :: JobId -> JobDetails
unknownJobDetails :: JobId -> JobDetails
unknownJobDetails JobId
jid =
  JobDetails
    { jdJid :: JobId
jdJid = JobId
jid
    , jdPercent :: Maybe Int
jdPercent = forall a. Maybe a
Nothing
    , jdDesc :: Maybe Text
jdDesc = forall a. Maybe a
Nothing
    , jdState :: JobState
jdState = JobState
JobStateUnknown
    , jdUpdatedAt :: Maybe UTCTime
jdUpdatedAt = forall a. Maybe a
Nothing
    }

data SetJobDetails = SetJobDetails
  { SetJobDetails -> JobId
sjdJid :: JobId
  , SetJobDetails -> Maybe Int
sjdPercent :: Maybe Int
  , SetJobDetails -> Maybe Text
sjdDesc :: Maybe Text
  , SetJobDetails -> Maybe UTCTime
sjdReserveUntil :: Maybe UTCTime
  }
  deriving stock (forall x. Rep SetJobDetails x -> SetJobDetails
forall x. SetJobDetails -> Rep SetJobDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetJobDetails x -> SetJobDetails
$cfrom :: forall x. SetJobDetails -> Rep SetJobDetails x
Generic)

instance ToJSON SetJobDetails where
  toJSON :: SetJobDetails -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON forall a b. (a -> b) -> a -> b
$ (JobId -> JobId) -> Options
aesonPrefix JobId -> JobId
snakeCase
  toEncoding :: SetJobDetails -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding forall a b. (a -> b) -> a -> b
$ (JobId -> JobId) -> Options
aesonPrefix JobId -> JobId
snakeCase

trackGet :: Producer -> JobId -> IO (Either String (Maybe JobDetails))
trackGet :: Producer -> JobId -> IO (Either JobId (Maybe JobDetails))
trackGet Producer
producer JobId
jid =
  forall a.
FromJSON a =>
Client -> ByteString -> [ByteString] -> IO (Either JobId (Maybe a))
commandJSON (Producer -> Client
producerClient Producer
producer) ByteString
"TRACK GET" [JobId -> ByteString
BSL8.pack JobId
jid]

-- | 'trackGet' but mask any failures to 'JobStateUnknown'
trackGetHush :: Producer -> JobId -> IO JobDetails
trackGetHush :: Producer -> JobId -> IO JobDetails
trackGetHush Producer
producer JobId
jid =
  forall a. a -> Maybe a -> a
fromMaybe (JobId -> JobDetails
unknownJobDetails JobId
jid) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Either a b -> Maybe b
hush forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Producer -> JobId -> IO (Either JobId (Maybe JobDetails))
trackGet Producer
producer JobId
jid

trackSet :: HasCallStack => Producer -> SetJobDetails -> IO ()
trackSet :: HasCallStack => Producer -> SetJobDetails -> IO ()
trackSet Producer
producer SetJobDetails
details =
  HasCallStack => Client -> ByteString -> [ByteString] -> IO ()
commandOK (Producer -> Client
producerClient Producer
producer) ByteString
"TRACK SET" [forall a. ToJSON a => a -> ByteString
encode SetJobDetails
details]