-- | 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. CustomTrack -> Rep CustomTrack x)
-> (forall x. Rep CustomTrack x -> CustomTrack)
-> Generic CustomTrack
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
(CustomTrack -> Value)
-> (CustomTrack -> Encoding)
-> ([CustomTrack] -> Value)
-> ([CustomTrack] -> Encoding)
-> ToJSON CustomTrack
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 = CustomTrack -> JobOptions
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 :: JobOptions -> Producer -> arg -> IO JobId
trackPerform JobOptions
options = JobOptions -> Producer -> arg -> IO JobId
forall arg.
(HasCallStack, ToJSON arg) =>
JobOptions -> Producer -> arg -> IO JobId
perform (JobOptions
options JobOptions -> JobOptions -> JobOptions
forall a. Semigroup a => a -> a -> a
<> CustomTrack -> JobOptions
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. JobDetails -> Rep JobDetails x)
-> (forall x. Rep JobDetails x -> JobDetails) -> Generic JobDetails
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 = Options -> Value -> Parser JobDetails
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser JobDetails)
-> Options -> Value -> Parser JobDetails
forall a b. (a -> b) -> a -> b
$ (JobId -> JobId) -> Options
aesonPrefix JobId -> JobId
snakeCase

unknownJobDetails :: JobId -> JobDetails
unknownJobDetails :: JobId -> JobDetails
unknownJobDetails JobId
jid = JobDetails :: JobId
-> Maybe Int
-> Maybe Text
-> JobState
-> Maybe UTCTime
-> JobDetails
JobDetails
  { jdJid :: JobId
jdJid = JobId
jid
  , jdPercent :: Maybe Int
jdPercent = Maybe Int
forall a. Maybe a
Nothing
  , jdDesc :: Maybe Text
jdDesc = Maybe Text
forall a. Maybe a
Nothing
  , jdState :: JobState
jdState = JobState
JobStateUnknown
  , jdUpdatedAt :: Maybe UTCTime
jdUpdatedAt = Maybe UTCTime
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. SetJobDetails -> Rep SetJobDetails x)
-> (forall x. Rep SetJobDetails x -> SetJobDetails)
-> Generic SetJobDetails
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 = Options -> SetJobDetails -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> SetJobDetails -> Value)
-> Options -> SetJobDetails -> Value
forall a b. (a -> b) -> a -> b
$ (JobId -> JobId) -> Options
aesonPrefix JobId -> JobId
snakeCase
  toEncoding :: SetJobDetails -> Encoding
toEncoding = Options -> SetJobDetails -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> SetJobDetails -> Encoding)
-> Options -> SetJobDetails -> Encoding
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 =
  Client
-> ByteString
-> [ByteString]
-> IO (Either JobId (Maybe JobDetails))
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 =
  JobDetails -> Maybe JobDetails -> JobDetails
forall a. a -> Maybe a -> a
fromMaybe (JobId -> JobDetails
unknownJobDetails JobId
jid) (Maybe JobDetails -> JobDetails)
-> (Either JobId (Maybe JobDetails) -> Maybe JobDetails)
-> Either JobId (Maybe JobDetails)
-> JobDetails
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe JobDetails) -> Maybe JobDetails
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe JobDetails) -> Maybe JobDetails)
-> (Either JobId (Maybe JobDetails) -> Maybe (Maybe JobDetails))
-> Either JobId (Maybe JobDetails)
-> Maybe JobDetails
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either JobId (Maybe JobDetails) -> Maybe (Maybe JobDetails)
forall a b. Either a b -> Maybe b
hush (Either JobId (Maybe JobDetails) -> JobDetails)
-> IO (Either JobId (Maybe JobDetails)) -> IO JobDetails
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 :: Producer -> SetJobDetails -> IO ()
trackSet Producer
producer SetJobDetails
details =
  HasCallStack => Client -> ByteString -> [ByteString] -> IO ()
Client -> ByteString -> [ByteString] -> IO ()
commandOK (Producer -> Client
producerClient Producer
producer) ByteString
"TRACK SET" [SetJobDetails -> ByteString
forall a. ToJSON a => a -> ByteString
encode SetJobDetails
details]