simplex-chat/src/Simplex/Chat/Store/RelayRequests.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Simplex.Chat.Store.RelayRequests
  ( hasPendingRelayRequests,
    getNextPendingRelayRequest,
    updateRelayRequestRetries,
    setRelayRequestErr,
  )
where

import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Time.Clock (UTCTime, getCurrentTime)
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Chat.Types.Shared
import Simplex.Messaging.Agent.Protocol (InvitationId)
import Simplex.Messaging.Agent.Store.AgentStore (getWorkItem, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Util (firstRow')
import Simplex.Messaging.Version
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (Only (..))
import Database.SQLite.Simple.QQ (sql)
#endif

hasPendingRelayRequests :: DB.Connection -> IO Bool
hasPendingRelayRequests db =
  fromOnly . head
    <$> DB.query
      db
      [sql|
        SELECT EXISTS (
          SELECT 1
          FROM groups
          WHERE relay_own_status = ?
            AND relay_request_failed = 0
            AND relay_request_err_reason IS NULL
          LIMIT 1
        )
      |]
      (Only RSInvited)

getNextPendingRelayRequest :: DB.Connection -> IO (Either StoreError (Maybe (GroupId, RelayRequestData)))
getNextPendingRelayRequest db =
  getWorkItem "relay request" getNextRequestGroupId getRelayRequestData (markRelayRequestFailed db)
  where
    getNextRequestGroupId :: IO (Maybe GroupId)
    getNextRequestGroupId =
      maybeFirstRow fromOnly $
        DB.query
          db
          [sql|
            SELECT group_id
            FROM groups
            WHERE relay_own_status = ?
              AND relay_request_failed = 0
              AND relay_request_err_reason IS NULL
            ORDER BY relay_request_execute_at ASC
            LIMIT 1
          |]
          (Only RSInvited)
    getRelayRequestData :: GroupId -> IO (Either StoreError (GroupId, RelayRequestData))
    getRelayRequestData groupId =
      firstRow' toRelayRequestData (SEGroupNotFound groupId) $
        DB.query
          db
          [sql|
            SELECT
              relay_request_inv_id, relay_request_group_link,
              relay_request_peer_chat_min_version, relay_request_peer_chat_max_version,
              relay_request_delay, relay_request_retries, created_at, relay_request_execute_at
            FROM groups
            WHERE group_id = ?
          |]
          (Only groupId)
      where
        toRelayRequestData :: (Maybe InvitationId, Maybe ShortLinkContact, Maybe VersionChat, Maybe VersionChat, Int64, Int, UTCTime, UTCTime) -> Either StoreError (GroupId, RelayRequestData)
        toRelayRequestData = \case
          (Just relayInvId, Just reqGroupLink, Just minV, Just maxV, reqDelay, reqRetries, reqCreatedAt, reqExecuteAt) ->
            Right (groupId, RelayRequestData {relayInvId, reqGroupLink, reqChatVRange = fromMaybe (versionToRange maxV) $ safeVersionRange minV maxV, reqDelay, reqRetries, reqCreatedAt, reqExecuteAt})
          _ -> Left $ SEInternalError "missing relay request data"

updateRelayRequestRetries :: DB.Connection -> GroupId -> Int64 -> UTCTime -> IO ()
updateRelayRequestRetries db groupId delay executeAt = do
  currentTs <- getCurrentTime
  DB.execute
    db
    "UPDATE groups SET relay_request_retries = relay_request_retries + 1, relay_request_delay = ?, relay_request_execute_at = ?, updated_at = ? WHERE group_id = ?"
    (delay, executeAt, currentTs, groupId)

markRelayRequestFailed :: DB.Connection -> GroupId -> IO ()
markRelayRequestFailed db groupId = do
  currentTs <- getCurrentTime
  DB.execute
    db
    "UPDATE groups SET relay_request_failed = 1, updated_at = ? WHERE group_id = ?"
    (currentTs, groupId)

setRelayRequestErr :: DB.Connection -> GroupId -> Text -> IO ()
setRelayRequestErr db groupId errReason = do
  currentTs <- getCurrentTime
  DB.execute
    db
    "UPDATE groups SET relay_request_err_reason = ?, updated_at = ? WHERE group_id = ?"
    (errReason, currentTs, groupId)