{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Types for the @cron_schedules@ table.
--
-- Code-defined defaults and user overrides sit in separate columns. Worker startup
-- upserts the defaults. An override survives every deploy.
module Arbiter.Core.CronSchedule
  ( -- * Types
    CronScheduleRow (..)
  , CronScheduleUpdate (..)

    -- * Effective values
  , effectiveExpression
  , effectiveOverlap
  , effectiveTimezone

    -- * DDL
  , cronSchedulesTable
  , cronSchedulesTableName
  , createCronSchedulesTableSQL
  , addTimezoneColumnSQL
  , addQueueNameColumnSQL
  , addRunRequestedColumnSQL
  , addLastManualRunColumnSQL
  ) where

import Control.Applicative ((<|>))
import Data.Aeson
  ( FromJSON (..)
  , ToJSON (..)
  , genericToEncoding
  , genericToJSON
  , withObject
  , (.:?)
  )
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (UTCTime)
import GHC.Generics (Generic)

import Arbiter.Core.Json (explicitOptionalField, patchOptions)
import Arbiter.Core.SqlLiterals (quoteIdentifier)

-- | A row from the @cron_schedules@ table.
data CronScheduleRow = CronScheduleRow
  { CronScheduleRow -> Text
name :: Text
  , CronScheduleRow -> Text
queueName :: Text
  , CronScheduleRow -> Text
defaultExpression :: Text
  , CronScheduleRow -> Text
defaultOverlap :: Text
  , CronScheduleRow -> Maybe Text
defaultTimezone :: Maybe Text
  -- ^ Code-defined IANA tz name. @NULL@ = UTC.
  , CronScheduleRow -> Maybe Text
overrideExpression :: Maybe Text
  , CronScheduleRow -> Maybe Text
overrideOverlap :: Maybe Text
  , CronScheduleRow -> Maybe Text
overrideTimezone :: Maybe Text
  -- ^ User override. @NULL@ = use default. To force UTC when the default is
  -- not UTC, set to @\"UTC\"@.
  , CronScheduleRow -> Bool
enabled :: Bool
  , CronScheduleRow -> Maybe UTCTime
lastFiredAt :: Maybe UTCTime
  , CronScheduleRow -> Maybe UTCTime
lastCheckedAt :: Maybe UTCTime
  , CronScheduleRow -> Maybe UTCTime
runRequestedAt :: Maybe UTCTime
  -- ^ Manual run awaiting a worker pool. @NULL@ = none pending.
  , CronScheduleRow -> Maybe UTCTime
lastManualRunAt :: Maybe UTCTime
  -- ^ When a manual run last fired a job. @NULL@ = never.
  , CronScheduleRow -> UTCTime
createdAt :: UTCTime
  , CronScheduleRow -> UTCTime
updatedAt :: UTCTime
  }
  deriving stock (CronScheduleRow -> CronScheduleRow -> Bool
(CronScheduleRow -> CronScheduleRow -> Bool)
-> (CronScheduleRow -> CronScheduleRow -> Bool)
-> Eq CronScheduleRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CronScheduleRow -> CronScheduleRow -> Bool
== :: CronScheduleRow -> CronScheduleRow -> Bool
$c/= :: CronScheduleRow -> CronScheduleRow -> Bool
/= :: CronScheduleRow -> CronScheduleRow -> Bool
Eq, (forall x. CronScheduleRow -> Rep CronScheduleRow x)
-> (forall x. Rep CronScheduleRow x -> CronScheduleRow)
-> Generic CronScheduleRow
forall x. Rep CronScheduleRow x -> CronScheduleRow
forall x. CronScheduleRow -> Rep CronScheduleRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CronScheduleRow -> Rep CronScheduleRow x
from :: forall x. CronScheduleRow -> Rep CronScheduleRow x
$cto :: forall x. Rep CronScheduleRow x -> CronScheduleRow
to :: forall x. Rep CronScheduleRow x -> CronScheduleRow
Generic, Int -> CronScheduleRow -> ShowS
[CronScheduleRow] -> ShowS
CronScheduleRow -> String
(Int -> CronScheduleRow -> ShowS)
-> (CronScheduleRow -> String)
-> ([CronScheduleRow] -> ShowS)
-> Show CronScheduleRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CronScheduleRow -> ShowS
showsPrec :: Int -> CronScheduleRow -> ShowS
$cshow :: CronScheduleRow -> String
show :: CronScheduleRow -> String
$cshowList :: [CronScheduleRow] -> ShowS
showList :: [CronScheduleRow] -> ShowS
Show)
  deriving anyclass (Maybe CronScheduleRow
Value -> Parser [CronScheduleRow]
Value -> Parser CronScheduleRow
(Value -> Parser CronScheduleRow)
-> (Value -> Parser [CronScheduleRow])
-> Maybe CronScheduleRow
-> FromJSON CronScheduleRow
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser CronScheduleRow
parseJSON :: Value -> Parser CronScheduleRow
$cparseJSONList :: Value -> Parser [CronScheduleRow]
parseJSONList :: Value -> Parser [CronScheduleRow]
$comittedField :: Maybe CronScheduleRow
omittedField :: Maybe CronScheduleRow
FromJSON, [CronScheduleRow] -> Value
[CronScheduleRow] -> Encoding
CronScheduleRow -> Bool
CronScheduleRow -> Value
CronScheduleRow -> Encoding
(CronScheduleRow -> Value)
-> (CronScheduleRow -> Encoding)
-> ([CronScheduleRow] -> Value)
-> ([CronScheduleRow] -> Encoding)
-> (CronScheduleRow -> Bool)
-> ToJSON CronScheduleRow
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CronScheduleRow -> Value
toJSON :: CronScheduleRow -> Value
$ctoEncoding :: CronScheduleRow -> Encoding
toEncoding :: CronScheduleRow -> Encoding
$ctoJSONList :: [CronScheduleRow] -> Value
toJSONList :: [CronScheduleRow] -> Value
$ctoEncodingList :: [CronScheduleRow] -> Encoding
toEncodingList :: [CronScheduleRow] -> Encoding
$comitField :: CronScheduleRow -> Bool
omitField :: CronScheduleRow -> Bool
ToJSON)

-- | The override expression if set, else the default.
effectiveExpression :: CronScheduleRow -> Text
effectiveExpression :: CronScheduleRow -> Text
effectiveExpression CronScheduleRow {defaultExpression :: CronScheduleRow -> Text
defaultExpression = Text
def, overrideExpression :: CronScheduleRow -> Maybe Text
overrideExpression = Maybe Text
mOvr} = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
def Maybe Text
mOvr

-- | The override overlap policy if set, else the default.
effectiveOverlap :: CronScheduleRow -> Text
effectiveOverlap :: CronScheduleRow -> Text
effectiveOverlap CronScheduleRow {defaultOverlap :: CronScheduleRow -> Text
defaultOverlap = Text
def, overrideOverlap :: CronScheduleRow -> Maybe Text
overrideOverlap = Maybe Text
mOvr} = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
def Maybe Text
mOvr

-- | The override timezone if set, else the default. 'Nothing' means UTC.
effectiveTimezone :: CronScheduleRow -> Maybe Text
effectiveTimezone :: CronScheduleRow -> Maybe Text
effectiveTimezone CronScheduleRow {defaultTimezone :: CronScheduleRow -> Maybe Text
defaultTimezone = Maybe Text
mDef, overrideTimezone :: CronScheduleRow -> Maybe Text
overrideTimezone = Maybe Text
mOvr} = Maybe Text
mOvr Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
mDef

-- | A patch over a cron schedule's overrides. 'Nothing' leaves a field unchanged, @Just
-- Nothing@ clears the override back to the default, @Just (Just v)@ sets it.
data CronScheduleUpdate = CronScheduleUpdate
  { CronScheduleUpdate -> Maybe (Maybe Text)
overrideExpression :: Maybe (Maybe Text)
  , CronScheduleUpdate -> Maybe (Maybe Text)
overrideOverlap :: Maybe (Maybe Text)
  , CronScheduleUpdate -> Maybe (Maybe Text)
overrideTimezone :: Maybe (Maybe Text)
  , CronScheduleUpdate -> Maybe Bool
enabled :: Maybe Bool
  }
  deriving stock (CronScheduleUpdate -> CronScheduleUpdate -> Bool
(CronScheduleUpdate -> CronScheduleUpdate -> Bool)
-> (CronScheduleUpdate -> CronScheduleUpdate -> Bool)
-> Eq CronScheduleUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CronScheduleUpdate -> CronScheduleUpdate -> Bool
== :: CronScheduleUpdate -> CronScheduleUpdate -> Bool
$c/= :: CronScheduleUpdate -> CronScheduleUpdate -> Bool
/= :: CronScheduleUpdate -> CronScheduleUpdate -> Bool
Eq, (forall x. CronScheduleUpdate -> Rep CronScheduleUpdate x)
-> (forall x. Rep CronScheduleUpdate x -> CronScheduleUpdate)
-> Generic CronScheduleUpdate
forall x. Rep CronScheduleUpdate x -> CronScheduleUpdate
forall x. CronScheduleUpdate -> Rep CronScheduleUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CronScheduleUpdate -> Rep CronScheduleUpdate x
from :: forall x. CronScheduleUpdate -> Rep CronScheduleUpdate x
$cto :: forall x. Rep CronScheduleUpdate x -> CronScheduleUpdate
to :: forall x. Rep CronScheduleUpdate x -> CronScheduleUpdate
Generic, Int -> CronScheduleUpdate -> ShowS
[CronScheduleUpdate] -> ShowS
CronScheduleUpdate -> String
(Int -> CronScheduleUpdate -> ShowS)
-> (CronScheduleUpdate -> String)
-> ([CronScheduleUpdate] -> ShowS)
-> Show CronScheduleUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CronScheduleUpdate -> ShowS
showsPrec :: Int -> CronScheduleUpdate -> ShowS
$cshow :: CronScheduleUpdate -> String
show :: CronScheduleUpdate -> String
$cshowList :: [CronScheduleUpdate] -> ShowS
showList :: [CronScheduleUpdate] -> ShowS
Show)

instance ToJSON CronScheduleUpdate where
  toJSON :: CronScheduleUpdate -> Value
toJSON = Options -> CronScheduleUpdate -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
patchOptions
  toEncoding :: CronScheduleUpdate -> Encoding
toEncoding = Options -> CronScheduleUpdate -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
patchOptions

-- Plain @.:?@ collapses missing and null for @Maybe (Maybe a)@. 'explicitOptionalField' distinguishes them.
instance FromJSON CronScheduleUpdate where
  parseJSON :: Value -> Parser CronScheduleUpdate
parseJSON = String
-> (Object -> Parser CronScheduleUpdate)
-> Value
-> Parser CronScheduleUpdate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CronScheduleUpdate" ((Object -> Parser CronScheduleUpdate)
 -> Value -> Parser CronScheduleUpdate)
