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

-- | Types and @postgresql-simple@ operations for the @cron_schedules@ table.
--
-- Since cron operations are administrative metadata (not part of job processing
-- transactions), they use @postgresql-simple@ directly via a 'Connection'
-- parameter -- no 'MonadArbiter' needed.
--
-- The table stores both the code-defined defaults and user overrides separately.
-- On worker init, only the @default_*@ columns are upserted -- user overrides
-- (@override_*@, @enabled@) are preserved.
module Arbiter.Core.CronSchedule
  ( -- * Types
    CronScheduleRow (..)
  , CronScheduleUpdate (..)

    -- * Effective values
  , effectiveExpression
  , effectiveOverlap

    -- * Operations
  , upsertCronScheduleDefault
  , listCronSchedules
  , getCronScheduleByName
  , updateCronSchedule
  , touchCronScheduleLastFired
  , deleteStaleSchedules
  , touchCronSchedulesChecked

    -- * SQL helpers
  , cronSchedulesTable
  , createCronSchedulesTableSQL
  ) where

import Data.Aeson (FromJSON (..), ToJSON, withObject, (.:?))
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (encodeUtf8)
import Data.Time (UTCTime)
import Database.PostgreSQL.Simple
  ( Connection
  , Only (..)
  , execute
  , query
  , query_
  )
import Database.PostgreSQL.Simple.FromRow (FromRow)
import Database.PostgreSQL.Simple.ToRow (ToRow)
import Database.PostgreSQL.Simple.Types (In (..), Query (..))
import GHC.Generics (Generic)

import Arbiter.Core.Job.Schema (quoteIdentifier)

