{-# LANGUAGE OverloadedStrings #-}

-- | Completed-job archive types. Arbiter archives an acked job when @archiveFor@
-- is positive and removes it after the retention period. Re-enqueue entries with
-- 'Arbiter.Core.HighLevel.reEnqueueFromArchive'.
module Arbiter.Core.Job.Archive
  ( ArchiveJob (..)
  ) where

import Data.Aeson (FromJSON (..), KeyValue (..), ToJSON (..), Value, object, pairs, withObject, (.:), (.:?))
import Data.Int (Int64)
import Data.Time (UTCTime)
import GHC.Generics (Generic)

import Arbiter.Core.Job.DLQ (JobSnapshot)

-- | A completed job in the archive.
data ArchiveJob payload = ArchiveJob
  { forall payload. ArchiveJob payload -> Int64
archivePrimaryKey :: Int64
  -- ^ Archive table primary key. The snapshot keeps its own job id.
  , forall payload. ArchiveJob payload -> UTCTime
completedAt :: UTCTime
  -- ^ When the job was acked and archived.
  , forall payload. ArchiveJob payload -> JobSnapshot payload
jobSnapshot :: JobSnapshot payload
  -- ^ Full job state at completion.
  , forall payload. ArchiveJob payload -> Maybe Value
archivedResult :: Maybe Value
  -- ^ Handler result stored for a completed root job (one with no parent).
  }
  deriving stock (ArchiveJob payload -> ArchiveJob payload -> Bool
(ArchiveJob payload -> ArchiveJob payload -> Bool)
-> (ArchiveJob payload -> ArchiveJob payload -> Bool)
-> Eq (ArchiveJob payload)
forall payload.
Eq payload =>
ArchiveJob payload -> ArchiveJob payload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall payload.
Eq payload =>
ArchiveJob payload -> ArchiveJob payload -> Bool
== :: ArchiveJob payload -> ArchiveJob payload -> Bool
$c/= :: forall payload.
Eq payload =>
ArchiveJob payload -> ArchiveJob payload -> Bool
/= :: ArchiveJob payload -> ArchiveJob payload -> Bool
Eq, (forall x. ArchiveJob payload -> Rep (ArchiveJob payload) x)
-> (forall x. Rep (ArchiveJob payload) x -> ArchiveJob payload)
-> Generic (ArchiveJob payload)
forall x. Rep (ArchiveJob payload) x -> ArchiveJob payload
forall x. ArchiveJob payload -> Rep (ArchiveJob payload) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall payload x. Rep (ArchiveJob payload) x -> ArchiveJob payload
forall payload x. ArchiveJob payload -> Rep (ArchiveJob payload) x
$cfrom :: forall payload x. ArchiveJob payload -> Rep (ArchiveJob payload) x
from :: forall x. ArchiveJob payload -> Rep (ArchiveJob payload) x
$cto :: forall payload x. Rep (ArchiveJob payload) x -> ArchiveJob payload
to :: forall x. Rep (ArchiveJob payload) x -> ArchiveJob payload
Generic, Int -> ArchiveJob payload -> ShowS
[ArchiveJob payload] -> ShowS
ArchiveJob payload -> String
(Int -> ArchiveJob payload -> ShowS)
-> (ArchiveJob payload -> String)
-> ([ArchiveJob payload] -> ShowS)
-> Show (ArchiveJob payload)
forall payload. Show payload => Int -> ArchiveJob payload -> ShowS
forall payload. Show payload => [ArchiveJob payload] -> ShowS
forall payload. Show payload => ArchiveJob payload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall payload. Show payload => Int -> ArchiveJob payload -> ShowS
showsPrec :: Int -> ArchiveJob payload -> ShowS
$cshow :: forall payload. Show payload => ArchiveJob payload -> String
show :: ArchiveJob payload -> String
$cshowList :: forall payload. Show payload => [ArchiveJob payload] -> ShowS
showList :: [ArchiveJob payload] -> ShowS
Show)

instance (ToJSON payload) => ToJSON (ArchiveJob payload) where
  toJSON :: ArchiveJob payload -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (ArchiveJob payload -> [Pair]) -> ArchiveJob payload -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveJob payload -> [Pair]
forall e kv payload.
(KeyValue e kv, ToJSON payload) =>
ArchiveJob payload -> [kv]
archiveJobFields
  toEncoding :: ArchiveJob payload -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (ArchiveJob payload -> Series) -> ArchiveJob payload -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (ArchiveJob payload -> [Series]) -> ArchiveJob payload -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveJob payload -> [Series]
forall e kv payload.
(KeyValue e kv, ToJSON payload) =>
ArchiveJob payload -> [kv]
archiveJobFields

archiveJobFields :: (KeyValue e kv, ToJSON payload) => ArchiveJob payload -> [kv]
archiveJobFields :: forall e kv payload.
(KeyValue e kv, ToJSON payload) =>
ArchiveJob payload -> [kv]
archiveJobFields ArchiveJob payload
archived =
  [ Key
"archivePrimaryKey" Key -> Int64 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ArchiveJob payload -> Int64
forall payload. ArchiveJob payload -> Int64
archivePrimaryKey ArchiveJob payload
archived
  , Key
"completedAt" Key -> UTCTime -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ArchiveJob payload -> UTCTime
forall payload. ArchiveJob payload -> UTCTime
completedAt ArchiveJob payload
archived
  , Key
"jobSnapshot" Key -> JobSnapshot payload -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ArchiveJob payload -> JobSnapshot payload
forall payload. ArchiveJob payload -> JobSnapshot payload
jobSnapshot ArchiveJob payload
archived
  , Key
"result" Key -> Maybe Value -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ArchiveJob payload -> Maybe Value
forall payload. ArchiveJob payload -> Maybe Value
archivedResult ArchiveJob payload
archived
  ]

instance (FromJSON payload) => FromJSON (ArchiveJob payload) where
  parseJSON :: Value -> Parser (ArchiveJob payload)
parseJSON = String
-> (Object -> Parser (ArchiveJob payload))
-> Value
-> Parser (ArchiveJob payload)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ArchiveJob" ((Object -> Parser (ArchiveJob payload))
 -> Value -> Parser (ArchiveJob payload))
-> (Object -> Parser (ArchiveJob payload))
-> Value
-> Parser (ArchiveJob payload)
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    Int64
-> UTCTime
-> JobSnapshot payload
-> Maybe Value
-> ArchiveJob payload
forall payload.
Int64
-> UTCTime
-> JobSnapshot payload
-> Maybe Value
-> ArchiveJob payload
ArchiveJob
      (Int64
 -> UTCTime
 -> JobSnapshot payload
 -> Maybe Value
 -> ArchiveJob payload)
-> Parser Int64
-> Parser
     (UTCTime
      -> JobSnapshot payload -> Maybe Value -> ArchiveJob payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Int64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"archivePrimaryKey"
      Parser
  (UTCTime
   -> JobSnapshot payload -> Maybe Value -> ArchiveJob payload)
-> Parser UTCTime
-> Parser
     (JobSnapshot payload -> Maybe Value -> ArchiveJob payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"completedAt"
      Parser (JobSnapshot payload -> Maybe Value -> ArchiveJob payload)
-> Parser (JobSnapshot payload)
-> Parser (Maybe Value -> ArchiveJob payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (JobSnapshot payload)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jobSnapshot"
      Parser (Maybe Value -> ArchiveJob payload)
-> Parser (Maybe Value) -> Parser (ArchiveJob payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"result"