-> (Object -> Parser CronScheduleUpdate)
-> Value
-> Parser CronScheduleUpdate
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    expression <- Object -> Text -> Parser (Maybe (Maybe Text))
forall a. FromJSON a => Object -> Text -> Parser (Maybe (Maybe a))
explicitOptionalField Object
obj Text
"overrideExpression"
    overlap <- explicitOptionalField obj "overrideOverlap"
    timezone <- explicitOptionalField obj "overrideTimezone"
    enabledPatch <- obj .:? "enabled"
    pure
      CronScheduleUpdate
        { overrideExpression = expression
        , overrideOverlap = overlap
        , overrideTimezone = timezone
        , enabled = enabledPatch
        }

-- | Qualified table name for the cron_schedules table.
cronSchedulesTable :: Text -> Text
cronSchedulesTable :: Text -> Text
cronSchedulesTable Text
schemaName = Text -> Text
quoteIdentifier Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cronSchedulesTableName

-- | Bare name of the cron table, for catalog lookups by relname.
cronSchedulesTableName :: Text
cronSchedulesTableName :: Text
cronSchedulesTableName = Text
"cron_schedules"

-- | DDL for the @cron_schedules@ table.
createCronSchedulesTableSQL :: Text -> Text
createCronSchedulesTableSQL :: Text -> Text
createCronSchedulesTableSQL Text
schemaName =
  [Text] -> Text
