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

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

import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Time.Clock (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 :: Connection -> IO Bool
hasPendingRelayRequests Connection
db =
  Only Bool -> Bool
forall a. Only a -> a
fromOnly (Only Bool -> Bool)
-> ([Only Bool] -> Only Bool) -> [Only Bool] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Bool] -> Only Bool
forall a. HasCallStack => [a] -> a
head
    ([Only Bool] -> Bool) -> IO [Only Bool] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> Only RelayStatus -> IO [Only Bool]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
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
        )
      |]
      (RelayStatus -> Only RelayStatus
forall a. a -> Only a
Only RelayStatus
RSInvited)

getNextPendingRelayRequest :: DB.Connection -> IO (Either StoreError (Maybe (GroupId, RelayRequestData)))
getNextPendingRelayRequest :: Connection
-> IO (Either StoreError (Maybe (GroupId, RelayRequestData)))
getNextPendingRelayRequest Connection
db =
  String
-> IO (Maybe GroupId)
-> (GroupId -> IO (Either StoreError (GroupId, RelayRequestData)))
-> (GroupId -> IO ())
-> IO (Either StoreError (Maybe (GroupId, RelayRequestData)))
forall i e a.
(Show i, AnyStoreError e) =>
String
-> IO (Maybe i)
-> (i -> IO (Either e a))
-> (i -> IO ())
-> IO (Either e (Maybe a))
getWorkItem String
"relay request" IO (Maybe GroupId)
getNextRequestGroupId GroupId -> IO (Either StoreError (GroupId, RelayRequestData))
getRelayRequestData (Connection -> GroupId -> IO ()
markRelayRequestFailed Connection
db)
  where
    getNextRequestGroupId :: IO (Maybe GroupId)
    getNextRequestGroupId :: IO (Maybe GroupId)
getNextRequestGroupId =
      (Only GroupId -> GroupId)
-> IO [Only GroupId] -> IO (Maybe GroupId)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only GroupId -> GroupId
forall a. Only a -> a
fromOnly (IO [Only GroupId] -> IO (Maybe GroupId))
-> IO [Only GroupId] -> IO (Maybe GroupId)
forall a b. (a -> b) -> a -> b
$
        Connection -> Query -> Only RelayStatus -> IO [Only GroupId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
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 group_id ASC
            LIMIT 1
          |]
          (RelayStatus -> Only RelayStatus
forall a. a -> Only a
Only RelayStatus
RSInvited)
    getRelayRequestData :: GroupId -> IO (Either StoreError (GroupId, RelayRequestData))
    getRelayRequestData :: GroupId -> IO (Either StoreError (GroupId, RelayRequestData))
getRelayRequestData GroupId
groupId =
      ((Maybe InvitationId, Maybe ShortLinkContact, Maybe VersionChat,
  Maybe VersionChat)
 -> Either StoreError (GroupId, RelayRequestData))
-> StoreError
-> IO
     [(Maybe InvitationId, Maybe ShortLinkContact, Maybe VersionChat,
       Maybe VersionChat)]
-> IO (Either StoreError (GroupId, RelayRequestData))
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (Maybe InvitationId, Maybe ShortLinkContact, Maybe VersionChat,
 Maybe VersionChat)
-> Either StoreError (GroupId, RelayRequestData)
toRelayRequestData (GroupId -> StoreError
SEGroupNotFound GroupId
groupId) (IO
   [(Maybe InvitationId, Maybe ShortLinkContact, Maybe VersionChat,
     Maybe VersionChat)]
 -> IO (Either StoreError (GroupId, RelayRequestData)))
-> IO
     [(Maybe InvitationId, Maybe ShortLinkContact, Maybe VersionChat,
       Maybe VersionChat)]
-> IO (Either StoreError (GroupId, RelayRequestData))
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> Only GroupId
-> IO
     [(Maybe InvitationId, Maybe ShortLinkContact, Maybe VersionChat,
       Maybe VersionChat)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT
              relay_request_inv_id, relay_request_group_link,
              relay_request_peer_chat_min_version, relay_request_peer_chat_max_version
            FROM groups
            WHERE group_id = ?
          |]
          (GroupId -> Only GroupId
forall a. a -> Only a
Only GroupId
groupId)
      where
        toRelayRequestData :: (Maybe InvitationId, Maybe ShortLinkContact, Maybe VersionChat, Maybe VersionChat) -> Either StoreError (GroupId, RelayRequestData)
        toRelayRequestData :: (Maybe InvitationId, Maybe ShortLinkContact, Maybe VersionChat,
 Maybe VersionChat)
-> Either StoreError (GroupId, RelayRequestData)
toRelayRequestData = \case
          (Just InvitationId
relayInvId, Just ShortLinkContact
reqGroupLink, Just VersionChat
minV, Just VersionChat
maxV) ->
            (GroupId, RelayRequestData)
-> Either StoreError (GroupId, RelayRequestData)
forall a b. b -> Either a b
Right (GroupId
groupId, RelayRequestData {InvitationId
relayInvId :: InvitationId
$sel:relayInvId:RelayRequestData :: InvitationId
relayInvId, ShortLinkContact
reqGroupLink :: ShortLinkContact
$sel:reqGroupLink:RelayRequestData :: ShortLinkContact
reqGroupLink, $sel:reqChatVRange:RelayRequestData :: VersionRangeChat
reqChatVRange = VersionRangeChat -> Maybe VersionRangeChat -> VersionRangeChat
forall a. a -> Maybe a -> a
fromMaybe (VersionChat -> VersionRangeChat
forall v. Version v -> VersionRange v
versionToRange VersionChat
maxV) (Maybe VersionRangeChat -> VersionRangeChat)
-> Maybe VersionRangeChat -> VersionRangeChat
forall a b. (a -> b) -> a -> b
$ VersionChat -> VersionChat -> Maybe VersionRangeChat
forall v. Version v -> Version v -> Maybe (VersionRange v)
safeVersionRange VersionChat
minV VersionChat
maxV})
          (Maybe InvitationId, Maybe ShortLinkContact, Maybe VersionChat,
 Maybe VersionChat)
_ -> StoreError -> Either StoreError (GroupId, RelayRequestData)
forall a b. a -> Either a b
Left (StoreError -> Either StoreError (GroupId, RelayRequestData))
-> StoreError -> Either StoreError (GroupId, RelayRequestData)
forall a b. (a -> b) -> a -> b
$ String -> StoreError
SEInternalError String
"missing relay request data"

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

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