-- | A row from the @cron_schedules@ table.
data CronScheduleRow = CronScheduleRow
  { CronScheduleRow -> Text
name :: Text
  , CronScheduleRow -> Text
defaultExpression :: Text
  , CronScheduleRow -> Text
defaultOverlap :: Text
  , CronScheduleRow -> Maybe Text
overrideExpression :: Maybe Text
  , CronScheduleRow -> Maybe Text
overrideOverlap :: Maybe Text
  , CronScheduleRow -> Bool
enabled :: Bool
  , CronScheduleRow -> Maybe UTCTime
lastFiredAt :: Maybe UTCTime
  , CronScheduleRow -> Maybe UTCTime
lastCheckedAt :: Maybe UTCTime
  , 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, RowParser CronScheduleRow
RowParser CronScheduleRow -> FromRow CronScheduleRow
forall a. RowParser a -> FromRow a
$cfromRow :: RowParser CronScheduleRow
fromRow :: RowParser CronScheduleRow
FromRow, [CronScheduleRow] -> Encoding
[CronScheduleRow] -> Value
CronScheduleRow -> Bool
CronScheduleRow -> Encoding
CronScheduleRow -> Value
(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, CronScheduleRow -> [Action]
(CronScheduleRow -> [Action]) -> ToRow CronScheduleRow
forall a. (a -> [Action]) -> ToRow a
$ctoRow :: CronScheduleRow -> [Action]
toRow :: CronScheduleRow -> [Action]
ToRow)

-- | Effective expression: override if set, else default.
effectiveExpression :: CronScheduleRow -> Text
effectiveExpression :: CronScheduleRow -> Text
effectiveExpression CronScheduleRow
row = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe CronScheduleRow
row.defaultExpression CronScheduleRow
row.overrideExpression

-- | Effective overlap policy: override if set, else default.
effectiveOverlap :: CronScheduleRow -> Text
effectiveOverlap :: CronScheduleRow -> Text
effectiveOverlap CronScheduleRow
row = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe CronScheduleRow
row.defaultOverlap CronScheduleRow
row.overrideOverlap

-- | Patch update for a cron schedule.
--
-- Each field uses @Maybe (Maybe a)@:
--
--   * @Nothing@ = don't change
--   * @Just Nothing@ = reset to default (set column to NULL)
--   * @Just (Just x)@ = set to @x@
data CronScheduleUpdate = CronScheduleUpdate
  { CronScheduleUpdate -> Maybe (Maybe Text)
overrideExpression :: Maybe (Maybe Text)
  , CronScheduleUpdate -> Maybe (Maybe Text)
overrideOverlap :: 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)
  deriving anyclass ([CronScheduleUpdate] -> Encoding
[CronScheduleUpdate] -> Value
CronScheduleUpdate -> Bool
CronScheduleUpdate -> Encoding
CronScheduleUpdate -> Value
(CronScheduleUpdate -> Value)
-> (CronScheduleUpdate -> Encoding)
-> ([CronScheduleUpdate] -> Value)
-> ([CronScheduleUpdate] -> Encoding)
-> (CronScheduleUpdate -> Bool)
-> ToJSON CronScheduleUpdate
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CronScheduleUpdate -> Value
toJSON :: CronScheduleUpdate -> Value
$ctoEncoding :: CronScheduleUpdate -> Encoding
toEncoding :: CronScheduleUpdate -> Encoding
$ctoJSONList :: [CronScheduleUpdate] -> Value
toJSONList :: [CronScheduleUpdate] -> Value
$ctoEncodingList :: [CronScheduleUpdate] -> Encoding
toEncodingList :: [CronScheduleUpdate] -> Encoding
$comitField :: CronScheduleUpdate -> Bool
omitField :: CronScheduleUpdate -> Bool
ToJSON)

-- | Manual instance to distinguish missing keys from @null@ values.
--
-- * Key missing → @Nothing@ (don't change)
-- * Key present with @null@ → @Just Nothing@ (reset to default)
-- * Key present with value → @Just (Just x)@ (set override)
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
o -> do
    oe <-
      if Key -> Object -> Bool
forall a. Key -> KeyMap a -> Bool
KeyMap.member (Text -> Key
Key.fromText Text
"overrideExpression") Object
o
        then Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Maybe Text -> Maybe (Maybe Text))
-> Parser (Maybe Text) -> Parser (Maybe (Maybe Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"overrideExpression"
        else Maybe (Maybe Text) -> Parser (Maybe (Maybe Text))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Maybe Text)
forall a. Maybe a
Nothing
    oo <-
      if KeyMap.member (Key.fromText "overrideOverlap") o
        then Just <$> o .:? "overrideOverlap"
        else pure Nothing
    en <- o .:? "enabled"
    pure
      CronScheduleUpdate
        { overrideExpression = oe
        , overrideOverlap = oo
        , enabled = en
        }

-- | 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
".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
");"
    ]

-- | Upsert a cron schedule's default values.
--
-- INSERT ON CONFLICT (name) DO UPDATE SET default_expression, default_overlap, updated_at.
-- Does NOT touch override_expression, override_overlap, or enabled.
upsertCronScheduleDefault :: Connection -> Text -> Text -> Text -> Text -> IO ()
upsertCronScheduleDefault :: Connection -> Text -> Text -> Text -> Text -> IO ()
upsertCronScheduleDefault Connection
conn Text
schemaName Text
scheduleName Text
defaultExpr Text
defaultOv = do
  let sql :: Query
sql =
        ByteString -> Query
Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
          Text
"INSERT INTO "
            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
" (name, default_expression, default_overlap) VALUES (?, ?, ?)"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ON CONFLICT (name) DO UPDATE SET"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" default_expression = EXCLUDED.default_expression,"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" default_overlap = EXCLUDED.default_overlap,"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" updated_at = NOW()"
  _ <- Connection -> Query -> (Text, Text, Text) -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
execute Connection
conn Query
sql (Text
scheduleName, Text
defaultExpr, Text
defaultOv)
  pure ()

-- | List all cron schedules.
listCronSchedules :: Connection -> Text -> IO [CronScheduleRow]
listCronSchedules :: Connection -> Text -> IO [CronScheduleRow]
listCronSchedules Connection
conn Text
schemaName =
  Connection -> Query -> IO [CronScheduleRow]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn (Query -> IO [CronScheduleRow])
-> (Text -> Query) -> Text -> IO [CronScheduleRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Query
Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> IO [CronScheduleRow]) -> Text -> IO [CronScheduleRow]
forall a b. (a -> b) -> a -> b
$
    Text
"SELECT name, default_expression, default_overlap,"
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" override_expression, override_overlap, enabled,"
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" last_fired_at, last_checked_at, created_at, updated_at"
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" FROM "
      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
" ORDER BY name"

-- | Get a single cron schedule by name.
getCronScheduleByName :: Connection -> Text -> Text -> IO (Maybe CronScheduleRow)
getCronScheduleByName :: Connection -> Text -> Text -> IO (Maybe CronScheduleRow)
getCronScheduleByName Connection
conn Text
schemaName Text
scheduleName = do
  rows <-
    Connection -> Query -> Only Text -> IO [CronScheduleRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query
      Connection
conn
      ( ByteString -> Query
Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
          Text
"SELECT name, default_expression, default_overlap,"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" override_expression, override_overlap, enabled,"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" last_fired_at, last_checked_at, created_at, updated_at"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" FROM "
            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
" WHERE name = ?"
      )
      (Text -> Only Text
forall a. a -> Only a
Only Text
scheduleName)
  pure $ case rows of
    [CronScheduleRow
row] -> CronScheduleRow -> Maybe CronScheduleRow
forall a. a -> Maybe a
Just CronScheduleRow
row
    [CronScheduleRow]
_ -> Maybe CronScheduleRow
forall a. Maybe a
Nothing

-- | Update a cron schedule (patch semantics).
--
-- Returns the number of rows affected (0 = not found, 1 = updated).
updateCronSchedule :: Connection -> Text -> Text -> CronScheduleUpdate -> IO Int64
updateCronSchedule :: Connection -> Text -> Text -> CronScheduleUpdate -> IO Int64
updateCronSchedule Connection
conn Text
schemaName Text
scheduleName CronScheduleUpdate
upd = do
  let ([Text]
clauses, [Text]
params) =
        [([Text], [Text])] -> ([Text], [Text])
forall a. Monoid a => [a] -> a
mconcat
          [ case CronScheduleUpdate
upd.overrideExpression of
              Maybe (Maybe Text)
Nothing -> ([], [])
              Just Maybe Text
Nothing -> ([Text
"override_expression = NULL"], [])
              Just (Just Text
expr) -> ([Text
"override_expression = ?"], [Text
expr])
          , case CronScheduleUpdate
upd.overrideOverlap of
              Maybe (Maybe Text)
Nothing -> ([], [])
              Just Maybe Text
Nothing -> ([Text
"override_overlap = NULL"], [])
              Just (Just Text
ov) -> ([Text
"override_overlap = ?"], [Text
ov])
          , case CronScheduleUpdate
upd.enabled of
              Maybe Bool
Nothing -> ([], [])
              Just Bool
True -> ([Text
"enabled = TRUE"], [])
              Just Bool
False -> ([Text
"enabled = FALSE"], [])
          ]
  if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
clauses
    then Int64 -> IO Int64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
    else do
      let setSQL :: Text
setSQL = Text -> [Text] -> Text
T.intercalate Text
", " [Text]
clauses Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", updated_at = NOW()"
          sql :: Query
sql =
            ByteString -> Query
Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
              Text
"UPDATE "
                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
" SET "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
setSQL
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" WHERE name = ?"
      Connection -> Query -> [Text] -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
execute Connection
conn Query
sql ([Text]
params [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
scheduleName])

-- | Update @last_fired_at@ to NOW().
touchCronScheduleLastFired :: Connection -> Text -> Text -> IO ()
touchCronScheduleLastFired :: Connection -> Text -> Text -> IO ()
touchCronScheduleLastFired Connection
conn Text
schemaName Text
scheduleName = do
  let sql :: Query
sql =
        ByteString -> Query
Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
          Text
"UPDATE "
            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
" SET last_fired_at = NOW(), updated_at = NOW()"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" WHERE name = ?"
  _ <- Connection -> Query -> Only Text -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
execute Connection
conn Query
sql (Text -> Only Text
forall a. a -> Only a
Only Text
scheduleName)
  pure ()

-- | Delete schedules whose names are not in the given list.
--
-- Returns the number of rows deleted. Does nothing if the list is empty.
deleteStaleSchedules :: Connection -> Text -> [Text] -> IO Int64
deleteStaleSchedules :: Connection -> Text -> [Text] -> IO Int64
deleteStaleSchedules Connection
_ Text
_ [] = Int64 -> IO Int64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
deleteStaleSchedules Connection
conn Text
schemaName [Text]
names = do
  let sql :: Query
sql =
        ByteString -> Query
Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
          Text
"DELETE FROM "
            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
" WHERE name NOT IN ?"
  Connection -> Query -> Only (In [Text]) -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
execute Connection
conn Query
sql (In [Text] -> Only (In [Text])
forall a. a -> Only a
Only ([Text] -> In [Text]
forall a. a -> In a
In [Text]
names))

-- | Update @last_checked_at@ to NOW() for the given schedule names.
touchCronSchedulesChecked :: Connection -> Text -> [Text] -> IO ()
touchCronSchedulesChecked :: Connection -> Text -> [Text] -> IO ()
touchCronSchedulesChecked Connection
_ Text
_ [] = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
touchCronSchedulesChecked Connection
conn Text
schemaName [Text]
names = do
  let sql :: Query
sql =
        ByteString -> Query
Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
          Text
"UPDATE "
            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
" SET last_checked_at = NOW()"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" WHERE name IN ?"
  _ <- Connection -> Query -> Only (In [Text]) -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
execute Connection
conn Query
sql (In [Text] -> Only (In [Text])
forall a. a -> Only a
Only ([Text] -> In [Text]
forall a. a -> In a
In [Text]
names))
  pure ()