T.unlines
    [ Text
"CREATE TABLE IF NOT EXISTS " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cronSchedulesTable Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
    , Text
"  name TEXT PRIMARY KEY,"
    , Text
"  default_expression TEXT NOT NULL,"
    , Text
"  default_overlap TEXT NOT NULL CHECK (default_overlap IN ('SkipOverlap', 'AllowOverlap')),"
    , Text
"  override_expression TEXT,"
    , Text
"  override_overlap TEXT CHECK (override_overlap IS NULL OR override_overlap IN ('SkipOverlap', 'AllowOverlap')),"
    , Text
"  enabled BOOLEAN NOT NULL DEFAULT TRUE,"
    , Text
"  last_fired_at TIMESTAMPTZ,"
    , Text
"  last_checked_at TIMESTAMPTZ,"
    , Text
"  created_at TIMESTAMPTZ NOT NULL DEFAULT NOW(),"
    , Text
"  updated_at TIMESTAMPTZ NOT NULL DEFAULT NOW()"
    , Text
");"
    ]

-- | Idempotent migration adding the timezone columns to an existing table.
addTimezoneColumnSQL :: Text -> Text
addTimezoneColumnSQL :: Text -> Text
addTimezoneColumnSQL Text
schemaName =
  [Text] -> Text
T.unlines
    [ Text
"ALTER TABLE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cronSchedulesTable Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ADD COLUMN IF NOT EXISTS default_timezone TEXT;"
    , Text
"ALTER TABLE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cronSchedulesTable Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ADD COLUMN IF NOT EXISTS override_timezone TEXT;"
    ]

-- | Migration adding the queue name column.
addQueueNameColumnSQL :: Text -> Text
addQueueNameColumnSQL :: Text -> Text
addQueueNameColumnSQL Text
schemaName =
  Text
"ALTER TABLE "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cronSchedulesTable Text
schemaName
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ADD COLUMN IF NOT EXISTS queue_name TEXT NOT NULL DEFAULT 'pre-migration';"

-- | Idempotent migration adding the manual run-request column to an existing table.
addRunRequestedColumnSQL :: Text -> Text
addRunRequestedColumnSQL :: Text -> Text
addRunRequestedColumnSQL Text
schemaName =
  Text
"ALTER TABLE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cronSchedulesTable Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ADD COLUMN IF NOT EXISTS run_requested_at TIMESTAMPTZ;"

-- | Idempotent migration adding the manual run-completed column to an existing table.
addLastManualRunColumnSQL :: Text -> Text
addLastManualRunColumnSQL :: Text -> Text
addLastManualRunColumnSQL Text
schemaName =
  Text
"ALTER TABLE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cronSchedulesTable Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ADD COLUMN IF NOT EXISTS last_manual_run_at TIMESTAMPTZ;"