{-# LANGUAGE OverloadedStrings #-}

-- | Deduplication strategy carried by a job at enqueue.
module Arbiter.Core.Job.Dedup
  ( DedupKey (..)

    -- * Internal

    -- | Internal to the arbiter packages. Not covered by the PVP.
  , dedupParts
  , dedupFromParts
  , dedupStrategyText
  , isReplaceDuplicate
  , dedupFromStrategy
  ) where

import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.=))
import Data.Aeson.Types (Parser)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import GHC.Generics (Generic)

-- | Deduplication strategy, checked on INSERT via @ON CONFLICT@ on the dedup key.
data DedupKey
  = -- | Skip if the main queue table holds a job with this key (@DO NOTHING@).
    -- DLQ and archive rows do not conflict.
    IgnoreDuplicate Text
  | -- | Replace the main queue table's job with this key (@DO UPDATE@), unless it is
    -- in flight (claimed under a live lease), force-cancel-flagged, has a different
    -- parent, or has children. Children in the DLQ count.
    ReplaceDuplicate Text
  deriving stock (DedupKey -> DedupKey -> Bool
(DedupKey -> DedupKey -> Bool)
-> (DedupKey -> DedupKey -> Bool) -> Eq DedupKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DedupKey -> DedupKey -> Bool
== :: DedupKey -> DedupKey -> Bool
$c/= :: DedupKey -> DedupKey -> Bool
/= :: DedupKey -> DedupKey -> Bool
Eq, (forall x. DedupKey -> Rep DedupKey x)
-> (forall x. Rep DedupKey x -> DedupKey) -> Generic DedupKey
forall x. Rep DedupKey x -> DedupKey
forall x. DedupKey -> Rep DedupKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DedupKey -> Rep DedupKey x
from :: forall x. DedupKey -> Rep DedupKey x
$cto :: forall x. Rep DedupKey x -> DedupKey
to :: forall x. Rep DedupKey x -> DedupKey
Generic, Int -> DedupKey -> ShowS
[DedupKey] -> ShowS
DedupKey -> String
(Int -> DedupKey -> ShowS)
-> (DedupKey -> String) -> ([DedupKey] -> ShowS) -> Show DedupKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DedupKey -> ShowS
showsPrec :: Int -> DedupKey -> ShowS
$cshow :: DedupKey -> String
show :: DedupKey -> String
$cshowList :: [DedupKey] -> ShowS
showList :: [DedupKey] -> ShowS
Show)

instance ToJSON DedupKey where
  toJSON :: DedupKey -> Value
toJSON DedupKey
dedup = [Pair] -> Value
object [Key
"key" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DedupKey -> Text
dedupKeyValue DedupKey
dedup, Key
"strategy" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DedupKey -> Text
dedupStrategyText DedupKey
dedup]

instance FromJSON DedupKey where
  parseJSON :: Value -> Parser DedupKey
parseJSON = String -> (Object -> Parser DedupKey) -> Value -> Parser DedupKey
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DedupKey" ((Object -> Parser DedupKey) -> Value -> Parser DedupKey)
-> (Object -> Parser DedupKey) -> Value -> Parser DedupKey
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    key <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"key"
    strategy <- obj .: "strategy" :: Parser Text
    case dedupFromStrategy strategy of
      Just Text -> DedupKey
build -> DedupKey -> Parser DedupKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DedupKey -> Parser DedupKey) -> DedupKey -> Parser DedupKey
forall a b. (a -> b) -> a -> b
$ Text -> DedupKey
build Text
key
      Maybe (Text -> DedupKey)
Nothing -> String -> Parser DedupKey
forall a. HasCallStack => String -> Parser a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail (String -> Parser DedupKey) -> String -> Parser DedupKey
forall a b. (a -> b) -> a -> b
$ String
"Unknown dedup strategy: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
strategy

-- | The @dedup_strategy@ text for a 'DedupKey'.
dedupStrategyText :: DedupKey -> Text
dedupStrategyText :: DedupKey -> Text
dedupStrategyText IgnoreDuplicate {} = Text
"ignore"
dedupStrategyText ReplaceDuplicate {} = Text
"replace"

-- | Whether a job's dedup key replaces a duplicate.
isReplaceDuplicate :: Maybe DedupKey -> Bool
isReplaceDuplicate :: Maybe DedupKey -> Bool
isReplaceDuplicate (Just ReplaceDuplicate {}) = Bool
True
isReplaceDuplicate Maybe DedupKey
_ = Bool
False

-- | The 'DedupKey' constructor for a @dedup_strategy@ text.
dedupFromStrategy :: Text -> Maybe (Text -> DedupKey)
dedupFromStrategy :: Text -> Maybe (Text -> DedupKey)
dedupFromStrategy Text
"ignore" = (Text -> DedupKey) -> Maybe (Text -> DedupKey)
forall a. a -> Maybe a
Just Text -> DedupKey
IgnoreDuplicate
dedupFromStrategy Text
"replace" = (Text -> DedupKey) -> Maybe (Text -> DedupKey)
forall a. a -> Maybe a
Just Text -> DedupKey
ReplaceDuplicate
dedupFromStrategy Text
_ = Maybe (Text -> DedupKey)
forall a. Maybe a
Nothing

dedupKeyValue :: DedupKey -> Text
dedupKeyValue :: DedupKey -> Text
dedupKeyValue (IgnoreDuplicate Text
key) = Text
key
dedupKeyValue (ReplaceDuplicate Text
key) = Text
key

-- | The @dedup_key@ and @dedup_strategy@ column values for a 'DedupKey'.
dedupParts :: Maybe DedupKey -> (Maybe Text, Maybe Text)
dedupParts :: Maybe DedupKey -> (Maybe Text, Maybe Text)
dedupParts Maybe DedupKey
dedup = (DedupKey -> Text
dedupKeyValue (DedupKey -> Text) -> Maybe DedupKey -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DedupKey
dedup, DedupKey -> Text
dedupStrategyText (DedupKey -> Text) -> Maybe DedupKey -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DedupKey
dedup)

-- | The inverse of 'dedupParts'. An unknown or absent strategy reads as ignore.
dedupFromParts :: Maybe Text -> Maybe Text -> Maybe DedupKey
dedupFromParts :: Maybe Text -> Maybe Text -> Maybe DedupKey
dedupFromParts Maybe Text
key Maybe Text
strategy = (Text -> DedupKey) -> Maybe (Text -> DedupKey) -> Text -> DedupKey
forall a. a -> Maybe a -> a
fromMaybe Text -> DedupKey
IgnoreDuplicate (Text -> Maybe (Text -> DedupKey)
dedupFromStrategy (Text -> Maybe (Text -> DedupKey))
-> Maybe Text -> Maybe (Text -> DedupKey)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
strategy) (Text -> DedupKey) -> Maybe Text -> Maybe DedupKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
key