{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Simplex.Messaging.Agent.Store.AgentStore
  ( -- * Users
    createUserRecord,
    getUserIds,
    deleteUserRecord,
    setUserDeleted,
    deleteUserWithoutConns,
    deleteUsersWithoutConns,
    checkUser,

    -- * Queues and connections
    createServer,
    createNewConn,
    updateNewConnRcv,
    updateNewConnSnd,
    createSndConn,
    getClientNotices,
    updateClientNotices,
    getSubscriptionServers,
    getUserServerRcvQueueSubs,
    unsetQueuesToSubscribe,
    getConnIds,
    getConn,
    getDeletedConn,
    getConns,
    getConnSubs,
    getDeletedConns,
    getConnsData,
    lockConnForUpdate,
    setConnDeleted,
    setConnUserId,
    setConnAgentVersion,
    setConnPQSupport,
    updateNewConnJoin,
    getDeletedConnIds,
    getDeletedWaitingDeliveryConnIds,
    setConnRatchetSync,
    addProcessedRatchetKeyHash,
    checkRatchetKeyHashExists,
    deleteRatchetKeyHashesExpired,
    getRcvConn,
    getRcvQueueById,
    getSndQueueById,
    deleteConn,
    deleteConnRecord,
    upgradeRcvConnToDuplex,
    upgradeSndConnToDuplex,
    addConnRcvQueue,
    addConnSndQueue,
    setRcvQueueStatus,
    setRcvSwitchStatus,
    setRcvQueueDeleted,
    setRcvQueueConfirmedE2E,
    setSndQueueStatus,
    setSndSwitchStatus,
    setRcvQueuePrimary,
    setSndQueuePrimary,
    deleteConnRcvQueue,
    incRcvDeleteErrors,
    deleteConnSndQueue,
    getPrimaryRcvQueue,
    getRcvQueue,
    getDeletedRcvQueue,
    setRcvQueueNtfCreds,
    -- Confirmations
    createConfirmation,
    acceptConfirmation,
    getAcceptedConfirmation,
    removeConfirmations,
    -- Invitations - sent via Contact connections
    createInvitation,
    getInvitation,
    acceptInvitation,
    unacceptInvitation,
    deleteInvitation,
    getInvShortLink,
    getInvShortLinkKeys,
    deleteInvShortLink,
    createInvShortLink,
    setInvShortLinkSndId,
    updateShortLinkCreds,
    -- Messages
    updateRcvIds,
    createRcvMsg,
    setLastBrokerTs,
    updateRcvMsgHash,
    createSndMsgBody,
    updateSndIds,
    createSndMsg,
    updateSndMsgHash,
    createSndMsgDelivery,
    getSndMsgViaRcpt,
    updateSndMsgRcpt,
    getPendingQueueMsg,
    getConnectionsForDelivery,
    getAllSndQueuesForDelivery,
    updatePendingMsgRIState,
    deletePendingMsgs,
    getExpiredSndMessages,
    setMsgUserAck,
    getRcvMsg,
    getLastMsg,
    incMsgRcvAttempts,
    checkRcvMsgHashExists,
    getRcvMsgBrokerTs,
    deleteMsg,
    deleteDeliveredSndMsg,
    deleteSndMsgDelivery,
    deleteRcvMsgHashesExpired,
    deleteSndMsgsExpired,
    -- Double ratchet persistence
    createRatchetX3dhKeys,
    getRatchetX3dhKeys,
    setRatchetX3dhKeys,
    createSndRatchet,
    getSndRatchet,
    createRatchet,
    deleteRatchet,
    getRatchet,
    getRatchetForUpdate,
    getSkippedMsgKeys,
    updateRatchet,
    -- Async commands
    createCommand,
    getPendingCommandServers,
    getAllPendingCommandConns,
    getPendingServerCommand,
    updateCommandServer,
    deleteCommand,
    -- Notification device token persistence
    createNtfToken,
    getSavedNtfToken,
    updateNtfTokenRegistration,
    updateDeviceToken,
    updateNtfMode,
    updateNtfToken,
    removeNtfToken,
    addNtfTokenToDelete,
    deleteExpiredNtfTokensToDelete,
    NtfTokenToDelete,
    getNextNtfTokenToDelete,
    markNtfTokenToDeleteFailed_, -- exported for tests
    getPendingDelTknServers,
    deleteNtfTokenToDelete,
    -- Notification subscription persistence
    NtfSupervisorSub,
    getNtfSubscription,
    createNtfSubscription,
    supervisorUpdateNtfSub,
    supervisorUpdateNtfAction,
    updateNtfSubscription,
    setNullNtfSubscriptionAction,
    deleteNtfSubscription,
    deleteNtfSubscription',
    getNextNtfSubNTFActions,
    markNtfSubActionNtfFailed_, -- exported for tests
    getNextNtfSubSMPActions,
    markNtfSubActionSMPFailed_, -- exported for tests
    getActiveNtfToken,
    getNtfRcvQueue,
    setConnectionNtfs,

    -- * File transfer

    -- Rcv files
    createRcvFile,
    createRcvFileRedirect,
    lockRcvFileForUpdate,
    getRcvFile,
    getRcvFileByEntityId,
    getRcvFileRedirects,
    updateRcvChunkReplicaDelay,
    updateRcvFileChunkReceived,
    updateRcvFileStatus,
    updateRcvFileError,
    updateRcvFileComplete,
    updateRcvFileRedirect,
    updateRcvFileNoTmpPath,
    updateRcvFileDeleted,
    deleteRcvFile',
    getNextRcvChunkToDownload,
    getNextRcvFileToDecrypt,
    getPendingRcvFilesServers,
    getCleanupRcvFilesTmpPaths,
    getCleanupRcvFilesDeleted,
    getRcvFilesExpired,
    -- Snd files
    createSndFile,
    lockSndFileForUpdate,
    getSndFile,
    getSndFileByEntityId,
    getNextSndFileToPrepare,
    updateSndFileError,
    updateSndFileStatus,
    updateSndFileEncrypted,
    updateSndFileComplete,
    updateSndFileNoPrefixPath,
    updateSndFileDeleted,
    deleteSndFile',
    getSndFileDeleted,
    createSndFileReplica,
    createSndFileReplica_, -- exported for tests
    getNextSndChunkToUpload,
    updateSndChunkReplicaDelay,
    addSndChunkReplicaRecipients,
    updateSndChunkReplicaStatus,
    getPendingSndFilesServers,
    getCleanupSndFilesPrefixPaths,
    getCleanupSndFilesDeleted,
    getSndFilesExpired,
    createDeletedSndChunkReplica,
    getNextDeletedSndChunkReplica,
    updateDeletedSndChunkReplicaDelay,
    deleteDeletedSndChunkReplica,
    getPendingDelFilesServers,
    deleteDeletedSndChunkReplicasExpired,
    -- Stats
    updateServersStats,
    getServersStats,
    resetServersStats,

    -- * utilities
    withConnection,
    withTransaction,
    withTransactionPriority,
    firstRow,
    firstRow',
    maybeFirstRow,
    fromOnlyBI,
    getWorkItem,
    getWorkItems,
  )
where

import Control.Logger.Simple
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import Crypto.Random (ChaChaDRG)
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base64.URL as U
import qualified Data.ByteString.Char8 as B
import Data.Functor (($>))
import Data.Int (Int64)
import Data.List (foldl', sortBy)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
import Data.Ord (Down (..))
import qualified Data.Set as S
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
import Data.Word (Word32)
import Network.Socket (ServiceName)
import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
import Simplex.FileTransfer.Description
import Simplex.FileTransfer.Protocol (FileParty (..), SFileParty (..))
import Simplex.FileTransfer.Types
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.RetryInterval (RI2State (..))
import Simplex.Messaging.Agent.Stats
import Simplex.Messaging.Agent.Store
import Simplex.Messaging.Agent.Store.Common
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), FromField (..), ToField (..), SQLError, blobFieldDecoder, fromTextField_)
import Simplex.Messaging.Agent.Store.Entity
import Simplex.Messaging.Client (SMPTransportSession)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), RatchetX448, SkippedMsgDiff (..), SkippedMsgKeys)
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfSubscriptionId, NtfTknStatus (..), NtfTokenId, SMPQueueNtf (..))
import Simplex.Messaging.Notifications.Types
import Simplex.Messaging.Parsers (parseAll)
import Simplex.Messaging.Protocol
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Protocol.Types
import Simplex.Messaging.SystemTime
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.Messaging.Util
import Simplex.Messaging.Version.Internal
import qualified UnliftIO.Exception as E
import UnliftIO.STM
#if defined(dbPostgres)
import Data.List (sortOn)
import Database.PostgreSQL.Simple (In (..), Only (..), Query, (:.) (..))
import Database.PostgreSQL.Simple.Errors (constraintViolation)
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (FromRow (..), Only (..), Query (..), ToRow (..), field, (:.) (..))
import qualified Database.SQLite.Simple as SQL
import Database.SQLite.Simple.QQ (sql)
#endif

checkConstraint :: StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
checkConstraint :: forall a.
StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
checkConstraint StoreError
err IO (Either StoreError a)
action = IO (Either StoreError a)
action IO (Either StoreError a)
-> (SQLError -> IO (Either StoreError a))
-> IO (Either StoreError a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catch` (Either StoreError a -> IO (Either StoreError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError a -> IO (Either StoreError a))
-> (SQLError -> Either StoreError a)
-> SQLError
-> IO (Either StoreError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError a
forall a b. a -> Either a b
Left (StoreError -> Either StoreError a)
-> (SQLError -> StoreError) -> SQLError -> Either StoreError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> SQLError -> StoreError
handleSQLError StoreError
err)

handleSQLError :: StoreError -> SQLError -> StoreError
#if defined(dbPostgres)
handleSQLError err e = case constraintViolation e of
  Just _ -> err
  Nothing -> SEInternal $ bshow e
#else
handleSQLError :: StoreError -> SQLError -> StoreError
handleSQLError StoreError
err SQLError
e
  | SQLError -> Error
SQL.sqlError SQLError
e Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
SQL.ErrorConstraint = StoreError
err
  | Bool
otherwise = SndFileId -> StoreError
SEInternal (SndFileId -> StoreError) -> SndFileId -> StoreError
forall a b. (a -> b) -> a -> b
$ SQLError -> SndFileId
forall a. Show a => a -> SndFileId
bshow SQLError
e
#endif

createUserRecord :: DB.Connection -> IO UserId
createUserRecord :: Connection -> IO Int64
createUserRecord Connection
db = do
  Connection -> Query -> IO ()
DB.execute_ Connection
db Query
"INSERT INTO users DEFAULT VALUES"
  Connection -> IO Int64
insertedRowId Connection
db

getUserIds :: DB.Connection -> IO [UserId]
getUserIds :: Connection -> IO [Int64]
getUserIds Connection
db =
  (Only Int64 -> Int64) -> [Only Int64] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map Only Int64 -> Int64
forall a. Only a -> a
fromOnly ([Only Int64] -> [Int64]) -> IO [Only Int64] -> IO [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> IO [Only Int64]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_ Connection
db Query
"SELECT user_id FROM users WHERE deleted = 0"

checkUser :: DB.Connection -> UserId -> IO (Either StoreError ())
checkUser :: Connection -> Int64 -> IO (Either StoreError ())
checkUser Connection
db Int64
userId =
  (Only Int64 -> ())
-> StoreError -> IO [Only Int64] -> IO (Either StoreError ())
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (\(Only Int64
_ :: Only Int64) -> ()) StoreError
SEUserNotFound (IO [Only Int64] -> IO (Either StoreError ()))
-> IO [Only Int64] -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> (Int64, BoolInt) -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT user_id FROM users WHERE user_id = ? AND deleted = ?" (Int64
userId, Bool -> BoolInt
BI Bool
False)

deleteUserRecord :: DB.Connection -> UserId -> IO (Either StoreError ())
deleteUserRecord :: Connection -> Int64 -> IO (Either StoreError ())
deleteUserRecord Connection
db Int64
userId = ExceptT StoreError IO () -> IO (Either StoreError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO () -> IO (Either StoreError ()))
-> ExceptT StoreError IO () -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ do
  IO (Either StoreError ()) -> ExceptT StoreError IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ()) -> ExceptT StoreError IO ())
-> IO (Either StoreError ()) -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Int64 -> IO (Either StoreError ())
checkUser Connection
db Int64
userId
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM users WHERE user_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
userId)

setUserDeleted :: DB.Connection -> UserId -> IO (Either StoreError [ConnId])
setUserDeleted :: Connection -> Int64 -> IO (Either StoreError [SndFileId])
setUserDeleted Connection
db Int64
userId = ExceptT StoreError IO [SndFileId]
-> IO (Either StoreError [SndFileId])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO [SndFileId]
 -> IO (Either StoreError [SndFileId]))
-> ExceptT StoreError IO [SndFileId]
-> IO (Either StoreError [SndFileId])
forall a b. (a -> b) -> a -> b
$ do
  IO (Either StoreError ()) -> ExceptT StoreError IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ()) -> ExceptT StoreError IO ())
-> IO (Either StoreError ()) -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Int64 -> IO (Either StoreError ())
checkUser Connection
db Int64
userId
  IO [SndFileId] -> ExceptT StoreError IO [SndFileId]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SndFileId] -> ExceptT StoreError IO [SndFileId])
-> IO [SndFileId] -> ExceptT StoreError IO [SndFileId]
forall a b. (a -> b) -> a -> b
$ do
    Connection -> Query -> (BoolInt, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE users SET deleted = ? WHERE user_id = ?" (Bool -> BoolInt
BI Bool
True, Int64
userId)
    (Only SndFileId -> SndFileId) -> [Only SndFileId] -> [SndFileId]
forall a b. (a -> b) -> [a] -> [b]
map Only SndFileId -> SndFileId
forall a. Only a -> a
fromOnly ([Only SndFileId] -> [SndFileId])
-> IO [Only SndFileId] -> IO [SndFileId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> Only Int64 -> IO [Only SndFileId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT conn_id FROM connections WHERE user_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
userId)

deleteUserWithoutConns :: DB.Connection -> UserId -> IO Bool
deleteUserWithoutConns :: Connection -> Int64 -> IO Bool
deleteUserWithoutConns Connection
db Int64
userId = do
  Maybe Int64
userId_ :: Maybe Int64 <-
    (Only Int64 -> Int64) -> IO [Only Int64] -> IO (Maybe Int64)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly (IO [Only Int64] -> IO (Maybe Int64))
-> IO [Only Int64] -> IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$
      Connection -> Query -> (Int64, BoolInt) -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT user_id FROM users u
          WHERE u.user_id = ?
            AND u.deleted = ?
            AND NOT EXISTS (SELECT c.conn_id FROM connections c WHERE c.user_id = u.user_id)
        |]
        (Int64
userId, Bool -> BoolInt
BI Bool
True)
  case Maybe Int64
userId_ of
    Just Int64
_ -> Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM users WHERE user_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
userId) IO () -> Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True
    Maybe Int64
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

deleteUsersWithoutConns :: DB.Connection -> IO [Int64]
deleteUsersWithoutConns :: Connection -> IO [Int64]
deleteUsersWithoutConns Connection
db = do
  [Int64]
userIds <-
    (Only Int64 -> Int64) -> [Only Int64] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map Only Int64 -> Int64
forall a. Only a -> a
fromOnly
      ([Only Int64] -> [Int64]) -> IO [Only Int64] -> IO [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> Only BoolInt -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT user_id FROM users u
          WHERE u.deleted = ?
            AND NOT EXISTS (SELECT c.conn_id FROM connections c WHERE c.user_id = u.user_id)
        |]
        (BoolInt -> Only BoolInt
forall a. a -> Only a
Only (Bool -> BoolInt
BI Bool
True))
  [Int64] -> (Int64 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int64]
userIds ((Int64 -> IO ()) -> IO ()) -> (Int64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM users WHERE user_id = ?" (Only Int64 -> IO ()) -> (Int64 -> Only Int64) -> Int64 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Only Int64
forall a. a -> Only a
Only
  [Int64] -> IO [Int64]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Int64]
userIds

createConn_ ::
  DB.Connection ->
  TVar ChaChaDRG ->
  ConnData ->
  (ConnId -> IO a) ->
  IO (Either StoreError (ConnId, a))
createConn_ :: forall a.
Connection
-> TVar ChaChaDRG
-> ConnData
-> (SndFileId -> IO a)
-> IO (Either StoreError (SndFileId, a))
createConn_ Connection
db TVar ChaChaDRG
gVar ConnData
cData SndFileId -> IO a
create = StoreError
-> IO (Either StoreError (SndFileId, a))
-> IO (Either StoreError (SndFileId, a))
forall a.
StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
checkConstraint StoreError
SEConnDuplicate (IO (Either StoreError (SndFileId, a))
 -> IO (Either StoreError (SndFileId, a)))
-> IO (Either StoreError (SndFileId, a))
-> IO (Either StoreError (SndFileId, a))
forall a b. (a -> b) -> a -> b
$ case ConnData
cData of
  ConnData {$sel:connId:ConnData :: ConnData -> SndFileId
connId = SndFileId
""} -> Connection
-> TVar ChaChaDRG
-> (SndFileId -> IO a)
-> IO (Either StoreError (SndFileId, a))
forall a.
Connection
-> TVar ChaChaDRG
-> (SndFileId -> IO a)
-> IO (Either StoreError (SndFileId, a))
createWithRandomId' Connection
db TVar ChaChaDRG
gVar SndFileId -> IO a
create
  ConnData {SndFileId
$sel:connId:ConnData :: ConnData -> SndFileId
connId :: SndFileId
connId} -> (SndFileId, a) -> Either StoreError (SndFileId, a)
forall a b. b -> Either a b
Right ((SndFileId, a) -> Either StoreError (SndFileId, a))
-> (a -> (SndFileId, a)) -> a -> Either StoreError (SndFileId, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SndFileId
connId,) (a -> Either StoreError (SndFileId, a))
-> IO a -> IO (Either StoreError (SndFileId, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SndFileId -> IO a
create SndFileId
connId

createNewConn :: DB.Connection -> TVar ChaChaDRG -> ConnData -> SConnectionMode c -> IO (Either StoreError ConnId)
createNewConn :: forall (c :: ConnectionMode).
Connection
-> TVar ChaChaDRG
-> ConnData
-> SConnectionMode c
-> IO (Either StoreError SndFileId)
createNewConn Connection
db TVar ChaChaDRG
gVar ConnData
cData SConnectionMode c
cMode = do
  (SndFileId, ()) -> SndFileId
forall a b. (a, b) -> a
fst ((SndFileId, ()) -> SndFileId)
-> IO (Either StoreError (SndFileId, ()))
-> IO (Either StoreError SndFileId)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Connection
-> TVar ChaChaDRG
-> ConnData
-> (SndFileId -> IO ())
-> IO (Either StoreError (SndFileId, ()))
forall a.
Connection
-> TVar ChaChaDRG
-> ConnData
-> (SndFileId -> IO a)
-> IO (Either StoreError (SndFileId, a))
createConn_ Connection
db TVar ChaChaDRG
gVar ConnData
cData (\SndFileId
connId -> Connection -> SndFileId -> ConnData -> SConnectionMode c -> IO ()
forall (c :: ConnectionMode).
Connection -> SndFileId -> ConnData -> SConnectionMode c -> IO ()
createConnRecord Connection
db SndFileId
connId ConnData
cData SConnectionMode c
cMode)

-- TODO [certs rcv] store clientServiceId from NewRcvQueue
updateNewConnRcv :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> IO (Either StoreError RcvQueue)
updateNewConnRcv :: Connection
-> SndFileId
-> NewRcvQueue
-> SubscriptionMode
-> IO (Either StoreError RcvQueue)
updateNewConnRcv Connection
db SndFileId
connId NewRcvQueue
rq SubscriptionMode
subMode =
  Connection -> SndFileId -> IO (Either StoreError SomeConn)
getConnForUpdate Connection
db SndFileId
connId IO (Either StoreError SomeConn)
-> (SomeConn -> IO (Either StoreError RcvQueue))
-> IO (Either StoreError RcvQueue)
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Monad f, Traversable f) =>
m (f a) -> (a -> m (f b)) -> m (f b)
$>>= \case
    (SomeConn SConnType d
_ NewConnection {}) -> IO (Either StoreError RcvQueue)
updateConn
    (SomeConn SConnType d
_ RcvConnection {}) -> IO (Either StoreError RcvQueue)
updateConn -- to allow retries
    (SomeConn SConnType d
c Connection' d RcvQueue SndQueue
_) -> Either StoreError RcvQueue -> IO (Either StoreError RcvQueue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError RcvQueue -> IO (Either StoreError RcvQueue))
-> (ConnType -> Either StoreError RcvQueue)
-> ConnType
-> IO (Either StoreError RcvQueue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError RcvQueue
forall a b. a -> Either a b
Left (StoreError -> Either StoreError RcvQueue)
-> (ConnType -> StoreError)
-> ConnType
-> Either StoreError RcvQueue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> ConnType -> StoreError
SEBadConnType ServiceName
"updateNewConnRcv" (ConnType -> IO (Either StoreError RcvQueue))
-> ConnType -> IO (Either StoreError RcvQueue)
forall a b. (a -> b) -> a -> b
$ SConnType d -> ConnType
forall (c :: ConnType). SConnType c -> ConnType
connType SConnType d
c
  where
    updateConn :: IO (Either StoreError RcvQueue)
    updateConn :: IO (Either StoreError RcvQueue)
updateConn = RcvQueue -> Either StoreError RcvQueue
forall a b. b -> Either a b
Right (RcvQueue -> Either StoreError RcvQueue)
-> IO RcvQueue -> IO (Either StoreError RcvQueue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> SndFileId -> NewRcvQueue -> SubscriptionMode -> IO RcvQueue
addConnRcvQueue_ Connection
db SndFileId
connId NewRcvQueue
rq SubscriptionMode
subMode

updateNewConnSnd :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreError SndQueue)
updateNewConnSnd :: Connection
-> SndFileId -> NewSndQueue -> IO (Either StoreError SndQueue)
updateNewConnSnd Connection
db SndFileId
connId NewSndQueue
sq =
  Connection -> SndFileId -> IO (Either StoreError SomeConn)
getConnForUpdate Connection
db SndFileId
connId IO (Either StoreError SomeConn)
-> (SomeConn -> IO (Either StoreError SndQueue))
-> IO (Either StoreError SndQueue)
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Monad f, Traversable f) =>
m (f a) -> (a -> m (f b)) -> m (f b)
$>>= \case
    (SomeConn SConnType d
_ NewConnection {}) -> IO (Either StoreError SndQueue)
updateConn
    (SomeConn SConnType d
c Connection' d RcvQueue SndQueue
_) -> Either StoreError SndQueue -> IO (Either StoreError SndQueue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError SndQueue -> IO (Either StoreError SndQueue))
-> (ConnType -> Either StoreError SndQueue)
-> ConnType
-> IO (Either StoreError SndQueue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError SndQueue
forall a b. a -> Either a b
Left (StoreError -> Either StoreError SndQueue)
-> (ConnType -> StoreError)
-> ConnType
-> Either StoreError SndQueue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> ConnType -> StoreError
SEBadConnType ServiceName
"updateNewConnSnd" (ConnType -> IO (Either StoreError SndQueue))
-> ConnType -> IO (Either StoreError SndQueue)
forall a b. (a -> b) -> a -> b
$ SConnType d -> ConnType
forall (c :: ConnType). SConnType c -> ConnType
connType SConnType d
c
  where
    updateConn :: IO (Either StoreError SndQueue)
    updateConn :: IO (Either StoreError SndQueue)
updateConn = SndQueue -> Either StoreError SndQueue
forall a b. b -> Either a b
Right (SndQueue -> Either StoreError SndQueue)
-> IO SndQueue -> IO (Either StoreError SndQueue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> SndFileId -> NewSndQueue -> IO SndQueue
addConnSndQueue_ Connection
db SndFileId
connId NewSndQueue
sq

createSndConn :: DB.Connection -> TVar ChaChaDRG -> ConnData -> NewSndQueue -> IO (Either StoreError (ConnId, SndQueue))
createSndConn :: Connection
-> TVar ChaChaDRG
-> ConnData
-> NewSndQueue
-> IO (Either StoreError (SndFileId, SndQueue))
createSndConn Connection
db TVar ChaChaDRG
gVar ConnData
cData q :: NewSndQueue
q@SndQueue {SMPServer
server :: SMPServer
$sel:server:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> SMPServer
server} =
  -- check confirmed snd queue doesn't already exist, to prevent it being deleted by REPLACE in insertSndQueue_
  IO Bool
-> IO (Either StoreError (SndFileId, SndQueue))
-> IO (Either StoreError (SndFileId, SndQueue))
-> IO (Either StoreError (SndFileId, SndQueue))
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (IO Bool -> IO Bool
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Connection -> NewSndQueue -> IO Bool
checkConfirmedSndQueueExists_ Connection
db NewSndQueue
q) (Either StoreError (SndFileId, SndQueue)
-> IO (Either StoreError (SndFileId, SndQueue))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError (SndFileId, SndQueue)
 -> IO (Either StoreError (SndFileId, SndQueue)))
-> Either StoreError (SndFileId, SndQueue)
-> IO (Either StoreError (SndFileId, SndQueue))
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError (SndFileId, SndQueue)
forall a b. a -> Either a b
Left StoreError
SESndQueueExists) (IO (Either StoreError (SndFileId, SndQueue))
 -> IO (Either StoreError (SndFileId, SndQueue)))
-> IO (Either StoreError (SndFileId, SndQueue))
-> IO (Either StoreError (SndFileId, SndQueue))
forall a b. (a -> b) -> a -> b
$
    Connection
-> TVar ChaChaDRG
-> ConnData
-> (SndFileId -> IO SndQueue)
-> IO (Either StoreError (SndFileId, SndQueue))
forall a.
Connection
-> TVar ChaChaDRG
-> ConnData
-> (SndFileId -> IO a)
-> IO (Either StoreError (SndFileId, a))
createConn_ Connection
db TVar ChaChaDRG
gVar ConnData
cData ((SndFileId -> IO SndQueue)
 -> IO (Either StoreError (SndFileId, SndQueue)))
-> (SndFileId -> IO SndQueue)
-> IO (Either StoreError (SndFileId, SndQueue))
forall a b. (a -> b) -> a -> b
$ \SndFileId
connId -> do
      Maybe KeyHash
serverKeyHash_ <- Connection -> SMPServer -> IO (Maybe KeyHash)
createServer Connection
db SMPServer
server
      Connection
-> SndFileId -> ConnData -> SConnectionMode 'CMInvitation -> IO ()
forall (c :: ConnectionMode).
Connection -> SndFileId -> ConnData -> SConnectionMode c -> IO ()
createConnRecord Connection
db SndFileId
connId ConnData
cData SConnectionMode 'CMInvitation
SCMInvitation
      Connection
-> SndFileId -> NewSndQueue -> Maybe KeyHash -> IO SndQueue
insertSndQueue_ Connection
db SndFileId
connId NewSndQueue
q Maybe KeyHash
serverKeyHash_

createConnRecord :: DB.Connection -> ConnId -> ConnData -> SConnectionMode c -> IO ()
createConnRecord :: forall (c :: ConnectionMode).
Connection -> SndFileId -> ConnData -> SConnectionMode c -> IO ()
createConnRecord Connection
db SndFileId
connId ConnData {Int64
userId :: Int64
$sel:userId:ConnData :: ConnData -> Int64
userId, VersionSMPA
connAgentVersion :: VersionSMPA
$sel:connAgentVersion:ConnData :: ConnData -> VersionSMPA
connAgentVersion, Bool
enableNtfs :: Bool
$sel:enableNtfs:ConnData :: ConnData -> Bool
enableNtfs, PQSupport
pqSupport :: PQSupport
$sel:pqSupport:ConnData :: ConnData -> PQSupport
pqSupport} SConnectionMode c
cMode =
  Connection
-> Query
-> (Int64, SndFileId, SConnectionMode c, VersionSMPA, BoolInt,
    PQSupport, BoolInt)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO connections
        (user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, pq_support, duplex_handshake) VALUES (?,?,?,?,?,?,?)
    |]
    (Int64
userId, SndFileId
connId, SConnectionMode c
cMode, VersionSMPA
connAgentVersion, Bool -> BoolInt
BI Bool
enableNtfs, PQSupport
pqSupport, Bool -> BoolInt
BI Bool
True)

deleteConnRecord :: DB.Connection -> ConnId -> IO ()
deleteConnRecord :: Connection -> SndFileId -> IO ()
deleteConnRecord Connection
db SndFileId
connId = Connection -> Query -> Only SndFileId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM connections WHERE conn_id = ?" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)

checkConfirmedSndQueueExists_ :: DB.Connection -> NewSndQueue -> IO Bool
checkConfirmedSndQueueExists_ :: Connection -> NewSndQueue -> IO Bool
checkConfirmedSndQueueExists_ Connection
db SndQueue {SMPServer
$sel:server:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> SMPServer
server :: SMPServer
server, SenderId
sndId :: SenderId
$sel:sndId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> SenderId
sndId} =
  Bool -> (Only BoolInt -> Bool) -> IO [Only BoolInt] -> IO Bool
forall (f :: * -> *) b a.
Functor f =>
b -> (a -> b) -> f [a] -> f b
maybeFirstRow' Bool
False Only BoolInt -> Bool
fromOnlyBI (IO [Only BoolInt] -> IO Bool) -> IO [Only BoolInt] -> IO Bool
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, SenderId, QueueStatus)
-> IO [Only BoolInt]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      ( Query
"SELECT 1 FROM snd_queues WHERE host = ? AND port = ? AND snd_id = ? AND status != ? LIMIT 1"
#if defined(dbPostgres)
          <> " FOR UPDATE"
#endif
      )
      (SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host SMPServer
server, SMPServer -> ServiceName
forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port SMPServer
server, SenderId
sndId, QueueStatus
New)

getRcvConn :: DB.Connection -> SMPServer -> SMP.RecipientId -> IO (Either StoreError (RcvQueue, SomeConn))
getRcvConn :: Connection
-> SMPServer
-> SenderId
-> IO (Either StoreError (RcvQueue, SomeConn))
getRcvConn Connection
db ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port} SenderId
rcvId = ExceptT StoreError IO (RcvQueue, SomeConn)
-> IO (Either StoreError (RcvQueue, SomeConn))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (RcvQueue, SomeConn)
 -> IO (Either StoreError (RcvQueue, SomeConn)))
-> ExceptT StoreError IO (RcvQueue, SomeConn)
-> IO (Either StoreError (RcvQueue, SomeConn))
forall a b. (a -> b) -> a -> b
$ do
  rq :: RcvQueue
rq@RcvQueue {SndFileId
connId :: SndFileId
$sel:connId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SndFileId
connId} <-
    IO (Either StoreError RcvQueue) -> ExceptT StoreError IO RcvQueue
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError RcvQueue) -> ExceptT StoreError IO RcvQueue)
-> (IO
      [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
        SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
        Maybe DhSecretX25519, SenderId, Maybe QueueMode)
       :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
            DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
            Maybe VersionSMPC, Int)
           :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
                Maybe DhSecretX25519)
               :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                   Maybe EncDataBytes)))]
    -> IO (Either StoreError RcvQueue))
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
-> ExceptT StoreError IO RcvQueue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
   SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
   Maybe DhSecretX25519, SenderId, Maybe QueueMode)
  :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
       DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
       Maybe VersionSMPC, Int)
      :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
           Maybe DhSecretX25519)
          :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
              Maybe EncDataBytes))))
 -> RcvQueue)
-> StoreError
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
-> IO (Either StoreError RcvQueue)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
  SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
  Maybe DhSecretX25519, SenderId, Maybe QueueMode)
 :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
      DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
      Maybe VersionSMPC, Int)
     :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
          Maybe DhSecretX25519)
         :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
             Maybe EncDataBytes))))
-> RcvQueue
toRcvQueue StoreError
SEConnNotFound (IO
   [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
     SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
     Maybe DhSecretX25519, SenderId, Maybe QueueMode)
    :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
         DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
         Maybe VersionSMPC, Int)
        :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
             Maybe DhSecretX25519)
            :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                Maybe EncDataBytes)))]
 -> ExceptT StoreError IO RcvQueue)
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
-> ExceptT StoreError IO RcvQueue
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, SenderId)
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
rcvQueueQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE q.host = ? AND q.port = ? AND q.rcv_id = ? AND q.deleted = 0") (NonEmpty TransportHost
host, ServiceName
port, SenderId
rcvId)
  (RcvQueue
rq,) (SomeConn -> (RcvQueue, SomeConn))
-> ExceptT StoreError IO SomeConn
-> ExceptT StoreError IO (RcvQueue, SomeConn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either StoreError SomeConn) -> ExceptT StoreError IO SomeConn
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Connection -> SndFileId -> IO (Either StoreError SomeConn)
getConn Connection
db SndFileId
connId)

-- | Deletes connection, optionally checking for pending snd message deliveries; returns connection id if it was deleted
deleteConn :: DB.Connection -> Maybe NominalDiffTime -> ConnId -> IO (Maybe ConnId)
deleteConn :: Connection
-> Maybe NominalDiffTime -> SndFileId -> IO (Maybe SndFileId)
deleteConn Connection
db Maybe NominalDiffTime
waitDeliveryTimeout_ SndFileId
connId = case Maybe NominalDiffTime
waitDeliveryTimeout_ of
  Maybe NominalDiffTime
Nothing -> IO (Maybe SndFileId)
delete
  Just NominalDiffTime
timeout ->
    IO Bool
-> IO (Maybe SndFileId)
-> IO (Maybe SndFileId)
-> IO (Maybe SndFileId)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM
      IO Bool
checkNoPendingDeliveries_
      IO (Maybe SndFileId)
delete
      ( IO Bool
-> IO (Maybe SndFileId)
-> IO (Maybe SndFileId)
-> IO (Maybe SndFileId)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM
          (NominalDiffTime -> IO Bool
checkWaitDeliveryTimeout_ NominalDiffTime
timeout)
          IO (Maybe SndFileId)
delete
          (Maybe SndFileId -> IO (Maybe SndFileId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SndFileId
forall a. Maybe a
Nothing)
      )
  where
    delete :: IO (Maybe SndFileId)
delete = Connection -> SndFileId -> IO ()
deleteConnRecord Connection
db SndFileId
connId IO () -> Maybe SndFileId -> IO (Maybe SndFileId)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SndFileId -> Maybe SndFileId
forall a. a -> Maybe a
Just SndFileId
connId
    checkNoPendingDeliveries_ :: IO Bool
checkNoPendingDeliveries_ = do
      Maybe Int64
r :: (Maybe Int64) <-
        (Only Int64 -> Int64) -> IO [Only Int64] -> IO (Maybe Int64)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly (IO [Only Int64] -> IO (Maybe Int64))
-> IO [Only Int64] -> IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$
          Connection -> Query -> Only SndFileId -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT 1 FROM snd_message_deliveries WHERE conn_id = ? AND failed = 0 LIMIT 1" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
      Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Maybe Int64 -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int64
r
    checkWaitDeliveryTimeout_ :: NominalDiffTime -> IO Bool
checkWaitDeliveryTimeout_ NominalDiffTime
timeout = do
      UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
timeout) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
      Maybe Int64
r :: (Maybe Int64) <-
        (Only Int64 -> Int64) -> IO [Only Int64] -> IO (Maybe Int64)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly (IO [Only Int64] -> IO (Maybe Int64))
-> IO [Only Int64] -> IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$
          Connection -> Query -> (SndFileId, UTCTime) -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT 1 FROM connections WHERE conn_id = ? AND deleted_at_wait_delivery < ? LIMIT 1" (SndFileId
connId, UTCTime
cutoffTs)
      Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Maybe Int64 -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int64
r

upgradeRcvConnToDuplex :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreError SndQueue)
upgradeRcvConnToDuplex :: Connection
-> SndFileId -> NewSndQueue -> IO (Either StoreError SndQueue)
upgradeRcvConnToDuplex Connection
db SndFileId
connId NewSndQueue
sq =
  Connection -> SndFileId -> IO (Either StoreError SomeConn)
getConnForUpdate Connection
db SndFileId
connId IO (Either StoreError SomeConn)
-> (SomeConn -> IO (Either StoreError SndQueue))
-> IO (Either StoreError SndQueue)
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Monad f, Traversable f) =>
m (f a) -> (a -> m (f b)) -> m (f b)
$>>= \case
    (SomeConn SConnType d
_ RcvConnection {}) -> SndQueue -> Either StoreError SndQueue
forall a b. b -> Either a b
Right (SndQueue -> Either StoreError SndQueue)
-> IO SndQueue -> IO (Either StoreError SndQueue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> SndFileId -> NewSndQueue -> IO SndQueue
addConnSndQueue_ Connection
db SndFileId
connId NewSndQueue
sq
    (SomeConn SConnType d
c Connection' d RcvQueue SndQueue
_) -> Either StoreError SndQueue -> IO (Either StoreError SndQueue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError SndQueue -> IO (Either StoreError SndQueue))
-> (ConnType -> Either StoreError SndQueue)
-> ConnType
-> IO (Either StoreError SndQueue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError SndQueue
forall a b. a -> Either a b
Left (StoreError -> Either StoreError SndQueue)
-> (ConnType -> StoreError)
-> ConnType
-> Either StoreError SndQueue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> ConnType -> StoreError
SEBadConnType ServiceName
"upgradeRcvConnToDuplex" (ConnType -> IO (Either StoreError SndQueue))
-> ConnType -> IO (Either StoreError SndQueue)
forall a b. (a -> b) -> a -> b
$ SConnType d -> ConnType
forall (c :: ConnType). SConnType c -> ConnType
connType SConnType d
c

-- TODO [certs rcv] store clientServiceId from NewRcvQueue
upgradeSndConnToDuplex :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> IO (Either StoreError RcvQueue)
upgradeSndConnToDuplex :: Connection
-> SndFileId
-> NewRcvQueue
-> SubscriptionMode
-> IO (Either StoreError RcvQueue)
upgradeSndConnToDuplex Connection
db SndFileId
connId NewRcvQueue
rq SubscriptionMode
subMode =
  Connection -> SndFileId -> IO (Either StoreError SomeConn)
getConnForUpdate Connection
db SndFileId
connId IO (Either StoreError SomeConn)
-> (Either StoreError SomeConn -> IO (Either StoreError RcvQueue))
-> IO (Either StoreError RcvQueue)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right (SomeConn SConnType d
_ SndConnection {}) -> RcvQueue -> Either StoreError RcvQueue
forall a b. b -> Either a b
Right (RcvQueue -> Either StoreError RcvQueue)
-> IO RcvQueue -> IO (Either StoreError RcvQueue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> SndFileId -> NewRcvQueue -> SubscriptionMode -> IO RcvQueue
addConnRcvQueue_ Connection
db SndFileId
connId NewRcvQueue
rq SubscriptionMode
subMode
    Right (SomeConn SConnType d
c Connection' d RcvQueue SndQueue
_) -> Either StoreError RcvQueue -> IO (Either StoreError RcvQueue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError RcvQueue -> IO (Either StoreError RcvQueue))
-> (ConnType -> Either StoreError RcvQueue)
-> ConnType
-> IO (Either StoreError RcvQueue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError RcvQueue
forall a b. a -> Either a b
Left (StoreError -> Either StoreError RcvQueue)
-> (ConnType -> StoreError)
-> ConnType
-> Either StoreError RcvQueue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> ConnType -> StoreError
SEBadConnType ServiceName
"upgradeSndConnToDuplex" (ConnType -> IO (Either StoreError RcvQueue))
-> ConnType -> IO (Either StoreError RcvQueue)
forall a b. (a -> b) -> a -> b
$ SConnType d -> ConnType
forall (c :: ConnType). SConnType c -> ConnType
connType SConnType d
c
    Either StoreError SomeConn
_ -> Either StoreError RcvQueue -> IO (Either StoreError RcvQueue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError RcvQueue -> IO (Either StoreError RcvQueue))
-> Either StoreError RcvQueue -> IO (Either StoreError RcvQueue)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError RcvQueue
forall a b. a -> Either a b
Left StoreError
SEConnNotFound

-- TODO [certs rcv] store clientServiceId from NewRcvQueue
addConnRcvQueue :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> IO (Either StoreError RcvQueue)
addConnRcvQueue :: Connection
-> SndFileId
-> NewRcvQueue
-> SubscriptionMode
-> IO (Either StoreError RcvQueue)
addConnRcvQueue Connection
db SndFileId
connId NewRcvQueue
rq SubscriptionMode
subMode =
  Connection -> SndFileId -> IO (Either StoreError SomeConn)
getConnForUpdate Connection
db SndFileId
connId IO (Either StoreError SomeConn)
-> (Either StoreError SomeConn -> IO (Either StoreError RcvQueue))
-> IO (Either StoreError RcvQueue)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right (SomeConn SConnType d
_ DuplexConnection {}) -> RcvQueue -> Either StoreError RcvQueue
forall a b. b -> Either a b
Right (RcvQueue -> Either StoreError RcvQueue)
-> IO RcvQueue -> IO (Either StoreError RcvQueue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> SndFileId -> NewRcvQueue -> SubscriptionMode -> IO RcvQueue
addConnRcvQueue_ Connection
db SndFileId
connId NewRcvQueue
rq SubscriptionMode
subMode
    Right (SomeConn SConnType d
c Connection' d RcvQueue SndQueue
_) -> Either StoreError RcvQueue -> IO (Either StoreError RcvQueue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError RcvQueue -> IO (Either StoreError RcvQueue))
-> (ConnType -> Either StoreError RcvQueue)
-> ConnType
-> IO (Either StoreError RcvQueue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError RcvQueue
forall a b. a -> Either a b
Left (StoreError -> Either StoreError RcvQueue)
-> (ConnType -> StoreError)
-> ConnType
-> Either StoreError RcvQueue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> ConnType -> StoreError
SEBadConnType ServiceName
"addConnRcvQueue" (ConnType -> IO (Either StoreError RcvQueue))
-> ConnType -> IO (Either StoreError RcvQueue)
forall a b. (a -> b) -> a -> b
$ SConnType d -> ConnType
forall (c :: ConnType). SConnType c -> ConnType
connType SConnType d
c
    Either StoreError SomeConn
_ -> Either StoreError RcvQueue -> IO (Either StoreError RcvQueue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError RcvQueue -> IO (Either StoreError RcvQueue))
-> Either StoreError RcvQueue -> IO (Either StoreError RcvQueue)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError RcvQueue
forall a b. a -> Either a b
Left StoreError
SEConnNotFound

addConnRcvQueue_ :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> IO RcvQueue
addConnRcvQueue_ :: Connection
-> SndFileId -> NewRcvQueue -> SubscriptionMode -> IO RcvQueue
addConnRcvQueue_ Connection
db SndFileId
connId rq :: NewRcvQueue
rq@RcvQueue {SMPServer
server :: SMPServer
$sel:server:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SMPServer
server} SubscriptionMode
subMode = do
  Maybe KeyHash
serverKeyHash_ <- Connection -> SMPServer -> IO (Maybe KeyHash)
createServer Connection
db SMPServer
server
  Connection
-> SndFileId
-> NewRcvQueue
-> SubscriptionMode
-> Maybe KeyHash
-> IO RcvQueue
insertRcvQueue_ Connection
db SndFileId
connId NewRcvQueue
rq SubscriptionMode
subMode Maybe KeyHash
serverKeyHash_

addConnSndQueue :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreError SndQueue)
addConnSndQueue :: Connection
-> SndFileId -> NewSndQueue -> IO (Either StoreError SndQueue)
addConnSndQueue Connection
db SndFileId
connId NewSndQueue
sq =
  Connection -> SndFileId -> IO (Either StoreError SomeConn)
getConnForUpdate Connection
db SndFileId
connId IO (Either StoreError SomeConn)
-> (Either StoreError SomeConn -> IO (Either StoreError SndQueue))
-> IO (Either StoreError SndQueue)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right (SomeConn SConnType d
_ DuplexConnection {}) -> SndQueue -> Either StoreError SndQueue
forall a b. b -> Either a b
Right (SndQueue -> Either StoreError SndQueue)
-> IO SndQueue -> IO (Either StoreError SndQueue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> SndFileId -> NewSndQueue -> IO SndQueue
addConnSndQueue_ Connection
db SndFileId
connId NewSndQueue
sq
    Right (SomeConn SConnType d
c Connection' d RcvQueue SndQueue
_) -> Either StoreError SndQueue -> IO (Either StoreError SndQueue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError SndQueue -> IO (Either StoreError SndQueue))
-> (ConnType -> Either StoreError SndQueue)
-> ConnType
-> IO (Either StoreError SndQueue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError SndQueue
forall a b. a -> Either a b
Left (StoreError -> Either StoreError SndQueue)
-> (ConnType -> StoreError)
-> ConnType
-> Either StoreError SndQueue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName -> ConnType -> StoreError
SEBadConnType ServiceName
"addConnSndQueue" (ConnType -> IO (Either StoreError SndQueue))
-> ConnType -> IO (Either StoreError SndQueue)
forall a b. (a -> b) -> a -> b
$ SConnType d -> ConnType
forall (c :: ConnType). SConnType c -> ConnType
connType SConnType d
c
    Either StoreError SomeConn
_ -> Either StoreError SndQueue -> IO (Either StoreError SndQueue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError SndQueue -> IO (Either StoreError SndQueue))
-> Either StoreError SndQueue -> IO (Either StoreError SndQueue)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError SndQueue
forall a b. a -> Either a b
Left StoreError
SEConnNotFound

addConnSndQueue_ :: DB.Connection -> ConnId -> NewSndQueue -> IO SndQueue
addConnSndQueue_ :: Connection -> SndFileId -> NewSndQueue -> IO SndQueue
addConnSndQueue_ Connection
db SndFileId
connId sq :: NewSndQueue
sq@SndQueue {SMPServer
$sel:server:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> SMPServer
server :: SMPServer
server} = do
  Maybe KeyHash
serverKeyHash_ <- Connection -> SMPServer -> IO (Maybe KeyHash)
createServer Connection
db SMPServer
server
  Connection
-> SndFileId -> NewSndQueue -> Maybe KeyHash -> IO SndQueue
insertSndQueue_ Connection
db SndFileId
connId NewSndQueue
sq Maybe KeyHash
serverKeyHash_

setRcvQueueStatus :: DB.Connection -> RcvQueue -> QueueStatus -> IO ()
setRcvQueueStatus :: Connection -> RcvQueue -> QueueStatus -> IO ()
setRcvQueueStatus Connection
db RcvQueue {SenderId
rcvId :: SenderId
$sel:rcvId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SenderId
rcvId, $sel:server:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SMPServer
server = ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port}} QueueStatus
status =
  -- ? return error if queue does not exist?
  Connection
-> Query
-> (QueueStatus, NonEmpty TransportHost, ServiceName, SenderId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE rcv_queues
      SET status = ?
      WHERE host = ? AND port = ? AND rcv_id = ?
    |]
    (QueueStatus
status, NonEmpty TransportHost
host, ServiceName
port, SenderId
rcvId)

setRcvSwitchStatus :: DB.Connection -> RcvQueue -> Maybe RcvSwitchStatus -> IO RcvQueue
setRcvSwitchStatus :: Connection -> RcvQueue -> Maybe RcvSwitchStatus -> IO RcvQueue
setRcvSwitchStatus Connection
db rq :: RcvQueue
rq@RcvQueue {SenderId
$sel:rcvId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SenderId
rcvId :: SenderId
rcvId, $sel:server:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SMPServer
server = ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port}} Maybe RcvSwitchStatus
rcvSwchStatus = do
  Connection
-> Query
-> (Maybe RcvSwitchStatus, NonEmpty TransportHost, ServiceName,
    SenderId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE rcv_queues
      SET switch_status = ?
      WHERE host = ? AND port = ? AND rcv_id = ?
    |]
    (Maybe RcvSwitchStatus
rcvSwchStatus, NonEmpty TransportHost
host, ServiceName
port, SenderId
rcvId)
  RcvQueue -> IO RcvQueue
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvQueue
rq {rcvSwchStatus}

setRcvQueueDeleted :: DB.Connection -> RcvQueue -> IO ()
setRcvQueueDeleted :: Connection -> RcvQueue -> IO ()
setRcvQueueDeleted Connection
db RcvQueue {SenderId
$sel:rcvId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SenderId
rcvId :: SenderId
rcvId, $sel:server:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SMPServer
server = ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port}} = do
  Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, SenderId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE rcv_queues
      SET deleted = 1
      WHERE host = ? AND port = ? AND rcv_id = ?
    |]
    (NonEmpty TransportHost
host, ServiceName
port, SenderId
rcvId)

setRcvQueueConfirmedE2E :: DB.Connection -> RcvQueue -> C.DhSecretX25519 -> VersionSMPC -> IO ()
setRcvQueueConfirmedE2E :: Connection -> RcvQueue -> DhSecretX25519 -> VersionSMPC -> IO ()
setRcvQueueConfirmedE2E Connection
db RcvQueue {SenderId
$sel:rcvId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SenderId
rcvId :: SenderId
rcvId, $sel:server:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SMPServer
server = ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port}} DhSecretX25519
e2eDhSecret VersionSMPC
smpClientVersion =
  Connection
-> Query
-> (DhSecretX25519, QueueStatus, VersionSMPC,
    NonEmpty TransportHost, ServiceName, SenderId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE rcv_queues
      SET e2e_dh_secret = ?,
          status = ?,
          smp_client_version = ?
      WHERE host = ? AND port = ? AND rcv_id = ?
    |]
    (DhSecretX25519
e2eDhSecret, QueueStatus
Confirmed, VersionSMPC
smpClientVersion, NonEmpty TransportHost
host, ServiceName
port, SenderId
rcvId)

setSndQueueStatus :: DB.Connection -> SndQueue -> QueueStatus -> IO ()
setSndQueueStatus :: Connection -> SndQueue -> QueueStatus -> IO ()
setSndQueueStatus Connection
db SndQueue {SenderId
$sel:sndId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> SenderId
sndId :: SenderId
sndId, $sel:server:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> SMPServer
server = ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port}} QueueStatus
status =
  -- ? return error if queue does not exist?
  Connection
-> Query
-> (QueueStatus, NonEmpty TransportHost, ServiceName, SenderId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE snd_queues
      SET status = ?
      WHERE host = ? AND port = ? AND snd_id = ?
    |]
    (QueueStatus
status, NonEmpty TransportHost
host, ServiceName
port, SenderId
sndId)

setSndSwitchStatus :: DB.Connection -> SndQueue -> Maybe SndSwitchStatus -> IO SndQueue
setSndSwitchStatus :: Connection -> SndQueue -> Maybe SndSwitchStatus -> IO SndQueue
setSndSwitchStatus Connection
db sq :: SndQueue
sq@SndQueue {SenderId
$sel:sndId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> SenderId
sndId :: SenderId
sndId, $sel:server:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> SMPServer
server = ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port}} Maybe SndSwitchStatus
sndSwchStatus = do
  Connection
-> Query
-> (Maybe SndSwitchStatus, NonEmpty TransportHost, ServiceName,
    SenderId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE snd_queues
      SET switch_status = ?
      WHERE host = ? AND port = ? AND snd_id = ?
    |]
    (Maybe SndSwitchStatus
sndSwchStatus, NonEmpty TransportHost
host, ServiceName
port, SenderId
sndId)
  SndQueue -> IO SndQueue
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndQueue
sq {sndSwchStatus}

setRcvQueuePrimary :: DB.Connection -> ConnId -> RcvQueue -> IO ()
setRcvQueuePrimary :: Connection -> SndFileId -> RcvQueue -> IO ()
setRcvQueuePrimary Connection
db SndFileId
connId RcvQueue {DBEntityId' 'DBStored
dbQueueId :: DBEntityId' 'DBStored
$sel:dbQueueId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> DBEntityId' q
dbQueueId} = do
  Connection -> Query -> (BoolInt, SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_queues SET rcv_primary = ? WHERE conn_id = ?" (Bool -> BoolInt
BI Bool
False, SndFileId
connId)
  Connection
-> Query
-> (BoolInt, Maybe Int64, SndFileId, DBEntityId' 'DBStored)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE rcv_queues SET rcv_primary = ?, replace_rcv_queue_id = ? WHERE conn_id = ? AND rcv_queue_id = ?"
    (Bool -> BoolInt
BI Bool
True, Maybe Int64
forall a. Maybe a
Nothing :: Maybe Int64, SndFileId
connId, DBEntityId' 'DBStored
dbQueueId)

setSndQueuePrimary :: DB.Connection -> ConnId -> SndQueue -> IO ()
setSndQueuePrimary :: Connection -> SndFileId -> SndQueue -> IO ()
setSndQueuePrimary Connection
db SndFileId
connId SndQueue {DBEntityId' 'DBStored
dbQueueId :: DBEntityId' 'DBStored
$sel:dbQueueId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> DBEntityId' q
dbQueueId} = do
  Connection -> Query -> (BoolInt, SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_queues SET snd_primary = ? WHERE conn_id = ?" (Bool -> BoolInt
BI Bool
False, SndFileId
connId)
  Connection
-> Query
-> (BoolInt, Maybe Int64, SndFileId, DBEntityId' 'DBStored)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE snd_queues SET snd_primary = ?, replace_snd_queue_id = ? WHERE conn_id = ? AND snd_queue_id = ?"
    (Bool -> BoolInt
BI Bool
True, Maybe Int64
forall a. Maybe a
Nothing :: Maybe Int64, SndFileId
connId, DBEntityId' 'DBStored
dbQueueId)

incRcvDeleteErrors :: DB.Connection -> RcvQueue -> IO ()
incRcvDeleteErrors :: Connection -> RcvQueue -> IO ()
incRcvDeleteErrors Connection
db RcvQueue {SndFileId
$sel:connId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SndFileId
connId :: SndFileId
connId, DBEntityId' 'DBStored
$sel:dbQueueId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> DBEntityId' q
dbQueueId :: DBEntityId' 'DBStored
dbQueueId} =
  Connection -> Query -> (SndFileId, DBEntityId' 'DBStored) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_queues SET delete_errors = delete_errors + 1 WHERE conn_id = ? AND rcv_queue_id = ?" (SndFileId
connId, DBEntityId' 'DBStored
dbQueueId)

deleteConnRcvQueue :: DB.Connection -> RcvQueue -> IO ()
deleteConnRcvQueue :: Connection -> RcvQueue -> IO ()
deleteConnRcvQueue Connection
db RcvQueue {SndFileId
$sel:connId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SndFileId
connId :: SndFileId
connId, DBEntityId' 'DBStored
$sel:dbQueueId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> DBEntityId' q
dbQueueId :: DBEntityId' 'DBStored
dbQueueId} =
  Connection -> Query -> (SndFileId, DBEntityId' 'DBStored) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM rcv_queues WHERE conn_id = ? AND rcv_queue_id = ?" (SndFileId
connId, DBEntityId' 'DBStored
dbQueueId)

deleteConnSndQueue :: DB.Connection -> ConnId -> SndQueue -> IO ()
deleteConnSndQueue :: Connection -> SndFileId -> SndQueue -> IO ()
deleteConnSndQueue Connection
db SndFileId
connId SndQueue {DBEntityId' 'DBStored
$sel:dbQueueId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> DBEntityId' q
dbQueueId :: DBEntityId' 'DBStored
dbQueueId} = do
  Connection -> Query -> (SndFileId, DBEntityId' 'DBStored) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM snd_queues WHERE conn_id = ? AND snd_queue_id = ?" (SndFileId
connId, DBEntityId' 'DBStored
dbQueueId)
  Connection -> Query -> (SndFileId, DBEntityId' 'DBStored) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM snd_message_deliveries WHERE conn_id = ? AND snd_queue_id = ?" (SndFileId
connId, DBEntityId' 'DBStored
dbQueueId)

getPrimaryRcvQueue :: DB.Connection -> ConnId -> IO (Either StoreError RcvQueue)
getPrimaryRcvQueue :: Connection -> SndFileId -> IO (Either StoreError RcvQueue)
getPrimaryRcvQueue Connection
db SndFileId
connId =
  Either StoreError RcvQueue
-> (NonEmpty RcvQueue -> Either StoreError RcvQueue)
-> Maybe (NonEmpty RcvQueue)
-> Either StoreError RcvQueue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (StoreError -> Either StoreError RcvQueue
forall a b. a -> Either a b
Left StoreError
SEConnNotFound) (RcvQueue -> Either StoreError RcvQueue
forall a b. b -> Either a b
Right (RcvQueue -> Either StoreError RcvQueue)
-> (NonEmpty RcvQueue -> RcvQueue)
-> NonEmpty RcvQueue
-> Either StoreError RcvQueue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty RcvQueue -> RcvQueue
forall a. NonEmpty a -> a
L.head) (Maybe (NonEmpty RcvQueue) -> Either StoreError RcvQueue)
-> IO (Maybe (NonEmpty RcvQueue))
-> IO (Either StoreError RcvQueue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> SndFileId -> IO (Maybe (NonEmpty RcvQueue))
getRcvQueuesByConnId_ Connection
db SndFileId
connId

getRcvQueue :: DB.Connection -> ConnId -> SMPServer -> SMP.RecipientId -> IO (Either StoreError RcvQueue)
getRcvQueue :: Connection
-> SndFileId
-> SMPServer
-> SenderId
-> IO (Either StoreError RcvQueue)
getRcvQueue Connection
db SndFileId
connId (SMPServer NonEmpty TransportHost
host ServiceName
port KeyHash
_) SenderId
rcvId =
  (((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
   SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
   Maybe DhSecretX25519, SenderId, Maybe QueueMode)
  :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
       DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
       Maybe VersionSMPC, Int)
      :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
           Maybe DhSecretX25519)
          :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
              Maybe EncDataBytes))))
 -> RcvQueue)
-> StoreError
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
-> IO (Either StoreError RcvQueue)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
  SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
  Maybe DhSecretX25519, SenderId, Maybe QueueMode)
 :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
      DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
      Maybe VersionSMPC, Int)
     :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
          Maybe DhSecretX25519)
         :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
             Maybe EncDataBytes))))
-> RcvQueue
toRcvQueue StoreError
SEConnNotFound (IO
   [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
     SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
     Maybe DhSecretX25519, SenderId, Maybe QueueMode)
    :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
         DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
         Maybe VersionSMPC, Int)
        :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
             Maybe DhSecretX25519)
            :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                Maybe EncDataBytes)))]
 -> IO (Either StoreError RcvQueue))
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
-> IO (Either StoreError RcvQueue)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (SndFileId, NonEmpty TransportHost, ServiceName, SenderId)
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
rcvQueueQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE q.conn_id = ? AND q.host = ? AND q.port = ? AND q.rcv_id = ? AND q.deleted = 0") (SndFileId
connId, NonEmpty TransportHost
host, ServiceName
port, SenderId
rcvId)

getDeletedRcvQueue :: DB.Connection -> ConnId -> SMPServer -> SMP.RecipientId -> IO (Either StoreError RcvQueue)
getDeletedRcvQueue :: Connection
-> SndFileId
-> SMPServer
-> SenderId
-> IO (Either StoreError RcvQueue)
getDeletedRcvQueue Connection
db SndFileId
connId (SMPServer NonEmpty TransportHost
host ServiceName
port KeyHash
_) SenderId
rcvId =
  (((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
   SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
   Maybe DhSecretX25519, SenderId, Maybe QueueMode)
  :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
       DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
       Maybe VersionSMPC, Int)
      :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
           Maybe DhSecretX25519)
          :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
              Maybe EncDataBytes))))
 -> RcvQueue)
-> StoreError
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
-> IO (Either StoreError RcvQueue)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
  SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
  Maybe DhSecretX25519, SenderId, Maybe QueueMode)
 :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
      DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
      Maybe VersionSMPC, Int)
     :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
          Maybe DhSecretX25519)
         :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
             Maybe EncDataBytes))))
-> RcvQueue
toRcvQueue StoreError
SEConnNotFound (IO
   [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
     SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
     Maybe DhSecretX25519, SenderId, Maybe QueueMode)
    :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
         DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
         Maybe VersionSMPC, Int)
        :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
             Maybe DhSecretX25519)
            :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                Maybe EncDataBytes)))]
 -> IO (Either StoreError RcvQueue))
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
-> IO (Either StoreError RcvQueue)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (SndFileId, NonEmpty TransportHost, ServiceName, SenderId)
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
rcvQueueQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE q.conn_id = ? AND q.host = ? AND q.port = ? AND q.rcv_id = ? AND q.deleted = 1") (SndFileId
connId, NonEmpty TransportHost
host, ServiceName
port, SenderId
rcvId)

setRcvQueueNtfCreds :: DB.Connection -> ConnId -> Maybe ClientNtfCreds -> IO ()
setRcvQueueNtfCreds :: Connection -> SndFileId -> Maybe ClientNtfCreds -> IO ()
setRcvQueueNtfCreds Connection
db SndFileId
connId Maybe ClientNtfCreds
clientNtfCreds =
  Connection
-> Query
-> (Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
    Maybe DhSecretX25519, SndFileId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE rcv_queues
      SET ntf_public_key = ?, ntf_private_key = ?, ntf_id = ?, rcv_ntf_dh_secret = ?
      WHERE conn_id = ?
    |]
    (Maybe NtfPublicAuthKey
ntfPublicKey_, Maybe APrivateAuthKey
ntfPrivateKey_, Maybe SenderId
notifierId_, Maybe DhSecretX25519
rcvNtfDhSecret_, SndFileId
connId)
  where
    (Maybe NtfPublicAuthKey
ntfPublicKey_, Maybe APrivateAuthKey
ntfPrivateKey_, Maybe SenderId
notifierId_, Maybe DhSecretX25519
rcvNtfDhSecret_) = case Maybe ClientNtfCreds
clientNtfCreds of
      Just ClientNtfCreds {NtfPublicAuthKey
ntfPublicKey :: NtfPublicAuthKey
$sel:ntfPublicKey:ClientNtfCreds :: ClientNtfCreds -> NtfPublicAuthKey
ntfPublicKey, APrivateAuthKey
ntfPrivateKey :: APrivateAuthKey
$sel:ntfPrivateKey:ClientNtfCreds :: ClientNtfCreds -> APrivateAuthKey
ntfPrivateKey, SenderId
notifierId :: SenderId
$sel:notifierId:ClientNtfCreds :: ClientNtfCreds -> SenderId
notifierId, DhSecretX25519
rcvNtfDhSecret :: DhSecretX25519
$sel:rcvNtfDhSecret:ClientNtfCreds :: ClientNtfCreds -> DhSecretX25519
rcvNtfDhSecret} -> (NtfPublicAuthKey -> Maybe NtfPublicAuthKey
forall a. a -> Maybe a
Just NtfPublicAuthKey
ntfPublicKey, APrivateAuthKey -> Maybe APrivateAuthKey
forall a. a -> Maybe a
Just APrivateAuthKey
ntfPrivateKey, SenderId -> Maybe SenderId
forall a. a -> Maybe a
Just SenderId
notifierId, DhSecretX25519 -> Maybe DhSecretX25519
forall a. a -> Maybe a
Just DhSecretX25519
rcvNtfDhSecret)
      Maybe ClientNtfCreds
Nothing -> (Maybe NtfPublicAuthKey
forall a. Maybe a
Nothing, Maybe APrivateAuthKey
forall a. Maybe a
Nothing, Maybe SenderId
forall a. Maybe a
Nothing, Maybe DhSecretX25519
forall a. Maybe a
Nothing)

type SMPConfirmationRow = (Maybe SndPublicAuthKey, C.PublicKeyX25519, ConnInfo, Maybe [SMPQueueInfo], Maybe VersionSMPC)

smpConfirmation :: SMPConfirmationRow -> SMPConfirmation
smpConfirmation :: SMPConfirmationRow -> SMPConfirmation
smpConfirmation (Maybe NtfPublicAuthKey
senderKey, PublicKeyX25519
e2ePubKey, SndFileId
connInfo, Maybe [SMPQueueInfo]
smpReplyQueues_, Maybe VersionSMPC
smpClientVersion_) =
  SMPConfirmation
    { Maybe NtfPublicAuthKey
senderKey :: Maybe NtfPublicAuthKey
$sel:senderKey:SMPConfirmation :: Maybe NtfPublicAuthKey
senderKey,
      PublicKeyX25519
e2ePubKey :: PublicKeyX25519
$sel:e2ePubKey:SMPConfirmation :: PublicKeyX25519
e2ePubKey,
      SndFileId
connInfo :: SndFileId
$sel:connInfo:SMPConfirmation :: SndFileId
connInfo,
      $sel:smpReplyQueues:SMPConfirmation :: [SMPQueueInfo]
smpReplyQueues = [SMPQueueInfo] -> Maybe [SMPQueueInfo] -> [SMPQueueInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [SMPQueueInfo]
smpReplyQueues_,
      $sel:smpClientVersion:SMPConfirmation :: VersionSMPC
smpClientVersion = VersionSMPC -> Maybe VersionSMPC -> VersionSMPC
forall a. a -> Maybe a -> a
fromMaybe VersionSMPC
initialSMPClientVersion Maybe VersionSMPC
smpClientVersion_
    }

createConfirmation :: DB.Connection -> TVar ChaChaDRG -> NewConfirmation -> IO (Either StoreError ConfirmationId)
createConfirmation :: Connection
-> TVar ChaChaDRG
-> NewConfirmation
-> IO (Either StoreError SndFileId)
createConfirmation Connection
db TVar ChaChaDRG
gVar NewConfirmation {SndFileId
connId :: SndFileId
$sel:connId:NewConfirmation :: NewConfirmation -> SndFileId
connId, $sel:senderConf:NewConfirmation :: NewConfirmation -> SMPConfirmation
senderConf = SMPConfirmation {Maybe NtfPublicAuthKey
$sel:senderKey:SMPConfirmation :: SMPConfirmation -> Maybe NtfPublicAuthKey
senderKey :: Maybe NtfPublicAuthKey
senderKey, PublicKeyX25519
$sel:e2ePubKey:SMPConfirmation :: SMPConfirmation -> PublicKeyX25519
e2ePubKey :: PublicKeyX25519
e2ePubKey, SndFileId
$sel:connInfo:SMPConfirmation :: SMPConfirmation -> SndFileId
connInfo :: SndFileId
connInfo, [SMPQueueInfo]
$sel:smpReplyQueues:SMPConfirmation :: SMPConfirmation -> [SMPQueueInfo]
smpReplyQueues :: [SMPQueueInfo]
smpReplyQueues, VersionSMPC
$sel:smpClientVersion:SMPConfirmation :: SMPConfirmation -> VersionSMPC
smpClientVersion :: VersionSMPC
smpClientVersion}, RatchetX448
ratchetState :: RatchetX448
$sel:ratchetState:NewConfirmation :: NewConfirmation -> RatchetX448
ratchetState} =
  Connection
-> TVar ChaChaDRG
-> (SndFileId -> IO ())
-> IO (Either StoreError SndFileId)
createWithRandomId Connection
db TVar ChaChaDRG
gVar ((SndFileId -> IO ()) -> IO (Either StoreError SndFileId))
-> (SndFileId -> IO ()) -> IO (Either StoreError SndFileId)
forall a b. (a -> b) -> a -> b
$ \SndFileId
confirmationId ->
    Connection
-> Query
-> (Binary SndFileId, SndFileId, Maybe NtfPublicAuthKey,
    PublicKeyX25519, RatchetX448, Binary SndFileId, [SMPQueueInfo],
    VersionSMPC)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        INSERT INTO conn_confirmations
        (confirmation_id, conn_id, sender_key, e2e_snd_pub_key, ratchet_state, sender_conn_info, smp_reply_queues, smp_client_version, accepted) VALUES (?, ?, ?, ?, ?, ?, ?, ?, 0);
      |]
      (SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
confirmationId, SndFileId
connId, Maybe NtfPublicAuthKey
senderKey, PublicKeyX25519
e2ePubKey, RatchetX448
ratchetState, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
connInfo, [SMPQueueInfo]
smpReplyQueues, VersionSMPC
smpClientVersion)

acceptConfirmation :: DB.Connection -> ConfirmationId -> ConnInfo -> IO (Either StoreError AcceptedConfirmation)
acceptConfirmation :: Connection
-> SndFileId
-> SndFileId
-> IO (Either StoreError AcceptedConfirmation)
acceptConfirmation Connection
db SndFileId
confirmationId SndFileId
ownConnInfo = do
  Connection
-> Query -> (Binary SndFileId, Binary SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE conn_confirmations
      SET accepted = 1,
          own_conn_info = ?
      WHERE confirmation_id = ?
    |]
    (SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
ownConnInfo, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
confirmationId)
  (((SndFileId, RatchetX448) :. SMPConfirmationRow)
 -> AcceptedConfirmation)
-> StoreError
-> IO [(SndFileId, RatchetX448) :. SMPConfirmationRow]
-> IO (Either StoreError AcceptedConfirmation)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((SndFileId, RatchetX448) :. SMPConfirmationRow)
-> AcceptedConfirmation
confirmation StoreError
SEConfirmationNotFound (IO [(SndFileId, RatchetX448) :. SMPConfirmationRow]
 -> IO (Either StoreError AcceptedConfirmation))
-> IO [(SndFileId, RatchetX448) :. SMPConfirmationRow]
-> IO (Either StoreError AcceptedConfirmation)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> Only (Binary SndFileId)
-> IO [(SndFileId, RatchetX448) :. SMPConfirmationRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT conn_id, ratchet_state, sender_key, e2e_snd_pub_key, sender_conn_info, smp_reply_queues, smp_client_version
        FROM conn_confirmations
        WHERE confirmation_id = ?;
      |]
      (Binary SndFileId -> Only (Binary SndFileId)
forall a. a -> Only a
Only (SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
confirmationId))
  where
    confirmation :: ((SndFileId, RatchetX448) :. SMPConfirmationRow)
-> AcceptedConfirmation
confirmation ((SndFileId
connId, RatchetX448
ratchetState) :. SMPConfirmationRow
confRow) =
      AcceptedConfirmation
        { SndFileId
confirmationId :: SndFileId
$sel:confirmationId:AcceptedConfirmation :: SndFileId
confirmationId,
          SndFileId
connId :: SndFileId
$sel:connId:AcceptedConfirmation :: SndFileId
connId,
          $sel:senderConf:AcceptedConfirmation :: SMPConfirmation
senderConf = SMPConfirmationRow -> SMPConfirmation
smpConfirmation SMPConfirmationRow
confRow,
          RatchetX448
ratchetState :: RatchetX448
$sel:ratchetState:AcceptedConfirmation :: RatchetX448
ratchetState,
          SndFileId
ownConnInfo :: SndFileId
$sel:ownConnInfo:AcceptedConfirmation :: SndFileId
ownConnInfo
        }

getAcceptedConfirmation :: DB.Connection -> ConnId -> IO (Either StoreError AcceptedConfirmation)
getAcceptedConfirmation :: Connection
-> SndFileId -> IO (Either StoreError AcceptedConfirmation)
getAcceptedConfirmation Connection
db SndFileId
connId =
  (((SndFileId, RatchetX448, SndFileId) :. SMPConfirmationRow)
 -> AcceptedConfirmation)
-> StoreError
-> IO [(SndFileId, RatchetX448, SndFileId) :. SMPConfirmationRow]
-> IO (Either StoreError AcceptedConfirmation)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((SndFileId, RatchetX448, SndFileId) :. SMPConfirmationRow)
-> AcceptedConfirmation
confirmation StoreError
SEConfirmationNotFound (IO [(SndFileId, RatchetX448, SndFileId) :. SMPConfirmationRow]
 -> IO (Either StoreError AcceptedConfirmation))
-> IO [(SndFileId, RatchetX448, SndFileId) :. SMPConfirmationRow]
-> IO (Either StoreError AcceptedConfirmation)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> Only SndFileId
-> IO [(SndFileId, RatchetX448, SndFileId) :. SMPConfirmationRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT confirmation_id, ratchet_state, own_conn_info, sender_key, e2e_snd_pub_key, sender_conn_info, smp_reply_queues, smp_client_version
        FROM conn_confirmations
        WHERE conn_id = ? AND accepted = 1;
      |]
      (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
  where
    confirmation :: ((SndFileId, RatchetX448, SndFileId) :. SMPConfirmationRow)
-> AcceptedConfirmation
confirmation ((SndFileId
confirmationId, RatchetX448
ratchetState, SndFileId
ownConnInfo) :. SMPConfirmationRow
confRow) =
      AcceptedConfirmation
        { SndFileId
$sel:confirmationId:AcceptedConfirmation :: SndFileId
confirmationId :: SndFileId
confirmationId,
          SndFileId
$sel:connId:AcceptedConfirmation :: SndFileId
connId :: SndFileId
connId,
          $sel:senderConf:AcceptedConfirmation :: SMPConfirmation
senderConf = SMPConfirmationRow -> SMPConfirmation
smpConfirmation SMPConfirmationRow
confRow,
          RatchetX448
$sel:ratchetState:AcceptedConfirmation :: RatchetX448
ratchetState :: RatchetX448
ratchetState,
          SndFileId
$sel:ownConnInfo:AcceptedConfirmation :: SndFileId
ownConnInfo :: SndFileId
ownConnInfo
        }

removeConfirmations :: DB.Connection -> ConnId -> IO ()
removeConfirmations :: Connection -> SndFileId -> IO ()
removeConfirmations Connection
db SndFileId
connId =
  Connection -> Query -> Only SndFileId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM conn_confirmations
      WHERE conn_id = ?
    |]
    (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)

createInvitation :: DB.Connection -> TVar ChaChaDRG -> NewInvitation -> IO (Either StoreError InvitationId)
createInvitation :: Connection
-> TVar ChaChaDRG
-> NewInvitation
-> IO (Either StoreError SndFileId)
createInvitation Connection
db TVar ChaChaDRG
gVar NewInvitation {SndFileId
contactConnId :: SndFileId
$sel:contactConnId:NewInvitation :: NewInvitation -> SndFileId
contactConnId, ConnectionRequestUri 'CMInvitation
connReq :: ConnectionRequestUri 'CMInvitation
$sel:connReq:NewInvitation :: NewInvitation -> ConnectionRequestUri 'CMInvitation
connReq, SndFileId
recipientConnInfo :: SndFileId
$sel:recipientConnInfo:NewInvitation :: NewInvitation -> SndFileId
recipientConnInfo} =
  Connection
-> TVar ChaChaDRG
-> (SndFileId -> IO ())
-> IO (Either StoreError SndFileId)
createWithRandomId Connection
db TVar ChaChaDRG
gVar ((SndFileId -> IO ()) -> IO (Either StoreError SndFileId))
-> (SndFileId -> IO ()) -> IO (Either StoreError SndFileId)
forall a b. (a -> b) -> a -> b
$ \SndFileId
invitationId ->
    Connection
-> Query
-> (Binary SndFileId, SndFileId,
    ConnectionRequestUri 'CMInvitation, Binary SndFileId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        INSERT INTO conn_invitations
        (invitation_id, contact_conn_id, cr_invitation, recipient_conn_info, accepted) VALUES (?, ?, ?, ?, 0);
      |]
      (SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
invitationId, SndFileId
contactConnId, ConnectionRequestUri 'CMInvitation
connReq, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
recipientConnInfo)

getInvitation :: DB.Connection -> String -> InvitationId -> IO (Either StoreError Invitation)
getInvitation :: Connection
-> ServiceName -> SndFileId -> IO (Either StoreError Invitation)
getInvitation Connection
db ServiceName
cxt SndFileId
invitationId =
  ((Maybe SndFileId, ConnectionRequestUri 'CMInvitation, SndFileId,
  Maybe SndFileId, BoolInt)
 -> Invitation)
-> StoreError
-> IO
     [(Maybe SndFileId, ConnectionRequestUri 'CMInvitation, SndFileId,
       Maybe SndFileId, BoolInt)]
-> IO (Either StoreError Invitation)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (Maybe SndFileId, ConnectionRequestUri 'CMInvitation, SndFileId,
 Maybe SndFileId, BoolInt)
-> Invitation
invitation (ServiceName -> SndFileId -> StoreError
SEInvitationNotFound ServiceName
cxt SndFileId
invitationId) (IO
   [(Maybe SndFileId, ConnectionRequestUri 'CMInvitation, SndFileId,
     Maybe SndFileId, BoolInt)]
 -> IO (Either StoreError Invitation))
-> IO
     [(Maybe SndFileId, ConnectionRequestUri 'CMInvitation, SndFileId,
       Maybe SndFileId, BoolInt)]
-> IO (Either StoreError Invitation)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> Only (Binary SndFileId)
-> IO
     [(Maybe SndFileId, ConnectionRequestUri 'CMInvitation, SndFileId,
       Maybe SndFileId, BoolInt)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT contact_conn_id, cr_invitation, recipient_conn_info, own_conn_info, accepted
        FROM conn_invitations
        WHERE invitation_id = ?
          AND accepted = 0
      |]
      (Binary SndFileId -> Only (Binary SndFileId)
forall a. a -> Only a
Only (SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
invitationId))
  where
    invitation :: (Maybe SndFileId, ConnectionRequestUri 'CMInvitation, SndFileId,
 Maybe SndFileId, BoolInt)
-> Invitation
invitation (Maybe SndFileId
contactConnId_, ConnectionRequestUri 'CMInvitation
connReq, SndFileId
recipientConnInfo, Maybe SndFileId
ownConnInfo, BI Bool
accepted) =
      Invitation {SndFileId
invitationId :: SndFileId
$sel:invitationId:Invitation :: SndFileId
invitationId, Maybe SndFileId
contactConnId_ :: Maybe SndFileId
$sel:contactConnId_:Invitation :: Maybe SndFileId
contactConnId_, ConnectionRequestUri 'CMInvitation
connReq :: ConnectionRequestUri 'CMInvitation
$sel:connReq:Invitation :: ConnectionRequestUri 'CMInvitation
connReq, SndFileId
recipientConnInfo :: SndFileId
$sel:recipientConnInfo:Invitation :: SndFileId
recipientConnInfo, Maybe SndFileId
ownConnInfo :: Maybe SndFileId
$sel:ownConnInfo:Invitation :: Maybe SndFileId
ownConnInfo, Bool
accepted :: Bool
$sel:accepted:Invitation :: Bool
accepted}

acceptInvitation :: DB.Connection -> InvitationId -> ConnInfo -> IO ()
acceptInvitation :: Connection -> SndFileId -> SndFileId -> IO ()
acceptInvitation Connection
db SndFileId
invitationId SndFileId
ownConnInfo =
  Connection
-> Query -> (Binary SndFileId, Binary SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE conn_invitations
      SET accepted = 1,
          own_conn_info = ?
      WHERE invitation_id = ?
    |]
    (SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
ownConnInfo, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
invitationId)

unacceptInvitation :: DB.Connection -> InvitationId -> IO ()
unacceptInvitation :: Connection -> SndFileId -> IO ()
unacceptInvitation Connection
db SndFileId
invitationId =
  Connection -> Query -> Only (Binary SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE conn_invitations SET accepted = 0, own_conn_info = NULL WHERE invitation_id = ?" (Binary SndFileId -> Only (Binary SndFileId)
forall a. a -> Only a
Only (SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
invitationId))

deleteInvitation :: DB.Connection -> InvitationId -> IO ()
deleteInvitation :: Connection -> SndFileId -> IO ()
deleteInvitation Connection
db SndFileId
invId =
  Connection -> Query -> Only (Binary SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM conn_invitations WHERE invitation_id = ?" (Binary SndFileId -> Only (Binary SndFileId)
forall a. a -> Only a
Only (SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
invId))

getInvShortLink :: DB.Connection -> SMPServer -> LinkId -> IO (Maybe InvShortLink)
getInvShortLink :: Connection -> SMPServer -> SenderId -> IO (Maybe InvShortLink)
getInvShortLink Connection
db SMPServer
server SenderId
linkId =
  ((LinkKey, APrivateAuthKey, Maybe SenderId) -> InvShortLink)
-> IO [(LinkKey, APrivateAuthKey, Maybe SenderId)]
-> IO (Maybe InvShortLink)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (LinkKey, APrivateAuthKey, Maybe SenderId) -> InvShortLink
toInvShortLink (IO [(LinkKey, APrivateAuthKey, Maybe SenderId)]
 -> IO (Maybe InvShortLink))
-> IO [(LinkKey, APrivateAuthKey, Maybe SenderId)]
-> IO (Maybe InvShortLink)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, SenderId)
-> IO [(LinkKey, APrivateAuthKey, Maybe SenderId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT link_key, snd_private_key, snd_id
        FROM inv_short_links
        WHERE host = ? AND port = ? AND link_id = ?
      |]
      (SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host SMPServer
server, SMPServer -> ServiceName
forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port SMPServer
server, SenderId
linkId)
  where
    toInvShortLink :: (LinkKey, C.APrivateAuthKey, Maybe SenderId) -> InvShortLink
    toInvShortLink :: (LinkKey, APrivateAuthKey, Maybe SenderId) -> InvShortLink
toInvShortLink (LinkKey
linkKey, APrivateAuthKey
sndPrivateKey, Maybe SenderId
sndId) =
      InvShortLink {SMPServer
server :: SMPServer
$sel:server:InvShortLink :: SMPServer
server, SenderId
linkId :: SenderId
$sel:linkId:InvShortLink :: SenderId
linkId, LinkKey
linkKey :: LinkKey
$sel:linkKey:InvShortLink :: LinkKey
linkKey, APrivateAuthKey
sndPrivateKey :: APrivateAuthKey
$sel:sndPrivateKey:InvShortLink :: APrivateAuthKey
sndPrivateKey, Maybe SenderId
sndId :: Maybe SenderId
$sel:sndId:InvShortLink :: Maybe SenderId
sndId}

getInvShortLinkKeys :: DB.Connection -> SMPServer -> SenderId -> IO (Maybe (LinkId, C.APrivateAuthKey))
getInvShortLinkKeys :: Connection
-> SMPServer -> SenderId -> IO (Maybe (SenderId, APrivateAuthKey))
getInvShortLinkKeys Connection
db SMPServer
srv SenderId
sndId =
  ((SenderId, APrivateAuthKey) -> (SenderId, APrivateAuthKey))
-> IO [(SenderId, APrivateAuthKey)]
-> IO (Maybe (SenderId, APrivateAuthKey))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (SenderId, APrivateAuthKey) -> (SenderId, APrivateAuthKey)
forall a. a -> a
id (IO [(SenderId, APrivateAuthKey)]
 -> IO (Maybe (SenderId, APrivateAuthKey)))
-> IO [(SenderId, APrivateAuthKey)]
-> IO (Maybe (SenderId, APrivateAuthKey))
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, SenderId)
-> IO [(SenderId, APrivateAuthKey)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT link_id, snd_private_key
        FROM inv_short_links
        WHERE host = ? AND port = ? AND snd_id = ?
      |]
      (SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host SMPServer
srv, SMPServer -> ServiceName
forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port SMPServer
srv, SenderId
sndId)

deleteInvShortLink :: DB.Connection -> SMPServer -> LinkId -> IO ()
deleteInvShortLink :: Connection -> SMPServer -> SenderId -> IO ()
deleteInvShortLink Connection
db SMPServer
srv SenderId
lnkId =
  Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, SenderId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM inv_short_links WHERE host = ? AND port = ? AND link_id = ?" (SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host SMPServer
srv, SMPServer -> ServiceName
forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port SMPServer
srv, SenderId
lnkId)

createInvShortLink :: DB.Connection -> InvShortLink -> IO ()
createInvShortLink :: Connection -> InvShortLink -> IO ()
createInvShortLink Connection
db InvShortLink {SMPServer
$sel:server:InvShortLink :: InvShortLink -> SMPServer
server :: SMPServer
server, SenderId
$sel:linkId:InvShortLink :: InvShortLink -> SenderId
linkId :: SenderId
linkId, LinkKey
$sel:linkKey:InvShortLink :: InvShortLink -> LinkKey
linkKey :: LinkKey
linkKey, APrivateAuthKey
$sel:sndPrivateKey:InvShortLink :: InvShortLink -> APrivateAuthKey
sndPrivateKey :: APrivateAuthKey
sndPrivateKey, Maybe SenderId
$sel:sndId:InvShortLink :: InvShortLink -> Maybe SenderId
sndId :: Maybe SenderId
sndId} = do
  Maybe KeyHash
serverKeyHash_ <- Connection -> SMPServer -> IO (Maybe KeyHash)
createServer Connection
db SMPServer
server
  Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, Maybe KeyHash, SenderId,
    LinkKey, APrivateAuthKey, Maybe SenderId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO inv_short_links
        (host, port, server_key_hash, link_id, link_key, snd_private_key, snd_id)
      VALUES (?,?,?,?,?,?,?)
      ON CONFLICT (host, port, link_id)
      DO UPDATE SET
        server_key_hash = EXCLUDED.server_key_hash,
        link_key = EXCLUDED.link_key,
        snd_private_key = EXCLUDED.snd_private_key,
        snd_id = EXCLUDED.snd_id
    |]
    (SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host SMPServer
server, SMPServer -> ServiceName
forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port SMPServer
server, Maybe KeyHash
serverKeyHash_, SenderId
linkId, LinkKey
linkKey, APrivateAuthKey
sndPrivateKey, Maybe SenderId
sndId)

setInvShortLinkSndId :: DB.Connection -> InvShortLink -> SenderId -> IO ()
setInvShortLinkSndId :: Connection -> InvShortLink -> SenderId -> IO ()
setInvShortLinkSndId Connection
db InvShortLink {SMPServer
$sel:server:InvShortLink :: InvShortLink -> SMPServer
server :: SMPServer
server, SenderId
$sel:linkId:InvShortLink :: InvShortLink -> SenderId
linkId :: SenderId
linkId} SenderId
sndId =
  Connection
-> Query
-> (SenderId, NonEmpty TransportHost, ServiceName, SenderId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE inv_short_links
      SET snd_id = ?
      WHERE host = ? AND port = ? AND link_id = ?
    |]
    (SenderId
sndId, SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host SMPServer
server, SMPServer -> ServiceName
forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port SMPServer
server, SenderId
linkId)

updateShortLinkCreds :: DB.Connection -> RcvQueue -> ShortLinkCreds -> IO ()
updateShortLinkCreds :: Connection -> RcvQueue -> ShortLinkCreds -> IO ()
updateShortLinkCreds Connection
db RcvQueue {SMPServer
$sel:server:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SMPServer
server :: SMPServer
server, SenderId
$sel:rcvId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SenderId
rcvId :: SenderId
rcvId} ShortLinkCreds {SenderId
shortLinkId :: SenderId
$sel:shortLinkId:ShortLinkCreds :: ShortLinkCreds -> SenderId
shortLinkId, LinkKey
shortLinkKey :: LinkKey
$sel:shortLinkKey:ShortLinkCreds :: ShortLinkCreds -> LinkKey
shortLinkKey, PrivateKeyEd25519
linkPrivSigKey :: PrivateKeyEd25519
$sel:linkPrivSigKey:ShortLinkCreds :: ShortLinkCreds -> PrivateKeyEd25519
linkPrivSigKey, EncDataBytes
linkEncFixedData :: EncDataBytes
$sel:linkEncFixedData:ShortLinkCreds :: ShortLinkCreds -> EncDataBytes
linkEncFixedData} =
  Connection
-> Query
-> (SenderId, LinkKey, PrivateKeyEd25519, EncDataBytes,
    NonEmpty TransportHost, ServiceName, SenderId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE rcv_queues
      SET link_id = ?, link_key = ?, link_priv_sig_key = ?, link_enc_fixed_data = ?
      WHERE host = ? AND port = ? AND rcv_id = ?
    |]
    (SenderId
shortLinkId, LinkKey
shortLinkKey, PrivateKeyEd25519
linkPrivSigKey, EncDataBytes
linkEncFixedData, SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host SMPServer
server, SMPServer -> ServiceName
forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port SMPServer
server, SenderId
rcvId)

updateRcvIds :: DB.Connection -> ConnId -> IO (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
updateRcvIds :: Connection
-> SndFileId -> IO (InternalId, InternalRcvId, Int64, SndFileId)
updateRcvIds Connection
db SndFileId
connId = do
  (InternalId
lastInternalId, InternalRcvId
lastInternalRcvId, Int64
lastExternalSndId, SndFileId
lastRcvHash) <- Connection
-> SndFileId -> IO (InternalId, InternalRcvId, Int64, SndFileId)
retrieveLastIdsAndHashRcv_ Connection
db SndFileId
connId
  let internalId :: InternalId
internalId = Int64 -> InternalId
InternalId (Int64 -> InternalId) -> Int64 -> InternalId
forall a b. (a -> b) -> a -> b
$ InternalId -> Int64
unId InternalId
lastInternalId Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1
      internalRcvId :: InternalRcvId
internalRcvId = Int64 -> InternalRcvId
InternalRcvId (Int64 -> InternalRcvId) -> Int64 -> InternalRcvId
forall a b. (a -> b) -> a -> b
$ InternalRcvId -> Int64
unRcvId InternalRcvId
lastInternalRcvId Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1
  Connection -> SndFileId -> InternalId -> InternalRcvId -> IO ()
updateLastIdsRcv_ Connection
db SndFileId
connId InternalId
internalId InternalRcvId
internalRcvId
  (InternalId, InternalRcvId, Int64, SndFileId)
-> IO (InternalId, InternalRcvId, Int64, SndFileId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InternalId
internalId, InternalRcvId
internalRcvId, Int64
lastExternalSndId, SndFileId
lastRcvHash)

createRcvMsg :: DB.Connection -> ConnId -> RcvQueue -> RcvMsgData -> IO ()
createRcvMsg :: Connection -> SndFileId -> RcvQueue -> RcvMsgData -> IO ()
createRcvMsg Connection
db SndFileId
connId rq :: RcvQueue
rq@RcvQueue {DBEntityId' 'DBStored
$sel:dbQueueId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> DBEntityId' q
dbQueueId :: DBEntityId' 'DBStored
dbQueueId} rcvMsgData :: RcvMsgData
rcvMsgData@RcvMsgData {$sel:msgMeta:RcvMsgData :: RcvMsgData -> MsgMeta
msgMeta = MsgMeta {Int64
sndMsgId :: Int64
$sel:sndMsgId:MsgMeta :: MsgMeta -> Int64
sndMsgId, $sel:broker:MsgMeta :: MsgMeta -> (SndFileId, UTCTime)
broker = (SndFileId
_, UTCTime
brokerTs)}, InternalRcvId
internalRcvId :: InternalRcvId
$sel:internalRcvId:RcvMsgData :: RcvMsgData -> InternalRcvId
internalRcvId, SndFileId
internalHash :: SndFileId
$sel:internalHash:RcvMsgData :: RcvMsgData -> SndFileId
internalHash} = do
  Connection -> SndFileId -> RcvMsgData -> IO ()
insertRcvMsgBase_ Connection
db SndFileId
connId RcvMsgData
rcvMsgData
  Connection -> SndFileId -> RcvQueue -> RcvMsgData -> IO ()
insertRcvMsgDetails_ Connection
db SndFileId
connId RcvQueue
rq RcvMsgData
rcvMsgData
  Connection
-> SndFileId -> Int64 -> InternalRcvId -> SndFileId -> IO ()
updateRcvMsgHash Connection
db SndFileId
connId Int64
sndMsgId InternalRcvId
internalRcvId SndFileId
internalHash
  Connection
-> SndFileId -> DBEntityId' 'DBStored -> UTCTime -> IO ()
setLastBrokerTs Connection
db SndFileId
connId DBEntityId' 'DBStored
dbQueueId UTCTime
brokerTs

setLastBrokerTs :: DB.Connection -> ConnId -> DBEntityId -> UTCTime -> IO ()
setLastBrokerTs :: Connection
-> SndFileId -> DBEntityId' 'DBStored -> UTCTime -> IO ()
setLastBrokerTs Connection
db SndFileId
connId DBEntityId' 'DBStored
dbQueueId UTCTime
brokerTs =
  Connection
-> Query
-> (UTCTime, SndFileId, DBEntityId' 'DBStored, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_queues SET last_broker_ts = ? WHERE conn_id = ? AND rcv_queue_id = ? AND (last_broker_ts IS NULL OR last_broker_ts < ?)" (UTCTime
brokerTs, SndFileId
connId, DBEntityId' 'DBStored
dbQueueId, UTCTime
brokerTs)

createSndMsgBody :: DB.Connection -> AMessage -> IO Int64
createSndMsgBody :: Connection -> AMessage -> IO Int64
createSndMsgBody Connection
db AMessage
aMessage =
  Only Int64 -> Int64
forall a. Only a -> a
fromOnly (Only Int64 -> Int64)
-> ([Only Int64] -> Only Int64) -> [Only Int64] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int64] -> Only Int64
forall a. HasCallStack => [a] -> a
head ([Only Int64] -> Int64) -> IO [Only Int64] -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Connection -> Query -> Only AMessage -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      Query
"INSERT INTO snd_message_bodies (agent_msg) VALUES (?) RETURNING snd_message_body_id"
      (AMessage -> Only AMessage
forall a. a -> Only a
Only AMessage
aMessage)

updateSndIds :: DB.Connection -> ConnId -> IO (Either StoreError (InternalId, InternalSndId, PrevSndMsgHash))
updateSndIds :: Connection
-> SndFileId
-> IO (Either StoreError (InternalId, InternalSndId, SndFileId))
updateSndIds Connection
db SndFileId
connId = ExceptT StoreError IO (InternalId, InternalSndId, SndFileId)
-> IO (Either StoreError (InternalId, InternalSndId, SndFileId))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (InternalId, InternalSndId, SndFileId)
 -> IO (Either StoreError (InternalId, InternalSndId, SndFileId)))
-> ExceptT StoreError IO (InternalId, InternalSndId, SndFileId)
-> IO (Either StoreError (InternalId, InternalSndId, SndFileId))
forall a b. (a -> b) -> a -> b
$ do
  (InternalId
lastInternalId, InternalSndId
lastInternalSndId, SndFileId
prevSndHash) <- IO (Either StoreError (InternalId, InternalSndId, SndFileId))
-> ExceptT StoreError IO (InternalId, InternalSndId, SndFileId)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (InternalId, InternalSndId, SndFileId))
 -> ExceptT StoreError IO (InternalId, InternalSndId, SndFileId))
-> IO (Either StoreError (InternalId, InternalSndId, SndFileId))
-> ExceptT StoreError IO (InternalId, InternalSndId, SndFileId)
forall a b. (a -> b) -> a -> b
$ Connection
-> SndFileId
-> IO (Either StoreError (InternalId, InternalSndId, SndFileId))
retrieveLastIdsAndHashSnd_ Connection
db SndFileId
connId
  let internalId :: InternalId
internalId = Int64 -> InternalId
InternalId (Int64 -> InternalId) -> Int64 -> InternalId
forall a b. (a -> b) -> a -> b
$ InternalId -> Int64
unId InternalId
lastInternalId Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1
      internalSndId :: InternalSndId
internalSndId = Int64 -> InternalSndId
InternalSndId (Int64 -> InternalSndId) -> Int64 -> InternalSndId
forall a b. (a -> b) -> a -> b
$ InternalSndId -> Int64
unSndId InternalSndId
lastInternalSndId Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> SndFileId -> InternalId -> InternalSndId -> IO ()
updateLastIdsSnd_ Connection
db SndFileId
connId InternalId
internalId InternalSndId
internalSndId
  (InternalId, InternalSndId, SndFileId)
-> ExceptT StoreError IO (InternalId, InternalSndId, SndFileId)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InternalId
internalId, InternalSndId
internalSndId, SndFileId
prevSndHash)

createSndMsg :: DB.Connection -> ConnId -> SndMsgData -> IO ()
createSndMsg :: Connection -> SndFileId -> SndMsgData -> IO ()
createSndMsg Connection
db SndFileId
connId sndMsgData :: SndMsgData
sndMsgData@SndMsgData {InternalSndId
internalSndId :: InternalSndId
$sel:internalSndId:SndMsgData :: SndMsgData -> InternalSndId
internalSndId, SndFileId
internalHash :: SndFileId
$sel:internalHash:SndMsgData :: SndMsgData -> SndFileId
internalHash} = do
  Connection -> SndFileId -> SndMsgData -> IO ()
insertSndMsgBase_ Connection
db SndFileId
connId SndMsgData
sndMsgData
  Connection -> SndFileId -> SndMsgData -> IO ()
insertSndMsgDetails_ Connection
db SndFileId
connId SndMsgData
sndMsgData
  Connection -> SndFileId -> InternalSndId -> SndFileId -> IO ()
updateSndMsgHash Connection
db SndFileId
connId InternalSndId
internalSndId SndFileId
internalHash

createSndMsgDelivery :: DB.Connection -> SndQueue -> InternalId -> IO ()
createSndMsgDelivery :: Connection -> SndQueue -> InternalId -> IO ()
createSndMsgDelivery Connection
db SndQueue {SndFileId
connId :: SndFileId
$sel:connId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> SndFileId
connId, DBEntityId' 'DBStored
$sel:dbQueueId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> DBEntityId' q
dbQueueId :: DBEntityId' 'DBStored
dbQueueId} InternalId
msgId =
  Connection
-> Query -> (SndFileId, DBEntityId' 'DBStored, InternalId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"INSERT INTO snd_message_deliveries (conn_id, snd_queue_id, internal_id) VALUES (?, ?, ?)" (SndFileId
connId, DBEntityId' 'DBStored
dbQueueId, InternalId
msgId)

getSndMsgViaRcpt :: DB.Connection -> ConnId -> InternalSndId -> IO (Either StoreError SndMsg)
getSndMsgViaRcpt :: Connection
-> SndFileId -> InternalSndId -> IO (Either StoreError SndMsg)
getSndMsgViaRcpt Connection
db SndFileId
connId InternalSndId
sndMsgId =
  ((InternalId, AgentMessageType, SndFileId, Maybe Int64,
  Maybe MsgReceiptStatus)
 -> SndMsg)
-> StoreError
-> IO
     [(InternalId, AgentMessageType, SndFileId, Maybe Int64,
       Maybe MsgReceiptStatus)]
-> IO (Either StoreError SndMsg)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (InternalId, AgentMessageType, SndFileId, Maybe Int64,
 Maybe MsgReceiptStatus)
-> SndMsg
toSndMsg (ServiceName -> StoreError
SEMsgNotFound ServiceName
"getSndMsgViaRcpt") (IO
   [(InternalId, AgentMessageType, SndFileId, Maybe Int64,
     Maybe MsgReceiptStatus)]
 -> IO (Either StoreError SndMsg))
-> IO
     [(InternalId, AgentMessageType, SndFileId, Maybe Int64,
       Maybe MsgReceiptStatus)]
-> IO (Either StoreError SndMsg)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (SndFileId, InternalSndId)
-> IO
     [(InternalId, AgentMessageType, SndFileId, Maybe Int64,
       Maybe MsgReceiptStatus)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT s.internal_id, m.msg_type, s.internal_hash, s.rcpt_internal_id, s.rcpt_status
        FROM snd_messages s
        JOIN messages m ON s.conn_id = m.conn_id AND s.internal_id = m.internal_id
        WHERE s.conn_id = ? AND s.internal_snd_id = ?
      |]
      (SndFileId
connId, InternalSndId
sndMsgId)
  where
    toSndMsg :: (InternalId, AgentMessageType, MsgHash, Maybe AgentMsgId, Maybe MsgReceiptStatus) -> SndMsg
    toSndMsg :: (InternalId, AgentMessageType, SndFileId, Maybe Int64,
 Maybe MsgReceiptStatus)
-> SndMsg
toSndMsg (InternalId
internalId, AgentMessageType
msgType, SndFileId
internalHash, Maybe Int64
rcptInternalId_, Maybe MsgReceiptStatus
rcptStatus_) =
      let msgReceipt :: Maybe MsgReceipt
msgReceipt = Int64 -> MsgReceiptStatus -> MsgReceipt
MsgReceipt (Int64 -> MsgReceiptStatus -> MsgReceipt)
-> Maybe Int64 -> Maybe (MsgReceiptStatus -> MsgReceipt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
rcptInternalId_ Maybe (MsgReceiptStatus -> MsgReceipt)
-> Maybe MsgReceiptStatus -> Maybe MsgReceipt
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe MsgReceiptStatus
rcptStatus_
       in SndMsg {InternalId
internalId :: InternalId
$sel:internalId:SndMsg :: InternalId
internalId, $sel:internalSndId:SndMsg :: InternalSndId
internalSndId = InternalSndId
sndMsgId, AgentMessageType
msgType :: AgentMessageType
$sel:msgType:SndMsg :: AgentMessageType
msgType, SndFileId
internalHash :: SndFileId
$sel:internalHash:SndMsg :: SndFileId
internalHash, Maybe MsgReceipt
msgReceipt :: Maybe MsgReceipt
$sel:msgReceipt:SndMsg :: Maybe MsgReceipt
msgReceipt}

updateSndMsgRcpt :: DB.Connection -> ConnId -> InternalSndId -> MsgReceipt -> IO ()
updateSndMsgRcpt :: Connection -> SndFileId -> InternalSndId -> MsgReceipt -> IO ()
updateSndMsgRcpt Connection
db SndFileId
connId InternalSndId
sndMsgId MsgReceipt {Int64
agentMsgId :: Int64
$sel:agentMsgId:MsgReceipt :: MsgReceipt -> Int64
agentMsgId, MsgReceiptStatus
msgRcptStatus :: MsgReceiptStatus
$sel:msgRcptStatus:MsgReceipt :: MsgReceipt -> MsgReceiptStatus
msgRcptStatus} =
  Connection
-> Query
-> (Int64, MsgReceiptStatus, SndFileId, InternalSndId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE snd_messages SET rcpt_internal_id = ?, rcpt_status = ? WHERE conn_id = ? AND internal_snd_id = ?"
    (Int64
agentMsgId, MsgReceiptStatus
msgRcptStatus, SndFileId
connId, InternalSndId
sndMsgId)

getConnectionsForDelivery :: DB.Connection -> IO [ConnId]
getConnectionsForDelivery :: Connection -> IO [SndFileId]
getConnectionsForDelivery Connection
db =
  (Only SndFileId -> SndFileId) -> [Only SndFileId] -> [SndFileId]
forall a b. (a -> b) -> [a] -> [b]
map Only SndFileId -> SndFileId
forall a. Only a -> a
fromOnly ([Only SndFileId] -> [SndFileId])
-> IO [Only SndFileId] -> IO [SndFileId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> IO [Only SndFileId]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_ Connection
db Query
"SELECT DISTINCT conn_id FROM snd_message_deliveries WHERE failed = 0"

getAllSndQueuesForDelivery :: DB.Connection -> IO [SndQueue]
getAllSndQueuesForDelivery :: Connection -> IO [SndQueue]
getAllSndQueuesForDelivery Connection
db = (((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
   SenderId, Maybe QueueMode)
  :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
       QueueStatus)
      :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
          Maybe SndSwitchStatus, VersionSMPC)))
 -> SndQueue)
-> [(Int64, KeyHash, SndFileId, NonEmpty TransportHost,
     ServiceName, SenderId, Maybe QueueMode)
    :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
         QueueStatus)
        :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
            Maybe SndSwitchStatus, VersionSMPC))]
-> [SndQueue]
forall a b. (a -> b) -> [a] -> [b]
map ((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
  SenderId, Maybe QueueMode)
 :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
      QueueStatus)
     :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
         Maybe SndSwitchStatus, VersionSMPC)))
-> SndQueue
toSndQueue ([(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
   SenderId, Maybe QueueMode)
  :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
       QueueStatus)
      :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
          Maybe SndSwitchStatus, VersionSMPC))]
 -> [SndQueue])
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, Maybe QueueMode)
      :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
           QueueStatus)
          :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
              Maybe SndSwitchStatus, VersionSMPC))]
-> IO [SndQueue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, Maybe QueueMode)
      :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
           QueueStatus)
          :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
              Maybe SndSwitchStatus, VersionSMPC))]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_ Connection
db (Query
sndQueueQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
delivery)
  where
    delivery :: Query
delivery = [sql|
      JOIN (SELECT DISTINCT conn_id, snd_queue_id FROM snd_message_deliveries WHERE failed = 0) d
      ON d.conn_id = q.conn_id AND d.snd_queue_id = q.snd_queue_id
      WHERE c.deleted = 0
    |]

getPendingQueueMsg :: DB.Connection -> ConnId -> SndQueue -> IO (Either StoreError (Maybe (Maybe RcvQueue, PendingMsgData)))
getPendingQueueMsg :: Connection
-> SndFileId
-> SndQueue
-> IO (Either StoreError (Maybe (Maybe RcvQueue, PendingMsgData)))
getPendingQueueMsg Connection
db SndFileId
connId SndQueue {DBEntityId' 'DBStored
$sel:dbQueueId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> DBEntityId' q
dbQueueId :: DBEntityId' 'DBStored
dbQueueId} =
  ServiceName
-> IO (Maybe InternalId)
-> (InternalId
    -> IO (Either StoreError (Maybe RcvQueue, PendingMsgData)))
-> (InternalId -> IO ())
-> IO (Either StoreError (Maybe (Maybe RcvQueue, PendingMsgData)))
forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> IO (Maybe i)
-> (i -> IO (Either e a))
-> (i -> IO ())
-> IO (Either e (Maybe a))
getWorkItem ServiceName
"message" IO (Maybe InternalId)
getMsgId InternalId
-> IO (Either StoreError (Maybe RcvQueue, PendingMsgData))
getMsgData InternalId -> IO ()
markMsgFailed
  where
    getMsgId :: IO (Maybe InternalId)
    getMsgId :: IO (Maybe InternalId)
getMsgId =
      (Only InternalId -> InternalId)
-> IO [Only InternalId] -> IO (Maybe InternalId)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only InternalId -> InternalId
forall a. Only a -> a
fromOnly (IO [Only InternalId] -> IO (Maybe InternalId))
-> IO [Only InternalId] -> IO (Maybe InternalId)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (SndFileId, DBEntityId' 'DBStored)
-> IO [Only InternalId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT internal_id
            FROM snd_message_deliveries d
            WHERE conn_id = ? AND snd_queue_id = ? AND failed = 0
            ORDER BY internal_id ASC
            LIMIT 1
          |]
          (SndFileId
connId, DBEntityId' 'DBStored
dbQueueId)
    getMsgData :: InternalId -> IO (Either StoreError (Maybe RcvQueue, PendingMsgData))
    getMsgData :: InternalId
-> IO (Either StoreError (Maybe RcvQueue, PendingMsgData))
getMsgData InternalId
msgId = ExceptT StoreError IO (Maybe RcvQueue, PendingMsgData)
-> IO (Either StoreError (Maybe RcvQueue, PendingMsgData))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (Maybe RcvQueue, PendingMsgData)
 -> IO (Either StoreError (Maybe RcvQueue, PendingMsgData)))
-> ExceptT StoreError IO (Maybe RcvQueue, PendingMsgData)
-> IO (Either StoreError (Maybe RcvQueue, PendingMsgData))
forall a b. (a -> b) -> a -> b
$ do
      PendingMsgData
msg <- IO (Either StoreError PendingMsgData)
-> ExceptT StoreError IO PendingMsgData
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError PendingMsgData)
 -> ExceptT StoreError IO PendingMsgData)
-> IO (Either StoreError PendingMsgData)
-> ExceptT StoreError IO PendingMsgData
forall a b. (a -> b) -> a -> b
$ ((AgentMessageType, Maybe MsgFlags, SndFileId, PQEncryption,
  UTCTime, InternalSndId, SndFileId, Maybe Int64, Maybe Int64,
  Maybe MsgEncryptKeyX448, Maybe Int, Maybe AMessage)
 -> Either StoreError PendingMsgData)
-> StoreError
-> IO
     [(AgentMessageType, Maybe MsgFlags, SndFileId, PQEncryption,
       UTCTime, InternalSndId, SndFileId, Maybe Int64, Maybe Int64,
       Maybe MsgEncryptKeyX448, Maybe Int, Maybe AMessage)]
-> IO (Either StoreError PendingMsgData)
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (AgentMessageType, Maybe MsgFlags, SndFileId, PQEncryption,
 UTCTime, InternalSndId, SndFileId, Maybe Int64, Maybe Int64,
 Maybe MsgEncryptKeyX448, Maybe Int, Maybe AMessage)
-> Either StoreError PendingMsgData
pendingMsgData StoreError
err IO
  [(AgentMessageType, Maybe MsgFlags, SndFileId, PQEncryption,
    UTCTime, InternalSndId, SndFileId, Maybe Int64, Maybe Int64,
    Maybe MsgEncryptKeyX448, Maybe Int, Maybe AMessage)]
getMsgData_
      Maybe RcvQueue
rq_ <- IO (Maybe RcvQueue) -> ExceptT StoreError IO (Maybe RcvQueue)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe RcvQueue) -> ExceptT StoreError IO (Maybe RcvQueue))
-> IO (Maybe RcvQueue) -> ExceptT StoreError IO (Maybe RcvQueue)
forall a b. (a -> b) -> a -> b
$ NonEmpty RcvQueue -> RcvQueue
forall a. NonEmpty a -> a
L.head (NonEmpty RcvQueue -> RcvQueue)
-> IO (Maybe (NonEmpty RcvQueue)) -> IO (Maybe RcvQueue)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Connection -> SndFileId -> IO (Maybe (NonEmpty RcvQueue))
getRcvQueuesByConnId_ Connection
db SndFileId
connId
      (Maybe RcvQueue, PendingMsgData)
-> ExceptT StoreError IO (Maybe RcvQueue, PendingMsgData)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RcvQueue
rq_, PendingMsgData
msg)
      where
        getMsgData_ :: IO
  [(AgentMessageType, Maybe MsgFlags, SndFileId, PQEncryption,
    UTCTime, InternalSndId, SndFileId, Maybe Int64, Maybe Int64,
    Maybe MsgEncryptKeyX448, Maybe Int, Maybe AMessage)]
getMsgData_ =
          Connection
-> Query
-> (SndFileId, InternalId)
-> IO
     [(AgentMessageType, Maybe MsgFlags, SndFileId, PQEncryption,
       UTCTime, InternalSndId, SndFileId, Maybe Int64, Maybe Int64,
       Maybe MsgEncryptKeyX448, Maybe Int, Maybe AMessage)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
            Connection
db
            [sql|
              SELECT
                m.msg_type, m.msg_flags, m.msg_body, m.pq_encryption, m.internal_ts, m.internal_snd_id, s.previous_msg_hash,
                s.retry_int_slow, s.retry_int_fast, s.msg_encrypt_key, s.padded_msg_len, sb.agent_msg
              FROM messages m
              JOIN snd_messages s ON s.conn_id = m.conn_id AND s.internal_id = m.internal_id
              LEFT JOIN snd_message_bodies sb ON sb.snd_message_body_id = s.snd_message_body_id
              WHERE m.conn_id = ? AND m.internal_id = ?
            |]
            (SndFileId
connId, InternalId
msgId)
        err :: StoreError
err = SndFileId -> StoreError
SEInternal (SndFileId -> StoreError) -> SndFileId -> StoreError
forall a b. (a -> b) -> a -> b
$ SndFileId
"msg delivery " SndFileId -> SndFileId -> SndFileId
forall a. Semigroup a => a -> a -> a
<> InternalId -> SndFileId
forall a. Show a => a -> SndFileId
bshow InternalId
msgId SndFileId -> SndFileId -> SndFileId
forall a. Semigroup a => a -> a -> a
<> SndFileId
" returned []"
        pendingMsgData :: (AgentMessageType, Maybe MsgFlags, MsgBody, PQEncryption, InternalTs, InternalSndId, PrevSndMsgHash, Maybe Int64, Maybe Int64, Maybe CR.MsgEncryptKeyX448, Maybe Int, Maybe AMessage) -> Either StoreError PendingMsgData
        pendingMsgData :: (AgentMessageType, Maybe MsgFlags, SndFileId, PQEncryption,
 UTCTime, InternalSndId, SndFileId, Maybe Int64, Maybe Int64,
 Maybe MsgEncryptKeyX448, Maybe Int, Maybe AMessage)
-> Either StoreError PendingMsgData
pendingMsgData (AgentMessageType
msgType, Maybe MsgFlags
msgFlags_, SndFileId
msgBody, PQEncryption
pqEncryption, UTCTime
internalTs, InternalSndId
internalSndId, SndFileId
prevMsgHash, Maybe Int64
riSlow_, Maybe Int64
riFast_, Maybe MsgEncryptKeyX448
encryptKey_, Maybe Int
paddedLen_, Maybe AMessage
sndMsgBody_) = do
          let msgFlags :: MsgFlags
msgFlags = MsgFlags -> Maybe MsgFlags -> MsgFlags
forall a. a -> Maybe a -> a
fromMaybe MsgFlags
SMP.noMsgFlags Maybe MsgFlags
msgFlags_
              msgRetryState :: Maybe RI2State
msgRetryState = Int64 -> Int64 -> RI2State
RI2State (Int64 -> Int64 -> RI2State)
-> Maybe Int64 -> Maybe (Int64 -> RI2State)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
riSlow_ Maybe (Int64 -> RI2State) -> Maybe Int64 -> Maybe RI2State
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int64
riFast_
              result :: Maybe PendingMsgPrepData -> PendingMsgData
result Maybe PendingMsgPrepData
pendingMsgPrepData_ = PendingMsgData {InternalId
msgId :: InternalId
$sel:msgId:PendingMsgData :: InternalId
msgId, AgentMessageType
msgType :: AgentMessageType
$sel:msgType:PendingMsgData :: AgentMessageType
msgType, MsgFlags
msgFlags :: MsgFlags
$sel:msgFlags:PendingMsgData :: MsgFlags
msgFlags, SndFileId
msgBody :: SndFileId
$sel:msgBody:PendingMsgData :: SndFileId
msgBody, PQEncryption
pqEncryption :: PQEncryption
$sel:pqEncryption:PendingMsgData :: PQEncryption
pqEncryption, Maybe RI2State
msgRetryState :: Maybe RI2State
$sel:msgRetryState:PendingMsgData :: Maybe RI2State
msgRetryState, UTCTime
internalTs :: UTCTime
$sel:internalTs:PendingMsgData :: UTCTime
internalTs, InternalSndId
internalSndId :: InternalSndId
$sel:internalSndId:PendingMsgData :: InternalSndId
internalSndId, SndFileId
prevMsgHash :: SndFileId
$sel:prevMsgHash:PendingMsgData :: SndFileId
prevMsgHash, Maybe PendingMsgPrepData
pendingMsgPrepData_ :: Maybe PendingMsgPrepData
$sel:pendingMsgPrepData_:PendingMsgData :: Maybe PendingMsgPrepData
pendingMsgPrepData_}
           in Maybe PendingMsgPrepData -> PendingMsgData
result (Maybe PendingMsgPrepData -> PendingMsgData)
-> Either StoreError (Maybe PendingMsgPrepData)
-> Either StoreError PendingMsgData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case (Maybe MsgEncryptKeyX448
encryptKey_, Maybe Int
paddedLen_, Maybe AMessage
sndMsgBody_) of
                (Maybe MsgEncryptKeyX448
Nothing, Maybe Int
Nothing, Maybe AMessage
Nothing) -> Maybe PendingMsgPrepData
-> Either StoreError (Maybe PendingMsgPrepData)
forall a b. b -> Either a b
Right Maybe PendingMsgPrepData
forall a. Maybe a
Nothing
                (Just MsgEncryptKeyX448
encryptKey, Just Int
paddedLen, Just AMessage
sndMsgBody) -> Maybe PendingMsgPrepData
-> Either StoreError (Maybe PendingMsgPrepData)
forall a b. b -> Either a b
Right (Maybe PendingMsgPrepData
 -> Either StoreError (Maybe PendingMsgPrepData))
-> Maybe PendingMsgPrepData
-> Either StoreError (Maybe PendingMsgPrepData)
forall a b. (a -> b) -> a -> b
$ PendingMsgPrepData -> Maybe PendingMsgPrepData
forall a. a -> Maybe a
Just PendingMsgPrepData {MsgEncryptKeyX448
encryptKey :: MsgEncryptKeyX448
$sel:encryptKey:PendingMsgPrepData :: MsgEncryptKeyX448
encryptKey, Int
paddedLen :: Int
$sel:paddedLen:PendingMsgPrepData :: Int
paddedLen, AMessage
sndMsgBody :: AMessage
$sel:sndMsgBody:PendingMsgPrepData :: AMessage
sndMsgBody}
                (Maybe MsgEncryptKeyX448, Maybe Int, Maybe AMessage)
_ -> StoreError -> Either StoreError (Maybe PendingMsgPrepData)
forall a b. a -> Either a b
Left (StoreError -> Either StoreError (Maybe PendingMsgPrepData))
-> StoreError -> Either StoreError (Maybe PendingMsgPrepData)
forall a b. (a -> b) -> a -> b
$ SndFileId -> StoreError
SEInternal SndFileId
"unexpected snd msg data"
    markMsgFailed :: InternalId -> IO ()
markMsgFailed InternalId
msgId = Connection -> Query -> (SndFileId, InternalId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_message_deliveries SET failed = 1 WHERE conn_id = ? AND internal_id = ?" (SndFileId
connId, InternalId
msgId)

getWorkItem :: (Show i, AnyStoreError e) => String -> IO (Maybe i) -> (i -> IO (Either e a)) -> (i -> IO ()) -> IO (Either e (Maybe a))
getWorkItem :: forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> IO (Maybe i)
-> (i -> IO (Either e a))
-> (i -> IO ())
-> IO (Either e (Maybe a))
getWorkItem ServiceName
itemName IO (Maybe i)
getId i -> IO (Either e a)
getItem i -> IO ()
markFailed =
  ExceptT e IO (Maybe a) -> IO (Either e (Maybe a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e IO (Maybe a) -> IO (Either e (Maybe a)))
-> ExceptT e IO (Maybe a) -> IO (Either e (Maybe a))
forall a b. (a -> b) -> a -> b
$ ServiceName
-> ServiceName -> IO (Maybe i) -> ExceptT e IO (Maybe i)
forall e a.
AnyStoreError e =>
ServiceName -> ServiceName -> IO a -> ExceptT e IO a
handleWrkErr ServiceName
itemName ServiceName
"getId" IO (Maybe i)
getId ExceptT e IO (Maybe i)
-> (Maybe i -> ExceptT e IO (Maybe a)) -> ExceptT e IO (Maybe a)
forall a b.
ExceptT e IO a -> (a -> ExceptT e IO b) -> ExceptT e IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (i -> ExceptT e IO a) -> Maybe i -> ExceptT e IO (Maybe a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (ServiceName
-> (i -> IO (Either e a)) -> (i -> IO ()) -> i -> ExceptT e IO a
forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> (i -> IO (Either e a)) -> (i -> IO ()) -> i -> ExceptT e IO a
tryGetItem ServiceName
itemName i -> IO (Either e a)
getItem i -> IO ()
markFailed)

getWorkItems :: (Show i, AnyStoreError e) => String -> IO [i] -> (i -> IO (Either e a)) -> (i -> IO ()) -> IO (Either e [Either e a])
getWorkItems :: forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> IO [i]
-> (i -> IO (Either e a))
-> (i -> IO ())
-> IO (Either e [Either e a])
getWorkItems ServiceName
itemName IO [i]
getIds i -> IO (Either e a)
getItem i -> IO ()
markFailed =
  ExceptT e IO [Either e a] -> IO (Either e [Either e a])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e IO [Either e a] -> IO (Either e [Either e a]))
-> ExceptT e IO [Either e a] -> IO (Either e [Either e a])
forall a b. (a -> b) -> a -> b
$ ServiceName -> ServiceName -> IO [i] -> ExceptT e IO [i]
forall e a.
AnyStoreError e =>
ServiceName -> ServiceName -> IO a -> ExceptT e IO a
handleWrkErr ServiceName
itemName ServiceName
"getIds" IO [i]
getIds ExceptT e IO [i]
-> ([i] -> ExceptT e IO [Either e a]) -> ExceptT e IO [Either e a]
forall a b.
ExceptT e IO a -> (a -> ExceptT e IO b) -> ExceptT e IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (i -> ExceptT e IO (Either e a))
-> [i] -> ExceptT e IO [Either e a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ExceptT e IO a -> ExceptT e IO (Either e a)
forall (m :: * -> *) e a.
Monad m =>
ExceptT e m a -> ExceptT e m (Either e a)
tryE (ExceptT e IO a -> ExceptT e IO (Either e a))
-> (i -> ExceptT e IO a) -> i -> ExceptT e IO (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName
-> (i -> IO (Either e a)) -> (i -> IO ()) -> i -> ExceptT e IO a
forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> (i -> IO (Either e a)) -> (i -> IO ()) -> i -> ExceptT e IO a
tryGetItem ServiceName
itemName i -> IO (Either e a)
getItem i -> IO ()
markFailed)

tryGetItem :: (Show i, AnyStoreError e) => String -> (i -> IO (Either e a)) -> (i -> IO ()) -> i -> ExceptT e IO a
tryGetItem :: forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> (i -> IO (Either e a)) -> (i -> IO ()) -> i -> ExceptT e IO a
tryGetItem ServiceName
itemName i -> IO (Either e a)
getItem i -> IO ()
markFailed i
itemId = IO (Either e a) -> ExceptT e IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (i -> IO (Either e a)
getItem i
itemId) ExceptT e IO a -> (e -> ExceptT e IO a) -> ExceptT e IO a
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` \e
e -> ExceptT e IO ()
mark ExceptT e IO () -> ExceptT e IO a -> ExceptT e IO a
forall a b. ExceptT e IO a -> ExceptT e IO b -> ExceptT e IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> e -> ExceptT e IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
e
  where
    mark :: ExceptT e IO ()
mark = ServiceName -> ServiceName -> IO () -> ExceptT e IO ()
forall e a.
AnyStoreError e =>
ServiceName -> ServiceName -> IO a -> ExceptT e IO a
handleWrkErr ServiceName
itemName (ServiceName
"markFailed ID " ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> i -> ServiceName
forall a. Show a => a -> ServiceName
show i
itemId) (IO () -> ExceptT e IO ()) -> IO () -> ExceptT e IO ()
forall a b. (a -> b) -> a -> b
$ i -> IO ()
markFailed i
itemId

-- Errors caught by this function will suspend worker as if there is no more work,
handleWrkErr :: forall e a. AnyStoreError e => String -> String -> IO a -> ExceptT e IO a
handleWrkErr :: forall e a.
AnyStoreError e =>
ServiceName -> ServiceName -> IO a -> ExceptT e IO a
handleWrkErr ServiceName
itemName ServiceName
opName IO a
action = IO (Either e a) -> ExceptT e IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either e a) -> ExceptT e IO a)
-> IO (Either e a) -> ExceptT e IO a
forall a b. (a -> b) -> a -> b
$ (SomeException -> e) -> Either SomeException a -> Either e a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SomeException -> e
mkError (Either SomeException a -> Either e a)
-> IO (Either SomeException a) -> IO (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> IO (Either SomeException a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
E.try IO a
action
  where
    mkError :: E.SomeException -> e
    mkError :: SomeException -> e
mkError SomeException
e = ServiceName -> e
forall e. AnyStoreError e => ServiceName -> e
mkWorkItemError (ServiceName -> e) -> ServiceName -> e
forall a b. (a -> b) -> a -> b
$ ServiceName
itemName ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> ServiceName
" " ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> ServiceName
opName ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> ServiceName
" error: " ServiceName -> ServiceName -> ServiceName
forall a. Semigroup a => a -> a -> a
<> SomeException -> ServiceName
forall a. Show a => a -> ServiceName
show SomeException
e

updatePendingMsgRIState :: DB.Connection -> ConnId -> InternalId -> RI2State -> IO ()
updatePendingMsgRIState :: Connection -> SndFileId -> InternalId -> RI2State -> IO ()
updatePendingMsgRIState Connection
db SndFileId
connId InternalId
msgId RI2State {Int64
slowInterval :: Int64
slowInterval :: RI2State -> Int64
slowInterval, Int64
fastInterval :: Int64
fastInterval :: RI2State -> Int64
fastInterval} =
  Connection
-> Query -> (Int64, Int64, SndFileId, InternalId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_messages SET retry_int_slow = ?, retry_int_fast = ? WHERE conn_id = ? AND internal_id = ?" (Int64
slowInterval, Int64
fastInterval, SndFileId
connId, InternalId
msgId)

deletePendingMsgs :: DB.Connection -> ConnId -> SndQueue -> IO ()
deletePendingMsgs :: Connection -> SndFileId -> SndQueue -> IO ()
deletePendingMsgs Connection
db SndFileId
connId SndQueue {DBEntityId' 'DBStored
$sel:dbQueueId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> DBEntityId' q
dbQueueId :: DBEntityId' 'DBStored
dbQueueId} =
  Connection -> Query -> (SndFileId, DBEntityId' 'DBStored) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM snd_message_deliveries WHERE conn_id = ? AND snd_queue_id = ?" (SndFileId
connId, DBEntityId' 'DBStored
dbQueueId)

getExpiredSndMessages :: DB.Connection -> ConnId -> SndQueue -> UTCTime -> IO [InternalId]
getExpiredSndMessages :: Connection -> SndFileId -> SndQueue -> UTCTime -> IO [InternalId]
getExpiredSndMessages Connection
db SndFileId
connId SndQueue {DBEntityId' 'DBStored
$sel:dbQueueId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> DBEntityId' q
dbQueueId :: DBEntityId' 'DBStored
dbQueueId} UTCTime
expireTs = do
  -- type is Maybe InternalId because MAX always returns one row, possibly with NULL value
  [Maybe InternalId]
maxId :: [Maybe InternalId] <-
    (Only (Maybe InternalId) -> Maybe InternalId)
-> [Only (Maybe InternalId)] -> [Maybe InternalId]
forall a b. (a -> b) -> [a] -> [b]
map Only (Maybe InternalId) -> Maybe InternalId
forall a. Only a -> a
fromOnly
      ([Only (Maybe InternalId)] -> [Maybe InternalId])
-> IO [Only (Maybe InternalId)] -> IO [Maybe InternalId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> (SndFileId, UTCTime) -> IO [Only (Maybe InternalId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT MAX(internal_id)
          FROM messages
          WHERE conn_id = ? AND internal_snd_id IS NOT NULL AND internal_ts < ?
        |]
        (SndFileId
connId, UTCTime
expireTs)
  case [Maybe InternalId]
maxId of
    Just InternalId
msgId : [Maybe InternalId]
_ ->
      (Only InternalId -> InternalId)
-> [Only InternalId] -> [InternalId]
forall a b. (a -> b) -> [a] -> [b]
map Only InternalId -> InternalId
forall a. Only a -> a
fromOnly
        ([Only InternalId] -> [InternalId])
-> IO [Only InternalId] -> IO [InternalId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (SndFileId, DBEntityId' 'DBStored, InternalId)
-> IO [Only InternalId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT internal_id
            FROM snd_message_deliveries
            WHERE conn_id = ? AND snd_queue_id = ? AND failed = 0 AND internal_id <= ?
            ORDER BY internal_id ASC
          |]
          (SndFileId
connId, DBEntityId' 'DBStored
dbQueueId, InternalId
msgId)
    [Maybe InternalId]
_ -> [InternalId] -> IO [InternalId]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

setMsgUserAck :: DB.Connection -> ConnId -> InternalId -> IO (Either StoreError (RcvQueue, SMP.MsgId))
setMsgUserAck :: Connection
-> SndFileId
-> InternalId
-> IO (Either StoreError (RcvQueue, SndFileId))
setMsgUserAck Connection
db SndFileId
connId InternalId
agentMsgId = ExceptT StoreError IO (RcvQueue, SndFileId)
-> IO (Either StoreError (RcvQueue, SndFileId))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (RcvQueue, SndFileId)
 -> IO (Either StoreError (RcvQueue, SndFileId)))
-> ExceptT StoreError IO (RcvQueue, SndFileId)
-> IO (Either StoreError (RcvQueue, SndFileId))
forall a b. (a -> b) -> a -> b
$ do
  (Int64
dbRcvId, SndFileId
srvMsgId) <-
    IO (Either StoreError (Int64, SndFileId))
-> ExceptT StoreError IO (Int64, SndFileId)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (Int64, SndFileId))
 -> ExceptT StoreError IO (Int64, SndFileId))
-> (IO [(Int64, SndFileId)]
    -> IO (Either StoreError (Int64, SndFileId)))
-> IO [(Int64, SndFileId)]
-> ExceptT StoreError IO (Int64, SndFileId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int64, SndFileId) -> (Int64, SndFileId))
-> StoreError
-> IO [(Int64, SndFileId)]
-> IO (Either StoreError (Int64, SndFileId))
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (Int64, SndFileId) -> (Int64, SndFileId)
forall a. a -> a
id (ServiceName -> StoreError
SEMsgNotFound ServiceName
"setMsgUserAck") (IO [(Int64, SndFileId)]
 -> ExceptT StoreError IO (Int64, SndFileId))
-> IO [(Int64, SndFileId)]
-> ExceptT StoreError IO (Int64, SndFileId)
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query -> (SndFileId, InternalId) -> IO [(Int64, SndFileId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        ( Query
"SELECT rcv_queue_id, broker_id FROM rcv_messages WHERE conn_id = ? AND internal_id = ?"
#if defined(dbPostgres)
            <> " FOR UPDATE"
#endif
        )
        (SndFileId
connId, InternalId
agentMsgId)
  RcvQueue
rq <- IO (Either StoreError RcvQueue) -> ExceptT StoreError IO RcvQueue
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError RcvQueue) -> ExceptT StoreError IO RcvQueue)
-> IO (Either StoreError RcvQueue)
-> ExceptT StoreError IO RcvQueue
forall a b. (a -> b) -> a -> b
$ Connection -> SndFileId -> Int64 -> IO (Either StoreError RcvQueue)
getRcvQueueById Connection
db SndFileId
connId Int64
dbRcvId
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> (BoolInt, SndFileId, InternalId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_messages SET user_ack = ? WHERE conn_id = ? AND internal_id = ?" (Bool -> BoolInt
BI Bool
True, SndFileId
connId, InternalId
agentMsgId)
  (RcvQueue, SndFileId)
-> ExceptT StoreError IO (RcvQueue, SndFileId)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RcvQueue
rq, SndFileId
srvMsgId)

getRcvMsg :: DB.Connection -> ConnId -> InternalId -> IO (Either StoreError RcvMsg)
getRcvMsg :: Connection
-> SndFileId -> InternalId -> IO (Either StoreError RcvMsg)
getRcvMsg Connection
db SndFileId
connId InternalId
agentMsgId =
  (((Int64, UTCTime, SndFileId, UTCTime)
  :. (Int64, MsgIntegrity, SndFileId, AgentMessageType, SndFileId,
      PQEncryption, Maybe Int64, Maybe MsgReceiptStatus, BoolInt))
 -> RcvMsg)
-> StoreError
-> IO
     [(Int64, UTCTime, SndFileId, UTCTime)
      :. (Int64, MsgIntegrity, SndFileId, AgentMessageType, SndFileId,
          PQEncryption, Maybe Int64, Maybe MsgReceiptStatus, BoolInt)]
-> IO (Either StoreError RcvMsg)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((Int64, UTCTime, SndFileId, UTCTime)
 :. (Int64, MsgIntegrity, SndFileId, AgentMessageType, SndFileId,
     PQEncryption, Maybe Int64, Maybe MsgReceiptStatus, BoolInt))
-> RcvMsg
toRcvMsg (ServiceName -> StoreError
SEMsgNotFound ServiceName
"getRcvMsg") (IO
   [(Int64, UTCTime, SndFileId, UTCTime)
    :. (Int64, MsgIntegrity, SndFileId, AgentMessageType, SndFileId,
        PQEncryption, Maybe Int64, Maybe MsgReceiptStatus, BoolInt)]
 -> IO (Either StoreError RcvMsg))
-> IO
     [(Int64, UTCTime, SndFileId, UTCTime)
      :. (Int64, MsgIntegrity, SndFileId, AgentMessageType, SndFileId,
          PQEncryption, Maybe Int64, Maybe MsgReceiptStatus, BoolInt)]
-> IO (Either StoreError RcvMsg)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (SndFileId, InternalId)
-> IO
     [(Int64, UTCTime, SndFileId, UTCTime)
      :. (Int64, MsgIntegrity, SndFileId, AgentMessageType, SndFileId,
          PQEncryption, Maybe Int64, Maybe MsgReceiptStatus, BoolInt)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT
          r.internal_id, m.internal_ts, r.broker_id, r.broker_ts, r.external_snd_id, r.integrity, r.internal_hash,
          m.msg_type, m.msg_body, m.pq_encryption, s.internal_id, s.rcpt_status, r.user_ack
        FROM rcv_messages r
        JOIN messages m ON r.conn_id = m.conn_id AND r.internal_id = m.internal_id
        LEFT JOIN snd_messages s ON s.conn_id = r.conn_id AND s.rcpt_internal_id = r.internal_id
        WHERE r.conn_id = ? AND r.internal_id = ?
      |]
      (SndFileId
connId, InternalId
agentMsgId)

getLastMsg :: DB.Connection -> ConnId -> SMP.MsgId -> IO (Maybe RcvMsg)
getLastMsg :: Connection -> SndFileId -> SndFileId -> IO (Maybe RcvMsg)
getLastMsg Connection
db SndFileId
connId SndFileId
msgId =
  (((Int64, UTCTime, SndFileId, UTCTime)
  :. (Int64, MsgIntegrity, SndFileId, AgentMessageType, SndFileId,
      PQEncryption, Maybe Int64, Maybe MsgReceiptStatus, BoolInt))
 -> RcvMsg)
-> IO
     [(Int64, UTCTime, SndFileId, UTCTime)
      :. (Int64, MsgIntegrity, SndFileId, AgentMessageType, SndFileId,
          PQEncryption, Maybe Int64, Maybe MsgReceiptStatus, BoolInt)]
-> IO (Maybe RcvMsg)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow ((Int64, UTCTime, SndFileId, UTCTime)
 :. (Int64, MsgIntegrity, SndFileId, AgentMessageType, SndFileId,
     PQEncryption, Maybe Int64, Maybe MsgReceiptStatus, BoolInt))
-> RcvMsg
toRcvMsg (IO
   [(Int64, UTCTime, SndFileId, UTCTime)
    :. (Int64, MsgIntegrity, SndFileId, AgentMessageType, SndFileId,
        PQEncryption, Maybe Int64, Maybe MsgReceiptStatus, BoolInt)]
 -> IO (Maybe RcvMsg))
-> IO
     [(Int64, UTCTime, SndFileId, UTCTime)
      :. (Int64, MsgIntegrity, SndFileId, AgentMessageType, SndFileId,
          PQEncryption, Maybe Int64, Maybe MsgReceiptStatus, BoolInt)]
-> IO (Maybe RcvMsg)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (SndFileId, Binary SndFileId)
-> IO
     [(Int64, UTCTime, SndFileId, UTCTime)
      :. (Int64, MsgIntegrity, SndFileId, AgentMessageType, SndFileId,
          PQEncryption, Maybe Int64, Maybe MsgReceiptStatus, BoolInt)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT
          r.internal_id, m.internal_ts, r.broker_id, r.broker_ts, r.external_snd_id, r.integrity, r.internal_hash,
          m.msg_type, m.msg_body, m.pq_encryption, s.internal_id, s.rcpt_status, r.user_ack
        FROM rcv_messages r
        JOIN messages m ON r.conn_id = m.conn_id AND r.internal_id = m.internal_id
        JOIN connections c ON r.conn_id = c.conn_id AND c.last_internal_msg_id = r.internal_id
        LEFT JOIN snd_messages s ON s.conn_id = r.conn_id AND s.rcpt_internal_id = r.internal_id
        WHERE r.conn_id = ? AND r.broker_id = ?
      |]
      (SndFileId
connId, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
msgId)

toRcvMsg :: (Int64, InternalTs, BrokerId, BrokerTs) :. (AgentMsgId, MsgIntegrity, MsgHash, AgentMessageType, MsgBody, PQEncryption, Maybe AgentMsgId, Maybe MsgReceiptStatus, BoolInt) -> RcvMsg
toRcvMsg :: ((Int64, UTCTime, SndFileId, UTCTime)
 :. (Int64, MsgIntegrity, SndFileId, AgentMessageType, SndFileId,
     PQEncryption, Maybe Int64, Maybe MsgReceiptStatus, BoolInt))
-> RcvMsg
toRcvMsg ((Int64
agentMsgId, UTCTime
internalTs, SndFileId
brokerId, UTCTime
brokerTs) :. (Int64
sndMsgId, MsgIntegrity
integrity, SndFileId
internalHash, AgentMessageType
msgType, SndFileId
msgBody, PQEncryption
pqEncryption, Maybe Int64
rcptInternalId_, Maybe MsgReceiptStatus
rcptStatus_, BI Bool
userAck)) =
  let msgMeta :: MsgMeta
msgMeta = MsgMeta {$sel:recipient:MsgMeta :: (Int64, UTCTime)
recipient = (Int64
agentMsgId, UTCTime
internalTs), $sel:broker:MsgMeta :: (SndFileId, UTCTime)
broker = (SndFileId
brokerId, UTCTime
brokerTs), Int64
$sel:sndMsgId:MsgMeta :: Int64
sndMsgId :: Int64
sndMsgId, MsgIntegrity
integrity :: MsgIntegrity
$sel:integrity:MsgMeta :: MsgIntegrity
integrity, PQEncryption
pqEncryption :: PQEncryption
$sel:pqEncryption:MsgMeta :: PQEncryption
pqEncryption}
      msgReceipt :: Maybe MsgReceipt
msgReceipt = Int64 -> MsgReceiptStatus -> MsgReceipt
MsgReceipt (Int64 -> MsgReceiptStatus -> MsgReceipt)
-> Maybe Int64 -> Maybe (MsgReceiptStatus -> MsgReceipt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
rcptInternalId_ Maybe (MsgReceiptStatus -> MsgReceipt)
-> Maybe MsgReceiptStatus -> Maybe MsgReceipt
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe MsgReceiptStatus
rcptStatus_
   in RcvMsg {$sel:internalId:RcvMsg :: InternalId
internalId = Int64 -> InternalId
InternalId Int64
agentMsgId, MsgMeta
msgMeta :: MsgMeta
$sel:msgMeta:RcvMsg :: MsgMeta
msgMeta, AgentMessageType
msgType :: AgentMessageType
$sel:msgType:RcvMsg :: AgentMessageType
msgType, SndFileId
msgBody :: SndFileId
$sel:msgBody:RcvMsg :: SndFileId
msgBody, SndFileId
internalHash :: SndFileId
$sel:internalHash:RcvMsg :: SndFileId
internalHash, Maybe MsgReceipt
msgReceipt :: Maybe MsgReceipt
$sel:msgReceipt:RcvMsg :: Maybe MsgReceipt
msgReceipt, Bool
userAck :: Bool
$sel:userAck:RcvMsg :: Bool
userAck}

incMsgRcvAttempts :: DB.Connection -> ConnId -> InternalId -> IO Int
incMsgRcvAttempts :: Connection -> SndFileId -> InternalId -> IO Int
incMsgRcvAttempts Connection
db SndFileId
connId (InternalId Int64
msgId) =
  Only Int -> Int
forall a. Only a -> a
fromOnly (Only Int -> Int) -> ([Only Int] -> Only Int) -> [Only Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int] -> Only Int
forall a. HasCallStack => [a] -> a
head
    ([Only Int] -> Int) -> IO [Only Int] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> (SndFileId, Int64) -> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        UPDATE rcv_messages
        SET receive_attempts = receive_attempts + 1
        WHERE conn_id = ? AND internal_id = ?
        RETURNING receive_attempts
      |]
      (SndFileId
connId, Int64
msgId)

checkRcvMsgHashExists :: DB.Connection -> ConnId -> ByteString -> IO Bool
checkRcvMsgHashExists :: Connection -> SndFileId -> SndFileId -> IO Bool
checkRcvMsgHashExists Connection
db SndFileId
connId SndFileId
hash =
  Bool -> (Only BoolInt -> Bool) -> IO [Only BoolInt] -> IO Bool
forall (f :: * -> *) b a.
Functor f =>
b -> (a -> b) -> f [a] -> f b
maybeFirstRow' Bool
False Only BoolInt -> Bool
fromOnlyBI (IO [Only BoolInt] -> IO Bool) -> IO [Only BoolInt] -> IO Bool
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (SndFileId, Binary SndFileId) -> IO [Only BoolInt]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      Query
"SELECT 1 FROM encrypted_rcv_message_hashes WHERE conn_id = ? AND hash = ? LIMIT 1"
      (SndFileId
connId, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
hash)

getRcvMsgBrokerTs :: DB.Connection -> ConnId -> SMP.MsgId -> IO (Either StoreError BrokerTs)
getRcvMsgBrokerTs :: Connection
-> SndFileId -> SndFileId -> IO (Either StoreError UTCTime)
getRcvMsgBrokerTs Connection
db SndFileId
connId SndFileId
msgId =
  (Only UTCTime -> UTCTime)
-> StoreError
-> IO [Only UTCTime]
-> IO (Either StoreError UTCTime)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only UTCTime -> UTCTime
forall a. Only a -> a
fromOnly (ServiceName -> StoreError
SEMsgNotFound ServiceName
"getRcvMsgBrokerTs") (IO [Only UTCTime] -> IO (Either StoreError UTCTime))
-> IO [Only UTCTime] -> IO (Either StoreError UTCTime)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (SndFileId, Binary SndFileId) -> IO [Only UTCTime]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT broker_ts FROM rcv_messages WHERE conn_id = ? AND broker_id = ?" (SndFileId
connId, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
msgId)

deleteMsg :: DB.Connection -> ConnId -> InternalId -> IO ()
deleteMsg :: Connection -> SndFileId -> InternalId -> IO ()
deleteMsg Connection
db SndFileId
connId InternalId
msgId =
  Connection -> Query -> (SndFileId, InternalId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM messages WHERE conn_id = ? AND internal_id = ?;" (SndFileId
connId, InternalId
msgId)

deleteMsgContent :: DB.Connection -> ConnId -> InternalId -> IO ()
deleteMsgContent :: Connection -> SndFileId -> InternalId -> IO ()
deleteMsgContent Connection
db SndFileId
connId InternalId
msgId = do
#if defined(dbPostgres)
  DB.execute db "UPDATE messages SET msg_body = ''::BYTEA WHERE conn_id = ? AND internal_id = ?" (connId, msgId)
#else
  Connection -> Query -> (SndFileId, InternalId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE messages SET msg_body = x'' WHERE conn_id = ? AND internal_id = ?" (SndFileId
connId, InternalId
msgId)
#endif
  Connection -> Query -> (SndFileId, InternalId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_messages SET snd_message_body_id = NULL WHERE conn_id = ? AND internal_id = ?" (SndFileId
connId, InternalId
msgId)

deleteDeliveredSndMsg :: DB.Connection -> ConnId -> InternalId -> IO ()
deleteDeliveredSndMsg :: Connection -> SndFileId -> InternalId -> IO ()
deleteDeliveredSndMsg Connection
db SndFileId
connId InternalId
msgId = do
#if defined(dbPostgres)
  _ :: [Only Int] <- DB.query db "SELECT 1 FROM messages WHERE conn_id = ? AND internal_id = ? FOR UPDATE" (connId, msgId)
#endif
  Int
cnt <- Connection -> SndFileId -> InternalId -> IO Int
countPendingSndDeliveries_ Connection
db SndFileId
connId InternalId
msgId
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
cnt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> SndFileId -> InternalId -> IO ()
deleteMsg Connection
db SndFileId
connId InternalId
msgId

deleteSndMsgDelivery :: DB.Connection -> ConnId -> SndQueue -> InternalId -> Bool -> IO ()
deleteSndMsgDelivery :: Connection -> SndFileId -> SndQueue -> InternalId -> Bool -> IO ()
deleteSndMsgDelivery Connection
db SndFileId
connId SndQueue {DBEntityId' 'DBStored
$sel:dbQueueId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> DBEntityId' q
dbQueueId :: DBEntityId' 'DBStored
dbQueueId} InternalId
msgId Bool
keepForReceipt = do
  Connection
-> Query -> (SndFileId, DBEntityId' 'DBStored, InternalId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"DELETE FROM snd_message_deliveries WHERE conn_id = ? AND snd_queue_id = ? AND internal_id = ?"
    (SndFileId
connId, DBEntityId' 'DBStored
dbQueueId, InternalId
msgId)
  IO (Maybe (Maybe MsgReceiptStatus, Maybe Int64))
getRcptAndBodyId IO (Maybe (Maybe MsgReceiptStatus, Maybe Int64))
-> (Maybe (Maybe MsgReceiptStatus, Maybe Int64) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Maybe MsgReceiptStatus, Maybe Int64) -> IO ())
-> Maybe (Maybe MsgReceiptStatus, Maybe Int64) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Maybe MsgReceiptStatus, Maybe Int64) -> IO ()
deleteMsgAndBody
  where
    getRcptAndBodyId :: IO (Maybe (Maybe MsgReceiptStatus, Maybe Int64))
    getRcptAndBodyId :: IO (Maybe (Maybe MsgReceiptStatus, Maybe Int64))
getRcptAndBodyId =
      -- Get receipt status and message body ID if there are no pending deliveries.
      -- The current delivery is deleted above.
      ((Maybe MsgReceiptStatus, Maybe Int64)
 -> (Maybe MsgReceiptStatus, Maybe Int64))
-> IO [(Maybe MsgReceiptStatus, Maybe Int64)]
-> IO (Maybe (Maybe MsgReceiptStatus, Maybe Int64))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (Maybe MsgReceiptStatus, Maybe Int64)
-> (Maybe MsgReceiptStatus, Maybe Int64)
forall a. a -> a
id (IO [(Maybe MsgReceiptStatus, Maybe Int64)]
 -> IO (Maybe (Maybe MsgReceiptStatus, Maybe Int64)))
-> IO [(Maybe MsgReceiptStatus, Maybe Int64)]
-> IO (Maybe (Maybe MsgReceiptStatus, Maybe Int64))
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (SndFileId, InternalId, SndFileId, InternalId)
-> IO [(Maybe MsgReceiptStatus, Maybe Int64)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          ( [sql|
              SELECT rcpt_status, snd_message_body_id FROM snd_messages
              WHERE NOT EXISTS (SELECT 1 FROM snd_message_deliveries WHERE conn_id = ? AND internal_id = ? AND failed = 0)
                AND conn_id = ? AND internal_id = ?
            |]
#if defined(dbPostgres)
              <> " FOR UPDATE"
#endif
          )
          (SndFileId
connId, InternalId
msgId, SndFileId
connId, InternalId
msgId)
    deleteMsgAndBody :: (Maybe MsgReceiptStatus, Maybe Int64) -> IO ()
    deleteMsgAndBody :: (Maybe MsgReceiptStatus, Maybe Int64) -> IO ()
deleteMsgAndBody (Maybe MsgReceiptStatus
rcptStatus_, Maybe Int64
sndMsgBodyId_) = do
      let del :: Connection -> SndFileId -> InternalId -> IO ()
del = case Maybe MsgReceiptStatus
rcptStatus_ of
            -- we are not deleting message if receipt is not received or had incorrect hash (for debugging).
            Just MsgReceiptStatus
MROk -> Connection -> SndFileId -> InternalId -> IO ()
deleteMsg
            Maybe MsgReceiptStatus
_ -> if Bool
keepForReceipt then Connection -> SndFileId -> InternalId -> IO ()
deleteMsgContent else Connection -> SndFileId -> InternalId -> IO ()
deleteMsg
      Connection -> SndFileId -> InternalId -> IO ()
del Connection
db SndFileId
connId InternalId
msgId
      Maybe Int64 -> (Int64 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Int64
sndMsgBodyId_ ((Int64 -> IO ()) -> IO ()) -> (Int64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int64
bodyId -> do
#if defined(dbPostgres)
        -- lock for concurrent deletion of different records in snd_messages pointing to the same record in snd_message_bodies
        _ :: [Only Int] <- DB.query db "SELECT 1 FROM snd_message_bodies WHERE snd_message_body_id = ? FOR UPDATE" (Only bodyId)
#endif
        Connection -> Query -> (Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          [sql|
            DELETE FROM snd_message_bodies
            WHERE NOT EXISTS (SELECT 1 FROM snd_messages WHERE snd_message_body_id = ?)
              AND snd_message_body_id = ?
          |]
          (Int64
bodyId, Int64
bodyId)

countPendingSndDeliveries_ :: DB.Connection -> ConnId -> InternalId -> IO Int
countPendingSndDeliveries_ :: Connection -> SndFileId -> InternalId -> IO Int
countPendingSndDeliveries_ Connection
db SndFileId
connId InternalId
msgId = do
  (Only Int
cnt : [Only Int]
_) <- Connection -> Query -> (SndFileId, InternalId) -> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT count(*) FROM snd_message_deliveries WHERE conn_id = ? AND internal_id = ? AND failed = 0" (SndFileId
connId, InternalId
msgId)
  Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
cnt

deleteRcvMsgHashesExpired :: DB.Connection -> NominalDiffTime -> Int -> IO ()
deleteRcvMsgHashesExpired :: Connection -> NominalDiffTime -> Int -> IO ()
deleteRcvMsgHashesExpired Connection
db NominalDiffTime
ttl Int
limit = do
  UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, Int) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM encrypted_rcv_message_hashes
      WHERE encrypted_rcv_message_hash_id IN (
        SELECT encrypted_rcv_message_hash_id
        FROM encrypted_rcv_message_hashes
        WHERE created_at < ?
        ORDER BY created_at ASC
        LIMIT ?
      )
    |]
    (UTCTime
cutoffTs, Int
limit)

deleteSndMsgsExpired :: DB.Connection -> NominalDiffTime -> Int -> IO ()
deleteSndMsgsExpired :: Connection -> NominalDiffTime -> Int -> IO ()
deleteSndMsgsExpired Connection
db NominalDiffTime
ttl Int
limit = do
  UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, Int) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM messages
      WHERE (conn_id, internal_id) IN (
        SELECT conn_id, internal_id
        FROM messages
        WHERE internal_ts < ? AND internal_snd_id IS NOT NULL
        ORDER BY internal_ts ASC
        LIMIT ?
      )
    |]
    (UTCTime
cutoffTs, Int
limit)

createRatchetX3dhKeys :: DB.Connection -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> Maybe CR.RcvPrivRKEMParams -> IO ()
createRatchetX3dhKeys :: Connection
-> SndFileId
-> PrivateKeyX448
-> PrivateKeyX448
-> Maybe RcvPrivRKEMParams
-> IO ()
createRatchetX3dhKeys Connection
db SndFileId
connId PrivateKeyX448
x3dhPrivKey1 PrivateKeyX448
x3dhPrivKey2 Maybe RcvPrivRKEMParams
pqPrivKem =
  Connection
-> Query
-> (SndFileId, PrivateKeyX448, PrivateKeyX448,
    Maybe RcvPrivRKEMParams)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"INSERT INTO ratchets (conn_id, x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem) VALUES (?, ?, ?, ?)" (SndFileId
connId, PrivateKeyX448
x3dhPrivKey1, PrivateKeyX448
x3dhPrivKey2, Maybe RcvPrivRKEMParams
pqPrivKem)

getRatchetX3dhKeys :: DB.Connection -> ConnId -> IO (Either StoreError (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams))
getRatchetX3dhKeys :: Connection
-> SndFileId
-> IO
     (Either
        StoreError
        (PrivateKeyX448, PrivateKeyX448, Maybe RcvPrivRKEMParams))
getRatchetX3dhKeys Connection
db SndFileId
connId =
  ((Maybe PrivateKeyX448, Maybe PrivateKeyX448,
  Maybe RcvPrivRKEMParams)
 -> Either
      StoreError
      (PrivateKeyX448, PrivateKeyX448, Maybe RcvPrivRKEMParams))
-> StoreError
-> IO
     [(Maybe PrivateKeyX448, Maybe PrivateKeyX448,
       Maybe RcvPrivRKEMParams)]
-> IO
     (Either
        StoreError
        (PrivateKeyX448, PrivateKeyX448, Maybe RcvPrivRKEMParams))
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (Maybe PrivateKeyX448, Maybe PrivateKeyX448,
 Maybe RcvPrivRKEMParams)
-> Either
     StoreError
     (PrivateKeyX448, PrivateKeyX448, Maybe RcvPrivRKEMParams)
forall {a} {b} {c}.
(Maybe a, Maybe b, c) -> Either StoreError (a, b, c)
keys StoreError
SEX3dhKeysNotFound (IO
   [(Maybe PrivateKeyX448, Maybe PrivateKeyX448,
     Maybe RcvPrivRKEMParams)]
 -> IO
      (Either
         StoreError
         (PrivateKeyX448, PrivateKeyX448, Maybe RcvPrivRKEMParams)))
-> IO
     [(Maybe PrivateKeyX448, Maybe PrivateKeyX448,
       Maybe RcvPrivRKEMParams)]
-> IO
     (Either
        StoreError
        (PrivateKeyX448, PrivateKeyX448, Maybe RcvPrivRKEMParams))
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> Only SndFileId
-> IO
     [(Maybe PrivateKeyX448, Maybe PrivateKeyX448,
       Maybe RcvPrivRKEMParams)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem FROM ratchets WHERE conn_id = ?" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
  where
    keys :: (Maybe a, Maybe b, c) -> Either StoreError (a, b, c)
keys = \case
      (Just a
k1, Just b
k2, c
pKem) -> (a, b, c) -> Either StoreError (a, b, c)
forall a b. b -> Either a b
Right (a
k1, b
k2, c
pKem)
      (Maybe a, Maybe b, c)
_ -> StoreError -> Either StoreError (a, b, c)
forall a b. a -> Either a b
Left StoreError
SEX3dhKeysNotFound

-- used to remember new keys when starting ratchet re-synchronization
setRatchetX3dhKeys :: DB.Connection -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> Maybe CR.RcvPrivRKEMParams -> IO ()
setRatchetX3dhKeys :: Connection
-> SndFileId
-> PrivateKeyX448
-> PrivateKeyX448
-> Maybe RcvPrivRKEMParams
-> IO ()
setRatchetX3dhKeys Connection
db SndFileId
connId PrivateKeyX448
x3dhPrivKey1 PrivateKeyX448
x3dhPrivKey2 Maybe RcvPrivRKEMParams
pqPrivKem =
  Connection
-> Query
-> (PrivateKeyX448, PrivateKeyX448, Maybe RcvPrivRKEMParams,
    SndFileId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE ratchets
      SET x3dh_priv_key_1 = ?, x3dh_priv_key_2 = ?, pq_priv_kem = ?
      WHERE conn_id = ?
    |]
    (PrivateKeyX448
x3dhPrivKey1, PrivateKeyX448
x3dhPrivKey2, Maybe RcvPrivRKEMParams
pqPrivKem, SndFileId
connId)

createSndRatchet :: DB.Connection -> ConnId -> RatchetX448 -> CR.AE2ERatchetParams 'C.X448 -> IO ()
createSndRatchet :: Connection
-> SndFileId -> RatchetX448 -> AE2ERatchetParams 'X448 -> IO ()
createSndRatchet Connection
db SndFileId
connId RatchetX448
ratchetState (CR.AE2ERatchetParams SRatchetKEMState s
s (CR.E2ERatchetParams VersionE2E
_ PublicKey 'X448
x3dhPubKey1 PublicKey 'X448
x3dhPubKey2 Maybe (RKEMParams s)
pqPubKem)) =
  Connection
-> Query
-> (SndFileId, RatchetX448, PublicKey 'X448, PublicKey 'X448,
    Maybe ARKEMParams)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO ratchets
        (conn_id, ratchet_state, x3dh_pub_key_1, x3dh_pub_key_2, pq_pub_kem) VALUES (?, ?, ?, ?, ?)
      ON CONFLICT (conn_id) DO UPDATE SET
        ratchet_state = EXCLUDED.ratchet_state,
        x3dh_priv_key_1 = NULL,
        x3dh_priv_key_2 = NULL,
        x3dh_pub_key_1 = EXCLUDED.x3dh_pub_key_1,
        x3dh_pub_key_2 = EXCLUDED.x3dh_pub_key_2,
        pq_priv_kem = NULL,
        pq_pub_kem = EXCLUDED.pq_pub_kem
    |]
    (SndFileId
connId, RatchetX448
ratchetState, PublicKey 'X448
x3dhPubKey1, PublicKey 'X448
x3dhPubKey2, SRatchetKEMState s -> RKEMParams s -> ARKEMParams
forall (s :: RatchetKEMState).
RatchetKEMStateI s =>
SRatchetKEMState s -> RKEMParams s -> ARKEMParams
CR.ARKP SRatchetKEMState s
s (RKEMParams s -> ARKEMParams)
-> Maybe (RKEMParams s) -> Maybe ARKEMParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (RKEMParams s)
pqPubKem)

getSndRatchet :: DB.Connection -> ConnId -> CR.VersionE2E -> IO (Either StoreError (RatchetX448, CR.AE2ERatchetParams 'C.X448))
getSndRatchet :: Connection
-> SndFileId
-> VersionE2E
-> IO (Either StoreError (RatchetX448, AE2ERatchetParams 'X448))
getSndRatchet Connection
db SndFileId
connId VersionE2E
v =
  ((Maybe RatchetX448, Maybe (PublicKey 'X448),
  Maybe (PublicKey 'X448), Maybe ARKEMParams)
 -> Either StoreError (RatchetX448, AE2ERatchetParams 'X448))
-> StoreError
-> IO
     [(Maybe RatchetX448, Maybe (PublicKey 'X448),
       Maybe (PublicKey 'X448), Maybe ARKEMParams)]
-> IO (Either StoreError (RatchetX448, AE2ERatchetParams 'X448))
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (Maybe RatchetX448, Maybe (PublicKey 'X448),
 Maybe (PublicKey 'X448), Maybe ARKEMParams)
-> Either StoreError (RatchetX448, AE2ERatchetParams 'X448)
result StoreError
SEX3dhKeysNotFound (IO
   [(Maybe RatchetX448, Maybe (PublicKey 'X448),
     Maybe (PublicKey 'X448), Maybe ARKEMParams)]
 -> IO (Either StoreError (RatchetX448, AE2ERatchetParams 'X448)))
-> IO
     [(Maybe RatchetX448, Maybe (PublicKey 'X448),
       Maybe (PublicKey 'X448), Maybe ARKEMParams)]
-> IO (Either StoreError (RatchetX448, AE2ERatchetParams 'X448))
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> Only SndFileId
-> IO
     [(Maybe RatchetX448, Maybe (PublicKey 'X448),
       Maybe (PublicKey 'X448), Maybe ARKEMParams)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT ratchet_state, x3dh_pub_key_1, x3dh_pub_key_2, pq_pub_kem FROM ratchets WHERE conn_id = ?" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
  where
    result :: (Maybe RatchetX448, Maybe (PublicKey 'X448),
 Maybe (PublicKey 'X448), Maybe ARKEMParams)
-> Either StoreError (RatchetX448, AE2ERatchetParams 'X448)
result = \case
      (Just RatchetX448
ratchetState, Just PublicKey 'X448
k1, Just PublicKey 'X448
k2, Maybe ARKEMParams
pKem_) ->
        let params :: AE2ERatchetParams 'X448
params = case Maybe ARKEMParams
pKem_ of
              Maybe ARKEMParams
Nothing -> SRatchetKEMState 'RKSProposed
-> E2ERatchetParams 'RKSProposed 'X448 -> AE2ERatchetParams 'X448
forall (a :: Algorithm) (s :: RatchetKEMState).
RatchetKEMStateI s =>
SRatchetKEMState s -> E2ERatchetParams s a -> AE2ERatchetParams a
CR.AE2ERatchetParams SRatchetKEMState 'RKSProposed
CR.SRKSProposed (VersionE2E
-> PublicKey 'X448
-> PublicKey 'X448
-> Maybe (RKEMParams 'RKSProposed)
-> E2ERatchetParams 'RKSProposed 'X448
forall (s :: RatchetKEMState) (a :: Algorithm).
VersionE2E
-> PublicKey a
-> PublicKey a
-> Maybe (RKEMParams s)
-> E2ERatchetParams s a
CR.E2ERatchetParams VersionE2E
v PublicKey 'X448
k1 PublicKey 'X448
k2 Maybe (RKEMParams 'RKSProposed)
forall a. Maybe a
Nothing)
              Just (CR.ARKP SRatchetKEMState s
s RKEMParams s
pKem) -> SRatchetKEMState s
-> E2ERatchetParams s 'X448 -> AE2ERatchetParams 'X448
forall (a :: Algorithm) (s :: RatchetKEMState).
RatchetKEMStateI s =>
SRatchetKEMState s -> E2ERatchetParams s a -> AE2ERatchetParams a
CR.AE2ERatchetParams SRatchetKEMState s
s (VersionE2E
-> PublicKey 'X448
-> PublicKey 'X448
-> Maybe (RKEMParams s)
-> E2ERatchetParams s 'X448
forall (s :: RatchetKEMState) (a :: Algorithm).
VersionE2E
-> PublicKey a
-> PublicKey a
-> Maybe (RKEMParams s)
-> E2ERatchetParams s a
CR.E2ERatchetParams VersionE2E
v PublicKey 'X448
k1 PublicKey 'X448
k2 (RKEMParams s -> Maybe (RKEMParams s)
forall a. a -> Maybe a
Just RKEMParams s
pKem))
         in (RatchetX448, AE2ERatchetParams 'X448)
-> Either StoreError (RatchetX448, AE2ERatchetParams 'X448)
forall a b. b -> Either a b
Right (RatchetX448
ratchetState, AE2ERatchetParams 'X448
params)
      (Maybe RatchetX448, Maybe (PublicKey 'X448),
 Maybe (PublicKey 'X448), Maybe ARKEMParams)
_ -> StoreError
-> Either StoreError (RatchetX448, AE2ERatchetParams 'X448)
forall a b. a -> Either a b
Left StoreError
SEX3dhKeysNotFound

-- TODO remove the columns for public keys in v5.7.
createRatchet :: DB.Connection -> ConnId -> RatchetX448 -> IO ()
createRatchet :: Connection -> SndFileId -> RatchetX448 -> IO ()
createRatchet Connection
db SndFileId
connId RatchetX448
rc =
  Connection
-> Query -> (SndFileId, RatchetX448, RatchetX448) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO ratchets (conn_id, ratchet_state)
      VALUES (?, ?)
      ON CONFLICT (conn_id) DO UPDATE SET
        ratchet_state = ?,
        x3dh_priv_key_1 = NULL,
        x3dh_priv_key_2 = NULL,
        x3dh_pub_key_1 = NULL,
        x3dh_pub_key_2 = NULL,
        pq_priv_kem = NULL,
        pq_pub_kem = NULL
    |]
    (SndFileId
connId, RatchetX448
rc, RatchetX448
rc)

deleteRatchet :: DB.Connection -> ConnId -> IO ()
deleteRatchet :: Connection -> SndFileId -> IO ()
deleteRatchet Connection
db SndFileId
connId =
  Connection -> Query -> Only SndFileId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM ratchets WHERE conn_id = ?" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)

getRatchetForUpdate :: DB.Connection -> ConnId -> IO (Either StoreError RatchetX448)
getRatchetForUpdate :: Connection -> SndFileId -> IO (Either StoreError RatchetX448)
getRatchetForUpdate =
#if defined(dbPostgres)
  getRatchet_ (ratchetQuery <> " FOR UPDATE")
#else
  Query
-> Connection -> SndFileId -> IO (Either StoreError RatchetX448)
getRatchet_ Query
ratchetQuery
#endif
{-# INLINE getRatchetForUpdate #-}

getRatchet :: DB.Connection -> ConnId -> IO (Either StoreError RatchetX448)
getRatchet :: Connection -> SndFileId -> IO (Either StoreError RatchetX448)
getRatchet = Query
-> Connection -> SndFileId -> IO (Either StoreError RatchetX448)
getRatchet_ Query
ratchetQuery
{-# INLINE getRatchet #-}

ratchetQuery :: Query
ratchetQuery :: Query
ratchetQuery = Query
"SELECT ratchet_state FROM ratchets WHERE conn_id = ?"

getRatchet_ :: Query -> DB.Connection -> ConnId -> IO (Either StoreError RatchetX448)
getRatchet_ :: Query
-> Connection -> SndFileId -> IO (Either StoreError RatchetX448)
getRatchet_ Query
q Connection
db SndFileId
connId =
  (Only (Maybe RatchetX448) -> Either StoreError RatchetX448)
-> StoreError
-> IO [Only (Maybe RatchetX448)]
-> IO (Either StoreError RatchetX448)
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' Only (Maybe RatchetX448) -> Either StoreError RatchetX448
forall {b}. Only (Maybe b) -> Either StoreError b
ratchet StoreError
SERatchetNotFound (IO [Only (Maybe RatchetX448)]
 -> IO (Either StoreError RatchetX448))
-> IO [Only (Maybe RatchetX448)]
-> IO (Either StoreError RatchetX448)
forall a b. (a -> b) -> a -> b
$ Connection
-> Query -> Only SndFileId -> IO [Only (Maybe RatchetX448)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
q (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
  where
    ratchet :: Only (Maybe b) -> Either StoreError b
ratchet = Either StoreError b
-> (b -> Either StoreError b) -> Maybe b -> Either StoreError b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (StoreError -> Either StoreError b
forall a b. a -> Either a b
Left StoreError
SERatchetNotFound) b -> Either StoreError b
forall a b. b -> Either a b
Right (Maybe b -> Either StoreError b)
-> (Only (Maybe b) -> Maybe b)
-> Only (Maybe b)
-> Either StoreError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Only (Maybe b) -> Maybe b
forall a. Only a -> a
fromOnly

getSkippedMsgKeys :: DB.Connection -> ConnId -> IO SkippedMsgKeys
getSkippedMsgKeys :: Connection -> SndFileId -> IO SkippedMsgKeys
getSkippedMsgKeys Connection
db SndFileId
connId =
  [(HeaderKey, Word32, MessageKey)] -> SkippedMsgKeys
forall {a}.
[(HeaderKey, Word32, a)] -> Map HeaderKey (Map Word32 a)
skipped ([(HeaderKey, Word32, MessageKey)] -> SkippedMsgKeys)
-> IO [(HeaderKey, Word32, MessageKey)] -> IO SkippedMsgKeys
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> Only SndFileId -> IO [(HeaderKey, Word32, MessageKey)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT header_key, msg_n, msg_key FROM skipped_messages WHERE conn_id = ?" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
  where
    skipped :: [(HeaderKey, Word32, a)] -> Map HeaderKey (Map Word32 a)
skipped = (Map HeaderKey (Map Word32 a)
 -> (HeaderKey, Word32, a) -> Map HeaderKey (Map Word32 a))
-> Map HeaderKey (Map Word32 a)
-> [(HeaderKey, Word32, a)]
-> Map HeaderKey (Map Word32 a)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map HeaderKey (Map Word32 a)
-> (HeaderKey, Word32, a) -> Map HeaderKey (Map Word32 a)
forall {k} {k} {a}.
(Ord k, Ord k) =>
Map k (Map k a) -> (k, k, a) -> Map k (Map k a)
addSkippedKey Map HeaderKey (Map Word32 a)
forall k a. Map k a
M.empty
    addSkippedKey :: Map k (Map k a) -> (k, k, a) -> Map k (Map k a)
addSkippedKey Map k (Map k a)
smks (k
hk, k
msgN, a
mk) = (Maybe (Map k a) -> Maybe (Map k a))
-> k -> Map k (Map k a) -> Map k (Map k a)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (Map k a -> Maybe (Map k a)
forall a. a -> Maybe a
Just (Map k a -> Maybe (Map k a))
-> (Maybe (Map k a) -> Map k a)
-> Maybe (Map k a)
-> Maybe (Map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Map k a) -> Map k a
addMsgKey) k
hk Map k (Map k a)
smks
      where
        addMsgKey :: Maybe (Map k a) -> Map k a
addMsgKey = Map k a -> (Map k a -> Map k a) -> Maybe (Map k a) -> Map k a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (k -> a -> Map k a
forall k a. k -> a -> Map k a
M.singleton k
msgN a
mk) (k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
msgN a
mk)

updateRatchet :: DB.Connection -> ConnId -> RatchetX448 -> SkippedMsgDiff -> IO ()
updateRatchet :: Connection -> SndFileId -> RatchetX448 -> SkippedMsgDiff -> IO ()
updateRatchet Connection
db SndFileId
connId RatchetX448
rc SkippedMsgDiff
skipped = do
  Connection -> Query -> (RatchetX448, SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE ratchets SET ratchet_state = ? WHERE conn_id = ?" (RatchetX448
rc, SndFileId
connId)
  case SkippedMsgDiff
skipped of
    SkippedMsgDiff
SMDNoChange -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    SMDRemove HeaderKey
hk Word32
msgN ->
      Connection -> Query -> (SndFileId, HeaderKey, Word32) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM skipped_messages WHERE conn_id = ? AND header_key = ? AND msg_n = ?" (SndFileId
connId, HeaderKey
hk, Word32
msgN)
    SMDAdd SkippedMsgKeys
smks ->
      [(HeaderKey, SkippedHdrMsgKeys)]
-> ((HeaderKey, SkippedHdrMsgKeys) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (SkippedMsgKeys -> [(HeaderKey, SkippedHdrMsgKeys)]
forall k a. Map k a -> [(k, a)]
M.assocs SkippedMsgKeys
smks) (((HeaderKey, SkippedHdrMsgKeys) -> IO ()) -> IO ())
-> ((HeaderKey, SkippedHdrMsgKeys) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(HeaderKey
hk, SkippedHdrMsgKeys
mks) ->
        [(Word32, MessageKey)] -> ((Word32, MessageKey) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (SkippedHdrMsgKeys -> [(Word32, MessageKey)]
forall k a. Map k a -> [(k, a)]
M.assocs SkippedHdrMsgKeys
mks) (((Word32, MessageKey) -> IO ()) -> IO ())
-> ((Word32, MessageKey) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Word32
msgN, MessageKey
mk) ->
          Connection
-> Query -> (SndFileId, HeaderKey, Word32, MessageKey) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"INSERT INTO skipped_messages (conn_id, header_key, msg_n, msg_key) VALUES (?, ?, ?, ?)" (SndFileId
connId, HeaderKey
hk, Word32
msgN, MessageKey
mk)

createCommand :: DB.Connection -> ACorrId -> ConnId -> Maybe SMPServer -> AgentCommand -> IO (Either StoreError ())
createCommand :: Connection
-> SndFileId
-> SndFileId
-> Maybe SMPServer
-> AgentCommand
-> IO (Either StoreError ())
createCommand Connection
db SndFileId
corrId SndFileId
connId Maybe SMPServer
srv_ AgentCommand
cmd = ExceptT StoreError IO () -> IO (Either StoreError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO () -> IO (Either StoreError ()))
-> ExceptT StoreError IO () -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ do
  (Maybe (NonEmpty TransportHost)
host_, Maybe ServiceName
port_, Maybe KeyHash
serverKeyHash_) <- ExceptT
  StoreError
  IO
  (Maybe (NonEmpty TransportHost), Maybe ServiceName, Maybe KeyHash)
serverFields
  UTCTime
createdAt <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> (IO () -> IO ()) -> IO () -> ExceptT StoreError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SQLError -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle SQLError -> IO ()
handleErr (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (Maybe (NonEmpty TransportHost), Maybe ServiceName,
    Binary SndFileId, SndFileId, AgentCommandTag, AgentCommand,
    Maybe KeyHash, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT INTO commands (host, port, corr_id, conn_id, command_tag, command, server_key_hash, created_at) VALUES (?,?,?,?,?,?,?,?)"
      (Maybe (NonEmpty TransportHost)
host_, Maybe ServiceName
port_, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
corrId, SndFileId
connId, AgentCommandTag
cmdTag, AgentCommand
cmd, Maybe KeyHash
serverKeyHash_, UTCTime
createdAt)
  where
    cmdTag :: AgentCommandTag
cmdTag = AgentCommand -> AgentCommandTag
agentCommandTag AgentCommand
cmd
#if defined(dbPostgres)
    handleErr e = case constraintViolation e of
      Just _ -> logError $ "tried to create command " <> tshow cmdTag <> " for deleted connection"
      Nothing -> E.throwIO e
#else
    handleErr :: SQLError -> IO ()
handleErr SQLError
e
      | SQLError -> Error
SQL.sqlError SQLError
e Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
SQL.ErrorConstraint = Text -> IO ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
logError (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"tried to create command " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AgentCommandTag -> Text
forall a. Show a => a -> Text
tshow AgentCommandTag
cmdTag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for deleted connection"
      | Bool
otherwise = SQLError -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO SQLError
e
#endif
    serverFields :: ExceptT StoreError IO (Maybe (NonEmpty TransportHost), Maybe ServiceName, Maybe C.KeyHash)
    serverFields :: ExceptT
  StoreError
  IO
  (Maybe (NonEmpty TransportHost), Maybe ServiceName, Maybe KeyHash)
serverFields = case Maybe SMPServer
srv_ of
      Just srv :: SMPServer
srv@(SMPServer NonEmpty TransportHost
host ServiceName
port KeyHash
_) ->
        (NonEmpty TransportHost -> Maybe (NonEmpty TransportHost)
forall a. a -> Maybe a
Just NonEmpty TransportHost
host,ServiceName -> Maybe ServiceName
forall a. a -> Maybe a
Just ServiceName
port,) (Maybe KeyHash
 -> (Maybe (NonEmpty TransportHost), Maybe ServiceName,
     Maybe KeyHash))
-> ExceptT StoreError IO (Maybe KeyHash)
-> ExceptT
     StoreError
     IO
     (Maybe (NonEmpty TransportHost), Maybe ServiceName, Maybe KeyHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either StoreError (Maybe KeyHash))
-> ExceptT StoreError IO (Maybe KeyHash)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Connection -> SMPServer -> IO (Either StoreError (Maybe KeyHash))
getServerKeyHash_ Connection
db SMPServer
srv)
      Maybe SMPServer
Nothing -> (Maybe (NonEmpty TransportHost), Maybe ServiceName, Maybe KeyHash)
-> ExceptT
     StoreError
     IO
     (Maybe (NonEmpty TransportHost), Maybe ServiceName, Maybe KeyHash)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (NonEmpty TransportHost)
forall a. Maybe a
Nothing, Maybe ServiceName
forall a. Maybe a
Nothing, Maybe KeyHash
forall a. Maybe a
Nothing)

insertedRowId :: DB.Connection -> IO Int64
insertedRowId :: Connection -> IO Int64
insertedRowId Connection
db = Only Int64 -> Int64
forall a. Only a -> a
fromOnly (Only Int64 -> Int64)
-> ([Only Int64] -> Only Int64) -> [Only Int64] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int64] -> Only Int64
forall a. HasCallStack => [a] -> a
head ([Only Int64] -> Int64) -> IO [Only Int64] -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> IO [Only Int64]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_ Connection
db Query
q
  where
#if defined(dbPostgres)
    q = "SELECT lastval()"
#else
    q :: Query
q = Query
"SELECT last_insert_rowid()"
#endif

getPendingCommandServers :: DB.Connection -> [ConnId] -> IO [(ConnId, NonEmpty (Maybe SMPServer))]
getPendingCommandServers :: Connection
-> [SndFileId] -> IO [(SndFileId, NonEmpty (Maybe SMPServer))]
getPendingCommandServers Connection
db [SndFileId]
connIds =
  -- TODO review whether this can break if, e.g., the server has another key hash.
  (NonEmpty
   (Only SndFileId
    :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
        Maybe KeyHash))
 -> Maybe (SndFileId, NonEmpty (Maybe SMPServer)))
-> [NonEmpty
      (Only SndFileId
       :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
           Maybe KeyHash))]
-> [(SndFileId, NonEmpty (Maybe SMPServer))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NonEmpty
  (Only SndFileId
   :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
       Maybe KeyHash))
-> Maybe (SndFileId, NonEmpty (Maybe SMPServer))
connServers ([NonEmpty
    (Only SndFileId
     :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
         Maybe KeyHash))]
 -> [(SndFileId, NonEmpty (Maybe SMPServer))])
-> ([Only SndFileId
     :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
         Maybe KeyHash)]
    -> [NonEmpty
          (Only SndFileId
           :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
               Maybe KeyHash))])
-> [Only SndFileId
    :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
        Maybe KeyHash)]
-> [(SndFileId, NonEmpty (Maybe SMPServer))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Only SndFileId
  :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
      Maybe KeyHash))
 -> SndFileId)
-> [Only SndFileId
    :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
        Maybe KeyHash)]
-> [NonEmpty
      (Only SndFileId
       :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
           Maybe KeyHash))]
forall k a. Eq k => (a -> k) -> [a] -> [NonEmpty a]
groupOn' (Only SndFileId
 :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
     Maybe KeyHash))
-> SndFileId
forall {a} {t}. (Only a :. t) -> a
rowConnId
    ([Only SndFileId
  :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
      Maybe KeyHash)]
 -> [(SndFileId, NonEmpty (Maybe SMPServer))])
-> IO
     [Only SndFileId
      :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
          Maybe KeyHash)]
-> IO [(SndFileId, NonEmpty (Maybe SMPServer))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> IO
     [Only SndFileId
      :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
          Maybe KeyHash)]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_
      Connection
db
      [sql|
        SELECT DISTINCT c.conn_id, c.host, c.port, COALESCE(c.server_key_hash, s.key_hash)
        FROM commands c
        LEFT JOIN servers s ON s.host = c.host AND s.port = c.port
        ORDER BY c.conn_id
      |]
  where
    rowConnId :: (Only a :. t) -> a
rowConnId (Only a
connId :. t
_) = a
connId
    connServers :: NonEmpty
  (Only SndFileId
   :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
       Maybe KeyHash))
-> Maybe (SndFileId, NonEmpty (Maybe SMPServer))
connServers NonEmpty
  (Only SndFileId
   :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
       Maybe KeyHash))
rs =
      let connId :: SndFileId
connId = (Only SndFileId
 :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
     Maybe KeyHash))
-> SndFileId
forall {a} {t}. (Only a :. t) -> a
rowConnId ((Only SndFileId
  :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
      Maybe KeyHash))
 -> SndFileId)
-> (Only SndFileId
    :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
        Maybe KeyHash))
-> SndFileId
forall a b. (a -> b) -> a -> b
$ NonEmpty
  (Only SndFileId
   :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
       Maybe KeyHash))
-> Only SndFileId
   :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
       Maybe KeyHash)
forall a. NonEmpty a -> a
L.head NonEmpty
  (Only SndFileId
   :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
       Maybe KeyHash))
rs
          srvs :: NonEmpty (Maybe SMPServer)
srvs = ((Only SndFileId
  :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
      Maybe KeyHash))
 -> Maybe SMPServer)
-> NonEmpty
     (Only SndFileId
      :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
          Maybe KeyHash))
-> NonEmpty (Maybe SMPServer)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
L.map (\(Only SndFileId
_ :. (Maybe (NonEmpty TransportHost), Maybe ServiceName, Maybe KeyHash)
r) -> (Maybe (NonEmpty TransportHost), Maybe ServiceName, Maybe KeyHash)
-> Maybe SMPServer
forall {f :: * -> *}.
Applicative f =>
(f (NonEmpty TransportHost), f ServiceName, f KeyHash)
-> f SMPServer
smpServer (Maybe (NonEmpty TransportHost), Maybe ServiceName, Maybe KeyHash)
r) NonEmpty
  (Only SndFileId
   :. (Maybe (NonEmpty TransportHost), Maybe ServiceName,
       Maybe KeyHash))
rs
       in if SndFileId
connId SndFileId -> Set SndFileId -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set SndFileId
conns then (SndFileId, NonEmpty (Maybe SMPServer))
-> Maybe (SndFileId, NonEmpty (Maybe SMPServer))
forall a. a -> Maybe a
Just (SndFileId
connId, NonEmpty (Maybe SMPServer)
srvs) else Maybe (SndFileId, NonEmpty (Maybe SMPServer))
forall a. Maybe a
Nothing
    smpServer :: (f (NonEmpty TransportHost), f ServiceName, f KeyHash)
-> f SMPServer
smpServer (f (NonEmpty TransportHost)
host, f ServiceName
port, f KeyHash
keyHash) = NonEmpty TransportHost -> ServiceName -> KeyHash -> SMPServer
SMPServer (NonEmpty TransportHost -> ServiceName -> KeyHash -> SMPServer)
-> f (NonEmpty TransportHost)
-> f (ServiceName -> KeyHash -> SMPServer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (NonEmpty TransportHost)
host f (ServiceName -> KeyHash -> SMPServer)
-> f ServiceName -> f (KeyHash -> SMPServer)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f ServiceName
port f (KeyHash -> SMPServer) -> f KeyHash -> f SMPServer
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f KeyHash
keyHash
    conns :: Set SndFileId
conns = [SndFileId] -> Set SndFileId
forall a. Ord a => [a] -> Set a
S.fromList [SndFileId]
connIds

getAllPendingCommandConns :: DB.Connection -> IO [(ConnId, Maybe SMPServer)]
getAllPendingCommandConns :: Connection -> IO [(SndFileId, Maybe SMPServer)]
getAllPendingCommandConns Connection
db =
  ((SndFileId, Maybe (NonEmpty TransportHost), Maybe ServiceName,
  Maybe KeyHash)
 -> (SndFileId, Maybe SMPServer))
-> [(SndFileId, Maybe (NonEmpty TransportHost), Maybe ServiceName,
     Maybe KeyHash)]
-> [(SndFileId, Maybe SMPServer)]
forall a b. (a -> b) -> [a] -> [b]
map (SndFileId, Maybe (NonEmpty TransportHost), Maybe ServiceName,
 Maybe KeyHash)
-> (SndFileId, Maybe SMPServer)
forall {f :: * -> *} {a}.
Applicative f =>
(a, f (NonEmpty TransportHost), f ServiceName, f KeyHash)
-> (a, f SMPServer)
toResult
    ([(SndFileId, Maybe (NonEmpty TransportHost), Maybe ServiceName,
   Maybe KeyHash)]
 -> [(SndFileId, Maybe SMPServer)])
-> IO
     [(SndFileId, Maybe (NonEmpty TransportHost), Maybe ServiceName,
       Maybe KeyHash)]
-> IO [(SndFileId, Maybe SMPServer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> IO
     [(SndFileId, Maybe (NonEmpty TransportHost), Maybe ServiceName,
       Maybe KeyHash)]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_
      Connection
db
      [sql|
        SELECT DISTINCT c.conn_id, c.host, c.port, COALESCE(c.server_key_hash, s.key_hash)
        FROM commands c
        JOIN connections cs ON c.conn_id = cs.conn_id
        LEFT JOIN servers s ON s.host = c.host AND s.port = c.port
        WHERE cs.deleted = 0
      |]
  where
    toResult :: (a, f (NonEmpty TransportHost), f ServiceName, f KeyHash)
-> (a, f SMPServer)
toResult (a
connId, f (NonEmpty TransportHost)
host, f ServiceName
port, f KeyHash
keyHash) = (a
connId, NonEmpty TransportHost -> ServiceName -> KeyHash -> SMPServer
SMPServer (NonEmpty TransportHost -> ServiceName -> KeyHash -> SMPServer)
-> f (NonEmpty TransportHost)
-> f (ServiceName -> KeyHash -> SMPServer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (NonEmpty TransportHost)
host f (ServiceName -> KeyHash -> SMPServer)
-> f ServiceName -> f (KeyHash -> SMPServer)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f ServiceName
port f (KeyHash -> SMPServer) -> f KeyHash -> f SMPServer
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f KeyHash
keyHash)

getPendingServerCommand :: DB.Connection -> ConnId -> Maybe SMPServer -> IO (Either StoreError (Maybe PendingCommand))
getPendingServerCommand :: Connection
-> SndFileId
-> Maybe SMPServer
-> IO (Either StoreError (Maybe PendingCommand))
getPendingServerCommand Connection
db SndFileId
connId Maybe SMPServer
srv_ = ServiceName
-> IO (Maybe Int64)
-> (Int64 -> IO (Either StoreError PendingCommand))
-> (Int64 -> IO ())
-> IO (Either StoreError (Maybe PendingCommand))
forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> IO (Maybe i)
-> (i -> IO (Either e a))
-> (i -> IO ())
-> IO (Either e (Maybe a))
getWorkItem ServiceName
"command" IO (Maybe Int64)
getCmdId Int64 -> IO (Either StoreError PendingCommand)
getCommand Int64 -> IO ()
markCommandFailed
  where
    getCmdId :: IO (Maybe Int64)
    getCmdId :: IO (Maybe Int64)
getCmdId =
      (Only Int64 -> Int64) -> IO [Only Int64] -> IO (Maybe Int64)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly (IO [Only Int64] -> IO (Maybe Int64))
-> IO [Only Int64] -> IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$ case Maybe SMPServer
srv_ of
        Maybe SMPServer
Nothing ->
          Connection -> Query -> Only SndFileId -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
            Connection
db
            [sql|
              SELECT command_id FROM commands
              WHERE conn_id = ? AND host IS NULL AND port IS NULL AND failed = 0
              ORDER BY created_at ASC, command_id ASC
              LIMIT 1
            |]
            (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
        Just (SMPServer NonEmpty TransportHost
host ServiceName
port KeyHash
_) ->
          Connection
-> Query
-> (SndFileId, NonEmpty TransportHost, ServiceName)
-> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
            Connection
db
            [sql|
              SELECT command_id FROM commands
              WHERE conn_id = ? AND host = ? AND port = ? AND failed = 0
              ORDER BY created_at ASC, command_id ASC
              LIMIT 1
            |]
            (SndFileId
connId, NonEmpty TransportHost
host, ServiceName
port)
    getCommand :: Int64 -> IO (Either StoreError PendingCommand)
    getCommand :: Int64 -> IO (Either StoreError PendingCommand)
getCommand Int64
cmdId =
      ((SndFileId, Int64, AgentCommand) -> PendingCommand)
-> StoreError
-> IO [(SndFileId, Int64, AgentCommand)]
-> IO (Either StoreError PendingCommand)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (SndFileId, Int64, AgentCommand) -> PendingCommand
pendingCommand StoreError
err (IO [(SndFileId, Int64, AgentCommand)]
 -> IO (Either StoreError PendingCommand))
-> IO [(SndFileId, Int64, AgentCommand)]
-> IO (Either StoreError PendingCommand)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query -> Only Int64 -> IO [(SndFileId, Int64, AgentCommand)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT c.corr_id, cs.user_id, c.command
            FROM commands c
            JOIN connections cs USING (conn_id)
            WHERE c.command_id = ?
          |]
          (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
cmdId)
      where
        err :: StoreError
err = SndFileId -> StoreError
SEInternal (SndFileId -> StoreError) -> SndFileId -> StoreError
forall a b. (a -> b) -> a -> b
$ SndFileId
"command  " SndFileId -> SndFileId -> SndFileId
forall a. Semigroup a => a -> a -> a
<> Int64 -> SndFileId
forall a. Show a => a -> SndFileId
bshow Int64
cmdId SndFileId -> SndFileId -> SndFileId
forall a. Semigroup a => a -> a -> a
<> SndFileId
" returned []"
        pendingCommand :: (SndFileId, Int64, AgentCommand) -> PendingCommand
pendingCommand (SndFileId
corrId, Int64
userId, AgentCommand
command) = PendingCommand {Int64
cmdId :: Int64
$sel:cmdId:PendingCommand :: Int64
cmdId, SndFileId
corrId :: SndFileId
$sel:corrId:PendingCommand :: SndFileId
corrId, Int64
userId :: Int64
$sel:userId:PendingCommand :: Int64
userId, SndFileId
connId :: SndFileId
$sel:connId:PendingCommand :: SndFileId
connId, AgentCommand
command :: AgentCommand
$sel:command:PendingCommand :: AgentCommand
command}
    markCommandFailed :: Int64 -> IO ()
markCommandFailed Int64
cmdId = Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE commands SET failed = 1 WHERE command_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
cmdId)

updateCommandServer :: DB.Connection -> AsyncCmdId -> SMPServer -> IO (Either StoreError ())
updateCommandServer :: Connection -> Int64 -> SMPServer -> IO (Either StoreError ())
updateCommandServer Connection
db Int64
cmdId srv :: SMPServer
srv@(SMPServer NonEmpty TransportHost
host ServiceName
port KeyHash
_) = ExceptT StoreError IO () -> IO (Either StoreError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO () -> IO (Either StoreError ()))
-> ExceptT StoreError IO () -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ do
  Maybe KeyHash
serverKeyHash_ <- IO (Either StoreError (Maybe KeyHash))
-> ExceptT StoreError IO (Maybe KeyHash)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (Maybe KeyHash))
 -> ExceptT StoreError IO (Maybe KeyHash))
-> IO (Either StoreError (Maybe KeyHash))
-> ExceptT StoreError IO (Maybe KeyHash)
forall a b. (a -> b) -> a -> b
$ Connection -> SMPServer -> IO (Either StoreError (Maybe KeyHash))
getServerKeyHash_ Connection
db SMPServer
srv
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, Maybe KeyHash, Int64)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        UPDATE commands
        SET host = ?, port = ?, server_key_hash = ?
        WHERE command_id = ?
      |]
      (NonEmpty TransportHost
host, ServiceName
port, Maybe KeyHash
serverKeyHash_, Int64
cmdId)

deleteCommand :: DB.Connection -> AsyncCmdId -> IO ()
deleteCommand :: Connection -> Int64 -> IO ()
deleteCommand Connection
db Int64
cmdId =
  Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM commands WHERE command_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
cmdId)

createNtfToken :: DB.Connection -> NtfToken -> IO ()
createNtfToken :: Connection -> NtfToken -> IO ()
createNtfToken Connection
db NtfToken {$sel:deviceToken:NtfToken :: NtfToken -> DeviceToken
deviceToken = DeviceToken PushProvider
provider SndFileId
token, $sel:ntfServer:NtfToken :: NtfToken -> NtfServer
ntfServer = srv :: NtfServer
srv@ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port}, Maybe SenderId
ntfTokenId :: Maybe SenderId
$sel:ntfTokenId:NtfToken :: NtfToken -> Maybe SenderId
ntfTokenId, NtfPublicAuthKey
ntfPubKey :: NtfPublicAuthKey
$sel:ntfPubKey:NtfToken :: NtfToken -> NtfPublicAuthKey
ntfPubKey, APrivateAuthKey
ntfPrivKey :: APrivateAuthKey
$sel:ntfPrivKey:NtfToken :: NtfToken -> APrivateAuthKey
ntfPrivKey, $sel:ntfDhKeys:NtfToken :: NtfToken -> KeyPairX25519
ntfDhKeys = (PublicKeyType PrivateKeyX25519
ntfDhPubKey, PrivateKeyX25519
ntfDhPrivKey), Maybe DhSecretX25519
ntfDhSecret :: Maybe DhSecretX25519
$sel:ntfDhSecret:NtfToken :: NtfToken -> Maybe DhSecretX25519
ntfDhSecret, NtfTknStatus
ntfTknStatus :: NtfTknStatus
$sel:ntfTknStatus:NtfToken :: NtfToken -> NtfTknStatus
ntfTknStatus, Maybe NtfTknAction
ntfTknAction :: Maybe NtfTknAction
$sel:ntfTknAction:NtfToken :: NtfToken -> Maybe NtfTknAction
ntfTknAction, NotificationsMode
ntfMode :: NotificationsMode
$sel:ntfMode:NtfToken :: NtfToken -> NotificationsMode
ntfMode} = do
  Connection -> NtfServer -> IO ()
upsertNtfServer_ Connection
db NtfServer
srv
  Connection
-> Query
-> ((PushProvider, Binary SndFileId, NonEmpty TransportHost,
     ServiceName, Maybe SenderId, NtfPublicAuthKey, APrivateAuthKey,
     PublicKeyX25519, PrivateKeyX25519, Maybe DhSecretX25519)
    :. (NtfTknStatus, Maybe NtfTknAction, NotificationsMode))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO ntf_tokens
        (provider, device_token, ntf_host, ntf_port, tkn_id, tkn_pub_key, tkn_priv_key, tkn_pub_dh_key, tkn_priv_dh_key, tkn_dh_secret, tkn_status, tkn_action, ntf_mode) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
    |]
    ((PushProvider
provider, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
token, NonEmpty TransportHost
host, ServiceName
port, Maybe SenderId
ntfTokenId, NtfPublicAuthKey
ntfPubKey, APrivateAuthKey
ntfPrivKey, PublicKeyType PrivateKeyX25519
PublicKeyX25519
ntfDhPubKey, PrivateKeyX25519
ntfDhPrivKey, Maybe DhSecretX25519
ntfDhSecret) (PushProvider, Binary SndFileId, NonEmpty TransportHost,
 ServiceName, Maybe SenderId, NtfPublicAuthKey, APrivateAuthKey,
 PublicKeyX25519, PrivateKeyX25519, Maybe DhSecretX25519)
-> (NtfTknStatus, Maybe NtfTknAction, NotificationsMode)
-> (PushProvider, Binary SndFileId, NonEmpty TransportHost,
    ServiceName, Maybe SenderId, NtfPublicAuthKey, APrivateAuthKey,
    PublicKeyX25519, PrivateKeyX25519, Maybe DhSecretX25519)
   :. (NtfTknStatus, Maybe NtfTknAction, NotificationsMode)
forall h t. h -> t -> h :. t
:. (NtfTknStatus
ntfTknStatus, Maybe NtfTknAction
ntfTknAction, NotificationsMode
ntfMode))

getSavedNtfToken :: DB.Connection -> IO (Maybe NtfToken)
getSavedNtfToken :: Connection -> IO (Maybe NtfToken)
getSavedNtfToken Connection
db = do
  (((NonEmpty TransportHost, ServiceName, KeyHash)
  :. ((PushProvider, Binary SndFileId, Maybe SenderId,
       NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
       PrivateKeyX25519, Maybe DhSecretX25519)
      :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode)))
 -> NtfToken)
-> IO
     [(NonEmpty TransportHost, ServiceName, KeyHash)
      :. ((PushProvider, Binary SndFileId, Maybe SenderId,
           NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
           PrivateKeyX25519, Maybe DhSecretX25519)
          :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode))]
-> IO (Maybe NtfToken)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow ((NonEmpty TransportHost, ServiceName, KeyHash)
 :. ((PushProvider, Binary SndFileId, Maybe SenderId,
      NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
      PrivateKeyX25519, Maybe DhSecretX25519)
     :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode)))
-> NtfToken
ntfToken (IO
   [(NonEmpty TransportHost, ServiceName, KeyHash)
    :. ((PushProvider, Binary SndFileId, Maybe SenderId,
         NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
         PrivateKeyX25519, Maybe DhSecretX25519)
        :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode))]
 -> IO (Maybe NtfToken))
-> IO
     [(NonEmpty TransportHost, ServiceName, KeyHash)
      :. ((PushProvider, Binary SndFileId, Maybe SenderId,
           NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
           PrivateKeyX25519, Maybe DhSecretX25519)
          :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode))]
-> IO (Maybe NtfToken)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> IO
     [(NonEmpty TransportHost, ServiceName, KeyHash)
      :. ((PushProvider, Binary SndFileId, Maybe SenderId,
           NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
           PrivateKeyX25519, Maybe DhSecretX25519)
          :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode))]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_
      Connection
db
      [sql|
        SELECT s.ntf_host, s.ntf_port, s.ntf_key_hash,
          t.provider, t.device_token, t.tkn_id, t.tkn_pub_key, t.tkn_priv_key, t.tkn_pub_dh_key, t.tkn_priv_dh_key, t.tkn_dh_secret,
          t.tkn_status, t.tkn_action, t.ntf_mode
        FROM ntf_tokens t
        JOIN ntf_servers s USING (ntf_host, ntf_port)
      |]
  where
    ntfToken :: ((NonEmpty TransportHost, ServiceName, KeyHash)
 :. ((PushProvider, Binary SndFileId, Maybe SenderId,
      NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
      PrivateKeyX25519, Maybe DhSecretX25519)
     :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode)))
-> NtfToken
ntfToken ((NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash) :. (PushProvider
provider, Binary SndFileId
dt, Maybe SenderId
ntfTokenId, NtfPublicAuthKey
ntfPubKey, APrivateAuthKey
ntfPrivKey, PublicKeyX25519
ntfDhPubKey, PrivateKeyX25519
ntfDhPrivKey, Maybe DhSecretX25519
ntfDhSecret) :. (NtfTknStatus
ntfTknStatus, Maybe NtfTknAction
ntfTknAction, Maybe NotificationsMode
ntfMode_)) =
      let ntfServer :: NtfServer
ntfServer = NonEmpty TransportHost -> ServiceName -> KeyHash -> NtfServer
NtfServer NonEmpty TransportHost
host ServiceName
port KeyHash
keyHash
          ntfDhKeys :: (PublicKeyX25519, PrivateKeyX25519)
ntfDhKeys = (PublicKeyX25519
ntfDhPubKey, PrivateKeyX25519
ntfDhPrivKey)
          ntfMode :: NotificationsMode
ntfMode = NotificationsMode -> Maybe NotificationsMode -> NotificationsMode
forall a. a -> Maybe a -> a
fromMaybe NotificationsMode
NMPeriodic Maybe NotificationsMode
ntfMode_
       in NtfToken {$sel:deviceToken:NtfToken :: DeviceToken
deviceToken = PushProvider -> SndFileId -> DeviceToken
DeviceToken PushProvider
provider SndFileId
dt, NtfServer
$sel:ntfServer:NtfToken :: NtfServer
ntfServer :: NtfServer
ntfServer, Maybe SenderId
$sel:ntfTokenId:NtfToken :: Maybe SenderId
ntfTokenId :: Maybe SenderId
ntfTokenId, NtfPublicAuthKey
$sel:ntfPubKey:NtfToken :: NtfPublicAuthKey
ntfPubKey :: NtfPublicAuthKey
ntfPubKey, APrivateAuthKey
$sel:ntfPrivKey:NtfToken :: APrivateAuthKey
ntfPrivKey :: APrivateAuthKey
ntfPrivKey, KeyPairX25519
(PublicKeyX25519, PrivateKeyX25519)
$sel:ntfDhKeys:NtfToken :: KeyPairX25519
ntfDhKeys :: (PublicKeyX25519, PrivateKeyX25519)
ntfDhKeys, Maybe DhSecretX25519
$sel:ntfDhSecret:NtfToken :: Maybe DhSecretX25519
ntfDhSecret :: Maybe DhSecretX25519
ntfDhSecret, NtfTknStatus
$sel:ntfTknStatus:NtfToken :: NtfTknStatus
ntfTknStatus :: NtfTknStatus
ntfTknStatus, Maybe NtfTknAction
$sel:ntfTknAction:NtfToken :: Maybe NtfTknAction
ntfTknAction :: Maybe NtfTknAction
ntfTknAction, NotificationsMode
$sel:ntfMode:NtfToken :: NotificationsMode
ntfMode :: NotificationsMode
ntfMode}

updateNtfTokenRegistration :: DB.Connection -> NtfToken -> NtfTokenId -> C.DhSecretX25519 -> IO ()
updateNtfTokenRegistration :: Connection -> NtfToken -> SenderId -> DhSecretX25519 -> IO ()
updateNtfTokenRegistration Connection
db NtfToken {$sel:deviceToken:NtfToken :: NtfToken -> DeviceToken
deviceToken = DeviceToken PushProvider
provider SndFileId
token, $sel:ntfServer:NtfToken :: NtfToken -> NtfServer
ntfServer = ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port}} SenderId
tknId DhSecretX25519
ntfDhSecret = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (SenderId, DhSecretX25519, NtfTknStatus, Maybe NtfTknAction,
    UTCTime, PushProvider, Binary SndFileId, NonEmpty TransportHost,
    ServiceName)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE ntf_tokens
      SET tkn_id = ?, tkn_dh_secret = ?, tkn_status = ?, tkn_action = ?, updated_at = ?
      WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
    |]
    (SenderId
tknId, DhSecretX25519
ntfDhSecret, NtfTknStatus
NTRegistered, Maybe NtfTknAction
forall a. Maybe a
Nothing :: Maybe NtfTknAction, UTCTime
updatedAt, PushProvider
provider, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
token, NonEmpty TransportHost
host, ServiceName
port)

updateDeviceToken :: DB.Connection -> NtfToken -> DeviceToken -> IO ()
updateDeviceToken :: Connection -> NtfToken -> DeviceToken -> IO ()
updateDeviceToken Connection
db NtfToken {$sel:deviceToken:NtfToken :: NtfToken -> DeviceToken
deviceToken = DeviceToken PushProvider
provider SndFileId
token, $sel:ntfServer:NtfToken :: NtfToken -> NtfServer
ntfServer = ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port}} (DeviceToken PushProvider
toProvider SndFileId
toToken) = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (PushProvider, Binary SndFileId, NtfTknStatus,
    Maybe NtfTknAction, UTCTime, PushProvider, Binary SndFileId,
    NonEmpty TransportHost, ServiceName)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE ntf_tokens
      SET provider = ?, device_token = ?, tkn_status = ?, tkn_action = ?, updated_at = ?
      WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
    |]
    (PushProvider
toProvider, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
toToken, NtfTknStatus
NTRegistered, Maybe NtfTknAction
forall a. Maybe a
Nothing :: Maybe NtfTknAction, UTCTime
updatedAt, PushProvider
provider, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
token, NonEmpty TransportHost
host, ServiceName
port)

updateNtfMode :: DB.Connection -> NtfToken -> NotificationsMode -> IO ()
updateNtfMode :: Connection -> NtfToken -> NotificationsMode -> IO ()
updateNtfMode Connection
db NtfToken {$sel:deviceToken:NtfToken :: NtfToken -> DeviceToken
deviceToken = DeviceToken PushProvider
provider SndFileId
token, $sel:ntfServer:NtfToken :: NtfToken -> NtfServer
ntfServer = ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port}} NotificationsMode
ntfMode = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (NotificationsMode, UTCTime, PushProvider, Binary SndFileId,
    NonEmpty TransportHost, ServiceName)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE ntf_tokens
      SET ntf_mode = ?, updated_at = ?
      WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
    |]
    (NotificationsMode
ntfMode, UTCTime
updatedAt, PushProvider
provider, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
token, NonEmpty TransportHost
host, ServiceName
port)

updateNtfToken :: DB.Connection -> NtfToken -> NtfTknStatus -> Maybe NtfTknAction -> IO ()
updateNtfToken :: Connection
-> NtfToken -> NtfTknStatus -> Maybe NtfTknAction -> IO ()
updateNtfToken Connection
db NtfToken {$sel:deviceToken:NtfToken :: NtfToken -> DeviceToken
deviceToken = DeviceToken PushProvider
provider SndFileId
token, $sel:ntfServer:NtfToken :: NtfToken -> NtfServer
ntfServer = ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port}} NtfTknStatus
tknStatus Maybe NtfTknAction
tknAction = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (NtfTknStatus, Maybe NtfTknAction, UTCTime, PushProvider,
    Binary SndFileId, NonEmpty TransportHost, ServiceName)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE ntf_tokens
      SET tkn_status = ?, tkn_action = ?, updated_at = ?
      WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
    |]
    (NtfTknStatus
tknStatus, Maybe NtfTknAction
tknAction, UTCTime
updatedAt, PushProvider
provider, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
token, NonEmpty TransportHost
host, ServiceName
port)

removeNtfToken :: DB.Connection -> NtfToken -> IO ()
removeNtfToken :: Connection -> NtfToken -> IO ()
removeNtfToken Connection
db NtfToken {$sel:deviceToken:NtfToken :: NtfToken -> DeviceToken
deviceToken = DeviceToken PushProvider
provider SndFileId
token, $sel:ntfServer:NtfToken :: NtfToken -> NtfServer
ntfServer = ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port}} =
  Connection
-> Query
-> (PushProvider, Binary SndFileId, NonEmpty TransportHost,
    ServiceName)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM ntf_tokens
      WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
    |]
    (PushProvider
provider, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
token, NonEmpty TransportHost
host, ServiceName
port)

addNtfTokenToDelete :: DB.Connection -> NtfServer -> C.APrivateAuthKey -> NtfTokenId -> IO ()
addNtfTokenToDelete :: Connection -> NtfServer -> APrivateAuthKey -> SenderId -> IO ()
addNtfTokenToDelete Connection
db ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port, KeyHash
keyHash :: KeyHash
$sel:keyHash:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> KeyHash
keyHash} APrivateAuthKey
ntfPrivKey SenderId
tknId =
  Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, KeyHash, SenderId,
    APrivateAuthKey)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"INSERT INTO ntf_tokens_to_delete (ntf_host, ntf_port, ntf_key_hash, tkn_id, tkn_priv_key) VALUES (?,?,?,?,?)" (NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash, SenderId
tknId, APrivateAuthKey
ntfPrivKey)

deleteExpiredNtfTokensToDelete :: DB.Connection -> NominalDiffTime -> IO ()
deleteExpiredNtfTokensToDelete :: Connection -> NominalDiffTime -> IO ()
deleteExpiredNtfTokensToDelete Connection
db NominalDiffTime
ttl = do
  UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  Connection -> Query -> Only UTCTime -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM ntf_tokens_to_delete WHERE created_at < ?" (UTCTime -> Only UTCTime
forall a. a -> Only a
Only UTCTime
cutoffTs)

type NtfTokenToDelete = (Int64, C.APrivateAuthKey, NtfTokenId)

getNextNtfTokenToDelete :: DB.Connection -> NtfServer -> IO (Either StoreError (Maybe NtfTokenToDelete))
getNextNtfTokenToDelete :: Connection
-> NtfServer -> IO (Either StoreError (Maybe NtfTokenToDelete))
getNextNtfTokenToDelete Connection
db (NtfServer NonEmpty TransportHost
ntfHost ServiceName
ntfPort KeyHash
_) =
  ServiceName
-> IO (Maybe Int64)
-> (Int64 -> IO (Either StoreError NtfTokenToDelete))
-> (Int64 -> IO ())
-> IO (Either StoreError (Maybe NtfTokenToDelete))
forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> IO (Maybe i)
-> (i -> IO (Either e a))
-> (i -> IO ())
-> IO (Either e (Maybe a))
getWorkItem ServiceName
"ntf tkn del" IO (Maybe Int64)
getNtfTknDbId Int64 -> IO (Either StoreError NtfTokenToDelete)
getNtfTknToDelete (Connection -> Int64 -> IO ()
markNtfTokenToDeleteFailed_ Connection
db)
  where
    getNtfTknDbId :: IO (Maybe Int64)
    getNtfTknDbId :: IO (Maybe Int64)
getNtfTknDbId =
      (Only Int64 -> Int64) -> IO [Only Int64] -> IO (Maybe Int64)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly (IO [Only Int64] -> IO (Maybe Int64))
-> IO [Only Int64] -> IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (NonEmpty TransportHost, ServiceName)
-> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT ntf_token_to_delete_id
            FROM ntf_tokens_to_delete
            WHERE ntf_host = ? AND ntf_port = ?
              AND del_failed = 0
            ORDER BY created_at ASC
            LIMIT 1
          |]
          (NonEmpty TransportHost
ntfHost, ServiceName
ntfPort)
    getNtfTknToDelete :: Int64 -> IO (Either StoreError NtfTokenToDelete)
    getNtfTknToDelete :: Int64 -> IO (Either StoreError NtfTokenToDelete)
getNtfTknToDelete Int64
tknDbId =
      ((APrivateAuthKey, SenderId) -> NtfTokenToDelete)
-> StoreError
-> IO [(APrivateAuthKey, SenderId)]
-> IO (Either StoreError NtfTokenToDelete)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (APrivateAuthKey, SenderId) -> NtfTokenToDelete
ntfTokenToDelete StoreError
err (IO [(APrivateAuthKey, SenderId)]
 -> IO (Either StoreError NtfTokenToDelete))
-> IO [(APrivateAuthKey, SenderId)]
-> IO (Either StoreError NtfTokenToDelete)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query -> Only Int64 -> IO [(APrivateAuthKey, SenderId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT tkn_priv_key, tkn_id
            FROM ntf_tokens_to_delete
            WHERE ntf_token_to_delete_id = ?
          |]
          (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
tknDbId)
      where
        err :: StoreError
err = SndFileId -> StoreError
SEInternal (SndFileId -> StoreError) -> SndFileId -> StoreError
forall a b. (a -> b) -> a -> b
$ SndFileId
"ntf token to delete " SndFileId -> SndFileId -> SndFileId
forall a. Semigroup a => a -> a -> a
<> Int64 -> SndFileId
forall a. Show a => a -> SndFileId
bshow Int64
tknDbId SndFileId -> SndFileId -> SndFileId
forall a. Semigroup a => a -> a -> a
<> SndFileId
" returned []"
        ntfTokenToDelete :: (APrivateAuthKey, SenderId) -> NtfTokenToDelete
ntfTokenToDelete (APrivateAuthKey
tknPrivKey, SenderId
tknId) = (Int64
tknDbId, APrivateAuthKey
tknPrivKey, SenderId
tknId)

markNtfTokenToDeleteFailed_ :: DB.Connection -> Int64 -> IO ()
markNtfTokenToDeleteFailed_ :: Connection -> Int64 -> IO ()
markNtfTokenToDeleteFailed_ Connection
db Int64
tknDbId =
  Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE ntf_tokens_to_delete SET del_failed = 1 where ntf_token_to_delete_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
tknDbId)

getPendingDelTknServers :: DB.Connection -> IO [NtfServer]
getPendingDelTknServers :: Connection -> IO [NtfServer]
getPendingDelTknServers Connection
db =
  ((NonEmpty TransportHost, ServiceName, KeyHash) -> NtfServer)
-> [(NonEmpty TransportHost, ServiceName, KeyHash)] -> [NtfServer]
forall a b. (a -> b) -> [a] -> [b]
map (NonEmpty TransportHost, ServiceName, KeyHash) -> NtfServer
toNtfServer
    ([(NonEmpty TransportHost, ServiceName, KeyHash)] -> [NtfServer])
-> IO [(NonEmpty TransportHost, ServiceName, KeyHash)]
-> IO [NtfServer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> IO [(NonEmpty TransportHost, ServiceName, KeyHash)]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_
      Connection
db
      [sql|
        SELECT DISTINCT ntf_host, ntf_port, ntf_key_hash
        FROM ntf_tokens_to_delete
      |]
  where
    toNtfServer :: (NonEmpty TransportHost, ServiceName, KeyHash) -> NtfServer
toNtfServer (NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash) = NonEmpty TransportHost -> ServiceName -> KeyHash -> NtfServer
NtfServer NonEmpty TransportHost
host ServiceName
port KeyHash
keyHash

deleteNtfTokenToDelete :: DB.Connection -> Int64 -> IO ()
deleteNtfTokenToDelete :: Connection -> Int64 -> IO ()
deleteNtfTokenToDelete Connection
db Int64
tknDbId =
  Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM ntf_tokens_to_delete WHERE ntf_token_to_delete_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
tknDbId)

type NtfSupervisorSub = (NtfSubscription, Maybe (NtfSubAction, NtfActionTs))

getNtfSubscription :: DB.Connection -> ConnId -> IO (Maybe NtfSupervisorSub)
getNtfSubscription :: Connection -> SndFileId -> IO (Maybe NtfSupervisorSub)
getNtfSubscription Connection
db SndFileId
connId =
  (((Int64, NonEmpty TransportHost, ServiceName, KeyHash,
   NonEmpty TransportHost, ServiceName, KeyHash)
  :. (Maybe SenderId, Maybe SenderId, NtfAgentSubStatus,
      Maybe NtfSubNTFAction, Maybe NtfSubSMPAction, Maybe UTCTime))
 -> NtfSupervisorSub)
-> IO
     [(Int64, NonEmpty TransportHost, ServiceName, KeyHash,
       NonEmpty TransportHost, ServiceName, KeyHash)
      :. (Maybe SenderId, Maybe SenderId, NtfAgentSubStatus,
          Maybe NtfSubNTFAction, Maybe NtfSubSMPAction, Maybe UTCTime)]
-> IO (Maybe NtfSupervisorSub)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow ((Int64, NonEmpty TransportHost, ServiceName, KeyHash,
  NonEmpty TransportHost, ServiceName, KeyHash)
 :. (Maybe SenderId, Maybe SenderId, NtfAgentSubStatus,
     Maybe NtfSubNTFAction, Maybe NtfSubSMPAction, Maybe UTCTime))
-> NtfSupervisorSub
ntfSubscription (IO
   [(Int64, NonEmpty TransportHost, ServiceName, KeyHash,
     NonEmpty TransportHost, ServiceName, KeyHash)
    :. (Maybe SenderId, Maybe SenderId, NtfAgentSubStatus,
        Maybe NtfSubNTFAction, Maybe NtfSubSMPAction, Maybe UTCTime)]
 -> IO (Maybe NtfSupervisorSub))
-> IO
     [(Int64, NonEmpty TransportHost, ServiceName, KeyHash,
       NonEmpty TransportHost, ServiceName, KeyHash)
      :. (Maybe SenderId, Maybe SenderId, NtfAgentSubStatus,
          Maybe NtfSubNTFAction, Maybe NtfSubSMPAction, Maybe UTCTime)]
-> IO (Maybe NtfSupervisorSub)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> Only SndFileId
-> IO
     [(Int64, NonEmpty TransportHost, ServiceName, KeyHash,
       NonEmpty TransportHost, ServiceName, KeyHash)
      :. (Maybe SenderId, Maybe SenderId, NtfAgentSubStatus,
          Maybe NtfSubNTFAction, Maybe NtfSubSMPAction, Maybe UTCTime)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT c.user_id, s.host, s.port, COALESCE(nsb.smp_server_key_hash, s.key_hash), ns.ntf_host, ns.ntf_port, ns.ntf_key_hash,
          nsb.smp_ntf_id, nsb.ntf_sub_id, nsb.ntf_sub_status, nsb.ntf_sub_action, nsb.ntf_sub_smp_action, nsb.ntf_sub_action_ts
        FROM ntf_subscriptions nsb
        JOIN connections c USING (conn_id)
        JOIN servers s ON s.host = nsb.smp_host AND s.port = nsb.smp_port
        JOIN ntf_servers ns USING (ntf_host, ntf_port)
        WHERE nsb.conn_id = ?
      |]
      (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
  where
    ntfSubscription :: ((Int64, NonEmpty TransportHost, ServiceName, KeyHash,
  NonEmpty TransportHost, ServiceName, KeyHash)
 :. (Maybe SenderId, Maybe SenderId, NtfAgentSubStatus,
     Maybe NtfSubNTFAction, Maybe NtfSubSMPAction, Maybe UTCTime))
-> NtfSupervisorSub
ntfSubscription ((Int64
userId, NonEmpty TransportHost
smpHost, ServiceName
smpPort, KeyHash
smpKeyHash, NonEmpty TransportHost
ntfHost, ServiceName
ntfPort, KeyHash
ntfKeyHash) :. (Maybe SenderId
ntfQueueId, Maybe SenderId
ntfSubId, NtfAgentSubStatus
ntfSubStatus, Maybe NtfSubNTFAction
ntfAction_, Maybe NtfSubSMPAction
smpAction_, Maybe UTCTime
actionTs_)) =
      let smpServer :: SMPServer
smpServer = NonEmpty TransportHost -> ServiceName -> KeyHash -> SMPServer
SMPServer NonEmpty TransportHost
smpHost ServiceName
smpPort KeyHash
smpKeyHash
          ntfServer :: NtfServer
ntfServer = NonEmpty TransportHost -> ServiceName -> KeyHash -> NtfServer
NtfServer NonEmpty TransportHost
ntfHost ServiceName
ntfPort KeyHash
ntfKeyHash
          action :: Maybe (NtfSubAction, UTCTime)
action = case (Maybe NtfSubNTFAction
ntfAction_, Maybe NtfSubSMPAction
smpAction_, Maybe UTCTime
actionTs_) of
            (Just NtfSubNTFAction
ntfAction, Maybe NtfSubSMPAction
Nothing, Just UTCTime
actionTs) -> (NtfSubAction, UTCTime) -> Maybe (NtfSubAction, UTCTime)
forall a. a -> Maybe a
Just (NtfSubNTFAction -> NtfSubAction
NSANtf NtfSubNTFAction
ntfAction, UTCTime
actionTs)
            (Maybe NtfSubNTFAction
Nothing, Just NtfSubSMPAction
smpAction, Just UTCTime
actionTs) -> (NtfSubAction, UTCTime) -> Maybe (NtfSubAction, UTCTime)
forall a. a -> Maybe a
Just (NtfSubSMPAction -> NtfSubAction
NSASMP NtfSubSMPAction
smpAction, UTCTime
actionTs)
            (Maybe NtfSubNTFAction, Maybe NtfSubSMPAction, Maybe UTCTime)
_ -> Maybe (NtfSubAction, UTCTime)
forall a. Maybe a
Nothing
       in (NtfSubscription {Int64
userId :: Int64
$sel:userId:NtfSubscription :: Int64
userId, SndFileId
connId :: SndFileId
$sel:connId:NtfSubscription :: SndFileId
connId, SMPServer
smpServer :: SMPServer
$sel:smpServer:NtfSubscription :: SMPServer
smpServer, Maybe SenderId
ntfQueueId :: Maybe SenderId
$sel:ntfQueueId:NtfSubscription :: Maybe SenderId
ntfQueueId, NtfServer
ntfServer :: NtfServer
$sel:ntfServer:NtfSubscription :: NtfServer
ntfServer, Maybe SenderId
ntfSubId :: Maybe SenderId
$sel:ntfSubId:NtfSubscription :: Maybe SenderId
ntfSubId, NtfAgentSubStatus
ntfSubStatus :: NtfAgentSubStatus
$sel:ntfSubStatus:NtfSubscription :: NtfAgentSubStatus
ntfSubStatus}, Maybe (NtfSubAction, UTCTime)
action)

createNtfSubscription :: DB.Connection -> NtfSubscription -> NtfSubAction -> IO (Either StoreError ())
createNtfSubscription :: Connection
-> NtfSubscription -> NtfSubAction -> IO (Either StoreError ())
createNtfSubscription Connection
db NtfSubscription
ntfSubscription NtfSubAction
action = ExceptT StoreError IO () -> IO (Either StoreError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO () -> IO (Either StoreError ()))
-> ExceptT StoreError IO () -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ do
  let NtfSubscription {SndFileId
$sel:connId:NtfSubscription :: NtfSubscription -> SndFileId
connId :: SndFileId
connId, $sel:smpServer:NtfSubscription :: NtfSubscription -> SMPServer
smpServer = smpServer :: SMPServer
smpServer@(SMPServer NonEmpty TransportHost
host ServiceName
port KeyHash
_), Maybe SenderId
$sel:ntfQueueId:NtfSubscription :: NtfSubscription -> Maybe SenderId
ntfQueueId :: Maybe SenderId
ntfQueueId, $sel:ntfServer:NtfSubscription :: NtfSubscription -> NtfServer
ntfServer = (NtfServer NonEmpty TransportHost
ntfHost ServiceName
ntfPort KeyHash
_), Maybe SenderId
$sel:ntfSubId:NtfSubscription :: NtfSubscription -> Maybe SenderId
ntfSubId :: Maybe SenderId
ntfSubId, NtfAgentSubStatus
$sel:ntfSubStatus:NtfSubscription :: NtfSubscription -> NtfAgentSubStatus
ntfSubStatus :: NtfAgentSubStatus
ntfSubStatus} = NtfSubscription
ntfSubscription
  Maybe KeyHash
smpServerKeyHash_ <- IO (Either StoreError (Maybe KeyHash))
-> ExceptT StoreError IO (Maybe KeyHash)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (Maybe KeyHash))
 -> ExceptT StoreError IO (Maybe KeyHash))
-> IO (Either StoreError (Maybe KeyHash))
-> ExceptT StoreError IO (Maybe KeyHash)
forall a b. (a -> b) -> a -> b
$ Connection -> SMPServer -> IO (Either StoreError (Maybe KeyHash))
getServerKeyHash_ Connection
db SMPServer
smpServer
  UTCTime
actionTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> ((SndFileId, NonEmpty TransportHost, ServiceName,
     Maybe SenderId, NonEmpty TransportHost, ServiceName,
     Maybe SenderId)
    :. (NtfAgentSubStatus, Maybe NtfSubNTFAction,
        Maybe NtfSubSMPAction, UTCTime, Maybe KeyHash))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        INSERT INTO ntf_subscriptions
          (conn_id, smp_host, smp_port, smp_ntf_id, ntf_host, ntf_port, ntf_sub_id,
            ntf_sub_status, ntf_sub_action, ntf_sub_smp_action, ntf_sub_action_ts, smp_server_key_hash)
        VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
      |]
      ( (SndFileId
connId, NonEmpty TransportHost
host, ServiceName
port, Maybe SenderId
ntfQueueId, NonEmpty TransportHost
ntfHost, ServiceName
ntfPort, Maybe SenderId
ntfSubId)
          (SndFileId, NonEmpty TransportHost, ServiceName, Maybe SenderId,
 NonEmpty TransportHost, ServiceName, Maybe SenderId)
-> (NtfAgentSubStatus, Maybe NtfSubNTFAction,
    Maybe NtfSubSMPAction, UTCTime, Maybe KeyHash)
-> (SndFileId, NonEmpty TransportHost, ServiceName, Maybe SenderId,
    NonEmpty TransportHost, ServiceName, Maybe SenderId)
   :. (NtfAgentSubStatus, Maybe NtfSubNTFAction,
       Maybe NtfSubSMPAction, UTCTime, Maybe KeyHash)
forall h t. h -> t -> h :. t
:. (NtfAgentSubStatus
ntfSubStatus, Maybe NtfSubNTFAction
ntfSubAction, Maybe NtfSubSMPAction
ntfSubSMPAction, UTCTime
actionTs, Maybe KeyHash
smpServerKeyHash_)
      )
  where
    (Maybe NtfSubNTFAction
ntfSubAction, Maybe NtfSubSMPAction
ntfSubSMPAction) = NtfSubAction -> (Maybe NtfSubNTFAction, Maybe NtfSubSMPAction)
ntfSubAndSMPAction NtfSubAction
action

supervisorUpdateNtfSub :: DB.Connection -> NtfSubscription -> NtfSubAction -> IO ()
supervisorUpdateNtfSub :: Connection -> NtfSubscription -> NtfSubAction -> IO ()
supervisorUpdateNtfSub Connection
db NtfSubscription {SndFileId
$sel:connId:NtfSubscription :: NtfSubscription -> SndFileId
connId :: SndFileId
connId, $sel:smpServer:NtfSubscription :: NtfSubscription -> SMPServer
smpServer = (SMPServer NonEmpty TransportHost
smpHost ServiceName
smpPort KeyHash
_), Maybe SenderId
$sel:ntfQueueId:NtfSubscription :: NtfSubscription -> Maybe SenderId
ntfQueueId :: Maybe SenderId
ntfQueueId, $sel:ntfServer:NtfSubscription :: NtfSubscription -> NtfServer
ntfServer = (NtfServer NonEmpty TransportHost
ntfHost ServiceName
ntfPort KeyHash
_), Maybe SenderId
$sel:ntfSubId:NtfSubscription :: NtfSubscription -> Maybe SenderId
ntfSubId :: Maybe SenderId
ntfSubId, NtfAgentSubStatus
$sel:ntfSubStatus:NtfSubscription :: NtfSubscription -> NtfAgentSubStatus
ntfSubStatus :: NtfAgentSubStatus
ntfSubStatus} NtfSubAction
action = do
  UTCTime
ts <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> ((NonEmpty TransportHost, ServiceName, Maybe SenderId,
     NonEmpty TransportHost, ServiceName, Maybe SenderId)
    :. (NtfAgentSubStatus, Maybe NtfSubNTFAction,
        Maybe NtfSubSMPAction, UTCTime, BoolInt, UTCTime, SndFileId))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE ntf_subscriptions
      SET smp_host = ?, smp_port = ?, smp_ntf_id = ?, ntf_host = ?, ntf_port = ?, ntf_sub_id = ?,
          ntf_sub_status = ?, ntf_sub_action = ?, ntf_sub_smp_action = ?, ntf_sub_action_ts = ?, updated_by_supervisor = ?, updated_at = ?
      WHERE conn_id = ?
    |]
    ( (NonEmpty TransportHost
smpHost, ServiceName
smpPort, Maybe SenderId
ntfQueueId, NonEmpty TransportHost
ntfHost, ServiceName
ntfPort, Maybe SenderId
ntfSubId)
        (NonEmpty TransportHost, ServiceName, Maybe SenderId,
 NonEmpty TransportHost, ServiceName, Maybe SenderId)
-> (NtfAgentSubStatus, Maybe NtfSubNTFAction,
    Maybe NtfSubSMPAction, UTCTime, BoolInt, UTCTime, SndFileId)
-> (NonEmpty TransportHost, ServiceName, Maybe SenderId,
    NonEmpty TransportHost, ServiceName, Maybe SenderId)
   :. (NtfAgentSubStatus, Maybe NtfSubNTFAction,
       Maybe NtfSubSMPAction, UTCTime, BoolInt, UTCTime, SndFileId)
forall h t. h -> t -> h :. t
:. (NtfAgentSubStatus
ntfSubStatus, Maybe NtfSubNTFAction
ntfSubAction, Maybe NtfSubSMPAction
ntfSubSMPAction, UTCTime
ts, Bool -> BoolInt
BI Bool
True, UTCTime
ts, SndFileId
connId)
    )
  where
    (Maybe NtfSubNTFAction
ntfSubAction, Maybe NtfSubSMPAction
ntfSubSMPAction) = NtfSubAction -> (Maybe NtfSubNTFAction, Maybe NtfSubSMPAction)
ntfSubAndSMPAction NtfSubAction
action

supervisorUpdateNtfAction :: DB.Connection -> ConnId -> NtfSubAction -> IO ()
supervisorUpdateNtfAction :: Connection -> SndFileId -> NtfSubAction -> IO ()
supervisorUpdateNtfAction Connection
db SndFileId
connId NtfSubAction
action = do
  UTCTime
ts <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (Maybe NtfSubNTFAction, Maybe NtfSubSMPAction, UTCTime, BoolInt,
    UTCTime, SndFileId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE ntf_subscriptions
      SET ntf_sub_action = ?, ntf_sub_smp_action = ?, ntf_sub_action_ts = ?, updated_by_supervisor = ?, updated_at = ?
      WHERE conn_id = ?
    |]
    (Maybe NtfSubNTFAction
ntfSubAction, Maybe NtfSubSMPAction
ntfSubSMPAction, UTCTime
ts, Bool -> BoolInt
BI Bool
True, UTCTime
ts, SndFileId
connId)
  where
    (Maybe NtfSubNTFAction
ntfSubAction, Maybe NtfSubSMPAction
ntfSubSMPAction) = NtfSubAction -> (Maybe NtfSubNTFAction, Maybe NtfSubSMPAction)
ntfSubAndSMPAction NtfSubAction
action

updateNtfSubscription :: DB.Connection -> NtfSubscription -> NtfSubAction -> NtfActionTs -> IO ()
updateNtfSubscription :: Connection -> NtfSubscription -> NtfSubAction -> UTCTime -> IO ()
updateNtfSubscription Connection
db NtfSubscription {SndFileId
$sel:connId:NtfSubscription :: NtfSubscription -> SndFileId
connId :: SndFileId
connId, Maybe SenderId
$sel:ntfQueueId:NtfSubscription :: NtfSubscription -> Maybe SenderId
ntfQueueId :: Maybe SenderId
ntfQueueId, $sel:ntfServer:NtfSubscription :: NtfSubscription -> NtfServer
ntfServer = (NtfServer NonEmpty TransportHost
ntfHost ServiceName
ntfPort KeyHash
_), Maybe SenderId
$sel:ntfSubId:NtfSubscription :: NtfSubscription -> Maybe SenderId
ntfSubId :: Maybe SenderId
ntfSubId, NtfAgentSubStatus
$sel:ntfSubStatus:NtfSubscription :: NtfSubscription -> NtfAgentSubStatus
ntfSubStatus :: NtfAgentSubStatus
ntfSubStatus} NtfSubAction
action UTCTime
actionTs = do
  Maybe Bool
r <- (Only BoolInt -> Bool) -> IO [Only BoolInt] -> IO (Maybe Bool)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only BoolInt -> Bool
fromOnlyBI (IO [Only BoolInt] -> IO (Maybe Bool))
-> IO [Only BoolInt] -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> Only SndFileId -> IO [Only BoolInt]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT updated_by_supervisor FROM ntf_subscriptions WHERE conn_id = ?" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
  Maybe Bool -> (Bool -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Bool
r ((Bool -> IO ()) -> IO ()) -> (Bool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Bool
updatedBySupervisor -> do
    UTCTime
updatedAt <- IO UTCTime
getCurrentTime
    if Bool
updatedBySupervisor
      then
        Connection
-> Query
-> (Maybe SenderId, Maybe SenderId, NtfAgentSubStatus, BoolInt,
    UTCTime, SndFileId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          [sql|
            UPDATE ntf_subscriptions
            SET smp_ntf_id = ?, ntf_sub_id = ?, ntf_sub_status = ?, updated_by_supervisor = ?, updated_at = ?
            WHERE conn_id = ?
          |]
          (Maybe SenderId
ntfQueueId, Maybe SenderId
ntfSubId, NtfAgentSubStatus
ntfSubStatus, Bool -> BoolInt
BI Bool
False, UTCTime
updatedAt, SndFileId
connId)
      else
        Connection
-> Query
-> ((Maybe SenderId, NonEmpty TransportHost, ServiceName,
     Maybe SenderId)
    :. (NtfAgentSubStatus, Maybe NtfSubNTFAction,
        Maybe NtfSubSMPAction, UTCTime, BoolInt, UTCTime, SndFileId))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          [sql|
            UPDATE ntf_subscriptions
            SET smp_ntf_id = ?, ntf_host = ?, ntf_port = ?, ntf_sub_id = ?, ntf_sub_status = ?, ntf_sub_action = ?, ntf_sub_smp_action = ?, ntf_sub_action_ts = ?, updated_by_supervisor = ?, updated_at = ?
            WHERE conn_id = ?
          |]
          ((Maybe SenderId
ntfQueueId, NonEmpty TransportHost
ntfHost, ServiceName
ntfPort, Maybe SenderId
ntfSubId) (Maybe SenderId, NonEmpty TransportHost, ServiceName,
 Maybe SenderId)
-> (NtfAgentSubStatus, Maybe NtfSubNTFAction,
    Maybe NtfSubSMPAction, UTCTime, BoolInt, UTCTime, SndFileId)
-> (Maybe SenderId, NonEmpty TransportHost, ServiceName,
    Maybe SenderId)
   :. (NtfAgentSubStatus, Maybe NtfSubNTFAction,
       Maybe NtfSubSMPAction, UTCTime, BoolInt, UTCTime, SndFileId)
forall h t. h -> t -> h :. t
:. (NtfAgentSubStatus
ntfSubStatus, Maybe NtfSubNTFAction
ntfSubAction, Maybe NtfSubSMPAction
ntfSubSMPAction, UTCTime
actionTs, Bool -> BoolInt
BI Bool
False, UTCTime
updatedAt, SndFileId
connId))
  where
    (Maybe NtfSubNTFAction
ntfSubAction, Maybe NtfSubSMPAction
ntfSubSMPAction) = NtfSubAction -> (Maybe NtfSubNTFAction, Maybe NtfSubSMPAction)
ntfSubAndSMPAction NtfSubAction
action

setNullNtfSubscriptionAction :: DB.Connection -> ConnId -> IO ()
setNullNtfSubscriptionAction :: Connection -> SndFileId -> IO ()
setNullNtfSubscriptionAction Connection
db SndFileId
connId = do
  Maybe Bool
r <- (Only BoolInt -> Bool) -> IO [Only BoolInt] -> IO (Maybe Bool)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only BoolInt -> Bool
fromOnlyBI (IO [Only BoolInt] -> IO (Maybe Bool))
-> IO [Only BoolInt] -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> Only SndFileId -> IO [Only BoolInt]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT updated_by_supervisor FROM ntf_subscriptions WHERE conn_id = ?" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
  Maybe Bool -> (Bool -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Bool
r ((Bool -> IO ()) -> IO ()) -> (Bool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Bool
updatedBySupervisor ->
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
updatedBySupervisor (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      UTCTime
updatedAt <- IO UTCTime
getCurrentTime
      Connection
-> Query
-> (Maybe NtfSubNTFAction, Maybe NtfSubSMPAction, Maybe UTCTime,
    BoolInt, UTCTime, SndFileId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          UPDATE ntf_subscriptions
          SET ntf_sub_action = ?, ntf_sub_smp_action = ?, ntf_sub_action_ts = ?, updated_by_supervisor = ?, updated_at = ?
          WHERE conn_id = ?
        |]
        (Maybe NtfSubNTFAction
forall a. Maybe a
Nothing :: Maybe NtfSubNTFAction, Maybe NtfSubSMPAction
forall a. Maybe a
Nothing :: Maybe NtfSubSMPAction, Maybe UTCTime
forall a. Maybe a
Nothing :: Maybe UTCTime, Bool -> BoolInt
BI Bool
False, UTCTime
updatedAt, SndFileId
connId)

deleteNtfSubscription :: DB.Connection -> ConnId -> IO ()
deleteNtfSubscription :: Connection -> SndFileId -> IO ()
deleteNtfSubscription Connection
db SndFileId
connId = do
  Maybe Bool
r <- (Only BoolInt -> Bool) -> IO [Only BoolInt] -> IO (Maybe Bool)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only BoolInt -> Bool
fromOnlyBI (IO [Only BoolInt] -> IO (Maybe Bool))
-> IO [Only BoolInt] -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> Only SndFileId -> IO [Only BoolInt]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT updated_by_supervisor FROM ntf_subscriptions WHERE conn_id = ?" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
  Maybe Bool -> (Bool -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Bool
r ((Bool -> IO ()) -> IO ()) -> (Bool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Bool
updatedBySupervisor -> do
    UTCTime
updatedAt <- IO UTCTime
getCurrentTime
    if Bool
updatedBySupervisor
      then
        Connection
-> Query
-> (Maybe SenderId, Maybe SenderId, NtfAgentSubStatus, BoolInt,
    UTCTime, SndFileId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          [sql|
            UPDATE ntf_subscriptions
            SET smp_ntf_id = ?, ntf_sub_id = ?, ntf_sub_status = ?, updated_by_supervisor = ?, updated_at = ?
            WHERE conn_id = ?
          |]
          (Maybe SenderId
forall a. Maybe a
Nothing :: Maybe SMP.NotifierId, Maybe SenderId
forall a. Maybe a
Nothing :: Maybe NtfSubscriptionId, NtfAgentSubStatus
NASDeleted, Bool -> BoolInt
BI Bool
False, UTCTime
updatedAt, SndFileId
connId)
      else Connection -> SndFileId -> IO ()
deleteNtfSubscription' Connection
db SndFileId
connId

deleteNtfSubscription' :: DB.Connection -> ConnId -> IO ()
deleteNtfSubscription' :: Connection -> SndFileId -> IO ()
deleteNtfSubscription' Connection
db SndFileId
connId = do
  Connection -> Query -> Only SndFileId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM ntf_subscriptions WHERE conn_id = ?" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)

getNextNtfSubNTFActions :: DB.Connection -> NtfServer -> Int -> IO (Either StoreError [Either StoreError (NtfSubNTFAction, NtfSubscription, NtfActionTs)])
getNextNtfSubNTFActions :: Connection
-> NtfServer
-> Int
-> IO
     (Either
        StoreError
        [Either StoreError (NtfSubNTFAction, NtfSubscription, UTCTime)])
getNextNtfSubNTFActions Connection
db ntfServer :: NtfServer
ntfServer@(NtfServer NonEmpty TransportHost
ntfHost ServiceName
ntfPort KeyHash
_) Int
ntfBatchSize =
  ServiceName
-> IO [SndFileId]
-> (SndFileId
    -> IO
         (Either StoreError (NtfSubNTFAction, NtfSubscription, UTCTime)))
-> (SndFileId -> IO ())
-> IO
     (Either
        StoreError
        [Either StoreError (NtfSubNTFAction, NtfSubscription, UTCTime)])
forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> IO [i]
-> (i -> IO (Either e a))
-> (i -> IO ())
-> IO (Either e [Either e a])
getWorkItems ServiceName
"ntf NTF" IO [SndFileId]
getNtfConnIds SndFileId
-> IO
     (Either StoreError (NtfSubNTFAction, NtfSubscription, UTCTime))
getNtfSubAction (Connection -> SndFileId -> IO ()
markNtfSubActionNtfFailed_ Connection
db)
  where
    getNtfConnIds :: IO [ConnId]
    getNtfConnIds :: IO [SndFileId]
getNtfConnIds =
      (Only SndFileId -> SndFileId) -> [Only SndFileId] -> [SndFileId]
forall a b. (a -> b) -> [a] -> [b]
map Only SndFileId -> SndFileId
forall a. Only a -> a
fromOnly
        ([Only SndFileId] -> [SndFileId])
-> IO [Only SndFileId] -> IO [SndFileId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, Int)
-> IO [Only SndFileId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT conn_id
            FROM ntf_subscriptions
            WHERE ntf_host = ? AND ntf_port = ? AND ntf_sub_action IS NOT NULL
              AND (ntf_failed = 0 OR updated_by_supervisor = 1)
            ORDER BY ntf_sub_action_ts ASC
            LIMIT ?
          |]
          (NonEmpty TransportHost
ntfHost, ServiceName
ntfPort, Int
ntfBatchSize)
    getNtfSubAction :: ConnId -> IO (Either StoreError (NtfSubNTFAction, NtfSubscription, NtfActionTs))
    getNtfSubAction :: SndFileId
-> IO
     (Either StoreError (NtfSubNTFAction, NtfSubscription, UTCTime))
getNtfSubAction SndFileId
connId = do
      Connection -> SndFileId -> IO ()
markUpdatedByWorker Connection
db SndFileId
connId
      ((Int64, NonEmpty TransportHost, ServiceName, KeyHash,
  Maybe SenderId, Maybe SenderId, NtfAgentSubStatus, UTCTime,
  NtfSubNTFAction)
 -> (NtfSubNTFAction, NtfSubscription, UTCTime))
-> StoreError
-> IO
     [(Int64, NonEmpty TransportHost, ServiceName, KeyHash,
       Maybe SenderId, Maybe SenderId, NtfAgentSubStatus, UTCTime,
       NtfSubNTFAction)]
-> IO
     (Either StoreError (NtfSubNTFAction, NtfSubscription, UTCTime))
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (Int64, NonEmpty TransportHost, ServiceName, KeyHash,
 Maybe SenderId, Maybe SenderId, NtfAgentSubStatus, UTCTime,
 NtfSubNTFAction)
-> (NtfSubNTFAction, NtfSubscription, UTCTime)
ntfSubAction StoreError
err (IO
   [(Int64, NonEmpty TransportHost, ServiceName, KeyHash,
     Maybe SenderId, Maybe SenderId, NtfAgentSubStatus, UTCTime,
     NtfSubNTFAction)]
 -> IO
      (Either StoreError (NtfSubNTFAction, NtfSubscription, UTCTime)))
-> IO
     [(Int64, NonEmpty TransportHost, ServiceName, KeyHash,
       Maybe SenderId, Maybe SenderId, NtfAgentSubStatus, UTCTime,
       NtfSubNTFAction)]
-> IO
     (Either StoreError (NtfSubNTFAction, NtfSubscription, UTCTime))
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> Only SndFileId
-> IO
     [(Int64, NonEmpty TransportHost, ServiceName, KeyHash,
       Maybe SenderId, Maybe SenderId, NtfAgentSubStatus, UTCTime,
       NtfSubNTFAction)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT c.user_id, s.host, s.port, COALESCE(ns.smp_server_key_hash, s.key_hash),
              ns.smp_ntf_id, ns.ntf_sub_id, ns.ntf_sub_status, ns.ntf_sub_action_ts, ns.ntf_sub_action
            FROM ntf_subscriptions ns
            JOIN connections c USING (conn_id)
            JOIN servers s ON s.host = ns.smp_host AND s.port = ns.smp_port
            WHERE ns.conn_id = ?
          |]
          (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
      where
        err :: StoreError
err = SndFileId -> StoreError
SEInternal (SndFileId -> StoreError) -> SndFileId -> StoreError
forall a b. (a -> b) -> a -> b
$ SndFileId
"ntf subscription " SndFileId -> SndFileId -> SndFileId
forall a. Semigroup a => a -> a -> a
<> SndFileId -> SndFileId
forall a. Show a => a -> SndFileId
bshow SndFileId
connId SndFileId -> SndFileId -> SndFileId
forall a. Semigroup a => a -> a -> a
<> SndFileId
" returned []"
        ntfSubAction :: (Int64, NonEmpty TransportHost, ServiceName, KeyHash,
 Maybe SenderId, Maybe SenderId, NtfAgentSubStatus, UTCTime,
 NtfSubNTFAction)
-> (NtfSubNTFAction, NtfSubscription, UTCTime)
ntfSubAction (Int64
userId, NonEmpty TransportHost
smpHost, ServiceName
smpPort, KeyHash
smpKeyHash, Maybe SenderId
ntfQueueId, Maybe SenderId
ntfSubId, NtfAgentSubStatus
ntfSubStatus, UTCTime
actionTs, NtfSubNTFAction
action) =
          let smpServer :: SMPServer
smpServer = NonEmpty TransportHost -> ServiceName -> KeyHash -> SMPServer
SMPServer NonEmpty TransportHost
smpHost ServiceName
smpPort KeyHash
smpKeyHash
              ntfSubscription :: NtfSubscription
ntfSubscription = NtfSubscription {Int64
$sel:userId:NtfSubscription :: Int64
userId :: Int64
userId, SndFileId
$sel:connId:NtfSubscription :: SndFileId
connId :: SndFileId
connId, SMPServer
$sel:smpServer:NtfSubscription :: SMPServer
smpServer :: SMPServer
smpServer, Maybe SenderId
$sel:ntfQueueId:NtfSubscription :: Maybe SenderId
ntfQueueId :: Maybe SenderId
ntfQueueId, NtfServer
$sel:ntfServer:NtfSubscription :: NtfServer
ntfServer :: NtfServer
ntfServer, Maybe SenderId
$sel:ntfSubId:NtfSubscription :: Maybe SenderId
ntfSubId :: Maybe SenderId
ntfSubId, NtfAgentSubStatus
$sel:ntfSubStatus:NtfSubscription :: NtfAgentSubStatus
ntfSubStatus :: NtfAgentSubStatus
ntfSubStatus}
           in (NtfSubNTFAction
action, NtfSubscription
ntfSubscription, UTCTime
actionTs)

markNtfSubActionNtfFailed_ :: DB.Connection -> ConnId -> IO ()
markNtfSubActionNtfFailed_ :: Connection -> SndFileId -> IO ()
markNtfSubActionNtfFailed_ Connection
db SndFileId
connId =
  Connection -> Query -> Only SndFileId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE ntf_subscriptions SET ntf_failed = 1 where conn_id = ?" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)

getNextNtfSubSMPActions :: DB.Connection -> SMPServer -> Int -> IO (Either StoreError [Either StoreError (NtfSubSMPAction, NtfSubscription)])
getNextNtfSubSMPActions :: Connection
-> SMPServer
-> Int
-> IO
     (Either
        StoreError [Either StoreError (NtfSubSMPAction, NtfSubscription)])
getNextNtfSubSMPActions Connection
db smpServer :: SMPServer
smpServer@(SMPServer NonEmpty TransportHost
smpHost ServiceName
smpPort KeyHash
_) Int
ntfBatchSize =
  ServiceName
-> IO [SndFileId]
-> (SndFileId
    -> IO (Either StoreError (NtfSubSMPAction, NtfSubscription)))
-> (SndFileId -> IO ())
-> IO
     (Either
        StoreError [Either StoreError (NtfSubSMPAction, NtfSubscription)])
forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> IO [i]
-> (i -> IO (Either e a))
-> (i -> IO ())
-> IO (Either e [Either e a])
getWorkItems ServiceName
"ntf SMP" IO [SndFileId]
getNtfConnIds SndFileId
-> IO (Either StoreError (NtfSubSMPAction, NtfSubscription))
getNtfSubAction (Connection -> SndFileId -> IO ()
markNtfSubActionSMPFailed_ Connection
db)
  where
    getNtfConnIds :: IO [ConnId]
    getNtfConnIds :: IO [SndFileId]
getNtfConnIds =
      (Only SndFileId -> SndFileId) -> [Only SndFileId] -> [SndFileId]
forall a b. (a -> b) -> [a] -> [b]
map Only SndFileId -> SndFileId
forall a. Only a -> a
fromOnly
        ([Only SndFileId] -> [SndFileId])
-> IO [Only SndFileId] -> IO [SndFileId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, Int)
-> IO [Only SndFileId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT conn_id
            FROM ntf_subscriptions ns
            WHERE smp_host = ? AND smp_port = ? AND ntf_sub_smp_action IS NOT NULL AND ntf_sub_action_ts IS NOT NULL
              AND (smp_failed = 0 OR updated_by_supervisor = 1)
            ORDER BY ntf_sub_action_ts ASC
            LIMIT ?
          |]
          (NonEmpty TransportHost
smpHost, ServiceName
smpPort, Int
ntfBatchSize)
    getNtfSubAction :: ConnId -> IO (Either StoreError (NtfSubSMPAction, NtfSubscription))
    getNtfSubAction :: SndFileId
-> IO (Either StoreError (NtfSubSMPAction, NtfSubscription))
getNtfSubAction SndFileId
connId = do
      Connection -> SndFileId -> IO ()
markUpdatedByWorker Connection
db SndFileId
connId
      ((Int64, NonEmpty TransportHost, ServiceName, KeyHash,
  Maybe SenderId, Maybe SenderId, NtfAgentSubStatus, NtfSubSMPAction)
 -> (NtfSubSMPAction, NtfSubscription))
-> StoreError
-> IO
     [(Int64, NonEmpty TransportHost, ServiceName, KeyHash,
       Maybe SenderId, Maybe SenderId, NtfAgentSubStatus,
       NtfSubSMPAction)]
-> IO (Either StoreError (NtfSubSMPAction, NtfSubscription))
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (Int64, NonEmpty TransportHost, ServiceName, KeyHash,
 Maybe SenderId, Maybe SenderId, NtfAgentSubStatus, NtfSubSMPAction)
-> (NtfSubSMPAction, NtfSubscription)
ntfSubAction StoreError
err (IO
   [(Int64, NonEmpty TransportHost, ServiceName, KeyHash,
     Maybe SenderId, Maybe SenderId, NtfAgentSubStatus,
     NtfSubSMPAction)]
 -> IO (Either StoreError (NtfSubSMPAction, NtfSubscription)))
-> IO
     [(Int64, NonEmpty TransportHost, ServiceName, KeyHash,
       Maybe SenderId, Maybe SenderId, NtfAgentSubStatus,
       NtfSubSMPAction)]
-> IO (Either StoreError (NtfSubSMPAction, NtfSubscription))
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> Only SndFileId
-> IO
     [(Int64, NonEmpty TransportHost, ServiceName, KeyHash,
       Maybe SenderId, Maybe SenderId, NtfAgentSubStatus,
       NtfSubSMPAction)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT c.user_id, s.ntf_host, s.ntf_port, s.ntf_key_hash,
              ns.smp_ntf_id, ns.ntf_sub_id, ns.ntf_sub_status, ns.ntf_sub_smp_action
            FROM ntf_subscriptions ns
            JOIN connections c USING (conn_id)
            JOIN ntf_servers s USING (ntf_host, ntf_port)
            WHERE ns.conn_id = ?
          |]
          (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
      where
        err :: StoreError
err = SndFileId -> StoreError
SEInternal (SndFileId -> StoreError) -> SndFileId -> StoreError
forall a b. (a -> b) -> a -> b
$ SndFileId
"ntf subscription " SndFileId -> SndFileId -> SndFileId
forall a. Semigroup a => a -> a -> a
<> SndFileId -> SndFileId
forall a. Show a => a -> SndFileId
bshow SndFileId
connId SndFileId -> SndFileId -> SndFileId
forall a. Semigroup a => a -> a -> a
<> SndFileId
" returned []"
        ntfSubAction :: (Int64, NonEmpty TransportHost, ServiceName, KeyHash,
 Maybe SenderId, Maybe SenderId, NtfAgentSubStatus, NtfSubSMPAction)
-> (NtfSubSMPAction, NtfSubscription)
ntfSubAction (Int64
userId, NonEmpty TransportHost
ntfHost, ServiceName
ntfPort, KeyHash
ntfKeyHash, Maybe SenderId
ntfQueueId, Maybe SenderId
ntfSubId, NtfAgentSubStatus
ntfSubStatus, NtfSubSMPAction
action) =
          let ntfServer :: NtfServer
ntfServer = NonEmpty TransportHost -> ServiceName -> KeyHash -> NtfServer
NtfServer NonEmpty TransportHost
ntfHost ServiceName
ntfPort KeyHash
ntfKeyHash
              ntfSubscription :: NtfSubscription
ntfSubscription = NtfSubscription {Int64
$sel:userId:NtfSubscription :: Int64
userId :: Int64
userId, SndFileId
$sel:connId:NtfSubscription :: SndFileId
connId :: SndFileId
connId, SMPServer
$sel:smpServer:NtfSubscription :: SMPServer
smpServer :: SMPServer
smpServer, Maybe SenderId
$sel:ntfQueueId:NtfSubscription :: Maybe SenderId
ntfQueueId :: Maybe SenderId
ntfQueueId, NtfServer
$sel:ntfServer:NtfSubscription :: NtfServer
ntfServer :: NtfServer
ntfServer, Maybe SenderId
$sel:ntfSubId:NtfSubscription :: Maybe SenderId
ntfSubId :: Maybe SenderId
ntfSubId, NtfAgentSubStatus
$sel:ntfSubStatus:NtfSubscription :: NtfAgentSubStatus
ntfSubStatus :: NtfAgentSubStatus
ntfSubStatus}
           in (NtfSubSMPAction
action, NtfSubscription
ntfSubscription)

markNtfSubActionSMPFailed_ :: DB.Connection -> ConnId -> IO ()
markNtfSubActionSMPFailed_ :: Connection -> SndFileId -> IO ()
markNtfSubActionSMPFailed_ Connection
db SndFileId
connId =
  Connection -> Query -> Only SndFileId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE ntf_subscriptions SET smp_failed = 1 where conn_id = ?" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)

markUpdatedByWorker :: DB.Connection -> ConnId -> IO ()
markUpdatedByWorker :: Connection -> SndFileId -> IO ()
markUpdatedByWorker Connection
db SndFileId
connId =
  Connection -> Query -> Only SndFileId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE ntf_subscriptions SET updated_by_supervisor = 0 WHERE conn_id = ?" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)

getActiveNtfToken :: DB.Connection -> IO (Maybe NtfToken)
getActiveNtfToken :: Connection -> IO (Maybe NtfToken)
getActiveNtfToken Connection
db =
  (((NonEmpty TransportHost, ServiceName, KeyHash)
  :. ((PushProvider, Binary SndFileId, Maybe SenderId,
       NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
       PrivateKeyX25519, Maybe DhSecretX25519)
      :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode)))
 -> NtfToken)
-> IO
     [(NonEmpty TransportHost, ServiceName, KeyHash)
      :. ((PushProvider, Binary SndFileId, Maybe SenderId,
           NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
           PrivateKeyX25519, Maybe DhSecretX25519)
          :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode))]
-> IO (Maybe NtfToken)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow ((NonEmpty TransportHost, ServiceName, KeyHash)
 :. ((PushProvider, Binary SndFileId, Maybe SenderId,
      NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
      PrivateKeyX25519, Maybe DhSecretX25519)
     :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode)))
-> NtfToken
ntfToken (IO
   [(NonEmpty TransportHost, ServiceName, KeyHash)
    :. ((PushProvider, Binary SndFileId, Maybe SenderId,
         NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
         PrivateKeyX25519, Maybe DhSecretX25519)
        :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode))]
 -> IO (Maybe NtfToken))
-> IO
     [(NonEmpty TransportHost, ServiceName, KeyHash)
      :. ((PushProvider, Binary SndFileId, Maybe SenderId,
           NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
           PrivateKeyX25519, Maybe DhSecretX25519)
          :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode))]
-> IO (Maybe NtfToken)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> Only NtfTknStatus
-> IO
     [(NonEmpty TransportHost, ServiceName, KeyHash)
      :. ((PushProvider, Binary SndFileId, Maybe SenderId,
           NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
           PrivateKeyX25519, Maybe DhSecretX25519)
          :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode))]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT s.ntf_host, s.ntf_port, s.ntf_key_hash,
          t.provider, t.device_token, t.tkn_id, t.tkn_pub_key, t.tkn_priv_key, t.tkn_pub_dh_key, t.tkn_priv_dh_key, t.tkn_dh_secret,
          t.tkn_status, t.tkn_action, t.ntf_mode
        FROM ntf_tokens t
        JOIN ntf_servers s USING (ntf_host, ntf_port)
        WHERE t.tkn_status = ?
      |]
      (NtfTknStatus -> Only NtfTknStatus
forall a. a -> Only a
Only NtfTknStatus
NTActive)
  where
    ntfToken :: ((NonEmpty TransportHost, ServiceName, KeyHash)
 :. ((PushProvider, Binary SndFileId, Maybe SenderId,
      NtfPublicAuthKey, APrivateAuthKey, PublicKeyX25519,
      PrivateKeyX25519, Maybe DhSecretX25519)
     :. (NtfTknStatus, Maybe NtfTknAction, Maybe NotificationsMode)))
-> NtfToken
ntfToken ((NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash) :. (PushProvider
provider, Binary SndFileId
dt, Maybe SenderId
ntfTokenId, NtfPublicAuthKey
ntfPubKey, APrivateAuthKey
ntfPrivKey, PublicKeyX25519
ntfDhPubKey, PrivateKeyX25519
ntfDhPrivKey, Maybe DhSecretX25519
ntfDhSecret) :. (NtfTknStatus
ntfTknStatus, Maybe NtfTknAction
ntfTknAction, Maybe NotificationsMode
ntfMode_)) =
      let ntfServer :: NtfServer
ntfServer = NonEmpty TransportHost -> ServiceName -> KeyHash -> NtfServer
NtfServer NonEmpty TransportHost
host ServiceName
port KeyHash
keyHash
          ntfDhKeys :: (PublicKeyX25519, PrivateKeyX25519)
ntfDhKeys = (PublicKeyX25519
ntfDhPubKey, PrivateKeyX25519
ntfDhPrivKey)
          ntfMode :: NotificationsMode
ntfMode = NotificationsMode -> Maybe NotificationsMode -> NotificationsMode
forall a. a -> Maybe a -> a
fromMaybe NotificationsMode
NMPeriodic Maybe NotificationsMode
ntfMode_
       in NtfToken {$sel:deviceToken:NtfToken :: DeviceToken
deviceToken = PushProvider -> SndFileId -> DeviceToken
DeviceToken PushProvider
provider SndFileId
dt, NtfServer
$sel:ntfServer:NtfToken :: NtfServer
ntfServer :: NtfServer
ntfServer, Maybe SenderId
$sel:ntfTokenId:NtfToken :: Maybe SenderId
ntfTokenId :: Maybe SenderId
ntfTokenId, NtfPublicAuthKey
$sel:ntfPubKey:NtfToken :: NtfPublicAuthKey
ntfPubKey :: NtfPublicAuthKey
ntfPubKey, APrivateAuthKey
$sel:ntfPrivKey:NtfToken :: APrivateAuthKey
ntfPrivKey :: APrivateAuthKey
ntfPrivKey, KeyPairX25519
(PublicKeyX25519, PrivateKeyX25519)
$sel:ntfDhKeys:NtfToken :: KeyPairX25519
ntfDhKeys :: (PublicKeyX25519, PrivateKeyX25519)
ntfDhKeys, Maybe DhSecretX25519
$sel:ntfDhSecret:NtfToken :: Maybe DhSecretX25519
ntfDhSecret :: Maybe DhSecretX25519
ntfDhSecret, NtfTknStatus
$sel:ntfTknStatus:NtfToken :: NtfTknStatus
ntfTknStatus :: NtfTknStatus
ntfTknStatus, Maybe NtfTknAction
$sel:ntfTknAction:NtfToken :: Maybe NtfTknAction
ntfTknAction :: Maybe NtfTknAction
ntfTknAction, NotificationsMode
$sel:ntfMode:NtfToken :: NotificationsMode
ntfMode :: NotificationsMode
ntfMode}

getNtfRcvQueue :: DB.Connection -> SMPQueueNtf -> IO (Either StoreError (ConnId, Int64, RcvNtfDhSecret, Maybe UTCTime))
getNtfRcvQueue :: Connection
-> SMPQueueNtf
-> IO
     (Either
        StoreError (SndFileId, Int64, DhSecretX25519, Maybe UTCTime))
getNtfRcvQueue Connection
db SMPQueueNtf {smpServer :: SMPQueueNtf -> SMPServer
smpServer = (SMPServer NonEmpty TransportHost
host ServiceName
port KeyHash
_), SenderId
notifierId :: SenderId
notifierId :: SMPQueueNtf -> SenderId
notifierId} =
  ((SndFileId, Int64, Maybe DhSecretX25519, Maybe UTCTime)
 -> Either
      StoreError (SndFileId, Int64, DhSecretX25519, Maybe UTCTime))
-> StoreError
-> IO [(SndFileId, Int64, Maybe DhSecretX25519, Maybe UTCTime)]
-> IO
     (Either
        StoreError (SndFileId, Int64, DhSecretX25519, Maybe UTCTime))
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (SndFileId, Int64, Maybe DhSecretX25519, Maybe UTCTime)
-> Either
     StoreError (SndFileId, Int64, DhSecretX25519, Maybe UTCTime)
forall {a} {b} {c} {d}.
(a, b, Maybe c, d) -> Either StoreError (a, b, c, d)
res StoreError
SEConnNotFound (IO [(SndFileId, Int64, Maybe DhSecretX25519, Maybe UTCTime)]
 -> IO
      (Either
         StoreError (SndFileId, Int64, DhSecretX25519, Maybe UTCTime)))
-> IO [(SndFileId, Int64, Maybe DhSecretX25519, Maybe UTCTime)]
-> IO
     (Either
        StoreError (SndFileId, Int64, DhSecretX25519, Maybe UTCTime))
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, SenderId)
-> IO [(SndFileId, Int64, Maybe DhSecretX25519, Maybe UTCTime)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT conn_id, rcv_queue_id, rcv_ntf_dh_secret, last_broker_ts
        FROM rcv_queues
        WHERE host = ? AND port = ? AND ntf_id = ? AND deleted = 0
      |]
      (NonEmpty TransportHost
host, ServiceName
port, SenderId
notifierId)
  where
    res :: (a, b, Maybe c, d) -> Either StoreError (a, b, c, d)
res (a
connId, b
dbQueueId, Just c
rcvNtfDhSecret, d
lastBrokerTs_) = (a, b, c, d) -> Either StoreError (a, b, c, d)
forall a b. b -> Either a b
Right (a
connId, b
dbQueueId, c
rcvNtfDhSecret, d
lastBrokerTs_)
    res (a, b, Maybe c, d)
_ = StoreError -> Either StoreError (a, b, c, d)
forall a b. a -> Either a b
Left StoreError
SEConnNotFound

setConnectionNtfs :: DB.Connection -> ConnId -> Bool -> IO ()
setConnectionNtfs :: Connection -> SndFileId -> Bool -> IO ()
setConnectionNtfs Connection
db SndFileId
connId Bool
enableNtfs =
  Connection -> Query -> (BoolInt, SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET enable_ntfs = ? WHERE conn_id = ?" (Bool -> BoolInt
BI Bool
enableNtfs, SndFileId
connId)

-- * Auxiliary helpers

instance ToField QueueStatus where toField :: QueueStatus -> SQLData
toField = Text -> SQLData
forall a. ToField a => a -> SQLData
toField (Text -> SQLData)
-> (QueueStatus -> Text) -> QueueStatus -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueueStatus -> Text
serializeQueueStatus

instance FromField QueueStatus where fromField :: FieldParser QueueStatus
fromField = (Text -> Maybe QueueStatus) -> FieldParser QueueStatus
forall a. Typeable a => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ Text -> Maybe QueueStatus
queueStatusT

instance ToField InternalRcvId where toField :: InternalRcvId -> SQLData
toField (InternalRcvId Int64
x) = Int64 -> SQLData
forall a. ToField a => a -> SQLData
toField Int64
x

deriving newtype instance FromField InternalRcvId

instance ToField InternalSndId where toField :: InternalSndId -> SQLData
toField (InternalSndId Int64
x) = Int64 -> SQLData
forall a. ToField a => a -> SQLData
toField Int64
x

deriving newtype instance FromField InternalSndId

instance ToField InternalId where toField :: InternalId -> SQLData
toField (InternalId Int64
x) = Int64 -> SQLData
forall a. ToField a => a -> SQLData
toField Int64
x

deriving newtype instance FromField InternalId

instance ToField AgentMessageType where toField :: AgentMessageType -> SQLData
toField = Binary SndFileId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary SndFileId -> SQLData)
-> (AgentMessageType -> Binary SndFileId)
-> AgentMessageType
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary (SndFileId -> Binary SndFileId)
-> (AgentMessageType -> SndFileId)
-> AgentMessageType
-> Binary SndFileId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AgentMessageType -> SndFileId
forall a. Encoding a => a -> SndFileId
smpEncode

instance FromField AgentMessageType where fromField :: FieldParser AgentMessageType
fromField = (SndFileId -> Either ServiceName AgentMessageType)
-> FieldParser AgentMessageType
forall k.
Typeable k =>
(SndFileId -> Either ServiceName k) -> FieldParser k
blobFieldDecoder SndFileId -> Either ServiceName AgentMessageType
forall a. Encoding a => SndFileId -> Either ServiceName a
smpDecode

instance ToField MsgIntegrity where toField :: MsgIntegrity -> SQLData
toField = Binary SndFileId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary SndFileId -> SQLData)
-> (MsgIntegrity -> Binary SndFileId) -> MsgIntegrity -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary (SndFileId -> Binary SndFileId)
-> (MsgIntegrity -> SndFileId) -> MsgIntegrity -> Binary SndFileId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgIntegrity -> SndFileId
forall a. StrEncoding a => a -> SndFileId
strEncode

instance FromField MsgIntegrity where fromField :: FieldParser MsgIntegrity
fromField = (SndFileId -> Either ServiceName MsgIntegrity)
-> FieldParser MsgIntegrity
forall k.
Typeable k =>
(SndFileId -> Either ServiceName k) -> FieldParser k
blobFieldDecoder SndFileId -> Either ServiceName MsgIntegrity
forall a. StrEncoding a => SndFileId -> Either ServiceName a
strDecode

instance ToField SMPQueueUri where toField :: SMPQueueUri -> SQLData
toField = Binary SndFileId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary SndFileId -> SQLData)
-> (SMPQueueUri -> Binary SndFileId) -> SMPQueueUri -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary (SndFileId -> Binary SndFileId)
-> (SMPQueueUri -> SndFileId) -> SMPQueueUri -> Binary SndFileId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMPQueueUri -> SndFileId
forall a. StrEncoding a => a -> SndFileId
strEncode

instance FromField SMPQueueUri where fromField :: FieldParser SMPQueueUri
fromField = (SndFileId -> Either ServiceName SMPQueueUri)
-> FieldParser SMPQueueUri
forall k.
Typeable k =>
(SndFileId -> Either ServiceName k) -> FieldParser k
blobFieldDecoder SndFileId -> Either ServiceName SMPQueueUri
forall a. StrEncoding a => SndFileId -> Either ServiceName a
strDecode

instance ToField AConnectionRequestUri where toField :: AConnectionRequestUri -> SQLData
toField = Binary SndFileId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary SndFileId -> SQLData)
-> (AConnectionRequestUri -> Binary SndFileId)
-> AConnectionRequestUri
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary (SndFileId -> Binary SndFileId)
-> (AConnectionRequestUri -> SndFileId)
-> AConnectionRequestUri
-> Binary SndFileId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AConnectionRequestUri -> SndFileId
forall a. StrEncoding a => a -> SndFileId
strEncode

instance FromField AConnectionRequestUri where fromField :: FieldParser AConnectionRequestUri
fromField = (SndFileId -> Either ServiceName AConnectionRequestUri)
-> FieldParser AConnectionRequestUri
forall k.
Typeable k =>
(SndFileId -> Either ServiceName k) -> FieldParser k
blobFieldDecoder SndFileId -> Either ServiceName AConnectionRequestUri
forall a. StrEncoding a => SndFileId -> Either ServiceName a
strDecode

instance ConnectionModeI c => ToField (ConnectionRequestUri c) where toField :: ConnectionRequestUri c -> SQLData
toField = Binary SndFileId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary SndFileId -> SQLData)
-> (ConnectionRequestUri c -> Binary SndFileId)
-> ConnectionRequestUri c
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary (SndFileId -> Binary SndFileId)
-> (ConnectionRequestUri c -> SndFileId)
-> ConnectionRequestUri c
-> Binary SndFileId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionRequestUri c -> SndFileId
forall a. StrEncoding a => a -> SndFileId
strEncode

instance (E.Typeable c, ConnectionModeI c) => FromField (ConnectionRequestUri c) where fromField :: FieldParser (ConnectionRequestUri c)
fromField = (SndFileId -> Either ServiceName (ConnectionRequestUri c))
-> FieldParser (ConnectionRequestUri c)
forall k.
Typeable k =>
(SndFileId -> Either ServiceName k) -> FieldParser k
blobFieldDecoder SndFileId -> Either ServiceName (ConnectionRequestUri c)
forall a. StrEncoding a => SndFileId -> Either ServiceName a
strDecode

instance ToField ConnectionMode where toField :: ConnectionMode -> SQLData
toField = Text -> SQLData
forall a. ToField a => a -> SQLData
toField (Text -> SQLData)
-> (ConnectionMode -> Text) -> ConnectionMode -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Text
decodeLatin1 (SndFileId -> Text)
-> (ConnectionMode -> SndFileId) -> ConnectionMode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionMode -> SndFileId
forall a. StrEncoding a => a -> SndFileId
strEncode

instance FromField ConnectionMode where fromField :: FieldParser ConnectionMode
fromField = (Text -> Maybe ConnectionMode) -> FieldParser ConnectionMode
forall a. Typeable a => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ Text -> Maybe ConnectionMode
connModeT

instance ToField (SConnectionMode c) where toField :: SConnectionMode c -> SQLData
toField = ConnectionMode -> SQLData
forall a. ToField a => a -> SQLData
toField (ConnectionMode -> SQLData)
-> (SConnectionMode c -> ConnectionMode)
-> SConnectionMode c
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SConnectionMode c -> ConnectionMode
forall (m :: ConnectionMode). SConnectionMode m -> ConnectionMode
connMode

instance FromField AConnectionMode where fromField :: FieldParser AConnectionMode
fromField = (Text -> Maybe AConnectionMode) -> FieldParser AConnectionMode
forall a. Typeable a => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ ((Text -> Maybe AConnectionMode) -> FieldParser AConnectionMode)
-> (Text -> Maybe AConnectionMode) -> FieldParser AConnectionMode
forall a b. (a -> b) -> a -> b
$ (ConnectionMode -> AConnectionMode)
-> Maybe ConnectionMode -> Maybe AConnectionMode
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConnectionMode -> AConnectionMode
connMode' (Maybe ConnectionMode -> Maybe AConnectionMode)
-> (Text -> Maybe ConnectionMode) -> Text -> Maybe AConnectionMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ConnectionMode
connModeT

instance ToField MsgFlags where toField :: MsgFlags -> SQLData
toField = Text -> SQLData
forall a. ToField a => a -> SQLData
toField (Text -> SQLData) -> (MsgFlags -> Text) -> MsgFlags -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Text
decodeLatin1 (SndFileId -> Text) -> (MsgFlags -> SndFileId) -> MsgFlags -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgFlags -> SndFileId
forall a. Encoding a => a -> SndFileId
smpEncode

instance FromField MsgFlags where fromField :: FieldParser MsgFlags
fromField = (Text -> Maybe MsgFlags) -> FieldParser MsgFlags
forall a. Typeable a => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ ((Text -> Maybe MsgFlags) -> FieldParser MsgFlags)
-> (Text -> Maybe MsgFlags) -> FieldParser MsgFlags
forall a b. (a -> b) -> a -> b
$ Either ServiceName MsgFlags -> Maybe MsgFlags
forall a b. Either a b -> Maybe b
eitherToMaybe (Either ServiceName MsgFlags -> Maybe MsgFlags)
-> (Text -> Either ServiceName MsgFlags) -> Text -> Maybe MsgFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Either ServiceName MsgFlags
forall a. Encoding a => SndFileId -> Either ServiceName a
smpDecode (SndFileId -> Either ServiceName MsgFlags)
-> (Text -> SndFileId) -> Text -> Either ServiceName MsgFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SndFileId
encodeUtf8

instance ToField [SMPQueueInfo] where toField :: [SMPQueueInfo] -> SQLData
toField = Binary SndFileId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary SndFileId -> SQLData)
-> ([SMPQueueInfo] -> Binary SndFileId)
-> [SMPQueueInfo]
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary (SndFileId -> Binary SndFileId)
-> ([SMPQueueInfo] -> SndFileId)
-> [SMPQueueInfo]
-> Binary SndFileId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SMPQueueInfo] -> SndFileId
forall a. Encoding a => [a] -> SndFileId
smpEncodeList

instance FromField [SMPQueueInfo] where fromField :: FieldParser [SMPQueueInfo]
fromField = (SndFileId -> Either ServiceName [SMPQueueInfo])
-> FieldParser [SMPQueueInfo]
forall k.
Typeable k =>
(SndFileId -> Either ServiceName k) -> FieldParser k
blobFieldDecoder ((SndFileId -> Either ServiceName [SMPQueueInfo])
 -> FieldParser [SMPQueueInfo])
-> (SndFileId -> Either ServiceName [SMPQueueInfo])
-> FieldParser [SMPQueueInfo]
forall a b. (a -> b) -> a -> b
$ Parser [SMPQueueInfo]
-> SndFileId -> Either ServiceName [SMPQueueInfo]
forall a. Parser a -> SndFileId -> Either ServiceName a
parseAll Parser [SMPQueueInfo]
forall a. Encoding a => Parser [a]
smpListP

instance ToField (NonEmpty TransportHost) where toField :: NonEmpty TransportHost -> SQLData
toField = Text -> SQLData
forall a. ToField a => a -> SQLData
toField (Text -> SQLData)
-> (NonEmpty TransportHost -> Text)
-> NonEmpty TransportHost
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Text
decodeLatin1 (SndFileId -> Text)
-> (NonEmpty TransportHost -> SndFileId)
-> NonEmpty TransportHost
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty TransportHost -> SndFileId
forall a. StrEncoding a => a -> SndFileId
strEncode

instance FromField (NonEmpty TransportHost) where fromField :: FieldParser (NonEmpty TransportHost)
fromField = (Text -> Maybe (NonEmpty TransportHost))
-> FieldParser (NonEmpty TransportHost)
forall a. Typeable a => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ ((Text -> Maybe (NonEmpty TransportHost))
 -> FieldParser (NonEmpty TransportHost))
-> (Text -> Maybe (NonEmpty TransportHost))
-> FieldParser (NonEmpty TransportHost)
forall a b. (a -> b) -> a -> b
$ Either ServiceName (NonEmpty TransportHost)
-> Maybe (NonEmpty TransportHost)
forall a b. Either a b -> Maybe b
eitherToMaybe (Either ServiceName (NonEmpty TransportHost)
 -> Maybe (NonEmpty TransportHost))
-> (Text -> Either ServiceName (NonEmpty TransportHost))
-> Text
-> Maybe (NonEmpty TransportHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Either ServiceName (NonEmpty TransportHost)
forall a. StrEncoding a => SndFileId -> Either ServiceName a
strDecode (SndFileId -> Either ServiceName (NonEmpty TransportHost))
-> (Text -> SndFileId)
-> Text
-> Either ServiceName (NonEmpty TransportHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SndFileId
encodeUtf8

instance ToField AgentCommand where toField :: AgentCommand -> SQLData
toField = Binary SndFileId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary SndFileId -> SQLData)
-> (AgentCommand -> Binary SndFileId) -> AgentCommand -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary (SndFileId -> Binary SndFileId)
-> (AgentCommand -> SndFileId) -> AgentCommand -> Binary SndFileId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AgentCommand -> SndFileId
forall a. StrEncoding a => a -> SndFileId
strEncode

instance FromField AgentCommand where fromField :: FieldParser AgentCommand
fromField = (SndFileId -> Either ServiceName AgentCommand)
-> FieldParser AgentCommand
forall k.
Typeable k =>
(SndFileId -> Either ServiceName k) -> FieldParser k
blobFieldDecoder SndFileId -> Either ServiceName AgentCommand
forall a. StrEncoding a => SndFileId -> Either ServiceName a
strDecode

instance ToField AgentCommandTag where toField :: AgentCommandTag -> SQLData
toField = Binary SndFileId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary SndFileId -> SQLData)
-> (AgentCommandTag -> Binary SndFileId)
-> AgentCommandTag
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary (SndFileId -> Binary SndFileId)
-> (AgentCommandTag -> SndFileId)
-> AgentCommandTag
-> Binary SndFileId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AgentCommandTag -> SndFileId
forall a. StrEncoding a => a -> SndFileId
strEncode

instance FromField AgentCommandTag where fromField :: FieldParser AgentCommandTag
fromField = (SndFileId -> Either ServiceName AgentCommandTag)
-> FieldParser AgentCommandTag
forall k.
Typeable k =>
(SndFileId -> Either ServiceName k) -> FieldParser k
blobFieldDecoder SndFileId -> Either ServiceName AgentCommandTag
forall a. StrEncoding a => SndFileId -> Either ServiceName a
strDecode

instance ToField MsgReceiptStatus where toField :: MsgReceiptStatus -> SQLData
toField = Text -> SQLData
forall a. ToField a => a -> SQLData
toField (Text -> SQLData)
-> (MsgReceiptStatus -> Text) -> MsgReceiptStatus -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Text
decodeLatin1 (SndFileId -> Text)
-> (MsgReceiptStatus -> SndFileId) -> MsgReceiptStatus -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgReceiptStatus -> SndFileId
forall a. StrEncoding a => a -> SndFileId
strEncode

instance FromField MsgReceiptStatus where fromField :: FieldParser MsgReceiptStatus
fromField = (Text -> Maybe MsgReceiptStatus) -> FieldParser MsgReceiptStatus
forall a. Typeable a => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ ((Text -> Maybe MsgReceiptStatus) -> FieldParser MsgReceiptStatus)
-> (Text -> Maybe MsgReceiptStatus) -> FieldParser MsgReceiptStatus
forall a b. (a -> b) -> a -> b
$ Either ServiceName MsgReceiptStatus -> Maybe MsgReceiptStatus
forall a b. Either a b -> Maybe b
eitherToMaybe (Either ServiceName MsgReceiptStatus -> Maybe MsgReceiptStatus)
-> (Text -> Either ServiceName MsgReceiptStatus)
-> Text
-> Maybe MsgReceiptStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Either ServiceName MsgReceiptStatus
forall a. StrEncoding a => SndFileId -> Either ServiceName a
strDecode (SndFileId -> Either ServiceName MsgReceiptStatus)
-> (Text -> SndFileId)
-> Text
-> Either ServiceName MsgReceiptStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SndFileId
encodeUtf8

instance ToField (Version v) where toField :: Version v -> SQLData
toField (Version Word16
v) = Word16 -> SQLData
forall a. ToField a => a -> SQLData
toField Word16
v

deriving newtype instance FromField (Version v)

instance ToField EntityId where toField :: SenderId -> SQLData
toField (EntityId SndFileId
s) = Binary SndFileId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary SndFileId -> SQLData) -> Binary SndFileId -> SQLData
forall a b. (a -> b) -> a -> b
$ SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
s

deriving newtype instance FromField EntityId

deriving newtype instance ToField ChunkReplicaId

deriving newtype instance FromField ChunkReplicaId

fromOnlyBI :: Only BoolInt -> Bool
fromOnlyBI :: Only BoolInt -> Bool
fromOnlyBI (Only (BI Bool
b)) = Bool
b
{-# INLINE fromOnlyBI #-}

#if !defined(dbPostgres)
{- ORMOLU_DISABLE -}
-- SQLite.Simple only has these up to 10 fields, which is insufficient for some of our queries
instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j,
          FromField k) =>
  FromRow (a,b,c,d,e,f,g,h,i,j,k) where
  fromRow :: RowParser (a, b, c, d, e, f, g, h, i, j, k)
fromRow = (,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser a
-> RowParser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser
  (b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser b
-> RowParser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> (a, b, c, d, e, f, g, h, i, j, k))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser
  (c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser c
-> RowParser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> (a, b, c, d, e, f, g, h, i, j, k))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser
  (d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser d
-> RowParser
     (e
      -> f -> g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field RowParser
  (e
   -> f -> g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser e
-> RowParser
     (f -> g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field
                         RowParser
  (f -> g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser f
-> RowParser
     (g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser f
forall a. FromField a => RowParser a
field RowParser
  (g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser g
-> RowParser
     (h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser g
forall a. FromField a => RowParser a
field RowParser (h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser h
-> RowParser (i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser h
forall a. FromField a => RowParser a
field RowParser (i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser i
-> RowParser (j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field RowParser (j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser j
-> RowParser (k -> (a, b, c, d, e, f, g, h, i, j, k))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field
                         RowParser (k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser k -> RowParser (a, b, c, d, e, f, g, h, i, j, k)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser k
forall a. FromField a => RowParser a
field

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j,
          FromField k, FromField l) =>
  FromRow (a,b,c,d,e,f,g,h,i,j,k,l) where
  fromRow :: RowParser (a, b, c, d, e, f, g, h, i, j, k, l)
fromRow = (,,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser a
-> RowParser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser
  (b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser b
-> RowParser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser
  (c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser c
-> RowParser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser
  (d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser d
-> RowParser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field RowParser
  (e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser e
-> RowParser
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field
                          RowParser
  (f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser f
-> RowParser
     (g
      -> h -> i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser f
forall a. FromField a => RowParser a
field RowParser
  (g
   -> h -> i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser g
-> RowParser
     (h -> i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser g
forall a. FromField a => RowParser a
field RowParser
  (h -> i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser h
-> RowParser
     (i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser h
forall a. FromField a => RowParser a
field RowParser
  (i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser i
-> RowParser (j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field RowParser (j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser j
-> RowParser (k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field
                          RowParser (k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser k
-> RowParser (l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser k
forall a. FromField a => RowParser a
field RowParser (l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser l -> RowParser (a, b, c, d, e, f, g, h, i, j, k, l)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser l
forall a. FromField a => RowParser a
field

instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
          ToField g, ToField h, ToField i, ToField j, ToField k, ToField l) =>
  ToRow (a,b,c,d,e,f,g,h,i,j,k,l) where
  toRow :: (a, b, c, d, e, f, g, h, i, j, k, l) -> [SQLData]
toRow (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l) =
    [ a -> SQLData
forall a. ToField a => a -> SQLData
toField a
a, b -> SQLData
forall a. ToField a => a -> SQLData
toField b
b, c -> SQLData
forall a. ToField a => a -> SQLData
toField c
c, d -> SQLData
forall a. ToField a => a -> SQLData
toField d
d, e -> SQLData
forall a. ToField a => a -> SQLData
toField e
e, f -> SQLData
forall a. ToField a => a -> SQLData
toField f
f,
      g -> SQLData
forall a. ToField a => a -> SQLData
toField g
g, h -> SQLData
forall a. ToField a => a -> SQLData
toField h
h, i -> SQLData
forall a. ToField a => a -> SQLData
toField i
i, j -> SQLData
forall a. ToField a => a -> SQLData
toField j
j, k -> SQLData
forall a. ToField a => a -> SQLData
toField k
k, l -> SQLData
forall a. ToField a => a -> SQLData
toField l
l
    ]

{- ORMOLU_ENABLE -}
#endif

-- * Server helper

-- | Creates a new server, if it doesn't exist, and returns the passed key hash if it is different from stored.
createServer :: DB.Connection -> SMPServer -> IO (Maybe C.KeyHash)
createServer :: Connection -> SMPServer -> IO (Maybe KeyHash)
createServer Connection
db newSrv :: SMPServer
newSrv@ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port, KeyHash
$sel:keyHash:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> KeyHash
keyHash :: KeyHash
keyHash} = do
  [Only Int]
r <- IO [Only Int]
insertNewServer_
  if [Only Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Only Int]
r
    then Connection -> SMPServer -> IO (Either StoreError (Maybe KeyHash))
getServerKeyHash_ Connection
db SMPServer
newSrv IO (Either StoreError (Maybe KeyHash))
-> (Either StoreError (Maybe KeyHash) -> IO (Maybe KeyHash))
-> IO (Maybe KeyHash)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StoreError -> IO (Maybe KeyHash))
-> (Maybe KeyHash -> IO (Maybe KeyHash))
-> Either StoreError (Maybe KeyHash)
-> IO (Maybe KeyHash)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StoreError -> IO (Maybe KeyHash)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO Maybe KeyHash -> IO (Maybe KeyHash)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    else Maybe KeyHash -> IO (Maybe KeyHash)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe KeyHash
forall a. Maybe a
Nothing
  where
    insertNewServer_ :: IO [Only Int]
    insertNewServer_ :: IO [Only Int]
insertNewServer_ =
      Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, KeyHash)
-> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"INSERT INTO servers (host, port, key_hash) VALUES (?,?,?) ON CONFLICT (host, port) DO NOTHING RETURNING 1" (NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash)

-- | Returns the passed server key hash if it is different from the stored one, or the error if the server does not exist.
getServerKeyHash_ :: DB.Connection -> SMPServer -> IO (Either StoreError (Maybe C.KeyHash))
getServerKeyHash_ :: Connection -> SMPServer -> IO (Either StoreError (Maybe KeyHash))
getServerKeyHash_ Connection
db ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port, KeyHash
$sel:keyHash:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> KeyHash
keyHash :: KeyHash
keyHash} = do
  (Only KeyHash -> Maybe KeyHash)
-> StoreError
-> IO [Only KeyHash]
-> IO (Either StoreError (Maybe KeyHash))
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only KeyHash -> Maybe KeyHash
useKeyHash StoreError
SEServerNotFound (IO [Only KeyHash] -> IO (Either StoreError (Maybe KeyHash)))
-> IO [Only KeyHash] -> IO (Either StoreError (Maybe KeyHash))
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (NonEmpty TransportHost, ServiceName)
-> IO [Only KeyHash]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT key_hash FROM servers WHERE host = ? AND port = ?" (NonEmpty TransportHost
host, ServiceName
port)
  where
    useKeyHash :: Only KeyHash -> Maybe KeyHash
useKeyHash (Only KeyHash
keyHash') = if KeyHash
keyHash KeyHash -> KeyHash -> Bool
forall a. Eq a => a -> a -> Bool
/= KeyHash
keyHash' then KeyHash -> Maybe KeyHash
forall a. a -> Maybe a
Just KeyHash
keyHash else Maybe KeyHash
forall a. Maybe a
Nothing

upsertNtfServer_ :: DB.Connection -> NtfServer -> IO ()
upsertNtfServer_ :: Connection -> NtfServer -> IO ()
upsertNtfServer_ Connection
db ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port, KeyHash
$sel:keyHash:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> KeyHash
keyHash :: KeyHash
keyHash} = do
  Connection
-> Query -> (NonEmpty TransportHost, ServiceName, KeyHash) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO ntf_servers (ntf_host, ntf_port, ntf_key_hash) VALUES (?,?,?)
      ON CONFLICT (ntf_host, ntf_port) DO UPDATE SET
        ntf_host=excluded.ntf_host,
        ntf_port=excluded.ntf_port,
        ntf_key_hash=excluded.ntf_key_hash;
    |]
    (NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash)

-- * createRcvConn helpers

insertRcvQueue_ :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> Maybe C.KeyHash -> IO RcvQueue
insertRcvQueue_ :: Connection
-> SndFileId
-> NewRcvQueue
-> SubscriptionMode
-> Maybe KeyHash
-> IO RcvQueue
insertRcvQueue_ Connection
db SndFileId
connId' rq :: NewRcvQueue
rq@RcvQueue {Bool
Int
Int64
Maybe Int64
Maybe QueueMode
Maybe DhSecretX25519
Maybe (StoredClientService 'DBNew)
Maybe ShortLinkCreds
Maybe RcvSwitchStatus
Maybe ClientNtfCreds
SndFileId
APrivateAuthKey
DhSecretX25519
PrivateKeyX25519
DBEntityId' 'DBNew
VersionSMPC
SenderId
SMPServer
QueueStatus
$sel:connId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SndFileId
$sel:server:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SMPServer
$sel:rcvId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SenderId
$sel:rcvSwchStatus:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Maybe RcvSwitchStatus
$sel:dbQueueId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> DBEntityId' q
userId :: Int64
connId :: SndFileId
server :: SMPServer
rcvId :: SenderId
rcvPrivateKey :: APrivateAuthKey
rcvDhSecret :: DhSecretX25519
e2ePrivKey :: PrivateKeyX25519
e2eDhSecret :: Maybe DhSecretX25519
sndId :: SenderId
queueMode :: Maybe QueueMode
shortLink :: Maybe ShortLinkCreds
clientService :: Maybe (StoredClientService 'DBNew)
status :: QueueStatus
enableNtfs :: Bool
clientNoticeId :: Maybe Int64
dbQueueId :: DBEntityId' 'DBNew
primary :: Bool
dbReplaceQueueId :: Maybe Int64
rcvSwchStatus :: Maybe RcvSwitchStatus
smpClientVersion :: VersionSMPC
clientNtfCreds :: Maybe ClientNtfCreds
deleteErrors :: Int
$sel:userId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Int64
$sel:rcvPrivateKey:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> APrivateAuthKey
$sel:rcvDhSecret:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> DhSecretX25519
$sel:e2ePrivKey:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> PrivateKeyX25519
$sel:e2eDhSecret:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Maybe DhSecretX25519
$sel:sndId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SenderId
$sel:queueMode:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Maybe QueueMode
$sel:shortLink:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Maybe ShortLinkCreds
$sel:clientService:RcvQueue :: forall (q :: DBStored).
StoredRcvQueue q -> Maybe (StoredClientService q)
$sel:status:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> QueueStatus
$sel:enableNtfs:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Bool
$sel:clientNoticeId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Maybe Int64
$sel:primary:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Bool
$sel:dbReplaceQueueId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Maybe Int64
$sel:smpClientVersion:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> VersionSMPC
$sel:clientNtfCreds:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Maybe ClientNtfCreds
$sel:deleteErrors:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Int
..} SubscriptionMode
subMode Maybe KeyHash
serverKeyHash_ = do
  -- to preserve ID if the queue already exists.
  -- possibly, it can be done in one query.
  Maybe (DBEntityId' 'DBStored)
currQId_ <- (Only (DBEntityId' 'DBStored) -> DBEntityId' 'DBStored)
-> IO [Only (DBEntityId' 'DBStored)]
-> IO (Maybe (DBEntityId' 'DBStored))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only (DBEntityId' 'DBStored) -> DBEntityId' 'DBStored
forall a. Only a -> a
fromOnly (IO [Only (DBEntityId' 'DBStored)]
 -> IO (Maybe (DBEntityId' 'DBStored)))
-> IO [Only (DBEntityId' 'DBStored)]
-> IO (Maybe (DBEntityId' 'DBStored))
forall a b. (a -> b) -> a -> b
$ Connection
-> Query
-> (SndFileId, NonEmpty TransportHost, ServiceName, SenderId)
-> IO [Only (DBEntityId' 'DBStored)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT rcv_queue_id FROM rcv_queues WHERE conn_id = ? AND host = ? AND port = ? AND snd_id = ?" (SndFileId
connId', SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host SMPServer
server, SMPServer -> ServiceName
forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port SMPServer
server, SenderId
sndId)
  DBEntityId' 'DBStored
qId <- IO (DBEntityId' 'DBStored)
-> (DBEntityId' 'DBStored -> IO (DBEntityId' 'DBStored))
-> Maybe (DBEntityId' 'DBStored)
-> IO (DBEntityId' 'DBStored)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Only Int64] -> DBEntityId' 'DBStored
newQueueId_ ([Only Int64] -> DBEntityId' 'DBStored)
-> IO [Only Int64] -> IO (DBEntityId' 'DBStored)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> Only SndFileId -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT rcv_queue_id FROM rcv_queues WHERE conn_id = ? ORDER BY rcv_queue_id DESC LIMIT 1" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId')) DBEntityId' 'DBStored -> IO (DBEntityId' 'DBStored)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (DBEntityId' 'DBStored)
currQId_
  Connection
-> Query
-> ((NonEmpty TransportHost, ServiceName, SenderId, SndFileId,
     APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
     Maybe DhSecretX25519)
    :. ((SenderId, Maybe QueueMode, QueueStatus, BoolInt,
         DBEntityId' 'DBStored, BoolInt, Maybe Int64, VersionSMPC,
         Maybe KeyHash)
        :. ((Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
             Maybe EncDataBytes)
            :. (Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
                Maybe DhSecretX25519))))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO rcv_queues
        ( host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret,
          snd_id, queue_mode, status, to_subscribe, rcv_queue_id, rcv_primary, replace_rcv_queue_id, smp_client_version, server_key_hash,
          link_id, link_key, link_priv_sig_key, link_enc_fixed_data,
          ntf_public_key, ntf_private_key, ntf_id, rcv_ntf_dh_secret
        ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
    |]
    ( (SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host SMPServer
server, SMPServer -> ServiceName
forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port SMPServer
server, SenderId
rcvId, SndFileId
connId', APrivateAuthKey
rcvPrivateKey, DhSecretX25519
rcvDhSecret, PrivateKeyX25519
e2ePrivKey, Maybe DhSecretX25519
e2eDhSecret)
        (NonEmpty TransportHost, ServiceName, SenderId, SndFileId,
 APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
 Maybe DhSecretX25519)
-> ((SenderId, Maybe QueueMode, QueueStatus, BoolInt,
     DBEntityId' 'DBStored, BoolInt, Maybe Int64, VersionSMPC,
     Maybe KeyHash)
    :. ((Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
         Maybe EncDataBytes)
        :. (Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
            Maybe DhSecretX25519)))
-> (NonEmpty TransportHost, ServiceName, SenderId, SndFileId,
    APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
    Maybe DhSecretX25519)
   :. ((SenderId, Maybe QueueMode, QueueStatus, BoolInt,
        DBEntityId' 'DBStored, BoolInt, Maybe Int64, VersionSMPC,
        Maybe KeyHash)
       :. ((Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
            Maybe EncDataBytes)
           :. (Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)))
forall h t. h -> t -> h :. t
:. (SenderId
sndId, Maybe QueueMode
queueMode, QueueStatus
status, Bool -> BoolInt
BI Bool
toSubscribe, DBEntityId' 'DBStored
qId, Bool -> BoolInt
BI Bool
primary, Maybe Int64
dbReplaceQueueId, VersionSMPC
smpClientVersion, Maybe KeyHash
serverKeyHash_)
        (SenderId, Maybe QueueMode, QueueStatus, BoolInt,
 DBEntityId' 'DBStored, BoolInt, Maybe Int64, VersionSMPC,
 Maybe KeyHash)
-> ((Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
     Maybe EncDataBytes)
    :. (Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
        Maybe DhSecretX25519))
-> (SenderId, Maybe QueueMode, QueueStatus, BoolInt,
    DBEntityId' 'DBStored, BoolInt, Maybe Int64, VersionSMPC,
    Maybe KeyHash)
   :. ((Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
        Maybe EncDataBytes)
       :. (Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
           Maybe DhSecretX25519))
forall h t. h -> t -> h :. t
:. (ShortLinkCreds -> SenderId
shortLinkId (ShortLinkCreds -> SenderId)
-> Maybe ShortLinkCreds -> Maybe SenderId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ShortLinkCreds
shortLink, ShortLinkCreds -> LinkKey
shortLinkKey (ShortLinkCreds -> LinkKey)
-> Maybe ShortLinkCreds -> Maybe LinkKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ShortLinkCreds
shortLink, ShortLinkCreds -> PrivateKeyEd25519
linkPrivSigKey (ShortLinkCreds -> PrivateKeyEd25519)
-> Maybe ShortLinkCreds -> Maybe PrivateKeyEd25519
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ShortLinkCreds
shortLink, ShortLinkCreds -> EncDataBytes
linkEncFixedData (ShortLinkCreds -> EncDataBytes)
-> Maybe ShortLinkCreds -> Maybe EncDataBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ShortLinkCreds
shortLink)
        (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
 Maybe EncDataBytes)
-> (Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
    Maybe DhSecretX25519)
-> (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
    Maybe EncDataBytes)
   :. (Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
       Maybe DhSecretX25519)
forall h t. h -> t -> h :. t
:. (Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
 Maybe DhSecretX25519)
ntfCredsFields
    )
  -- TODO [certs rcv] save client service
  RcvQueue -> IO RcvQueue
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewRcvQueue
rq :: NewRcvQueue) {connId = connId', dbQueueId = qId, clientService = Nothing}
  where
    toSubscribe :: Bool
toSubscribe = SubscriptionMode
subMode SubscriptionMode -> SubscriptionMode -> Bool
forall a. Eq a => a -> a -> Bool
== SubscriptionMode
SMOnlyCreate
    ntfCredsFields :: (Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
 Maybe DhSecretX25519)
ntfCredsFields = case Maybe ClientNtfCreds
clientNtfCreds of
      Just ClientNtfCreds {NtfPublicAuthKey
$sel:ntfPublicKey:ClientNtfCreds :: ClientNtfCreds -> NtfPublicAuthKey
ntfPublicKey :: NtfPublicAuthKey
ntfPublicKey, APrivateAuthKey
$sel:ntfPrivateKey:ClientNtfCreds :: ClientNtfCreds -> APrivateAuthKey
ntfPrivateKey :: APrivateAuthKey
ntfPrivateKey, SenderId
$sel:notifierId:ClientNtfCreds :: ClientNtfCreds -> SenderId
notifierId :: SenderId
notifierId, DhSecretX25519
$sel:rcvNtfDhSecret:ClientNtfCreds :: ClientNtfCreds -> DhSecretX25519
rcvNtfDhSecret :: DhSecretX25519
rcvNtfDhSecret} ->
        (NtfPublicAuthKey -> Maybe NtfPublicAuthKey
forall a. a -> Maybe a
Just NtfPublicAuthKey
ntfPublicKey, APrivateAuthKey -> Maybe APrivateAuthKey
forall a. a -> Maybe a
Just APrivateAuthKey
ntfPrivateKey, SenderId -> Maybe SenderId
forall a. a -> Maybe a
Just SenderId
notifierId, DhSecretX25519 -> Maybe DhSecretX25519
forall a. a -> Maybe a
Just DhSecretX25519
rcvNtfDhSecret)
      Maybe ClientNtfCreds
Nothing -> (Maybe NtfPublicAuthKey
forall a. Maybe a
Nothing, Maybe APrivateAuthKey
forall a. Maybe a
Nothing, Maybe SenderId
forall a. Maybe a
Nothing, Maybe DhSecretX25519
forall a. Maybe a
Nothing)

-- * createSndConn helpers

insertSndQueue_ :: DB.Connection -> ConnId -> NewSndQueue -> Maybe C.KeyHash -> IO SndQueue
insertSndQueue_ :: Connection
-> SndFileId -> NewSndQueue -> Maybe KeyHash -> IO SndQueue
insertSndQueue_ Connection
db SndFileId
connId' sq :: NewSndQueue
sq@SndQueue {Bool
Int64
Maybe Int64
Maybe QueueMode
Maybe PublicKeyX25519
Maybe SndSwitchStatus
SndFileId
APrivateAuthKey
DhSecretX25519
DBEntityId' 'DBNew
VersionSMPC
SenderId
SMPServer
QueueStatus
$sel:server:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> SMPServer
$sel:sndId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> SenderId
$sel:sndSwchStatus:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> Maybe SndSwitchStatus
$sel:dbQueueId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> DBEntityId' q
$sel:connId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> SndFileId
userId :: Int64
connId :: SndFileId
server :: SMPServer
sndId :: SenderId
queueMode :: Maybe QueueMode
sndPrivateKey :: APrivateAuthKey
e2ePubKey :: Maybe PublicKeyX25519
e2eDhSecret :: DhSecretX25519
status :: QueueStatus
dbQueueId :: DBEntityId' 'DBNew
primary :: Bool
dbReplaceQueueId :: Maybe Int64
sndSwchStatus :: Maybe SndSwitchStatus
smpClientVersion :: VersionSMPC
$sel:userId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> Int64
$sel:queueMode:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> Maybe QueueMode
$sel:sndPrivateKey:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> APrivateAuthKey
$sel:e2ePubKey:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> Maybe PublicKeyX25519
$sel:e2eDhSecret:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> DhSecretX25519
$sel:status:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> QueueStatus
$sel:primary:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> Bool
$sel:dbReplaceQueueId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> Maybe Int64
$sel:smpClientVersion:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> VersionSMPC
..} Maybe KeyHash
serverKeyHash_ = do
  -- to preserve ID if the queue already exists.
  -- possibly, it can be done in one query.
  Maybe (DBEntityId' 'DBStored)
currQId_ <- (Only (DBEntityId' 'DBStored) -> DBEntityId' 'DBStored)
-> IO [Only (DBEntityId' 'DBStored)]
-> IO (Maybe (DBEntityId' 'DBStored))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only (DBEntityId' 'DBStored) -> DBEntityId' 'DBStored
forall a. Only a -> a
fromOnly (IO [Only (DBEntityId' 'DBStored)]
 -> IO (Maybe (DBEntityId' 'DBStored)))
-> IO [Only (DBEntityId' 'DBStored)]
-> IO (Maybe (DBEntityId' 'DBStored))
forall a b. (a -> b) -> a -> b
$ Connection
-> Query
-> (SndFileId, NonEmpty TransportHost, ServiceName, SenderId)
-> IO [Only (DBEntityId' 'DBStored)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT snd_queue_id FROM snd_queues WHERE conn_id = ? AND host = ? AND port = ? AND snd_id = ?" (SndFileId
connId', SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host SMPServer
server, SMPServer -> ServiceName
forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port SMPServer
server, SenderId
sndId)
  DBEntityId' 'DBStored
qId <- IO (DBEntityId' 'DBStored)
-> (DBEntityId' 'DBStored -> IO (DBEntityId' 'DBStored))
-> Maybe (DBEntityId' 'DBStored)
-> IO (DBEntityId' 'DBStored)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Only Int64] -> DBEntityId' 'DBStored
newQueueId_ ([Only Int64] -> DBEntityId' 'DBStored)
-> IO [Only Int64] -> IO (DBEntityId' 'DBStored)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> Only SndFileId -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT snd_queue_id FROM snd_queues WHERE conn_id = ? ORDER BY snd_queue_id DESC LIMIT 1" (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId')) DBEntityId' 'DBStored -> IO (DBEntityId' 'DBStored)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (DBEntityId' 'DBStored)
currQId_
  Connection
-> Query
-> ((NonEmpty TransportHost, ServiceName, SenderId,
     Maybe QueueMode, SndFileId, APrivateAuthKey, Maybe PublicKeyX25519,
     DhSecretX25519)
    :. (QueueStatus, DBEntityId' 'DBStored, BoolInt, Maybe Int64,
        VersionSMPC, Maybe KeyHash))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO snd_queues
        (host, port, snd_id, queue_mode, conn_id, snd_private_key, e2e_pub_key, e2e_dh_secret,
         status, snd_queue_id, snd_primary, replace_snd_queue_id, smp_client_version, server_key_hash)
      VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
      ON CONFLICT (host, port, snd_id) DO UPDATE SET
        host=EXCLUDED.host,
        port=EXCLUDED.port,
        snd_id=EXCLUDED.snd_id,
        queue_mode=EXCLUDED.queue_mode,
        conn_id=EXCLUDED.conn_id,
        snd_private_key=EXCLUDED.snd_private_key,
        e2e_pub_key=EXCLUDED.e2e_pub_key,
        e2e_dh_secret=EXCLUDED.e2e_dh_secret,
        status=EXCLUDED.status,
        snd_queue_id=EXCLUDED.snd_queue_id,
        snd_primary=EXCLUDED.snd_primary,
        replace_snd_queue_id=EXCLUDED.replace_snd_queue_id,
        smp_client_version=EXCLUDED.smp_client_version,
        server_key_hash=EXCLUDED.server_key_hash
    |]
    ((SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host SMPServer
server, SMPServer -> ServiceName
forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port SMPServer
server, SenderId
sndId, Maybe QueueMode
queueMode, SndFileId
connId', APrivateAuthKey
sndPrivateKey, Maybe PublicKeyX25519
e2ePubKey, DhSecretX25519
e2eDhSecret)
    (NonEmpty TransportHost, ServiceName, SenderId, Maybe QueueMode,
 SndFileId, APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519)
-> (QueueStatus, DBEntityId' 'DBStored, BoolInt, Maybe Int64,
    VersionSMPC, Maybe KeyHash)
-> (NonEmpty TransportHost, ServiceName, SenderId, Maybe QueueMode,
    SndFileId, APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519)
   :. (QueueStatus, DBEntityId' 'DBStored, BoolInt, Maybe Int64,
       VersionSMPC, Maybe KeyHash)
forall h t. h -> t -> h :. t
:. (QueueStatus
status, DBEntityId' 'DBStored
qId, Bool -> BoolInt
BI Bool
primary, Maybe Int64
dbReplaceQueueId, VersionSMPC
smpClientVersion, Maybe KeyHash
serverKeyHash_))
  SndQueue -> IO SndQueue
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewSndQueue
sq :: NewSndQueue) {connId = connId', dbQueueId = qId}

newQueueId_ :: [Only Int64] -> DBEntityId
newQueueId_ :: [Only Int64] -> DBEntityId' 'DBStored
newQueueId_ [] = Int64 -> DBEntityId' 'DBStored
DBEntityId Int64
1
newQueueId_ (Only Int64
maxId : [Only Int64]
_) = Int64 -> DBEntityId' 'DBStored
DBEntityId (Int64
maxId Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1)

-- * subscribe all connections

getClientNotices :: DB.Connection -> [SMPServer] -> IO (Map (Maybe SMPServer) (Maybe SystemSeconds))
getClientNotices :: Connection
-> [SMPServer] -> IO (Map (Maybe SMPServer) (Maybe SystemSeconds))
getClientNotices Connection
db [SMPServer]
presetSrvs =
  ((Int64, Maybe Int64) -> Maybe SystemSeconds)
-> Map (Maybe SMPServer) (Int64, Maybe Int64)
-> Map (Maybe SMPServer) (Maybe SystemSeconds)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Int64, Maybe Int64) -> Maybe SystemSeconds
forall {f :: * -> *} {t :: Nat}.
Functor f =>
(Int64, f Int64) -> f (RoundedSystemTime t)
expiresAt (Map (Maybe SMPServer) (Int64, Maybe Int64)
 -> Map (Maybe SMPServer) (Maybe SystemSeconds))
-> ([(NonEmpty TransportHost, ServiceName, SenderId, KeyHash,
      Int64, Maybe Int64)]
    -> Map (Maybe SMPServer) (Int64, Maybe Int64))
-> [(NonEmpty TransportHost, ServiceName, SenderId, KeyHash, Int64,
     Maybe Int64)]
-> Map (Maybe SMPServer) (Maybe SystemSeconds)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Maybe SMPServer) (Int64, Maybe Int64)
 -> (NonEmpty TransportHost, ServiceName, SenderId, KeyHash, Int64,
     Maybe Int64)
 -> Map (Maybe SMPServer) (Int64, Maybe Int64))
-> Map (Maybe SMPServer) (Int64, Maybe Int64)
-> [(NonEmpty TransportHost, ServiceName, SenderId, KeyHash, Int64,
     Maybe Int64)]
-> Map (Maybe SMPServer) (Int64, Maybe Int64)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map (Maybe SMPServer) (Int64, Maybe Int64)
-> (NonEmpty TransportHost, ServiceName, SenderId, KeyHash, Int64,
    Maybe Int64)
-> Map (Maybe SMPServer) (Int64, Maybe Int64)
addNotice Map (Maybe SMPServer) (Int64, Maybe Int64)
forall k a. Map k a
M.empty
    ([(NonEmpty TransportHost, ServiceName, SenderId, KeyHash, Int64,
   Maybe Int64)]
 -> Map (Maybe SMPServer) (Maybe SystemSeconds))
-> IO
     [(NonEmpty TransportHost, ServiceName, SenderId, KeyHash, Int64,
       Maybe Int64)]
-> IO (Map (Maybe SMPServer) (Maybe SystemSeconds))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> IO
     [(NonEmpty TransportHost, ServiceName, SenderId, KeyHash, Int64,
       Maybe Int64)]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_
      Connection
db
      [sql|
        SELECT n.host, n.port, n.entity_id, COALESCE(n.server_key_hash, s.key_hash), n.created_at, n.notice_ttl
        FROM client_notices n
        JOIN servers s ON n.host = s.host AND n.port = s.port
        WHERE n.protocol = 'smp'
      |]
  where
    expiresAt :: (Int64, f Int64) -> f (RoundedSystemTime t)
expiresAt (Int64
createdAt, f Int64
ttl)  = Int64 -> RoundedSystemTime t
forall (t :: Nat). Int64 -> RoundedSystemTime t
RoundedSystemTime (Int64 -> RoundedSystemTime t)
-> (Int64 -> Int64) -> Int64 -> RoundedSystemTime t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64
createdAt Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+) (Int64 -> RoundedSystemTime t)
-> f Int64 -> f (RoundedSystemTime t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Int64
ttl
    addNotice ::
      Map (Maybe SMPServer) (Int64, Maybe Int64) ->
      (NonEmpty TransportHost, ServiceName, RecipientId, C.KeyHash, Int64, Maybe Int64) ->
      Map (Maybe SMPServer) (Int64, Maybe Int64)
    addNotice :: Map (Maybe SMPServer) (Int64, Maybe Int64)
-> (NonEmpty TransportHost, ServiceName, SenderId, KeyHash, Int64,
    Maybe Int64)
-> Map (Maybe SMPServer) (Int64, Maybe Int64)
addNotice Map (Maybe SMPServer) (Int64, Maybe Int64)
m (NonEmpty TransportHost
host, ServiceName
port, SenderId
_, KeyHash
keyHash, Int64
createdAt', Maybe Int64
ttl') =
      let srv :: SMPServer
srv = NonEmpty TransportHost -> ServiceName -> KeyHash -> SMPServer
SMPServer NonEmpty TransportHost
host ServiceName
port KeyHash
keyHash
          srvKey :: Maybe SMPServer
srvKey
            | SMPServer -> [SMPServer] -> Bool
forall (t :: * -> *).
Foldable t =>
SMPServer -> t SMPServer -> Bool
isPresetServer SMPServer
srv [SMPServer]
presetSrvs = Maybe SMPServer
forall a. Maybe a
Nothing
            | Bool
otherwise = SMPServer -> Maybe SMPServer
forall a. a -> Maybe a
Just SMPServer
srv
       in (Maybe (Int64, Maybe Int64) -> Maybe (Int64, Maybe Int64))
-> Maybe SMPServer
-> Map (Maybe SMPServer) (Int64, Maybe Int64)
-> Map (Maybe SMPServer) (Int64, Maybe Int64)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter ((Int64, Maybe Int64) -> Maybe (Int64, Maybe Int64)
forall a. a -> Maybe a
Just ((Int64, Maybe Int64) -> Maybe (Int64, Maybe Int64))
-> (Maybe (Int64, Maybe Int64) -> (Int64, Maybe Int64))
-> Maybe (Int64, Maybe Int64)
-> Maybe (Int64, Maybe Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Int64, Maybe Int64) -> (Int64, Maybe Int64)
addNoticeHost) Maybe SMPServer
srvKey Map (Maybe SMPServer) (Int64, Maybe Int64)
m
      where
        -- sum of ttls starting from the latest createdAt
        addNoticeHost :: Maybe (Int64, Maybe Int64) -> (Int64, Maybe Int64)
        addNoticeHost :: Maybe (Int64, Maybe Int64) -> (Int64, Maybe Int64)
addNoticeHost = \case
          Just (Int64
createdAt, Maybe Int64
ttl) -> (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
createdAt Int64
createdAt', Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
(+) (Int64 -> Int64 -> Int64) -> Maybe Int64 -> Maybe (Int64 -> Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
ttl Maybe (Int64 -> Int64) -> Maybe Int64 -> Maybe Int64
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int64
ttl')
          Maybe (Int64, Maybe Int64)
Nothing -> (Int64
createdAt', Maybe Int64
ttl')

updateClientNotices :: DB.Connection -> SMPTransportSession -> SystemSeconds -> [(RcvQueueSub, Maybe ClientNotice)] -> IO [(RecipientId, Maybe NoticeId)]
updateClientNotices :: Connection
-> SMPTransportSession
-> SystemSeconds
-> [(RcvQueueSub, Maybe ClientNotice)]
-> IO [(SenderId, Maybe Int64)]
updateClientNotices Connection
db (Int64
_, ProtoServer BrokerMsg
srv, Maybe SndFileId
_) SystemSeconds
now =
  ((RcvQueueSub, Maybe ClientNotice) -> IO (SenderId, Maybe Int64))
-> [(RcvQueueSub, Maybe ClientNotice)]
-> IO [(SenderId, Maybe Int64)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (((RcvQueueSub, Maybe ClientNotice) -> IO (SenderId, Maybe Int64))
 -> [(RcvQueueSub, Maybe ClientNotice)]
 -> IO [(SenderId, Maybe Int64)])
-> ((RcvQueueSub, Maybe ClientNotice)
    -> IO (SenderId, Maybe Int64))
-> [(RcvQueueSub, Maybe ClientNotice)]
-> IO [(SenderId, Maybe Int64)]
forall a b. (a -> b) -> a -> b
$ \(RcvQueueSub
rq, Maybe ClientNotice
notice_) -> IO (SenderId, Maybe Int64)
-> (ClientNotice -> IO (SenderId, Maybe Int64))
-> Maybe ClientNotice
-> IO (SenderId, Maybe Int64)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RcvQueueSub -> IO (SenderId, Maybe Int64)
deleteNotice RcvQueueSub
rq) (RcvQueueSub -> ClientNotice -> IO (SenderId, Maybe Int64)
upsertNotice RcvQueueSub
rq) Maybe ClientNotice
notice_
  where
    deleteNotice :: RcvQueueSub -> IO (SenderId, Maybe Int64)
deleteNotice RcvQueueSub {SenderId
rcvId :: SenderId
$sel:rcvId:RcvQueueSub :: RcvQueueSub -> SenderId
rcvId, Maybe Int64
clientNoticeId :: Maybe Int64
$sel:clientNoticeId:RcvQueueSub :: RcvQueueSub -> Maybe Int64
clientNoticeId} = do
      (Int64 -> IO ()) -> Maybe Int64 -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM client_notices WHERE client_notice_id = ?" (Only Int64 -> IO ()) -> (Int64 -> Only Int64) -> Int64 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Only Int64
forall a. a -> Only a
Only) Maybe Int64
clientNoticeId
      (SenderId, Maybe Int64) -> IO (SenderId, Maybe Int64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SenderId
rcvId, Maybe Int64
forall a. Maybe a
Nothing)
    upsertNotice :: RcvQueueSub -> ClientNotice -> IO (SenderId, Maybe Int64)
upsertNotice RcvQueueSub {SenderId
$sel:rcvId:RcvQueueSub :: RcvQueueSub -> SenderId
rcvId :: SenderId
rcvId, SMPServer
server :: SMPServer
$sel:server:RcvQueueSub :: RcvQueueSub -> SMPServer
server} ClientNotice {Maybe Int64
ttl :: Maybe Int64
ttl :: ClientNotice -> Maybe Int64
ttl} =
      Connection -> SMPServer -> IO (Either StoreError (Maybe KeyHash))
getServerKeyHash_ Connection
db SMPServer
server IO (Either StoreError (Maybe KeyHash))
-> (Either StoreError (Maybe KeyHash)
    -> IO (SenderId, Maybe Int64))
-> IO (SenderId, Maybe Int64)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left StoreError
_ -> (SenderId, Maybe Int64) -> IO (SenderId, Maybe Int64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SenderId
rcvId, Maybe Int64
forall a. Maybe a
Nothing)
        Right Maybe KeyHash
keyHash_ -> do
          Maybe Int64
noticeId_ <-
            (Only Int64 -> Int64) -> IO [Only Int64] -> IO (Maybe Int64)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly (IO [Only Int64] -> IO (Maybe Int64))
-> IO [Only Int64] -> IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$
              Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, SenderId, Maybe KeyHash,
    Maybe Int64, SystemSeconds, SystemSeconds)
-> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
                Connection
db
                [sql|
                  INSERT INTO client_notices(protocol, host, port, entity_id, server_key_hash, notice_ttl, created_at, updated_at)
                    VALUES ('smp',?,?,?,?,?,?,?)
                  ON CONFLICT (protocol, host, port, entity_id)
                  DO UPDATE SET
                    server_key_hash = EXCLUDED.server_key_hash,
                    notice_ttl = EXCLUDED.notice_ttl,
                    updated_at = EXCLUDED.updated_at
                  RETURNING client_notice_id
                |]
                (SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host ProtoServer BrokerMsg
SMPServer
srv, SMPServer -> ServiceName
forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port ProtoServer BrokerMsg
SMPServer
srv, SenderId
rcvId, Maybe KeyHash
keyHash_, Maybe Int64
ttl, SystemSeconds
now, SystemSeconds
now)
          Maybe Int64 -> (Int64 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Int64
noticeId_ ((Int64 -> IO ()) -> IO ()) -> (Int64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int64
noticeId -> do
            Connection
-> Query
-> (Int64, NonEmpty TransportHost, ServiceName, SenderId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
              Connection
db
              Query
"UPDATE rcv_queues SET client_notice_id = ? WHERE host = ? AND port = ?AND rcv_id = ?"
              (Int64
noticeId, SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host ProtoServer BrokerMsg
SMPServer
srv, SMPServer -> ServiceName
forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port ProtoServer BrokerMsg
SMPServer
srv, SenderId
rcvId)
          (SenderId, Maybe Int64) -> IO (SenderId, Maybe Int64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SenderId
rcvId, Maybe Int64
noticeId_)

getSubscriptionServers :: DB.Connection -> Bool -> IO [(UserId, SMPServer)]
getSubscriptionServers :: Connection -> Bool -> IO [(Int64, SMPServer)]
getSubscriptionServers Connection
db Bool
onlyNeeded =
  ((Int64, NonEmpty TransportHost, ServiceName, KeyHash)
 -> (Int64, SMPServer))
-> [(Int64, NonEmpty TransportHost, ServiceName, KeyHash)]
-> [(Int64, SMPServer)]
forall a b. (a -> b) -> [a] -> [b]
map (Int64, NonEmpty TransportHost, ServiceName, KeyHash)
-> (Int64, SMPServer)
toUserServer ([(Int64, NonEmpty TransportHost, ServiceName, KeyHash)]
 -> [(Int64, SMPServer)])
-> IO [(Int64, NonEmpty TransportHost, ServiceName, KeyHash)]
-> IO [(Int64, SMPServer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> IO [(Int64, NonEmpty TransportHost, ServiceName, KeyHash)]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_ Connection
db (Query
select Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
toSubscribe Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" c.deleted = 0 AND q.deleted = 0")
  where
    select :: Query
select =
      [sql|
        SELECT DISTINCT c.user_id, q.host, q.port, COALESCE(q.server_key_hash, s.key_hash)
        FROM rcv_queues q
        JOIN servers s ON q.host = s.host AND q.port = s.port
        JOIN connections c ON q.conn_id = c.conn_id
      |]
    toSubscribe :: Query
toSubscribe
      | Bool
onlyNeeded = Query
" WHERE q.to_subscribe = 1 AND "
      | Bool
otherwise = Query
" WHERE "
    toUserServer :: (UserId, NonEmpty TransportHost, ServiceName, C.KeyHash) -> (UserId, SMPServer)
    toUserServer :: (Int64, NonEmpty TransportHost, ServiceName, KeyHash)
-> (Int64, SMPServer)
toUserServer (Int64
userId, NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash) = (Int64
userId, NonEmpty TransportHost -> ServiceName -> KeyHash -> SMPServer
SMPServer NonEmpty TransportHost
host ServiceName
port KeyHash
keyHash)

getUserServerRcvQueueSubs :: DB.Connection -> UserId -> SMPServer -> Bool -> Int -> Maybe SMP.RecipientId -> IO [RcvQueueSub]
getUserServerRcvQueueSubs :: Connection
-> Int64
-> SMPServer
-> Bool
-> Int
-> Maybe SenderId
-> IO [RcvQueueSub]
getUserServerRcvQueueSubs Connection
db Int64
userId (SMPServer NonEmpty TransportHost
h ServiceName
p KeyHash
kh) Bool
onlyNeeded Int
limit Maybe SenderId
cursor_ =
  (((Int64, SndFileId, NonEmpty TransportHost, ServiceName, KeyHash,
   SenderId, APrivateAuthKey)
  :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
      Maybe Int64))
 -> RcvQueueSub)
-> [(Int64, SndFileId, NonEmpty TransportHost, ServiceName,
     KeyHash, SenderId, APrivateAuthKey)
    :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
        Maybe Int64)]
-> [RcvQueueSub]
forall a b. (a -> b) -> [a] -> [b]
map ((Int64, SndFileId, NonEmpty TransportHost, ServiceName, KeyHash,
  SenderId, APrivateAuthKey)
 :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
     Maybe Int64))
-> RcvQueueSub
toRcvQueueSub ([(Int64, SndFileId, NonEmpty TransportHost, ServiceName, KeyHash,
   SenderId, APrivateAuthKey)
  :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
      Maybe Int64)]
 -> [RcvQueueSub])
-> IO
     [(Int64, SndFileId, NonEmpty TransportHost, ServiceName, KeyHash,
       SenderId, APrivateAuthKey)
      :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
          Maybe Int64)]
-> IO [RcvQueueSub]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe SenderId
cursor_ of
    Maybe SenderId
Nothing -> Connection
-> Query
-> (Int64, NonEmpty TransportHost, ServiceName, KeyHash, Int)
-> IO
     [(Int64, SndFileId, NonEmpty TransportHost, ServiceName, KeyHash,
       SenderId, APrivateAuthKey)
      :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
          Maybe Int64)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
q Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
orderLimit) (Int64
userId, NonEmpty TransportHost
h, ServiceName
p, KeyHash
kh, Int
limit)
    Just SenderId
cursor -> Connection
-> Query
-> (Int64, NonEmpty TransportHost, ServiceName, KeyHash, SenderId,
    Int)
-> IO
     [(Int64, SndFileId, NonEmpty TransportHost, ServiceName, KeyHash,
       SenderId, APrivateAuthKey)
      :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
          Maybe Int64)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
q Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND q.rcv_id > ? " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
orderLimit) (Int64
userId, NonEmpty TransportHost
h, ServiceName
p, KeyHash
kh, SenderId
cursor, Int
limit)
  where
    q :: Query
q = Query
rcvQueueSubQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
toSubscribe Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" c.deleted = 0 AND q.deleted = 0 AND c.user_id = ? AND q.host = ? AND q.port = ? AND COALESCE(q.server_key_hash, s.key_hash) = ?"
    orderLimit :: Query
orderLimit = Query
" ORDER BY q.rcv_id LIMIT ?"
    toSubscribe :: Query
toSubscribe
      | Bool
onlyNeeded = Query
" WHERE q.to_subscribe = 1 AND "
      | Bool
otherwise = Query
" WHERE "

unsetQueuesToSubscribe :: DB.Connection -> IO ()
unsetQueuesToSubscribe :: Connection -> IO ()
unsetQueuesToSubscribe Connection
db = Connection -> Query -> IO ()
DB.execute_ Connection
db Query
"UPDATE rcv_queues SET to_subscribe = 0 WHERE to_subscribe = 1"

-- * getConn helpers

getConnIds :: DB.Connection -> IO [ConnId]
getConnIds :: Connection -> IO [SndFileId]
getConnIds Connection
db = (Only SndFileId -> SndFileId) -> [Only SndFileId] -> [SndFileId]
forall a b. (a -> b) -> [a] -> [b]
map Only SndFileId -> SndFileId
forall a. Only a -> a
fromOnly ([Only SndFileId] -> [SndFileId])
-> IO [Only SndFileId] -> IO [SndFileId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> IO [Only SndFileId]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_ Connection
db Query
"SELECT conn_id FROM connections WHERE deleted = 0"

getConn :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
getConn :: Connection -> SndFileId -> IO (Either StoreError SomeConn)
getConn = Bool
-> Bool
-> Connection
-> SndFileId
-> IO (Either StoreError SomeConn)
getAnyConn Bool
False Bool
False
{-# INLINE getConn #-}

getConnForUpdate :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
getConnForUpdate :: Connection -> SndFileId -> IO (Either StoreError SomeConn)
getConnForUpdate = Bool
-> Bool
-> Connection
-> SndFileId
-> IO (Either StoreError SomeConn)
getAnyConn Bool
False Bool
True
{-# INLINE getConnForUpdate #-}

getDeletedConn :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
getDeletedConn :: Connection -> SndFileId -> IO (Either StoreError SomeConn)
getDeletedConn = Bool
-> Bool
-> Connection
-> SndFileId
-> IO (Either StoreError SomeConn)
getAnyConn Bool
True Bool
False
{-# INLINE getDeletedConn #-}

getAnyConn :: Bool -> Bool -> DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
getAnyConn :: Bool
-> Bool
-> Connection
-> SndFileId
-> IO (Either StoreError SomeConn)
getAnyConn = (Connection -> SndFileId -> IO (Maybe (NonEmpty RcvQueue)))
-> (Connection -> SndFileId -> IO (Maybe (NonEmpty SndQueue)))
-> Bool
-> Bool
-> Connection
-> SndFileId
-> IO (Either StoreError SomeConn)
forall rq sq.
(Connection -> SndFileId -> IO (Maybe (NonEmpty rq)))
-> (Connection -> SndFileId -> IO (Maybe (NonEmpty sq)))
-> Bool
-> Bool
-> Connection
-> SndFileId
-> IO (Either StoreError (SomeConn' rq sq))
getAnyConn_ Connection -> SndFileId -> IO (Maybe (NonEmpty RcvQueue))
getRcvQueuesByConnId_ Connection -> SndFileId -> IO (Maybe (NonEmpty SndQueue))
getSndQueuesByConnId_
{-# INLINE getAnyConn #-}

getAnyConn_ ::
  (DB.Connection -> ConnId -> IO (Maybe (NonEmpty rq))) ->
  (DB.Connection -> ConnId -> IO (Maybe (NonEmpty sq))) ->
  (Bool -> Bool -> DB.Connection -> ConnId -> IO (Either StoreError (SomeConn' rq sq)))
getAnyConn_ :: forall rq sq.
(Connection -> SndFileId -> IO (Maybe (NonEmpty rq)))
-> (Connection -> SndFileId -> IO (Maybe (NonEmpty sq)))
-> Bool
-> Bool
-> Connection
-> SndFileId
-> IO (Either StoreError (SomeConn' rq sq))
getAnyConn_ Connection -> SndFileId -> IO (Maybe (NonEmpty rq))
getRQs Connection -> SndFileId -> IO (Maybe (NonEmpty sq))
getSQs Bool
deleted' Bool
forUpdate Connection
db SndFileId
connId =
  Bool
-> Bool
-> Connection
-> SndFileId
-> IO (Maybe (ConnData, ConnectionMode))
getConnData Bool
deleted' Bool
forUpdate Connection
db SndFileId
connId IO (Maybe (ConnData, ConnectionMode))
-> (Maybe (ConnData, ConnectionMode)
    -> IO (Either StoreError (SomeConn' rq sq)))
-> IO (Either StoreError (SomeConn' rq sq))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (ConnData
cData, ConnectionMode
cMode) -> do
      Maybe (NonEmpty rq)
rQ <- Connection -> SndFileId -> IO (Maybe (NonEmpty rq))
getRQs Connection
db SndFileId
connId
      Maybe (NonEmpty sq)
sQ <- Connection -> SndFileId -> IO (Maybe (NonEmpty sq))
getSQs Connection
db SndFileId
connId
      Either StoreError (SomeConn' rq sq)
-> IO (Either StoreError (SomeConn' rq sq))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError (SomeConn' rq sq)
 -> IO (Either StoreError (SomeConn' rq sq)))
-> Either StoreError (SomeConn' rq sq)
-> IO (Either StoreError (SomeConn' rq sq))
forall a b. (a -> b) -> a -> b
$ case (Maybe (NonEmpty rq)
rQ, Maybe (NonEmpty sq)
sQ, ConnectionMode
cMode) of
        (Just NonEmpty rq
rqs, Just NonEmpty sq
sqs, ConnectionMode
CMInvitation) -> SomeConn' rq sq -> Either StoreError (SomeConn' rq sq)
forall a b. b -> Either a b
Right (SomeConn' rq sq -> Either StoreError (SomeConn' rq sq))
-> SomeConn' rq sq -> Either StoreError (SomeConn' rq sq)
forall a b. (a -> b) -> a -> b
$ SConnType 'CDuplex -> Connection' 'CDuplex rq sq -> SomeConn' rq sq
forall rq sq (d :: ConnType).
SConnType d -> Connection' d rq sq -> SomeConn' rq sq
SomeConn SConnType 'CDuplex
SCDuplex (ConnData
-> NonEmpty rq -> NonEmpty sq -> Connection' 'CDuplex rq sq
forall rq sq.
ConnData
-> NonEmpty rq -> NonEmpty sq -> Connection' 'CDuplex rq sq
DuplexConnection ConnData
cData NonEmpty rq
rqs NonEmpty sq
sqs)
        (Just (rq
rq :| [rq]
_), Maybe (NonEmpty sq)
Nothing, ConnectionMode
CMInvitation) -> SomeConn' rq sq -> Either StoreError (SomeConn' rq sq)
forall a b. b -> Either a b
Right (SomeConn' rq sq -> Either StoreError (SomeConn' rq sq))
-> SomeConn' rq sq -> Either StoreError (SomeConn' rq sq)
forall a b. (a -> b) -> a -> b
$ SConnType 'CRcv -> Connection' 'CRcv rq sq -> SomeConn' rq sq
forall rq sq (d :: ConnType).
SConnType d -> Connection' d rq sq -> SomeConn' rq sq
SomeConn SConnType 'CRcv
SCRcv (ConnData -> rq -> Connection' 'CRcv rq sq
forall rq sq. ConnData -> rq -> Connection' 'CRcv rq sq
RcvConnection ConnData
cData rq
rq)
        (Maybe (NonEmpty rq)
Nothing, Just (sq
sq :| [sq]
_), ConnectionMode
CMInvitation) -> SomeConn' rq sq -> Either StoreError (SomeConn' rq sq)
forall a b. b -> Either a b
Right (SomeConn' rq sq -> Either StoreError (SomeConn' rq sq))
-> SomeConn' rq sq -> Either StoreError (SomeConn' rq sq)
forall a b. (a -> b) -> a -> b
$ SConnType 'CSnd -> Connection' 'CSnd rq sq -> SomeConn' rq sq
forall rq sq (d :: ConnType).
SConnType d -> Connection' d rq sq -> SomeConn' rq sq
SomeConn SConnType 'CSnd
SCSnd (ConnData -> sq -> Connection' 'CSnd rq sq
forall sq rq. ConnData -> sq -> Connection' 'CSnd rq sq
SndConnection ConnData
cData sq
sq)
        (Just (rq
rq :| [rq]
_), Maybe (NonEmpty sq)
Nothing, ConnectionMode
CMContact) -> SomeConn' rq sq -> Either StoreError (SomeConn' rq sq)
forall a b. b -> Either a b
Right (SomeConn' rq sq -> Either StoreError (SomeConn' rq sq))
-> SomeConn' rq sq -> Either StoreError (SomeConn' rq sq)
forall a b. (a -> b) -> a -> b
$ SConnType 'CContact
-> Connection' 'CContact rq sq -> SomeConn' rq sq
forall rq sq (d :: ConnType).
SConnType d -> Connection' d rq sq -> SomeConn' rq sq
SomeConn SConnType 'CContact
SCContact (ConnData -> rq -> Connection' 'CContact rq sq
forall rq sq. ConnData -> rq -> Connection' 'CContact rq sq
ContactConnection ConnData
cData rq
rq)
        (Maybe (NonEmpty rq)
Nothing, Maybe (NonEmpty sq)
Nothing, ConnectionMode
_) -> SomeConn' rq sq -> Either StoreError (SomeConn' rq sq)
forall a b. b -> Either a b
Right (SomeConn' rq sq -> Either StoreError (SomeConn' rq sq))
-> SomeConn' rq sq -> Either StoreError (SomeConn' rq sq)
forall a b. (a -> b) -> a -> b
$ SConnType 'CNew -> Connection' 'CNew rq sq -> SomeConn' rq sq
forall rq sq (d :: ConnType).
SConnType d -> Connection' d rq sq -> SomeConn' rq sq
SomeConn SConnType 'CNew
SCNew (ConnData -> Connection' 'CNew rq sq
forall rq sq. ConnData -> Connection' 'CNew rq sq
NewConnection ConnData
cData)
        (Maybe (NonEmpty rq), Maybe (NonEmpty sq), ConnectionMode)
_ -> StoreError -> Either StoreError (SomeConn' rq sq)
forall a b. a -> Either a b
Left StoreError
SEConnNotFound
    Maybe (ConnData, ConnectionMode)
Nothing -> Either StoreError (SomeConn' rq sq)
-> IO (Either StoreError (SomeConn' rq sq))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError (SomeConn' rq sq)
 -> IO (Either StoreError (SomeConn' rq sq)))
-> Either StoreError (SomeConn' rq sq)
-> IO (Either StoreError (SomeConn' rq sq))
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError (SomeConn' rq sq)
forall a b. a -> Either a b
Left StoreError
SEConnNotFound

getConns :: DB.Connection -> [ConnId] -> IO [Either StoreError SomeConn]
getConns :: Connection -> [SndFileId] -> IO [Either StoreError SomeConn]
getConns = Bool
-> Connection -> [SndFileId] -> IO [Either StoreError SomeConn]
getAnyConns Bool
False
{-# INLINE getConns #-}

getDeletedConns :: DB.Connection -> [ConnId] -> IO [Either StoreError SomeConn]
getDeletedConns :: Connection -> [SndFileId] -> IO [Either StoreError SomeConn]
getDeletedConns = Bool
-> Connection -> [SndFileId] -> IO [Either StoreError SomeConn]
getAnyConns Bool
True
{-# INLINE getDeletedConns #-}

#if defined(dbPostgres)
getAnyConns :: Bool -> DB.Connection -> [ConnId] -> IO [Either StoreError (SomeConn)]
getAnyConns = getAnyConns_ getRcvQueuesByConnIds_ getSndQueuesByConnIds_
{-# INLINE getAnyConns #-}

getConnSubs :: DB.Connection -> [ConnId] -> IO [Either StoreError SomeConnSub]
getConnSubs = getAnyConns_ getRcvQueueSubsByConnIds_ getSndQueuesByConnIds_ False
{-# INLINE getConnSubs #-}

getAnyConns_ ::
  forall rq sq.
  (DB.Connection -> [ConnId] -> IO (Map ConnId (NonEmpty rq))) ->
  (DB.Connection -> [ConnId] -> IO (Map ConnId (NonEmpty sq))) ->
  (Bool -> DB.Connection -> [ConnId] -> IO [Either StoreError (SomeConn' rq sq)])
getAnyConns_ getRQs getSQs deleted' db connIds = do
  cs <- getConnsData_ deleted' db connIds
  let connIds' = M.keys cs
  rQs :: Map ConnId (NonEmpty rq) <- getRQs db connIds'
  sQs :: Map ConnId (NonEmpty sq) <- getSQs db connIds'
  pure $ map (result cs rQs sQs) connIds
  where
    result cs rQs sQs connId = case M.lookup connId cs of
      Just (cData, cMode) -> case (M.lookup connId rQs, M.lookup connId sQs, cMode) of
        (Just rqs, Just sqs, CMInvitation) -> Right $ SomeConn SCDuplex (DuplexConnection cData rqs sqs)
        (Just (rq :| _), Nothing, CMInvitation) -> Right $ SomeConn SCRcv (RcvConnection cData rq)
        (Nothing, Just (sq :| _), CMInvitation) -> Right $ SomeConn SCSnd (SndConnection cData sq)
        (Just (rq :| _), Nothing, CMContact) -> Right $ SomeConn SCContact (ContactConnection cData rq)
        (Nothing, Nothing, _) -> Right $ SomeConn SCNew (NewConnection cData)
        _ -> Left SEConnNotFound
      Nothing -> Left SEConnNotFound

getRcvQueuesByConnIds_ :: DB.Connection -> [ConnId] -> IO (Map ConnId (NonEmpty RcvQueue))
getRcvQueuesByConnIds_ db connIds' =
  toQueueMap toRcvQueue <$> DB.query db (rcvQueueQuery <> " WHERE q.conn_id IN ? AND q.deleted = 0") (Only (In connIds'))

getSndQueuesByConnIds_ :: DB.Connection -> [ConnId] -> IO (Map ConnId (NonEmpty SndQueue))
getSndQueuesByConnIds_ db connIds' =
  toQueueMap toSndQueue <$> DB.query db (sndQueueQuery <> " WHERE q.conn_id IN ?") (Only (In connIds'))

getRcvQueueSubsByConnIds_ :: DB.Connection -> [ConnId] -> IO (Map ConnId (NonEmpty RcvQueueSub))
getRcvQueueSubsByConnIds_ db connIds' =
  toQueueMap toRcvQueueSub <$> DB.query db (rcvQueueSubQuery <> " WHERE q.conn_id IN ? AND q.deleted = 0") (Only (In connIds'))

toQueueMap :: SMPQueueRec q => (a -> q) -> [a] -> Map ConnId (NonEmpty q)
toQueueMap toQueue =
  M.fromList . map (\qs@(q :| _) -> (qConnId q, L.sortBy primaryFirst qs)) . groupOn' qConnId . sortOn qConnId . map toQueue

getConnsData :: DB.Connection -> [ConnId] -> IO [Either StoreError (Maybe (ConnData, ConnectionMode))]
getConnsData db connIds = do
  cs <- getConnsData_ False db connIds
  pure $ map (Right . (`M.lookup` cs)) connIds

getConnsData_ :: Bool -> DB.Connection -> [ConnId] -> IO (Map ConnId (ConnData, ConnectionMode))
getConnsData_ deleted' db connIds =
  M.fromList . map ((\c@(ConnData {connId}, _) -> (connId, c)) . rowToConnData) <$>
    DB.query
      db
      [sql|
        SELECT user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs,
          last_external_snd_msg_id, deleted, ratchet_sync_state, pq_support
        FROM connections
        WHERE conn_id IN ? AND deleted = ?
      |]
      (In connIds, BI deleted')

#else
getAnyConns :: Bool -> DB.Connection -> [ConnId] -> IO [Either StoreError SomeConn]
getAnyConns :: Bool
-> Connection -> [SndFileId] -> IO [Either StoreError SomeConn]
getAnyConns = (Connection -> SndFileId -> IO (Maybe (NonEmpty RcvQueue)))
-> (Connection -> SndFileId -> IO (Maybe (NonEmpty SndQueue)))
-> Bool
-> Connection
-> [SndFileId]
-> IO [Either StoreError SomeConn]
forall rq sq.
(Connection -> SndFileId -> IO (Maybe (NonEmpty rq)))
-> (Connection -> SndFileId -> IO (Maybe (NonEmpty sq)))
-> Bool
-> Connection
-> [SndFileId]
-> IO [Either StoreError (SomeConn' rq sq)]
getAnyConns_ Connection -> SndFileId -> IO (Maybe (NonEmpty RcvQueue))
getRcvQueuesByConnId_ Connection -> SndFileId -> IO (Maybe (NonEmpty SndQueue))
getSndQueuesByConnId_
{-# INLINE getAnyConns #-}

getConnSubs :: DB.Connection -> [ConnId] -> IO [Either StoreError SomeConnSub]
getConnSubs :: Connection -> [SndFileId] -> IO [Either StoreError SomeConnSub]
getConnSubs = (Connection -> SndFileId -> IO (Maybe (NonEmpty RcvQueueSub)))
-> (Connection -> SndFileId -> IO (Maybe (NonEmpty SndQueue)))
-> Bool
-> Connection
-> [SndFileId]
-> IO [Either StoreError SomeConnSub]
forall rq sq.
(Connection -> SndFileId -> IO (Maybe (NonEmpty rq)))
-> (Connection -> SndFileId -> IO (Maybe (NonEmpty sq)))
-> Bool
-> Connection
-> [SndFileId]
-> IO [Either StoreError (SomeConn' rq sq)]
getAnyConns_ Connection -> SndFileId -> IO (Maybe (NonEmpty RcvQueueSub))
getRcvQueueSubsByConnId_ Connection -> SndFileId -> IO (Maybe (NonEmpty SndQueue))
getSndQueuesByConnId_ Bool
False
{-# INLINE getConnSubs #-}

getAnyConns_ ::
  (DB.Connection -> ConnId -> IO (Maybe (NonEmpty rq))) ->
  (DB.Connection -> ConnId -> IO (Maybe (NonEmpty sq))) ->
  (Bool -> DB.Connection -> [ConnId] -> IO [Either StoreError (SomeConn' rq sq)])
getAnyConns_ :: forall rq sq.
(Connection -> SndFileId -> IO (Maybe (NonEmpty rq)))
-> (Connection -> SndFileId -> IO (Maybe (NonEmpty sq)))
-> Bool
-> Connection
-> [SndFileId]
-> IO [Either StoreError (SomeConn' rq sq)]
getAnyConns_ Connection -> SndFileId -> IO (Maybe (NonEmpty rq))
getRQs Connection -> SndFileId -> IO (Maybe (NonEmpty sq))
getSQs Bool
deleted' Connection
db [SndFileId]
connIds = [SndFileId]
-> (SndFileId -> IO (Either StoreError (SomeConn' rq sq)))
-> IO [Either StoreError (SomeConn' rq sq)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SndFileId]
connIds ((SndFileId -> IO (Either StoreError (SomeConn' rq sq)))
 -> IO [Either StoreError (SomeConn' rq sq)])
-> (SndFileId -> IO (Either StoreError (SomeConn' rq sq)))
-> IO [Either StoreError (SomeConn' rq sq)]
forall a b. (a -> b) -> a -> b
$ (SomeException -> IO (Either StoreError (SomeConn' rq sq)))
-> IO (Either StoreError (SomeConn' rq sq))
-> IO (Either StoreError (SomeConn' rq sq))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle SomeException -> IO (Either StoreError (SomeConn' rq sq))
forall a. SomeException -> IO (Either StoreError a)
handleDBError (IO (Either StoreError (SomeConn' rq sq))
 -> IO (Either StoreError (SomeConn' rq sq)))
-> (SndFileId -> IO (Either StoreError (SomeConn' rq sq)))
-> SndFileId
-> IO (Either StoreError (SomeConn' rq sq))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection -> SndFileId -> IO (Maybe (NonEmpty rq)))
-> (Connection -> SndFileId -> IO (Maybe (NonEmpty sq)))
-> Bool
-> Bool
-> Connection
-> SndFileId
-> IO (Either StoreError (SomeConn' rq sq))
forall rq sq.
(Connection -> SndFileId -> IO (Maybe (NonEmpty rq)))
-> (Connection -> SndFileId -> IO (Maybe (NonEmpty sq)))
-> Bool
-> Bool
-> Connection
-> SndFileId
-> IO (Either StoreError (SomeConn' rq sq))
getAnyConn_ Connection -> SndFileId -> IO (Maybe (NonEmpty rq))
getRQs Connection -> SndFileId -> IO (Maybe (NonEmpty sq))
getSQs Bool
deleted' Bool
False Connection
db

getConnsData :: DB.Connection -> [ConnId] -> IO [Either StoreError (Maybe (ConnData, ConnectionMode))]
getConnsData :: Connection
-> [SndFileId]
-> IO [Either StoreError (Maybe (ConnData, ConnectionMode))]
getConnsData Connection
db [SndFileId]
connIds = [SndFileId]
-> (SndFileId
    -> IO (Either StoreError (Maybe (ConnData, ConnectionMode))))
-> IO [Either StoreError (Maybe (ConnData, ConnectionMode))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SndFileId]
connIds ((SndFileId
  -> IO (Either StoreError (Maybe (ConnData, ConnectionMode))))
 -> IO [Either StoreError (Maybe (ConnData, ConnectionMode))])
-> (SndFileId
    -> IO (Either StoreError (Maybe (ConnData, ConnectionMode))))
-> IO [Either StoreError (Maybe (ConnData, ConnectionMode))]
forall a b. (a -> b) -> a -> b
$ (SomeException
 -> IO (Either StoreError (Maybe (ConnData, ConnectionMode))))
-> IO (Either StoreError (Maybe (ConnData, ConnectionMode)))
-> IO (Either StoreError (Maybe (ConnData, ConnectionMode)))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle SomeException
-> IO (Either StoreError (Maybe (ConnData, ConnectionMode)))
forall a. SomeException -> IO (Either StoreError a)
handleDBError (IO (Either StoreError (Maybe (ConnData, ConnectionMode)))
 -> IO (Either StoreError (Maybe (ConnData, ConnectionMode))))
-> (SndFileId
    -> IO (Either StoreError (Maybe (ConnData, ConnectionMode))))
-> SndFileId
-> IO (Either StoreError (Maybe (ConnData, ConnectionMode)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (ConnData, ConnectionMode)
 -> Either StoreError (Maybe (ConnData, ConnectionMode)))
-> IO (Maybe (ConnData, ConnectionMode))
-> IO (Either StoreError (Maybe (ConnData, ConnectionMode)))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (ConnData, ConnectionMode)
-> Either StoreError (Maybe (ConnData, ConnectionMode))
forall a b. b -> Either a b
Right (IO (Maybe (ConnData, ConnectionMode))
 -> IO (Either StoreError (Maybe (ConnData, ConnectionMode))))
-> (SndFileId -> IO (Maybe (ConnData, ConnectionMode)))
-> SndFileId
-> IO (Either StoreError (Maybe (ConnData, ConnectionMode)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Bool
-> Connection
-> SndFileId
-> IO (Maybe (ConnData, ConnectionMode))
getConnData Bool
False Bool
False Connection
db

handleDBError :: E.SomeException -> IO (Either StoreError a)
handleDBError :: forall a. SomeException -> IO (Either StoreError a)
handleDBError = Either StoreError a -> IO (Either StoreError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError a -> IO (Either StoreError a))
-> (SomeException -> Either StoreError a)
-> SomeException
-> IO (Either StoreError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError a
forall a b. a -> Either a b
Left (StoreError -> Either StoreError a)
-> (SomeException -> StoreError)
-> SomeException
-> Either StoreError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> StoreError
SEInternal (SndFileId -> StoreError)
-> (SomeException -> SndFileId) -> SomeException -> StoreError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> SndFileId
forall a. Show a => a -> SndFileId
bshow
#endif

getConnData :: Bool -> Bool -> DB.Connection -> ConnId -> IO (Maybe (ConnData, ConnectionMode))
getConnData :: Bool
-> Bool
-> Connection
-> SndFileId
-> IO (Maybe (ConnData, ConnectionMode))
getConnData Bool
deleted' Bool
forUpdate Connection
db SndFileId
connId' =
  ((Int64, SndFileId, ConnectionMode, VersionSMPA, Maybe BoolInt,
  Int64, BoolInt, RatchetSyncState, PQSupport)
 -> (ConnData, ConnectionMode))
-> IO
     [(Int64, SndFileId, ConnectionMode, VersionSMPA, Maybe BoolInt,
       Int64, BoolInt, RatchetSyncState, PQSupport)]
-> IO (Maybe (ConnData, ConnectionMode))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (Int64, SndFileId, ConnectionMode, VersionSMPA, Maybe BoolInt,
 Int64, BoolInt, RatchetSyncState, PQSupport)
-> (ConnData, ConnectionMode)
rowToConnData (IO
   [(Int64, SndFileId, ConnectionMode, VersionSMPA, Maybe BoolInt,
     Int64, BoolInt, RatchetSyncState, PQSupport)]
 -> IO (Maybe (ConnData, ConnectionMode)))
-> IO
     [(Int64, SndFileId, ConnectionMode, VersionSMPA, Maybe BoolInt,
       Int64, BoolInt, RatchetSyncState, PQSupport)]
-> IO (Maybe (ConnData, ConnectionMode))
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (SndFileId, BoolInt)
-> IO
     [(Int64, SndFileId, ConnectionMode, VersionSMPA, Maybe BoolInt,
       Int64, BoolInt, RatchetSyncState, PQSupport)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      ( [sql|
          SELECT user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs,
            last_external_snd_msg_id, deleted, ratchet_sync_state, pq_support
          FROM connections
          WHERE conn_id = ? AND deleted = ?
        |]
#if defined(dbPostgres)
          <> (if forUpdate then " FOR UPDATE" else "")
#endif
      )
      (SndFileId
connId', Bool -> BoolInt
BI Bool
deleted')

lockConnForUpdate :: DB.Connection -> ConnId -> IO ()
lockConnForUpdate :: Connection -> SndFileId -> IO ()
lockConnForUpdate Connection
db SndFileId
connId = do
#if defined(dbPostgres)
  _ :: [Only Int] <- DB.query db "SELECT 1 FROM connections WHERE conn_id = ? FOR UPDATE" (Only connId)
#endif
  () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

rowToConnData :: (UserId, ConnId, ConnectionMode, VersionSMPA, Maybe BoolInt, PrevExternalSndId, BoolInt, RatchetSyncState, PQSupport) -> (ConnData, ConnectionMode)
rowToConnData :: (Int64, SndFileId, ConnectionMode, VersionSMPA, Maybe BoolInt,
 Int64, BoolInt, RatchetSyncState, PQSupport)
-> (ConnData, ConnectionMode)
rowToConnData (Int64
userId, SndFileId
connId, ConnectionMode
cMode, VersionSMPA
connAgentVersion, Maybe BoolInt
enableNtfs_, Int64
lastExternalSndId, BI Bool
deleted, RatchetSyncState
ratchetSyncState, PQSupport
pqSupport) =
  (ConnData {Int64
$sel:userId:ConnData :: Int64
userId :: Int64
userId, SndFileId
$sel:connId:ConnData :: SndFileId
connId :: SndFileId
connId, VersionSMPA
$sel:connAgentVersion:ConnData :: VersionSMPA
connAgentVersion :: VersionSMPA
connAgentVersion, $sel:enableNtfs:ConnData :: Bool
enableNtfs = Bool -> (BoolInt -> Bool) -> Maybe BoolInt -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True BoolInt -> Bool
unBI Maybe BoolInt
enableNtfs_, Int64
lastExternalSndId :: Int64
$sel:lastExternalSndId:ConnData :: Int64
lastExternalSndId, Bool
deleted :: Bool
$sel:deleted:ConnData :: Bool
deleted, RatchetSyncState
ratchetSyncState :: RatchetSyncState
$sel:ratchetSyncState:ConnData :: RatchetSyncState
ratchetSyncState, PQSupport
$sel:pqSupport:ConnData :: PQSupport
pqSupport :: PQSupport
pqSupport}, ConnectionMode
cMode)

setConnDeleted :: DB.Connection -> Bool -> ConnId -> IO ()
setConnDeleted :: Connection -> Bool -> SndFileId -> IO ()
setConnDeleted Connection
db Bool
waitDelivery SndFileId
connId
  | Bool
waitDelivery = do
      UTCTime
currentTs <- IO UTCTime
getCurrentTime
      Connection -> Query -> (UTCTime, SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET deleted_at_wait_delivery = ? WHERE conn_id = ?" (UTCTime
currentTs, SndFileId
connId)
  | Bool
otherwise =
      Connection -> Query -> (BoolInt, SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET deleted = ? WHERE conn_id = ?" (Bool -> BoolInt
BI Bool
True, SndFileId
connId)

setConnUserId :: DB.Connection -> UserId -> ConnId -> UserId -> IO ()
setConnUserId :: Connection -> Int64 -> SndFileId -> Int64 -> IO ()
setConnUserId Connection
db Int64
oldUserId SndFileId
connId Int64
newUserId =
  Connection -> Query -> (Int64, SndFileId, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET user_id = ? WHERE conn_id = ? and user_id = ?" (Int64
newUserId, SndFileId
connId, Int64
oldUserId)

setConnAgentVersion :: DB.Connection -> ConnId -> VersionSMPA -> IO ()
setConnAgentVersion :: Connection -> SndFileId -> VersionSMPA -> IO ()
setConnAgentVersion Connection
db SndFileId
connId VersionSMPA
aVersion =
  Connection -> Query -> (VersionSMPA, SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET smp_agent_version = ? WHERE conn_id = ?" (VersionSMPA
aVersion, SndFileId
connId)

setConnPQSupport :: DB.Connection -> ConnId -> PQSupport -> IO ()
setConnPQSupport :: Connection -> SndFileId -> PQSupport -> IO ()
setConnPQSupport Connection
db SndFileId
connId PQSupport
pqSupport =
  Connection -> Query -> (PQSupport, SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET pq_support = ? WHERE conn_id = ?" (PQSupport
pqSupport, SndFileId
connId)

updateNewConnJoin :: DB.Connection -> ConnId -> VersionSMPA -> PQSupport -> Bool -> IO ()
updateNewConnJoin :: Connection
-> SndFileId -> VersionSMPA -> PQSupport -> Bool -> IO ()
updateNewConnJoin Connection
db SndFileId
connId VersionSMPA
aVersion PQSupport
pqSupport Bool
enableNtfs =
  Connection
-> Query -> (VersionSMPA, PQSupport, BoolInt, SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET smp_agent_version = ?, pq_support = ?, enable_ntfs = ? WHERE conn_id = ?" (VersionSMPA
aVersion, PQSupport
pqSupport, Bool -> BoolInt
BI Bool
enableNtfs, SndFileId
connId)

getDeletedConnIds :: DB.Connection -> IO [ConnId]
getDeletedConnIds :: Connection -> IO [SndFileId]
getDeletedConnIds Connection
db = (Only SndFileId -> SndFileId) -> [Only SndFileId] -> [SndFileId]
forall a b. (a -> b) -> [a] -> [b]
map Only SndFileId -> SndFileId
forall a. Only a -> a
fromOnly ([Only SndFileId] -> [SndFileId])
-> IO [Only SndFileId] -> IO [SndFileId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> Only BoolInt -> IO [Only SndFileId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT conn_id FROM connections WHERE deleted = ?" (BoolInt -> Only BoolInt
forall a. a -> Only a
Only (Bool -> BoolInt
BI Bool
True))

getDeletedWaitingDeliveryConnIds :: DB.Connection -> IO [ConnId]
getDeletedWaitingDeliveryConnIds :: Connection -> IO [SndFileId]
getDeletedWaitingDeliveryConnIds Connection
db =
  (Only SndFileId -> SndFileId) -> [Only SndFileId] -> [SndFileId]
forall a b. (a -> b) -> [a] -> [b]
map Only SndFileId -> SndFileId
forall a. Only a -> a
fromOnly ([Only SndFileId] -> [SndFileId])
-> IO [Only SndFileId] -> IO [SndFileId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> IO [Only SndFileId]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_ Connection
db Query
"SELECT conn_id FROM connections WHERE deleted_at_wait_delivery IS NOT NULL"

setConnRatchetSync :: DB.Connection -> ConnId -> RatchetSyncState -> IO ()
setConnRatchetSync :: Connection -> SndFileId -> RatchetSyncState -> IO ()
setConnRatchetSync Connection
db SndFileId
connId RatchetSyncState
ratchetSyncState =
  Connection -> Query -> (RatchetSyncState, SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET ratchet_sync_state = ? WHERE conn_id = ?" (RatchetSyncState
ratchetSyncState, SndFileId
connId)

addProcessedRatchetKeyHash :: DB.Connection -> ConnId -> ByteString -> IO ()
addProcessedRatchetKeyHash :: Connection -> SndFileId -> SndFileId -> IO ()
addProcessedRatchetKeyHash Connection
db SndFileId
connId SndFileId
hash =
  Connection -> Query -> (SndFileId, Binary SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"INSERT INTO processed_ratchet_key_hashes (conn_id, hash) VALUES (?,?)" (SndFileId
connId, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
hash)

checkRatchetKeyHashExists :: DB.Connection -> ConnId -> ByteString -> IO Bool
checkRatchetKeyHashExists :: Connection -> SndFileId -> SndFileId -> IO Bool
checkRatchetKeyHashExists Connection
db SndFileId
connId SndFileId
hash =
  Bool -> (Only BoolInt -> Bool) -> IO [Only BoolInt] -> IO Bool
forall (f :: * -> *) b a.
Functor f =>
b -> (a -> b) -> f [a] -> f b
maybeFirstRow' Bool
False Only BoolInt -> Bool
fromOnlyBI (IO [Only BoolInt] -> IO Bool) -> IO [Only BoolInt] -> IO Bool
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (SndFileId, Binary SndFileId) -> IO [Only BoolInt]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      ( Query
"SELECT 1 FROM processed_ratchet_key_hashes WHERE conn_id = ? AND hash = ? LIMIT 1"
#if defined(dbPostgres)
        <> " FOR UPDATE"
#endif
      )
      (SndFileId
connId, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
hash)

deleteRatchetKeyHashesExpired :: DB.Connection -> NominalDiffTime -> Int -> IO ()
deleteRatchetKeyHashesExpired :: Connection -> NominalDiffTime -> Int -> IO ()
deleteRatchetKeyHashesExpired Connection
db NominalDiffTime
ttl Int
limit = do
  UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, Int) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM processed_ratchet_key_hashes
      WHERE processed_ratchet_key_hash_id IN (
        SELECT processed_ratchet_key_hash_id
        FROM processed_ratchet_key_hashes
        WHERE created_at < ?
        ORDER BY created_at ASC
        LIMIT ?
      )
    |]
    (UTCTime
cutoffTs, Int
limit)

-- | returns all connection queues, the first queue is the primary one
getRcvQueuesByConnId_ :: DB.Connection -> ConnId -> IO (Maybe (NonEmpty RcvQueue))
getRcvQueuesByConnId_ :: Connection -> SndFileId -> IO (Maybe (NonEmpty RcvQueue))
getRcvQueuesByConnId_ Connection
db SndFileId
connId =
  [RcvQueue] -> Maybe (NonEmpty RcvQueue)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty ([RcvQueue] -> Maybe (NonEmpty RcvQueue))
-> ([(Int64, KeyHash, SndFileId, NonEmpty TransportHost,
      ServiceName, SenderId, APrivateAuthKey, DhSecretX25519,
      PrivateKeyX25519, Maybe DhSecretX25519, SenderId, Maybe QueueMode)
     :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
          DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
          Maybe VersionSMPC, Int)
         :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
              Maybe DhSecretX25519)
             :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                 Maybe EncDataBytes)))]
    -> [RcvQueue])
-> [(Int64, KeyHash, SndFileId, NonEmpty TransportHost,
     ServiceName, SenderId, APrivateAuthKey, DhSecretX25519,
     PrivateKeyX25519, Maybe DhSecretX25519, SenderId, Maybe QueueMode)
    :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
         DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
         Maybe VersionSMPC, Int)
        :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
             Maybe DhSecretX25519)
            :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                Maybe EncDataBytes)))]
-> Maybe (NonEmpty RcvQueue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RcvQueue -> RcvQueue -> Ordering) -> [RcvQueue] -> [RcvQueue]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy RcvQueue -> RcvQueue -> Ordering
forall q. SMPQueueRec q => q -> q -> Ordering
primaryFirst ([RcvQueue] -> [RcvQueue])
-> ([(Int64, KeyHash, SndFileId, NonEmpty TransportHost,
      ServiceName, SenderId, APrivateAuthKey, DhSecretX25519,
      PrivateKeyX25519, Maybe DhSecretX25519, SenderId, Maybe QueueMode)
     :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
          DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
          Maybe VersionSMPC, Int)
         :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
              Maybe DhSecretX25519)
             :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                 Maybe EncDataBytes)))]
    -> [RcvQueue])
-> [(Int64, KeyHash, SndFileId, NonEmpty TransportHost,
     ServiceName, SenderId, APrivateAuthKey, DhSecretX25519,
     PrivateKeyX25519, Maybe DhSecretX25519, SenderId, Maybe QueueMode)
    :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
         DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
         Maybe VersionSMPC, Int)
        :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
             Maybe DhSecretX25519)
            :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                Maybe EncDataBytes)))]
-> [RcvQueue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
   SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
   Maybe DhSecretX25519, SenderId, Maybe QueueMode)
  :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
       DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
       Maybe VersionSMPC, Int)
      :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
           Maybe DhSecretX25519)
          :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
              Maybe EncDataBytes))))
 -> RcvQueue)
-> [(Int64, KeyHash, SndFileId, NonEmpty TransportHost,
     ServiceName, SenderId, APrivateAuthKey, DhSecretX25519,
     PrivateKeyX25519, Maybe DhSecretX25519, SenderId, Maybe QueueMode)
    :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
         DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
         Maybe VersionSMPC, Int)
        :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
             Maybe DhSecretX25519)
            :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                Maybe EncDataBytes)))]
-> [RcvQueue]
forall a b. (a -> b) -> [a] -> [b]
map ((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
  SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
  Maybe DhSecretX25519, SenderId, Maybe QueueMode)
 :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
      DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
      Maybe VersionSMPC, Int)
     :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
          Maybe DhSecretX25519)
         :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
             Maybe EncDataBytes))))
-> RcvQueue
toRcvQueue
    ([(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
   SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
   Maybe DhSecretX25519, SenderId, Maybe QueueMode)
  :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
       DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
       Maybe VersionSMPC, Int)
      :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
           Maybe DhSecretX25519)
          :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
              Maybe EncDataBytes)))]
 -> Maybe (NonEmpty RcvQueue))
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
-> IO (Maybe (NonEmpty RcvQueue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only SndFileId
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
rcvQueueQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE q.conn_id = ? AND q.deleted = 0") (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)

-- the current primary queue is ordered first, the next primary - second
primaryFirst :: SMPQueueRec q => q -> q -> Ordering
primaryFirst :: forall q. SMPQueueRec q => q -> q -> Ordering
primaryFirst q
q q
q' = Down Bool -> Down Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Bool -> Down Bool
forall a. a -> Down a
Down (q -> Bool
forall q. SMPQueueRec q => q -> Bool
qPrimary q
q)) (Bool -> Down Bool
forall a. a -> Down a
Down (q -> Bool
forall q. SMPQueueRec q => q -> Bool
qPrimary q
q')) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Maybe Int64 -> Maybe Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (q -> Maybe Int64
forall q. SMPQueueRec q => q -> Maybe Int64
dbReplaceQId q
q) (q -> Maybe Int64
forall q. SMPQueueRec q => q -> Maybe Int64
dbReplaceQId q
q')

rcvQueueQuery :: Query
rcvQueueQuery :: Query
rcvQueueQuery =
  [sql|
    SELECT c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.rcv_id, q.rcv_private_key, q.rcv_dh_secret,
      q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.queue_mode, q.status, c.enable_ntfs, q.client_notice_id,
      q.rcv_queue_id, q.rcv_primary, q.replace_rcv_queue_id, q.switch_status, q.smp_client_version, q.delete_errors,
      q.ntf_public_key, q.ntf_private_key, q.ntf_id, q.rcv_ntf_dh_secret,
      q.link_id, q.link_key, q.link_priv_sig_key, q.link_enc_fixed_data
    FROM rcv_queues q
    JOIN servers s ON q.host = s.host AND q.port = s.port
    JOIN connections c ON q.conn_id = c.conn_id
  |]

toRcvQueue ::
  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SMP.RecipientId, SMP.RcvPrivateAuthKey, SMP.RcvDhSecret, C.PrivateKeyX25519, Maybe C.DhSecretX25519, SMP.SenderId, Maybe QueueMode)
    :. (QueueStatus, Maybe BoolInt, Maybe NoticeId, DBEntityId, BoolInt, Maybe Int64, Maybe RcvSwitchStatus, Maybe VersionSMPC, Int)
    :. (Maybe SMP.NtfPublicAuthKey, Maybe SMP.NtfPrivateAuthKey, Maybe SMP.NotifierId, Maybe RcvNtfDhSecret)
    :. (Maybe SMP.LinkId, Maybe LinkKey, Maybe C.PrivateKeyEd25519, Maybe EncDataBytes) ->
  RcvQueue
toRcvQueue :: ((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
  SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
  Maybe DhSecretX25519, SenderId, Maybe QueueMode)
 :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
      DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
      Maybe VersionSMPC, Int)
     :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
          Maybe DhSecretX25519)
         :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
             Maybe EncDataBytes))))
-> RcvQueue
toRcvQueue
  ( (Int64
userId, KeyHash
keyHash, SndFileId
connId, NonEmpty TransportHost
host, ServiceName
port, SenderId
rcvId, APrivateAuthKey
rcvPrivateKey, DhSecretX25519
rcvDhSecret, PrivateKeyX25519
e2ePrivKey, Maybe DhSecretX25519
e2eDhSecret, SenderId
sndId, Maybe QueueMode
queueMode)
      :. (QueueStatus
status, Maybe BoolInt
enableNtfs_, Maybe Int64
clientNoticeId, DBEntityId' 'DBStored
dbQueueId, BI Bool
primary, Maybe Int64
dbReplaceQueueId, Maybe RcvSwitchStatus
rcvSwchStatus, Maybe VersionSMPC
smpClientVersion_, Int
deleteErrors)
      :. (Maybe NtfPublicAuthKey
ntfPublicKey_, Maybe APrivateAuthKey
ntfPrivateKey_, Maybe SenderId
notifierId_, Maybe DhSecretX25519
rcvNtfDhSecret_)
      :. (Maybe SenderId
shortLinkId_, Maybe LinkKey
shortLinkKey_, Maybe PrivateKeyEd25519
linkPrivSigKey_, Maybe EncDataBytes
linkEncFixedData_)
  ) =
  let server :: SMPServer
server = NonEmpty TransportHost -> ServiceName -> KeyHash -> SMPServer
SMPServer NonEmpty TransportHost
host ServiceName
port KeyHash
keyHash
      smpClientVersion :: VersionSMPC
smpClientVersion = VersionSMPC -> Maybe VersionSMPC -> VersionSMPC
forall a. a -> Maybe a -> a
fromMaybe VersionSMPC
initialSMPClientVersion Maybe VersionSMPC
smpClientVersion_
      clientNtfCreds :: Maybe ClientNtfCreds
clientNtfCreds = case (Maybe NtfPublicAuthKey
ntfPublicKey_, Maybe APrivateAuthKey
ntfPrivateKey_, Maybe SenderId
notifierId_, Maybe DhSecretX25519
rcvNtfDhSecret_) of
        (Just NtfPublicAuthKey
ntfPublicKey, Just APrivateAuthKey
ntfPrivateKey, Just SenderId
notifierId, Just DhSecretX25519
rcvNtfDhSecret) -> ClientNtfCreds -> Maybe ClientNtfCreds
forall a. a -> Maybe a
Just ClientNtfCreds {NtfPublicAuthKey
$sel:ntfPublicKey:ClientNtfCreds :: NtfPublicAuthKey
ntfPublicKey :: NtfPublicAuthKey
ntfPublicKey, APrivateAuthKey
$sel:ntfPrivateKey:ClientNtfCreds :: APrivateAuthKey
ntfPrivateKey :: APrivateAuthKey
ntfPrivateKey, SenderId
$sel:notifierId:ClientNtfCreds :: SenderId
notifierId :: SenderId
notifierId, DhSecretX25519
$sel:rcvNtfDhSecret:ClientNtfCreds :: DhSecretX25519
rcvNtfDhSecret :: DhSecretX25519
rcvNtfDhSecret}
        (Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
 Maybe DhSecretX25519)
_ -> Maybe ClientNtfCreds
forall a. Maybe a
Nothing
      shortLink :: Maybe ShortLinkCreds
shortLink = case (Maybe SenderId
shortLinkId_, Maybe LinkKey
shortLinkKey_, Maybe PrivateKeyEd25519
linkPrivSigKey_, Maybe EncDataBytes
linkEncFixedData_) of
        (Just SenderId
shortLinkId, Just LinkKey
shortLinkKey, Just PrivateKeyEd25519
linkPrivSigKey, Just EncDataBytes
linkEncFixedData) -> ShortLinkCreds -> Maybe ShortLinkCreds
forall a. a -> Maybe a
Just ShortLinkCreds {SenderId
$sel:shortLinkId:ShortLinkCreds :: SenderId
shortLinkId :: SenderId
shortLinkId, LinkKey
$sel:shortLinkKey:ShortLinkCreds :: LinkKey
shortLinkKey :: LinkKey
shortLinkKey, PrivateKeyEd25519
$sel:linkPrivSigKey:ShortLinkCreds :: PrivateKeyEd25519
linkPrivSigKey :: PrivateKeyEd25519
linkPrivSigKey, $sel:linkRootSigKey:ShortLinkCreds :: Maybe PublicKeyEd25519
linkRootSigKey = Maybe PublicKeyEd25519
forall a. Maybe a
Nothing, EncDataBytes
$sel:linkEncFixedData:ShortLinkCreds :: EncDataBytes
linkEncFixedData :: EncDataBytes
linkEncFixedData} -- TODO linkRootSigKey should be stored in a separate field
        (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
 Maybe EncDataBytes)
_ -> Maybe ShortLinkCreds
forall a. Maybe a
Nothing
      enableNtfs :: Bool
enableNtfs = Bool -> (BoolInt -> Bool) -> Maybe BoolInt -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True BoolInt -> Bool
unBI Maybe BoolInt
enableNtfs_
      -- TODO [certs rcv] read client service
   in RcvQueue {Int64
$sel:userId:RcvQueue :: Int64
userId :: Int64
userId, SndFileId
$sel:connId:RcvQueue :: SndFileId
connId :: SndFileId
connId, SMPServer
$sel:server:RcvQueue :: SMPServer
server :: SMPServer
server, SenderId
$sel:rcvId:RcvQueue :: SenderId
rcvId :: SenderId
rcvId, APrivateAuthKey
$sel:rcvPrivateKey:RcvQueue :: APrivateAuthKey
rcvPrivateKey :: APrivateAuthKey
rcvPrivateKey, DhSecretX25519
$sel:rcvDhSecret:RcvQueue :: DhSecretX25519
rcvDhSecret :: DhSecretX25519
rcvDhSecret, PrivateKeyX25519
$sel:e2ePrivKey:RcvQueue :: PrivateKeyX25519
e2ePrivKey :: PrivateKeyX25519
e2ePrivKey, Maybe DhSecretX25519
$sel:e2eDhSecret:RcvQueue :: Maybe DhSecretX25519
e2eDhSecret :: Maybe DhSecretX25519
e2eDhSecret, SenderId
$sel:sndId:RcvQueue :: SenderId
sndId :: SenderId
sndId, Maybe QueueMode
$sel:queueMode:RcvQueue :: Maybe QueueMode
queueMode :: Maybe QueueMode
queueMode, Maybe ShortLinkCreds
$sel:shortLink:RcvQueue :: Maybe ShortLinkCreds
shortLink :: Maybe ShortLinkCreds
shortLink, $sel:clientService:RcvQueue :: Maybe (StoredClientService 'DBStored)
clientService = Maybe (StoredClientService 'DBStored)
forall a. Maybe a
Nothing, QueueStatus
$sel:status:RcvQueue :: QueueStatus
status :: QueueStatus
status, Bool
$sel:enableNtfs:RcvQueue :: Bool
enableNtfs :: Bool
enableNtfs, Maybe Int64
$sel:clientNoticeId:RcvQueue :: Maybe Int64
clientNoticeId :: Maybe Int64
clientNoticeId, DBEntityId' 'DBStored
$sel:dbQueueId:RcvQueue :: DBEntityId' 'DBStored
dbQueueId :: DBEntityId' 'DBStored
dbQueueId, Bool
$sel:primary:RcvQueue :: Bool
primary :: Bool
primary, Maybe Int64
$sel:dbReplaceQueueId:RcvQueue :: Maybe Int64
dbReplaceQueueId :: Maybe Int64
dbReplaceQueueId, Maybe RcvSwitchStatus
$sel:rcvSwchStatus:RcvQueue :: Maybe RcvSwitchStatus
rcvSwchStatus :: Maybe RcvSwitchStatus
rcvSwchStatus, VersionSMPC
$sel:smpClientVersion:RcvQueue :: VersionSMPC
smpClientVersion :: VersionSMPC
smpClientVersion, Maybe ClientNtfCreds
$sel:clientNtfCreds:RcvQueue :: Maybe ClientNtfCreds
clientNtfCreds :: Maybe ClientNtfCreds
clientNtfCreds, Int
$sel:deleteErrors:RcvQueue :: Int
deleteErrors :: Int
deleteErrors}

-- | returns all connection queue credentials, the first queue is the primary one
getRcvQueueSubsByConnId_ :: DB.Connection -> ConnId -> IO (Maybe (NonEmpty RcvQueueSub))
getRcvQueueSubsByConnId_ :: Connection -> SndFileId -> IO (Maybe (NonEmpty RcvQueueSub))
getRcvQueueSubsByConnId_ Connection
db SndFileId
connId =
  [RcvQueueSub] -> Maybe (NonEmpty RcvQueueSub)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty ([RcvQueueSub] -> Maybe (NonEmpty RcvQueueSub))
-> ([(Int64, SndFileId, NonEmpty TransportHost, ServiceName,
      KeyHash, SenderId, APrivateAuthKey)
     :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
         Maybe Int64)]
    -> [RcvQueueSub])
-> [(Int64, SndFileId, NonEmpty TransportHost, ServiceName,
     KeyHash, SenderId, APrivateAuthKey)
    :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
        Maybe Int64)]
-> Maybe (NonEmpty RcvQueueSub)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RcvQueueSub -> RcvQueueSub -> Ordering)
-> [RcvQueueSub] -> [RcvQueueSub]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy RcvQueueSub -> RcvQueueSub -> Ordering
forall q. SMPQueueRec q => q -> q -> Ordering
primaryFirst ([RcvQueueSub] -> [RcvQueueSub])
-> ([(Int64, SndFileId, NonEmpty TransportHost, ServiceName,
      KeyHash, SenderId, APrivateAuthKey)
     :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
         Maybe Int64)]
    -> [RcvQueueSub])
-> [(Int64, SndFileId, NonEmpty TransportHost, ServiceName,
     KeyHash, SenderId, APrivateAuthKey)
    :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
        Maybe Int64)]
-> [RcvQueueSub]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Int64, SndFileId, NonEmpty TransportHost, ServiceName, KeyHash,
   SenderId, APrivateAuthKey)
  :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
      Maybe Int64))
 -> RcvQueueSub)
-> [(Int64, SndFileId, NonEmpty TransportHost, ServiceName,
     KeyHash, SenderId, APrivateAuthKey)
    :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
        Maybe Int64)]
-> [RcvQueueSub]
forall a b. (a -> b) -> [a] -> [b]
map ((Int64, SndFileId, NonEmpty TransportHost, ServiceName, KeyHash,
  SenderId, APrivateAuthKey)
 :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
     Maybe Int64))
-> RcvQueueSub
toRcvQueueSub
    ([(Int64, SndFileId, NonEmpty TransportHost, ServiceName, KeyHash,
   SenderId, APrivateAuthKey)
  :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
      Maybe Int64)]
 -> Maybe (NonEmpty RcvQueueSub))
-> IO
     [(Int64, SndFileId, NonEmpty TransportHost, ServiceName, KeyHash,
       SenderId, APrivateAuthKey)
      :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
          Maybe Int64)]
-> IO (Maybe (NonEmpty RcvQueueSub))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only SndFileId
-> IO
     [(Int64, SndFileId, NonEmpty TransportHost, ServiceName, KeyHash,
       SenderId, APrivateAuthKey)
      :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
          Maybe Int64)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
rcvQueueSubQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE q.conn_id = ? AND q.deleted = 0") (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)

rcvQueueSubQuery :: Query
rcvQueueSubQuery :: Query
rcvQueueSubQuery =
  [sql|
    SELECT c.user_id, q.conn_id, q.host, q.port, COALESCE(q.server_key_hash, s.key_hash), q.rcv_id, q.rcv_private_key, q.status, c.enable_ntfs, q.client_notice_id,
      q.rcv_queue_id, q.rcv_primary, q.replace_rcv_queue_id
    FROM rcv_queues q
    JOIN servers s ON q.host = s.host AND q.port = s.port
    JOIN connections c ON q.conn_id = c.conn_id
  |]

toRcvQueueSub :: (UserId, ConnId, NonEmpty TransportHost, ServiceName, C.KeyHash, SMP.RecipientId, SMP.RcvPrivateAuthKey) :. (QueueStatus, Maybe BoolInt, Maybe NoticeId, Int64, BoolInt, Maybe Int64) -> RcvQueueSub
toRcvQueueSub :: ((Int64, SndFileId, NonEmpty TransportHost, ServiceName, KeyHash,
  SenderId, APrivateAuthKey)
 :. (QueueStatus, Maybe BoolInt, Maybe Int64, Int64, BoolInt,
     Maybe Int64))
-> RcvQueueSub
toRcvQueueSub ((Int64
userId, SndFileId
connId, NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash, SenderId
rcvId, APrivateAuthKey
rcvPrivateKey) :. (QueueStatus
status, Maybe BoolInt
enableNtfs_, Maybe Int64
clientNoticeId, Int64
dbQueueId, BI Bool
primary, Maybe Int64
dbReplaceQueueId)) =
  let enableNtfs :: Bool
enableNtfs = Bool -> (BoolInt -> Bool) -> Maybe BoolInt -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True BoolInt -> Bool
unBI Maybe BoolInt
enableNtfs_
   in RcvQueueSub {Int64
userId :: Int64
$sel:userId:RcvQueueSub :: Int64
userId, SndFileId
connId :: SndFileId
$sel:connId:RcvQueueSub :: SndFileId
connId, $sel:server:RcvQueueSub :: SMPServer
server = NonEmpty TransportHost -> ServiceName -> KeyHash -> SMPServer
SMPServer NonEmpty TransportHost
host ServiceName
port KeyHash
keyHash, SenderId
$sel:rcvId:RcvQueueSub :: SenderId
rcvId :: SenderId
rcvId, APrivateAuthKey
rcvPrivateKey :: APrivateAuthKey
$sel:rcvPrivateKey:RcvQueueSub :: APrivateAuthKey
rcvPrivateKey, QueueStatus
status :: QueueStatus
$sel:status:RcvQueueSub :: QueueStatus
status, Bool
enableNtfs :: Bool
$sel:enableNtfs:RcvQueueSub :: Bool
enableNtfs, Maybe Int64
$sel:clientNoticeId:RcvQueueSub :: Maybe Int64
clientNoticeId :: Maybe Int64
clientNoticeId, Int64
dbQueueId :: Int64
$sel:dbQueueId:RcvQueueSub :: Int64
dbQueueId, Bool
primary :: Bool
$sel:primary:RcvQueueSub :: Bool
primary, Maybe Int64
dbReplaceQueueId :: Maybe Int64
$sel:dbReplaceQueueId:RcvQueueSub :: Maybe Int64
dbReplaceQueueId}

getRcvQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError RcvQueue)
getRcvQueueById :: Connection -> SndFileId -> Int64 -> IO (Either StoreError RcvQueue)
getRcvQueueById Connection
db SndFileId
connId Int64
dbRcvId =
  (((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
   SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
   Maybe DhSecretX25519, SenderId, Maybe QueueMode)
  :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
       DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
       Maybe VersionSMPC, Int)
      :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
           Maybe DhSecretX25519)
          :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
              Maybe EncDataBytes))))
 -> RcvQueue)
-> StoreError
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
-> IO (Either StoreError RcvQueue)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
  SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
  Maybe DhSecretX25519, SenderId, Maybe QueueMode)
 :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
      DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
      Maybe VersionSMPC, Int)
     :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
          Maybe DhSecretX25519)
         :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
             Maybe EncDataBytes))))
-> RcvQueue
toRcvQueue StoreError
SEConnNotFound (IO
   [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
     SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
     Maybe DhSecretX25519, SenderId, Maybe QueueMode)
    :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
         DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
         Maybe VersionSMPC, Int)
        :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
             Maybe DhSecretX25519)
            :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                Maybe EncDataBytes)))]
 -> IO (Either StoreError RcvQueue))
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
-> IO (Either StoreError RcvQueue)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (SndFileId, Int64)
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, APrivateAuthKey, DhSecretX25519, PrivateKeyX25519,
       Maybe DhSecretX25519, SenderId, Maybe QueueMode)
      :. ((QueueStatus, Maybe BoolInt, Maybe Int64,
           DBEntityId' 'DBStored, BoolInt, Maybe Int64, Maybe RcvSwitchStatus,
           Maybe VersionSMPC, Int)
          :. ((Maybe NtfPublicAuthKey, Maybe APrivateAuthKey, Maybe SenderId,
               Maybe DhSecretX25519)
              :. (Maybe SenderId, Maybe LinkKey, Maybe PrivateKeyEd25519,
                  Maybe EncDataBytes)))]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
rcvQueueQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE q.conn_id = ? AND q.rcv_queue_id = ? AND q.deleted = 0") (SndFileId
connId, Int64
dbRcvId)

-- | returns all connection queues, the first queue is the primary one
getSndQueuesByConnId_ :: DB.Connection -> ConnId -> IO (Maybe (NonEmpty SndQueue))
getSndQueuesByConnId_ :: Connection -> SndFileId -> IO (Maybe (NonEmpty SndQueue))
getSndQueuesByConnId_ Connection
dbConn SndFileId
connId =
  [SndQueue] -> Maybe (NonEmpty SndQueue)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty ([SndQueue] -> Maybe (NonEmpty SndQueue))
-> ([(Int64, KeyHash, SndFileId, NonEmpty TransportHost,
      ServiceName, SenderId, Maybe QueueMode)
     :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
          QueueStatus)
         :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
             Maybe SndSwitchStatus, VersionSMPC))]
    -> [SndQueue])
-> [(Int64, KeyHash, SndFileId, NonEmpty TransportHost,
     ServiceName, SenderId, Maybe QueueMode)
    :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
         QueueStatus)
        :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
            Maybe SndSwitchStatus, VersionSMPC))]
-> Maybe (NonEmpty SndQueue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SndQueue -> SndQueue -> Ordering) -> [SndQueue] -> [SndQueue]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy SndQueue -> SndQueue -> Ordering
forall q. SMPQueueRec q => q -> q -> Ordering
primaryFirst ([SndQueue] -> [SndQueue])
-> ([(Int64, KeyHash, SndFileId, NonEmpty TransportHost,
      ServiceName, SenderId, Maybe QueueMode)
     :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
          QueueStatus)
         :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
             Maybe SndSwitchStatus, VersionSMPC))]
    -> [SndQueue])
-> [(Int64, KeyHash, SndFileId, NonEmpty TransportHost,
     ServiceName, SenderId, Maybe QueueMode)
    :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
         QueueStatus)
        :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
            Maybe SndSwitchStatus, VersionSMPC))]
-> [SndQueue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
   SenderId, Maybe QueueMode)
  :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
       QueueStatus)
      :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
          Maybe SndSwitchStatus, VersionSMPC)))
 -> SndQueue)
-> [(Int64, KeyHash, SndFileId, NonEmpty TransportHost,
     ServiceName, SenderId, Maybe QueueMode)
    :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
         QueueStatus)
        :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
            Maybe SndSwitchStatus, VersionSMPC))]
-> [SndQueue]
forall a b. (a -> b) -> [a] -> [b]
map ((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
  SenderId, Maybe QueueMode)
 :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
      QueueStatus)
     :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
         Maybe SndSwitchStatus, VersionSMPC)))
-> SndQueue
toSndQueue
    ([(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
   SenderId, Maybe QueueMode)
  :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
       QueueStatus)
      :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
          Maybe SndSwitchStatus, VersionSMPC))]
 -> Maybe (NonEmpty SndQueue))
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, Maybe QueueMode)
      :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
           QueueStatus)
          :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
              Maybe SndSwitchStatus, VersionSMPC))]
-> IO (Maybe (NonEmpty SndQueue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only SndFileId
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, Maybe QueueMode)
      :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
           QueueStatus)
          :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
              Maybe SndSwitchStatus, VersionSMPC))]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
dbConn (Query
sndQueueQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE q.conn_id = ?") (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)

sndQueueQuery :: Query
sndQueueQuery :: Query
sndQueueQuery =
  [sql|
    SELECT
      c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.snd_id, q.queue_mode,
      q.snd_private_key, q.e2e_pub_key, q.e2e_dh_secret, q.status,
      q.snd_queue_id, q.snd_primary, q.replace_snd_queue_id, q.switch_status, q.smp_client_version
    FROM snd_queues q
    JOIN servers s ON q.host = s.host AND q.port = s.port
    JOIN connections c ON q.conn_id = c.conn_id
  |]

toSndQueue ::
  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SenderId, Maybe QueueMode)
    :. (SndPrivateAuthKey, Maybe C.PublicKeyX25519, C.DhSecretX25519, QueueStatus)
    :. (DBEntityId, BoolInt, Maybe Int64, Maybe SndSwitchStatus, VersionSMPC) ->
  SndQueue
toSndQueue :: ((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
  SenderId, Maybe QueueMode)
 :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
      QueueStatus)
     :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
         Maybe SndSwitchStatus, VersionSMPC)))
-> SndQueue
toSndQueue
  ( (Int64
userId, KeyHash
keyHash, SndFileId
connId, NonEmpty TransportHost
host, ServiceName
port, SenderId
sndId, Maybe QueueMode
queueMode)
      :. (APrivateAuthKey
sndPrivateKey, Maybe PublicKeyX25519
e2ePubKey, DhSecretX25519
e2eDhSecret, QueueStatus
status)
      :. (DBEntityId' 'DBStored
dbQueueId, BI Bool
primary, Maybe Int64
dbReplaceQueueId, Maybe SndSwitchStatus
sndSwchStatus, VersionSMPC
smpClientVersion)
    ) =
    let server :: SMPServer
server = NonEmpty TransportHost -> ServiceName -> KeyHash -> SMPServer
SMPServer NonEmpty TransportHost
host ServiceName
port KeyHash
keyHash
     in SndQueue {Int64
$sel:userId:SndQueue :: Int64
userId :: Int64
userId, SndFileId
$sel:connId:SndQueue :: SndFileId
connId :: SndFileId
connId, SMPServer
$sel:server:SndQueue :: SMPServer
server :: SMPServer
server, SenderId
$sel:sndId:SndQueue :: SenderId
sndId :: SenderId
sndId, Maybe QueueMode
$sel:queueMode:SndQueue :: Maybe QueueMode
queueMode :: Maybe QueueMode
queueMode, APrivateAuthKey
$sel:sndPrivateKey:SndQueue :: APrivateAuthKey
sndPrivateKey :: APrivateAuthKey
sndPrivateKey, Maybe PublicKeyX25519
$sel:e2ePubKey:SndQueue :: Maybe PublicKeyX25519
e2ePubKey :: Maybe PublicKeyX25519
e2ePubKey, DhSecretX25519
$sel:e2eDhSecret:SndQueue :: DhSecretX25519
e2eDhSecret :: DhSecretX25519
e2eDhSecret, QueueStatus
$sel:status:SndQueue :: QueueStatus
status :: QueueStatus
status, DBEntityId' 'DBStored
$sel:dbQueueId:SndQueue :: DBEntityId' 'DBStored
dbQueueId :: DBEntityId' 'DBStored
dbQueueId, Bool
$sel:primary:SndQueue :: Bool
primary :: Bool
primary, Maybe Int64
$sel:dbReplaceQueueId:SndQueue :: Maybe Int64
dbReplaceQueueId :: Maybe Int64
dbReplaceQueueId, Maybe SndSwitchStatus
$sel:sndSwchStatus:SndQueue :: Maybe SndSwitchStatus
sndSwchStatus :: Maybe SndSwitchStatus
sndSwchStatus, VersionSMPC
$sel:smpClientVersion:SndQueue :: VersionSMPC
smpClientVersion :: VersionSMPC
smpClientVersion}

getSndQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError SndQueue)
getSndQueueById :: Connection -> SndFileId -> Int64 -> IO (Either StoreError SndQueue)
getSndQueueById Connection
db SndFileId
connId Int64
dbSndId =
  (((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
   SenderId, Maybe QueueMode)
  :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
       QueueStatus)
      :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
          Maybe SndSwitchStatus, VersionSMPC)))
 -> SndQueue)
-> StoreError
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, Maybe QueueMode)
      :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
           QueueStatus)
          :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
              Maybe SndSwitchStatus, VersionSMPC))]
-> IO (Either StoreError SndQueue)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
  SenderId, Maybe QueueMode)
 :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
      QueueStatus)
     :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
         Maybe SndSwitchStatus, VersionSMPC)))
-> SndQueue
toSndQueue StoreError
SEConnNotFound (IO
   [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
     SenderId, Maybe QueueMode)
    :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
         QueueStatus)
        :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
            Maybe SndSwitchStatus, VersionSMPC))]
 -> IO (Either StoreError SndQueue))
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, Maybe QueueMode)
      :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
           QueueStatus)
          :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
              Maybe SndSwitchStatus, VersionSMPC))]
-> IO (Either StoreError SndQueue)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (SndFileId, Int64)
-> IO
     [(Int64, KeyHash, SndFileId, NonEmpty TransportHost, ServiceName,
       SenderId, Maybe QueueMode)
      :. ((APrivateAuthKey, Maybe PublicKeyX25519, DhSecretX25519,
           QueueStatus)
          :. (DBEntityId' 'DBStored, BoolInt, Maybe Int64,
              Maybe SndSwitchStatus, VersionSMPC))]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
sndQueueQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE q.conn_id = ? AND q.snd_queue_id = ?") (SndFileId
connId, Int64
dbSndId)

-- * updateRcvIds helpers

retrieveLastIdsAndHashRcv_ :: DB.Connection -> ConnId -> IO (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
retrieveLastIdsAndHashRcv_ :: Connection
-> SndFileId -> IO (InternalId, InternalRcvId, Int64, SndFileId)
retrieveLastIdsAndHashRcv_ Connection
dbConn SndFileId
connId = do
  [(InternalId
lastInternalId, InternalRcvId
lastInternalRcvId, Int64
lastExternalSndId, SndFileId
lastRcvHash)] <-
    Connection
-> Query
-> Only SndFileId
-> IO [(InternalId, InternalRcvId, Int64, SndFileId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
dbConn
      ( [sql|
          SELECT last_internal_msg_id, last_internal_rcv_msg_id, last_external_snd_msg_id, last_rcv_msg_hash
          FROM connections
          WHERE conn_id = ?
        |]
#if defined(dbPostgres)
          <> " FOR UPDATE"
#endif
      )
      (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)
  (InternalId, InternalRcvId, Int64, SndFileId)
-> IO (InternalId, InternalRcvId, Int64, SndFileId)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InternalId
lastInternalId, InternalRcvId
lastInternalRcvId, Int64
lastExternalSndId, SndFileId
lastRcvHash)

updateLastIdsRcv_ :: DB.Connection -> ConnId -> InternalId -> InternalRcvId -> IO ()
updateLastIdsRcv_ :: Connection -> SndFileId -> InternalId -> InternalRcvId -> IO ()
updateLastIdsRcv_ Connection
dbConn SndFileId
connId InternalId
newInternalId InternalRcvId
newInternalRcvId =
  Connection
-> Query -> (InternalId, InternalRcvId, SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
dbConn
    [sql|
      UPDATE connections
      SET last_internal_msg_id = ?,
          last_internal_rcv_msg_id = ?
      WHERE conn_id = ?
    |]
    (InternalId
newInternalId, InternalRcvId
newInternalRcvId, SndFileId
connId)

-- * createRcvMsg helpers

insertRcvMsgBase_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
insertRcvMsgBase_ :: Connection -> SndFileId -> RcvMsgData -> IO ()
insertRcvMsgBase_ Connection
dbConn SndFileId
connId RcvMsgData {MsgMeta
$sel:msgMeta:RcvMsgData :: RcvMsgData -> MsgMeta
msgMeta :: MsgMeta
msgMeta, AgentMessageType
msgType :: AgentMessageType
$sel:msgType:RcvMsgData :: RcvMsgData -> AgentMessageType
msgType, MsgFlags
msgFlags :: MsgFlags
$sel:msgFlags:RcvMsgData :: RcvMsgData -> MsgFlags
msgFlags, SndFileId
msgBody :: SndFileId
$sel:msgBody:RcvMsgData :: RcvMsgData -> SndFileId
msgBody, InternalRcvId
$sel:internalRcvId:RcvMsgData :: RcvMsgData -> InternalRcvId
internalRcvId :: InternalRcvId
internalRcvId} = do
  let MsgMeta {$sel:recipient:MsgMeta :: MsgMeta -> (Int64, UTCTime)
recipient = (Int64
internalId, UTCTime
internalTs), PQEncryption
$sel:pqEncryption:MsgMeta :: MsgMeta -> PQEncryption
pqEncryption :: PQEncryption
pqEncryption} = MsgMeta
msgMeta
  Connection
-> Query
-> (SndFileId, Int64, UTCTime, InternalRcvId, Maybe Int64,
    AgentMessageType, MsgFlags, Binary SndFileId, PQEncryption)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
dbConn
    [sql|
      INSERT INTO messages
        (conn_id, internal_id, internal_ts, internal_rcv_id, internal_snd_id, msg_type, msg_flags, msg_body, pq_encryption)
        VALUES (?,?,?,?,?,?,?,?,?);
    |]
    (SndFileId
connId, Int64
internalId, UTCTime
internalTs, InternalRcvId
internalRcvId, Maybe Int64
forall a. Maybe a
Nothing :: Maybe Int64, AgentMessageType
msgType, MsgFlags
msgFlags, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
msgBody, PQEncryption
pqEncryption)

insertRcvMsgDetails_ :: DB.Connection -> ConnId -> RcvQueue -> RcvMsgData -> IO ()
insertRcvMsgDetails_ :: Connection -> SndFileId -> RcvQueue -> RcvMsgData -> IO ()
insertRcvMsgDetails_ Connection
db SndFileId
connId RcvQueue {DBEntityId' 'DBStored
$sel:dbQueueId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> DBEntityId' q
dbQueueId :: DBEntityId' 'DBStored
dbQueueId} RcvMsgData {MsgMeta
$sel:msgMeta:RcvMsgData :: RcvMsgData -> MsgMeta
msgMeta :: MsgMeta
msgMeta, InternalRcvId
$sel:internalRcvId:RcvMsgData :: RcvMsgData -> InternalRcvId
internalRcvId :: InternalRcvId
internalRcvId, SndFileId
$sel:internalHash:RcvMsgData :: RcvMsgData -> SndFileId
internalHash :: SndFileId
internalHash, SndFileId
externalPrevSndHash :: SndFileId
$sel:externalPrevSndHash:RcvMsgData :: RcvMsgData -> SndFileId
externalPrevSndHash, SndFileId
encryptedMsgHash :: SndFileId
$sel:encryptedMsgHash:RcvMsgData :: RcvMsgData -> SndFileId
encryptedMsgHash} = do
  let MsgMeta {MsgIntegrity
$sel:integrity:MsgMeta :: MsgMeta -> MsgIntegrity
integrity :: MsgIntegrity
integrity, (Int64, UTCTime)
$sel:recipient:MsgMeta :: MsgMeta -> (Int64, UTCTime)
recipient :: (Int64, UTCTime)
recipient, (SndFileId, UTCTime)
$sel:broker:MsgMeta :: MsgMeta -> (SndFileId, UTCTime)
broker :: (SndFileId, UTCTime)
broker, Int64
$sel:sndMsgId:MsgMeta :: MsgMeta -> Int64
sndMsgId :: Int64
sndMsgId} = MsgMeta
msgMeta
  Connection
-> Query
-> (SndFileId, DBEntityId' 'DBStored, InternalRcvId, Int64, Int64,
    Binary SndFileId, UTCTime, Binary SndFileId, Binary SndFileId,
    MsgIntegrity)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO rcv_messages
        ( conn_id, rcv_queue_id, internal_rcv_id, internal_id, external_snd_id,
          broker_id, broker_ts,
          internal_hash, external_prev_snd_hash, integrity)
      VALUES
        (?,?,?,?,?,?,?,?,?,?)
    |]
    (SndFileId
connId, DBEntityId' 'DBStored
dbQueueId, InternalRcvId
internalRcvId, (Int64, UTCTime) -> Int64
forall a b. (a, b) -> a
fst (Int64, UTCTime)
recipient, Int64
sndMsgId, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary ((SndFileId, UTCTime) -> SndFileId
forall a b. (a, b) -> a
fst (SndFileId, UTCTime)
broker), (SndFileId, UTCTime) -> UTCTime
forall a b. (a, b) -> b
snd (SndFileId, UTCTime)
broker, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
internalHash, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
externalPrevSndHash, MsgIntegrity
integrity)
  Connection -> Query -> (SndFileId, Binary SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"INSERT INTO encrypted_rcv_message_hashes (conn_id, hash) VALUES (?,?)" (SndFileId
connId, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
encryptedMsgHash)

updateRcvMsgHash :: DB.Connection -> ConnId -> AgentMsgId -> InternalRcvId -> MsgHash -> IO ()
updateRcvMsgHash :: Connection
-> SndFileId -> Int64 -> InternalRcvId -> SndFileId -> IO ()
updateRcvMsgHash Connection
db SndFileId
connId Int64
sndMsgId InternalRcvId
internalRcvId SndFileId
internalHash =
  Connection
-> Query
-> (Int64, Binary SndFileId, SndFileId, InternalRcvId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    -- last_internal_rcv_msg_id equality check prevents race condition in case next id was reserved
    [sql|
      UPDATE connections
      SET last_external_snd_msg_id = ?,
          last_rcv_msg_hash = ?
      WHERE conn_id = ?
        AND last_internal_rcv_msg_id = ?
    |]
    (Int64
sndMsgId, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
internalHash, SndFileId
connId, InternalRcvId
internalRcvId)

-- * updateSndIds helpers

retrieveLastIdsAndHashSnd_ :: DB.Connection -> ConnId -> IO (Either StoreError (InternalId, InternalSndId, PrevSndMsgHash))
retrieveLastIdsAndHashSnd_ :: Connection
-> SndFileId
-> IO (Either StoreError (InternalId, InternalSndId, SndFileId))
retrieveLastIdsAndHashSnd_ Connection
dbConn SndFileId
connId = do
  ((InternalId, InternalSndId, SndFileId)
 -> (InternalId, InternalSndId, SndFileId))
-> StoreError
-> IO [(InternalId, InternalSndId, SndFileId)]
-> IO (Either StoreError (InternalId, InternalSndId, SndFileId))
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (InternalId, InternalSndId, SndFileId)
-> (InternalId, InternalSndId, SndFileId)
forall a. a -> a
id StoreError
SEConnNotFound (IO [(InternalId, InternalSndId, SndFileId)]
 -> IO (Either StoreError (InternalId, InternalSndId, SndFileId)))
-> IO [(InternalId, InternalSndId, SndFileId)]
-> IO (Either StoreError (InternalId, InternalSndId, SndFileId))
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> Only SndFileId
-> IO [(InternalId, InternalSndId, SndFileId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
dbConn
      ( [sql|
          SELECT last_internal_msg_id, last_internal_snd_msg_id, last_snd_msg_hash
          FROM connections
          WHERE conn_id = ?
        |]
#if defined(dbPostgres)
          <> " FOR UPDATE"
#endif
      )
      (SndFileId -> Only SndFileId
forall a. a -> Only a
Only SndFileId
connId)

updateLastIdsSnd_ :: DB.Connection -> ConnId -> InternalId -> InternalSndId -> IO ()
updateLastIdsSnd_ :: Connection -> SndFileId -> InternalId -> InternalSndId -> IO ()
updateLastIdsSnd_ Connection
dbConn SndFileId
connId InternalId
newInternalId InternalSndId
newInternalSndId =
  Connection
-> Query -> (InternalId, InternalSndId, SndFileId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
dbConn
    [sql|
      UPDATE connections
      SET last_internal_msg_id = ?,
          last_internal_snd_msg_id = ?
      WHERE conn_id = ?
    |]
    (InternalId
newInternalId, InternalSndId
newInternalSndId, SndFileId
connId)

-- * createSndMsg helpers

insertSndMsgBase_ :: DB.Connection -> ConnId -> SndMsgData -> IO ()
insertSndMsgBase_ :: Connection -> SndFileId -> SndMsgData -> IO ()
insertSndMsgBase_ Connection
db SndFileId
connId SndMsgData {InternalId
internalId :: InternalId
$sel:internalId:SndMsgData :: SndMsgData -> InternalId
internalId, UTCTime
internalTs :: UTCTime
$sel:internalTs:SndMsgData :: SndMsgData -> UTCTime
internalTs, InternalSndId
$sel:internalSndId:SndMsgData :: SndMsgData -> InternalSndId
internalSndId :: InternalSndId
internalSndId, AgentMessageType
msgType :: AgentMessageType
$sel:msgType:SndMsgData :: SndMsgData -> AgentMessageType
msgType, MsgFlags
msgFlags :: MsgFlags
$sel:msgFlags:SndMsgData :: SndMsgData -> MsgFlags
msgFlags, SndFileId
msgBody :: SndFileId
$sel:msgBody:SndMsgData :: SndMsgData -> SndFileId
msgBody, PQEncryption
pqEncryption :: PQEncryption
$sel:pqEncryption:SndMsgData :: SndMsgData -> PQEncryption
pqEncryption} = do
  Connection
-> Query
-> (SndFileId, InternalId, UTCTime, Maybe Int64, InternalSndId,
    AgentMessageType, MsgFlags, Binary SndFileId, PQEncryption)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO messages
        (conn_id, internal_id, internal_ts, internal_rcv_id, internal_snd_id, msg_type, msg_flags, msg_body, pq_encryption)
      VALUES
        (?,?,?,?,?,?,?,?,?);
    |]
    (SndFileId
connId, InternalId
internalId, UTCTime
internalTs, Maybe Int64
forall a. Maybe a
Nothing :: Maybe Int64, InternalSndId
internalSndId, AgentMessageType
msgType, MsgFlags
msgFlags, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
msgBody, PQEncryption
pqEncryption)

insertSndMsgDetails_ :: DB.Connection -> ConnId -> SndMsgData -> IO ()
insertSndMsgDetails_ :: Connection -> SndFileId -> SndMsgData -> IO ()
insertSndMsgDetails_ Connection
dbConn SndFileId
connId SndMsgData {Maybe SndMsgPrepData
SndFileId
UTCTime
MsgFlags
PQEncryption
AgentMessageType
InternalId
InternalSndId
$sel:internalSndId:SndMsgData :: SndMsgData -> InternalSndId
$sel:internalHash:SndMsgData :: SndMsgData -> SndFileId
$sel:internalId:SndMsgData :: SndMsgData -> InternalId
$sel:internalTs:SndMsgData :: SndMsgData -> UTCTime
$sel:msgType:SndMsgData :: SndMsgData -> AgentMessageType
$sel:msgFlags:SndMsgData :: SndMsgData -> MsgFlags
$sel:msgBody:SndMsgData :: SndMsgData -> SndFileId
$sel:pqEncryption:SndMsgData :: SndMsgData -> PQEncryption
internalId :: InternalId
internalSndId :: InternalSndId
internalTs :: UTCTime
msgType :: AgentMessageType
msgFlags :: MsgFlags
msgBody :: SndFileId
pqEncryption :: PQEncryption
internalHash :: SndFileId
prevMsgHash :: SndFileId
sndMsgPrepData_ :: Maybe SndMsgPrepData
$sel:prevMsgHash:SndMsgData :: SndMsgData -> SndFileId
$sel:sndMsgPrepData_:SndMsgData :: SndMsgData -> Maybe SndMsgPrepData
..} =
  Connection
-> Query
-> (SndFileId, InternalSndId, InternalId, Binary SndFileId,
    Binary SndFileId, Maybe MsgEncryptKeyX448, Maybe Int, Maybe Int64)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
dbConn
    [sql|
      INSERT INTO snd_messages
        ( conn_id, internal_snd_id, internal_id, internal_hash, previous_msg_hash, msg_encrypt_key, padded_msg_len, snd_message_body_id)
      VALUES
        (?,?,?,?,?,?,?,?)
    |]
    (SndFileId
connId, InternalSndId
internalSndId, InternalId
internalId, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
internalHash, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
prevMsgHash, Maybe MsgEncryptKeyX448
encryptKey_, Maybe Int
paddedLen_, Maybe Int64
sndMsgBodyId_)
  where
    (Maybe MsgEncryptKeyX448
encryptKey_, Maybe Int
paddedLen_, Maybe Int64
sndMsgBodyId_) = case Maybe SndMsgPrepData
sndMsgPrepData_ of
      Maybe SndMsgPrepData
Nothing -> (Maybe MsgEncryptKeyX448
forall a. Maybe a
Nothing, Maybe Int
forall a. Maybe a
Nothing, Maybe Int64
forall a. Maybe a
Nothing)
      Just SndMsgPrepData {MsgEncryptKeyX448
encryptKey :: MsgEncryptKeyX448
$sel:encryptKey:SndMsgPrepData :: SndMsgPrepData -> MsgEncryptKeyX448
encryptKey, Int
paddedLen :: Int
$sel:paddedLen:SndMsgPrepData :: SndMsgPrepData -> Int
paddedLen, Int64
sndMsgBodyId :: Int64
$sel:sndMsgBodyId:SndMsgPrepData :: SndMsgPrepData -> Int64
sndMsgBodyId} -> (MsgEncryptKeyX448 -> Maybe MsgEncryptKeyX448
forall a. a -> Maybe a
Just MsgEncryptKeyX448
encryptKey, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
paddedLen, Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
sndMsgBodyId)

updateSndMsgHash :: DB.Connection -> ConnId -> InternalSndId -> MsgHash -> IO ()
updateSndMsgHash :: Connection -> SndFileId -> InternalSndId -> SndFileId -> IO ()
updateSndMsgHash Connection
db SndFileId
connId InternalSndId
internalSndId SndFileId
internalHash =
  Connection
-> Query -> (Binary SndFileId, SndFileId, InternalSndId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    -- last_internal_snd_msg_id equality check prevents race condition in case next id was reserved
    [sql|
      UPDATE connections
      SET last_snd_msg_hash = ?
      WHERE conn_id = ?
        AND last_internal_snd_msg_id = ?;
    |]
    (SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
internalHash, SndFileId
connId, InternalSndId
internalSndId)

-- create record with a random ID
createWithRandomId :: DB.Connection -> TVar ChaChaDRG -> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
createWithRandomId :: Connection
-> TVar ChaChaDRG
-> (SndFileId -> IO ())
-> IO (Either StoreError SndFileId)
createWithRandomId Connection
db TVar ChaChaDRG
gVar SndFileId -> IO ()
create = (SndFileId, ()) -> SndFileId
forall a b. (a, b) -> a
fst ((SndFileId, ()) -> SndFileId)
-> IO (Either StoreError (SndFileId, ()))
-> IO (Either StoreError SndFileId)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Connection
-> TVar ChaChaDRG
-> (SndFileId -> IO ())
-> IO (Either StoreError (SndFileId, ()))
forall a.
Connection
-> TVar ChaChaDRG
-> (SndFileId -> IO a)
-> IO (Either StoreError (SndFileId, a))
createWithRandomId' Connection
db TVar ChaChaDRG
gVar SndFileId -> IO ()
create

createWithRandomId' :: forall a. DB.Connection -> TVar ChaChaDRG -> (ByteString -> IO a) -> IO (Either StoreError (ByteString, a))
createWithRandomId' :: forall a.
Connection
-> TVar ChaChaDRG
-> (SndFileId -> IO a)
-> IO (Either StoreError (SndFileId, a))
createWithRandomId' Connection
db TVar ChaChaDRG
gVar SndFileId -> IO a
create = Int -> IO (Either StoreError (SndFileId, a))
tryCreate Int
3
  where
    tryCreate :: Int -> IO (Either StoreError (ByteString, a))
    tryCreate :: Int -> IO (Either StoreError (SndFileId, a))
tryCreate Int
0 = Either StoreError (SndFileId, a)
-> IO (Either StoreError (SndFileId, a))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError (SndFileId, a)
 -> IO (Either StoreError (SndFileId, a)))
-> Either StoreError (SndFileId, a)
-> IO (Either StoreError (SndFileId, a))
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError (SndFileId, a)
forall a b. a -> Either a b
Left StoreError
SEUniqueID
    tryCreate Int
n = do
      SndFileId
id' <- TVar ChaChaDRG -> Int -> IO SndFileId
randomId TVar ChaChaDRG
gVar Int
12
      Connection -> Query -> IO a -> IO (Either SQLError a)
forall a. Connection -> Query -> IO a -> IO (Either SQLError a)
withSavepoint Connection
db Query
"create_random_id" (SndFileId -> IO a
create SndFileId
id') IO (Either SQLError a)
-> (Either SQLError a -> IO (Either StoreError (SndFileId, a)))
-> IO (Either StoreError (SndFileId, a))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right a
r -> Either StoreError (SndFileId, a)
-> IO (Either StoreError (SndFileId, a))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError (SndFileId, a)
 -> IO (Either StoreError (SndFileId, a)))
-> Either StoreError (SndFileId, a)
-> IO (Either StoreError (SndFileId, a))
forall a b. (a -> b) -> a -> b
$ (SndFileId, a) -> Either StoreError (SndFileId, a)
forall a b. b -> Either a b
Right (SndFileId
id', a
r)
        Left SQLError
e -> Int -> SQLError -> IO (Either StoreError (SndFileId, a))
handleErr Int
n SQLError
e
#if defined(dbPostgres)
    handleErr n e = case constraintViolation e of
      Just _ -> tryCreate (n - 1)
      Nothing -> pure . Left . SEInternal $ bshow e
#else
    handleErr :: Int -> SQLError -> IO (Either StoreError (SndFileId, a))
handleErr Int
n SQLError
e
      | SQLError -> Error
SQL.sqlError SQLError
e Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
SQL.ErrorConstraint = Int -> IO (Either StoreError (SndFileId, a))
tryCreate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      | Bool
otherwise = Either StoreError (SndFileId, a)
-> IO (Either StoreError (SndFileId, a))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError (SndFileId, a)
 -> IO (Either StoreError (SndFileId, a)))
-> (SndFileId -> Either StoreError (SndFileId, a))
-> SndFileId
-> IO (Either StoreError (SndFileId, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError (SndFileId, a)
forall a b. a -> Either a b
Left (StoreError -> Either StoreError (SndFileId, a))
-> (SndFileId -> StoreError)
-> SndFileId
-> Either StoreError (SndFileId, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> StoreError
SEInternal (SndFileId -> IO (Either StoreError (SndFileId, a)))
-> SndFileId -> IO (Either StoreError (SndFileId, a))
forall a b. (a -> b) -> a -> b
$ SQLError -> SndFileId
forall a. Show a => a -> SndFileId
bshow SQLError
e
#endif

randomId :: TVar ChaChaDRG -> Int -> IO ByteString
randomId :: TVar ChaChaDRG -> Int -> IO SndFileId
randomId TVar ChaChaDRG
gVar Int
n = STM SndFileId -> IO SndFileId
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM SndFileId -> IO SndFileId) -> STM SndFileId -> IO SndFileId
forall a b. (a -> b) -> a -> b
$ SndFileId -> SndFileId
U.encode (SndFileId -> SndFileId) -> STM SndFileId -> STM SndFileId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> TVar ChaChaDRG -> STM SndFileId
C.randomBytes Int
n TVar ChaChaDRG
gVar

ntfSubAndSMPAction :: NtfSubAction -> (Maybe NtfSubNTFAction, Maybe NtfSubSMPAction)
ntfSubAndSMPAction :: NtfSubAction -> (Maybe NtfSubNTFAction, Maybe NtfSubSMPAction)
ntfSubAndSMPAction (NSANtf NtfSubNTFAction
action) = (NtfSubNTFAction -> Maybe NtfSubNTFAction
forall a. a -> Maybe a
Just NtfSubNTFAction
action, Maybe NtfSubSMPAction
forall a. Maybe a
Nothing)
ntfSubAndSMPAction (NSASMP NtfSubSMPAction
action) = (Maybe NtfSubNTFAction
forall a. Maybe a
Nothing, NtfSubSMPAction -> Maybe NtfSubSMPAction
forall a. a -> Maybe a
Just NtfSubSMPAction
action)

createXFTPServer_ :: DB.Connection -> XFTPServer -> IO Int64
createXFTPServer_ :: Connection -> XFTPServer -> IO Int64
createXFTPServer_ Connection
db ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port, KeyHash
$sel:keyHash:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> KeyHash
keyHash :: KeyHash
keyHash} = do
  Only Int64
serverId : [Only Int64]
_ <-
    Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, KeyHash)
-> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        INSERT INTO xftp_servers (xftp_host, xftp_port, xftp_key_hash)
        VALUES (?, ?, ?)
        ON CONFLICT (xftp_host, xftp_port, xftp_key_hash)
        DO UPDATE SET xftp_host = EXCLUDED.xftp_host
        RETURNING xftp_server_id
      |]
      (NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash)
  Int64 -> IO Int64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
serverId

createRcvFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> Bool -> IO (Either StoreError RcvFileId)
createRcvFile :: Connection
-> TVar ChaChaDRG
-> Int64
-> FileDescription 'FRecipient
-> ServiceName
-> ServiceName
-> CryptoFile
-> Bool
-> IO (Either StoreError SndFileId)
createRcvFile Connection
db TVar ChaChaDRG
gVar Int64
userId fd :: FileDescription 'FRecipient
fd@FileDescription {[FileChunk]
chunks :: [FileChunk]
$sel:chunks:FileDescription :: forall (p :: FileParty). FileDescription p -> [FileChunk]
chunks} ServiceName
prefixPath ServiceName
tmpPath CryptoFile
file Bool
approvedRelays = ExceptT StoreError IO SndFileId -> IO (Either StoreError SndFileId)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO SndFileId
 -> IO (Either StoreError SndFileId))
-> ExceptT StoreError IO SndFileId
-> IO (Either StoreError SndFileId)
forall a b. (a -> b) -> a -> b
$ do
  (SndFileId
rcvFileEntityId, Int64
rcvFileId) <- IO (Either StoreError (SndFileId, Int64))
-> ExceptT StoreError IO (SndFileId, Int64)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (SndFileId, Int64))
 -> ExceptT StoreError IO (SndFileId, Int64))
-> IO (Either StoreError (SndFileId, Int64))
-> ExceptT StoreError IO (SndFileId, Int64)
forall a b. (a -> b) -> a -> b
$ Connection
-> TVar ChaChaDRG
-> Int64
-> FileDescription 'FRecipient
-> ServiceName
-> ServiceName
-> CryptoFile
-> Maybe Int64
-> Maybe SndFileId
-> Bool
-> IO (Either StoreError (SndFileId, Int64))
insertRcvFile Connection
db TVar ChaChaDRG
gVar Int64
userId FileDescription 'FRecipient
fd ServiceName
prefixPath ServiceName
tmpPath CryptoFile
file Maybe Int64
forall a. Maybe a
Nothing Maybe SndFileId
forall a. Maybe a
Nothing Bool
approvedRelays
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
    [FileChunk] -> (FileChunk -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FileChunk]
chunks ((FileChunk -> IO ()) -> IO ()) -> (FileChunk -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \fc :: FileChunk
fc@FileChunk {[FileChunkReplica]
replicas :: [FileChunkReplica]
$sel:replicas:FileChunk :: FileChunk -> [FileChunkReplica]
replicas} -> do
      Int64
chunkId <- Connection -> FileChunk -> Int64 -> IO Int64
insertRcvFileChunk Connection
db FileChunk
fc Int64
rcvFileId
      [(Int, FileChunkReplica)]
-> ((Int, FileChunkReplica) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [FileChunkReplica] -> [(Int, FileChunkReplica)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [FileChunkReplica]
replicas) (((Int, FileChunkReplica) -> IO ()) -> IO ())
-> ((Int, FileChunkReplica) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
rno, FileChunkReplica
replica) -> Connection -> Int -> FileChunkReplica -> Int64 -> IO ()
insertRcvFileChunkReplica Connection
db Int
rno FileChunkReplica
replica Int64
chunkId
  SndFileId -> ExceptT StoreError IO SndFileId
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndFileId
rcvFileEntityId

createRcvFileRedirect :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> FilePath -> CryptoFile -> Bool -> IO (Either StoreError RcvFileId)
createRcvFileRedirect :: Connection
-> TVar ChaChaDRG
-> Int64
-> FileDescription 'FRecipient
-> ServiceName
-> ServiceName
-> CryptoFile
-> ServiceName
-> CryptoFile
-> Bool
-> IO (Either StoreError SndFileId)
createRcvFileRedirect Connection
_ TVar ChaChaDRG
_ Int64
_ FileDescription {$sel:redirect:FileDescription :: forall (p :: FileParty).
FileDescription p -> Maybe RedirectFileInfo
redirect = Maybe RedirectFileInfo
Nothing} ServiceName
_ ServiceName
_ CryptoFile
_ ServiceName
_ CryptoFile
_ Bool
_ = Either StoreError SndFileId -> IO (Either StoreError SndFileId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError SndFileId -> IO (Either StoreError SndFileId))
-> Either StoreError SndFileId -> IO (Either StoreError SndFileId)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError SndFileId
forall a b. a -> Either a b
Left (StoreError -> Either StoreError SndFileId)
-> StoreError -> Either StoreError SndFileId
forall a b. (a -> b) -> a -> b
$ SndFileId -> StoreError
SEInternal SndFileId
"createRcvFileRedirect called without redirect"
createRcvFileRedirect Connection
db TVar ChaChaDRG
gVar Int64
userId redirectFd :: FileDescription 'FRecipient
redirectFd@FileDescription {$sel:chunks:FileDescription :: forall (p :: FileParty). FileDescription p -> [FileChunk]
chunks = [FileChunk]
redirectChunks, $sel:redirect:FileDescription :: forall (p :: FileParty).
FileDescription p -> Maybe RedirectFileInfo
redirect = Just RedirectFileInfo {FileSize Int64
size :: FileSize Int64
$sel:size:RedirectFileInfo :: RedirectFileInfo -> FileSize Int64
size, FileDigest
digest :: FileDigest
$sel:digest:RedirectFileInfo :: RedirectFileInfo -> FileDigest
digest}} ServiceName
prefixPath ServiceName
redirectPath CryptoFile
redirectFile ServiceName
dstPath CryptoFile
dstFile Bool
approvedRelays = ExceptT StoreError IO SndFileId -> IO (Either StoreError SndFileId)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO SndFileId
 -> IO (Either StoreError SndFileId))
-> ExceptT StoreError IO SndFileId
-> IO (Either StoreError SndFileId)
forall a b. (a -> b) -> a -> b
$ do
  (SndFileId
dstEntityId, Int64
dstId) <- IO (Either StoreError (SndFileId, Int64))
-> ExceptT StoreError IO (SndFileId, Int64)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (SndFileId, Int64))
 -> ExceptT StoreError IO (SndFileId, Int64))
-> IO (Either StoreError (SndFileId, Int64))
-> ExceptT StoreError IO (SndFileId, Int64)
forall a b. (a -> b) -> a -> b
$ Connection
-> TVar ChaChaDRG
-> Int64
-> FileDescription 'FRecipient
-> ServiceName
-> ServiceName
-> CryptoFile
-> Maybe Int64
-> Maybe SndFileId
-> Bool
-> IO (Either StoreError (SndFileId, Int64))
insertRcvFile Connection
db TVar ChaChaDRG
gVar Int64
userId FileDescription 'FRecipient
dummyDst ServiceName
prefixPath ServiceName
dstPath CryptoFile
dstFile Maybe Int64
forall a. Maybe a
Nothing Maybe SndFileId
forall a. Maybe a
Nothing Bool
approvedRelays
  (SndFileId
_, Int64
redirectId) <- IO (Either StoreError (SndFileId, Int64))
-> ExceptT StoreError IO (SndFileId, Int64)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (SndFileId, Int64))
 -> ExceptT StoreError IO (SndFileId, Int64))
-> IO (Either StoreError (SndFileId, Int64))
-> ExceptT StoreError IO (SndFileId, Int64)
forall a b. (a -> b) -> a -> b
$ Connection
-> TVar ChaChaDRG
-> Int64
-> FileDescription 'FRecipient
-> ServiceName
-> ServiceName
-> CryptoFile
-> Maybe Int64
-> Maybe SndFileId
-> Bool
-> IO (Either StoreError (SndFileId, Int64))
insertRcvFile Connection
db TVar ChaChaDRG
gVar Int64
userId FileDescription 'FRecipient
redirectFd ServiceName
prefixPath ServiceName
redirectPath CryptoFile
redirectFile (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
dstId) (SndFileId -> Maybe SndFileId
forall a. a -> Maybe a
Just SndFileId
dstEntityId) Bool
approvedRelays
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
    [FileChunk] -> (FileChunk -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FileChunk]
redirectChunks ((FileChunk -> IO ()) -> IO ()) -> (FileChunk -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \fc :: FileChunk
fc@FileChunk {[FileChunkReplica]
$sel:replicas:FileChunk :: FileChunk -> [FileChunkReplica]
replicas :: [FileChunkReplica]
replicas} -> do
      Int64
chunkId <- Connection -> FileChunk -> Int64 -> IO Int64
insertRcvFileChunk Connection
db FileChunk
fc Int64
redirectId
      [(Int, FileChunkReplica)]
-> ((Int, FileChunkReplica) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [FileChunkReplica] -> [(Int, FileChunkReplica)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [FileChunkReplica]
replicas) (((Int, FileChunkReplica) -> IO ()) -> IO ())
-> ((Int, FileChunkReplica) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
rno, FileChunkReplica
replica) -> Connection -> Int -> FileChunkReplica -> Int64 -> IO ()
insertRcvFileChunkReplica Connection
db Int
rno FileChunkReplica
replica Int64
chunkId
  SndFileId -> ExceptT StoreError IO SndFileId
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndFileId
dstEntityId
  where
    dummyDst :: FileDescription 'FRecipient
dummyDst =
      FileDescription
        { $sel:party:FileDescription :: SFileParty 'FRecipient
party = SFileParty 'FRecipient
SFRecipient,
          FileSize Int64
size :: FileSize Int64
$sel:size:FileDescription :: FileSize Int64
size,
          FileDigest
digest :: FileDigest
$sel:digest:FileDescription :: FileDigest
digest,
          $sel:redirect:FileDescription :: Maybe RedirectFileInfo
redirect = Maybe RedirectFileInfo
forall a. Maybe a
Nothing,
          -- updated later with updateRcvFileRedirect
          $sel:key:FileDescription :: SbKey
key = SndFileId -> SbKey
C.unsafeSbKey (SndFileId -> SbKey) -> SndFileId -> SbKey
forall a b. (a -> b) -> a -> b
$ Int -> Char -> SndFileId
B.replicate Int
32 Char
'#',
          $sel:nonce:FileDescription :: CbNonce
nonce = SndFileId -> CbNonce
C.cbNonce SndFileId
"",
          $sel:chunkSize:FileDescription :: FileSize Word32
chunkSize = Word32 -> FileSize Word32
forall a. a -> FileSize a
FileSize Word32
0,
          $sel:chunks:FileDescription :: [FileChunk]
chunks = []
        }

insertRcvFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> Maybe DBRcvFileId -> Maybe RcvFileId -> Bool -> IO (Either StoreError (RcvFileId, DBRcvFileId))
insertRcvFile :: Connection
-> TVar ChaChaDRG
-> Int64
-> FileDescription 'FRecipient
-> ServiceName
-> ServiceName
-> CryptoFile
-> Maybe Int64
-> Maybe SndFileId
-> Bool
-> IO (Either StoreError (SndFileId, Int64))
insertRcvFile Connection
db TVar ChaChaDRG
gVar Int64
userId FileDescription {FileSize Int64
$sel:size:FileDescription :: forall (p :: FileParty). FileDescription p -> FileSize Int64
size :: FileSize Int64
size, FileDigest
$sel:digest:FileDescription :: forall (p :: FileParty). FileDescription p -> FileDigest
digest :: FileDigest
digest, SbKey
$sel:key:FileDescription :: forall (p :: FileParty). FileDescription p -> SbKey
key :: SbKey
key, CbNonce
$sel:nonce:FileDescription :: forall (p :: FileParty). FileDescription p -> CbNonce
nonce :: CbNonce
nonce, FileSize Word32
$sel:chunkSize:FileDescription :: forall (p :: FileParty). FileDescription p -> FileSize Word32
chunkSize :: FileSize Word32
chunkSize, Maybe RedirectFileInfo
$sel:redirect:FileDescription :: forall (p :: FileParty).
FileDescription p -> Maybe RedirectFileInfo
redirect :: Maybe RedirectFileInfo
redirect} ServiceName
prefixPath ServiceName
tmpPath (CryptoFile ServiceName
savePath Maybe CryptoFileArgs
cfArgs) Maybe Int64
redirectId_ Maybe SndFileId
redirectEntityId_ Bool
approvedRelays = ExceptT StoreError IO (SndFileId, Int64)
-> IO (Either StoreError (SndFileId, Int64))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (SndFileId, Int64)
 -> IO (Either StoreError (SndFileId, Int64)))
-> ExceptT StoreError IO (SndFileId, Int64)
-> IO (Either StoreError (SndFileId, Int64))
forall a b. (a -> b) -> a -> b
$ do
  let (Maybe FileDigest
redirectDigest_, Maybe (FileSize Int64)
redirectSize_) = case Maybe RedirectFileInfo
redirect of
        Just RedirectFileInfo {$sel:digest:RedirectFileInfo :: RedirectFileInfo -> FileDigest
digest = FileDigest
d, $sel:size:RedirectFileInfo :: RedirectFileInfo -> FileSize Int64
size = FileSize Int64
s} -> (FileDigest -> Maybe FileDigest
forall a. a -> Maybe a
Just FileDigest
d, FileSize Int64 -> Maybe (FileSize Int64)
forall a. a -> Maybe a
Just FileSize Int64
s)
        Maybe RedirectFileInfo
Nothing -> (Maybe FileDigest
forall a. Maybe a
Nothing, Maybe (FileSize Int64)
forall a. Maybe a
Nothing)
  SndFileId
rcvFileEntityId <- IO (Either StoreError SndFileId) -> ExceptT StoreError IO SndFileId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError SndFileId)
 -> ExceptT StoreError IO SndFileId)
-> IO (Either StoreError SndFileId)
-> ExceptT StoreError IO SndFileId
forall a b. (a -> b) -> a -> b
$
    Connection
-> TVar ChaChaDRG
-> (SndFileId -> IO ())
-> IO (Either StoreError SndFileId)
createWithRandomId Connection
db TVar ChaChaDRG
gVar ((SndFileId -> IO ()) -> IO (Either StoreError SndFileId))
-> (SndFileId -> IO ()) -> IO (Either StoreError SndFileId)
forall a b. (a -> b) -> a -> b
$ \SndFileId
rcvFileEntityId ->
      Connection
-> Query
-> ((Binary SndFileId, Int64, FileSize Int64, FileDigest, SbKey,
     CbNonce, FileSize Word32, ServiceName, ServiceName)
    :. (ServiceName, Maybe SbKey, Maybe CbNonce, RcvFileStatus,
        Maybe Int64, Maybe (Binary SndFileId), Maybe FileDigest,
        Maybe (FileSize Int64), BoolInt))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        Query
"INSERT INTO rcv_files (rcv_file_entity_id, user_id, size, digest, key, nonce, chunk_size, prefix_path, tmp_path, save_path, save_file_key, save_file_nonce, status, redirect_id, redirect_entity_id, redirect_digest, redirect_size, approved_relays) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
        ((SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
rcvFileEntityId, Int64
userId, FileSize Int64
size, FileDigest
digest, SbKey
key, CbNonce
nonce, FileSize Word32
chunkSize, ServiceName
prefixPath, ServiceName
tmpPath) (Binary SndFileId, Int64, FileSize Int64, FileDigest, SbKey,
 CbNonce, FileSize Word32, ServiceName, ServiceName)
-> (ServiceName, Maybe SbKey, Maybe CbNonce, RcvFileStatus,
    Maybe Int64, Maybe (Binary SndFileId), Maybe FileDigest,
    Maybe (FileSize Int64), BoolInt)
-> (Binary SndFileId, Int64, FileSize Int64, FileDigest, SbKey,
    CbNonce, FileSize Word32, ServiceName, ServiceName)
   :. (ServiceName, Maybe SbKey, Maybe CbNonce, RcvFileStatus,
       Maybe Int64, Maybe (Binary SndFileId), Maybe FileDigest,
       Maybe (FileSize Int64), BoolInt)
forall h t. h -> t -> h :. t
:. (ServiceName
savePath, CryptoFileArgs -> SbKey
fileKey (CryptoFileArgs -> SbKey) -> Maybe CryptoFileArgs -> Maybe SbKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CryptoFileArgs
cfArgs, CryptoFileArgs -> CbNonce
fileNonce (CryptoFileArgs -> CbNonce)
-> Maybe CryptoFileArgs -> Maybe CbNonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CryptoFileArgs
cfArgs, RcvFileStatus
RFSReceiving, Maybe Int64
redirectId_, SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary (SndFileId -> Binary SndFileId)
-> Maybe SndFileId -> Maybe (Binary SndFileId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SndFileId
redirectEntityId_, Maybe FileDigest
redirectDigest_, Maybe (FileSize Int64)
redirectSize_, Bool -> BoolInt
BI Bool
approvedRelays))
  Int64
rcvFileId <- IO Int64 -> ExceptT StoreError IO Int64
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> ExceptT StoreError IO Int64)
-> IO Int64 -> ExceptT StoreError IO Int64
forall a b. (a -> b) -> a -> b
$ Connection -> IO Int64
insertedRowId Connection
db
  (SndFileId, Int64) -> ExceptT StoreError IO (SndFileId, Int64)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SndFileId
rcvFileEntityId, Int64
rcvFileId)

insertRcvFileChunk :: DB.Connection -> FileChunk -> DBRcvFileId -> IO Int64
insertRcvFileChunk :: Connection -> FileChunk -> Int64 -> IO Int64
insertRcvFileChunk Connection
db FileChunk {Int
chunkNo :: Int
$sel:chunkNo:FileChunk :: FileChunk -> Int
chunkNo, FileSize Word32
chunkSize :: FileSize Word32
$sel:chunkSize:FileChunk :: FileChunk -> FileSize Word32
chunkSize, FileDigest
digest :: FileDigest
$sel:digest:FileChunk :: FileChunk -> FileDigest
digest} Int64
rcvFileId = do
  Connection
-> Query -> (Int64, Int, FileSize Word32, FileDigest) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"INSERT INTO rcv_file_chunks (rcv_file_id, chunk_no, chunk_size, digest) VALUES (?,?,?,?)"
    (Int64
rcvFileId, Int
chunkNo, FileSize Word32
chunkSize, FileDigest
digest)
  Connection -> IO Int64
insertedRowId Connection
db

insertRcvFileChunkReplica :: DB.Connection -> Int -> FileChunkReplica -> Int64 -> IO ()
insertRcvFileChunkReplica :: Connection -> Int -> FileChunkReplica -> Int64 -> IO ()
insertRcvFileChunkReplica Connection
db Int
replicaNo FileChunkReplica {XFTPServer
server :: XFTPServer
$sel:server:FileChunkReplica :: FileChunkReplica -> XFTPServer
server, ChunkReplicaId
replicaId :: ChunkReplicaId
$sel:replicaId:FileChunkReplica :: FileChunkReplica -> ChunkReplicaId
replicaId, APrivateAuthKey
replicaKey :: APrivateAuthKey
$sel:replicaKey:FileChunkReplica :: FileChunkReplica -> APrivateAuthKey
replicaKey} Int64
chunkId = do
  Int64
srvId <- Connection -> XFTPServer -> IO Int64
createXFTPServer_ Connection
db XFTPServer
server
  Connection
-> Query
-> (Int, Int64, Int64, ChunkReplicaId, APrivateAuthKey)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"INSERT INTO rcv_file_chunk_replicas (replica_number, rcv_file_chunk_id, xftp_server_id, replica_id, replica_key) VALUES (?,?,?,?,?)"
    (Int
replicaNo, Int64
chunkId, Int64
srvId, ChunkReplicaId
replicaId, APrivateAuthKey
replicaKey)

getRcvFileByEntityId :: DB.Connection -> RcvFileId -> IO (Either StoreError RcvFile)
getRcvFileByEntityId :: Connection -> SndFileId -> IO (Either StoreError RcvFile)
getRcvFileByEntityId Connection
db SndFileId
rcvFileEntityId = ExceptT StoreError IO RcvFile -> IO (Either StoreError RcvFile)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO RcvFile -> IO (Either StoreError RcvFile))
-> ExceptT StoreError IO RcvFile -> IO (Either StoreError RcvFile)
forall a b. (a -> b) -> a -> b
$ do
  Int64
rcvFileId <- IO (Either StoreError Int64) -> ExceptT StoreError IO Int64
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError Int64) -> ExceptT StoreError IO Int64)
-> IO (Either StoreError Int64) -> ExceptT StoreError IO Int64
forall a b. (a -> b) -> a -> b
$ Connection -> SndFileId -> IO (Either StoreError Int64)
getRcvFileIdByEntityId_ Connection
db SndFileId
rcvFileEntityId
  IO (Either StoreError RcvFile) -> ExceptT StoreError IO RcvFile
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError RcvFile) -> ExceptT StoreError IO RcvFile)
-> IO (Either StoreError RcvFile) -> ExceptT StoreError IO RcvFile
forall a b. (a -> b) -> a -> b
$ Connection -> Int64 -> IO (Either StoreError RcvFile)
getRcvFile Connection
db Int64
rcvFileId

getRcvFileIdByEntityId_ :: DB.Connection -> RcvFileId -> IO (Either StoreError DBRcvFileId)
getRcvFileIdByEntityId_ :: Connection -> SndFileId -> IO (Either StoreError Int64)
getRcvFileIdByEntityId_ Connection
db SndFileId
rcvFileEntityId =
  (Only Int64 -> Int64)
-> StoreError -> IO [Only Int64] -> IO (Either StoreError Int64)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly StoreError
SEFileNotFound (IO [Only Int64] -> IO (Either StoreError Int64))
-> IO [Only Int64] -> IO (Either StoreError Int64)
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> Only (Binary SndFileId) -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT rcv_file_id FROM rcv_files WHERE rcv_file_entity_id = ?" (Binary SndFileId -> Only (Binary SndFileId)
forall a. a -> Only a
Only (SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
rcvFileEntityId))

getRcvFileRedirects :: DB.Connection -> DBRcvFileId -> IO [RcvFile]
getRcvFileRedirects :: Connection -> Int64 -> IO [RcvFile]
getRcvFileRedirects Connection
db Int64
rcvFileId = do
  [Int64]
redirects <- Only Int64 -> Int64
forall a. Only a -> a
fromOnly (Only Int64 -> Int64) -> IO [Only Int64] -> IO [Int64]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Connection -> Query -> Only Int64 -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT rcv_file_id FROM rcv_files WHERE redirect_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
rcvFileId)
  ([Maybe RcvFile] -> [RcvFile])
-> IO [Maybe RcvFile] -> IO [RcvFile]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe RcvFile] -> [RcvFile]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe RcvFile] -> IO [RcvFile])
-> ((Int64 -> IO (Maybe RcvFile)) -> IO [Maybe RcvFile])
-> (Int64 -> IO (Maybe RcvFile))
-> IO [RcvFile]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> (Int64 -> IO (Maybe RcvFile)) -> IO [Maybe RcvFile]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int64]
redirects ((Int64 -> IO (Maybe RcvFile)) -> IO [RcvFile])
-> (Int64 -> IO (Maybe RcvFile)) -> IO [RcvFile]
forall a b. (a -> b) -> a -> b
$ Connection -> Int64 -> IO (Either StoreError RcvFile)
getRcvFile Connection
db (Int64 -> IO (Either StoreError RcvFile))
-> (Either StoreError RcvFile -> IO (Maybe RcvFile))
-> Int64
-> IO (Maybe RcvFile)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (StoreError -> IO (Maybe RcvFile))
-> (RcvFile -> IO (Maybe RcvFile))
-> Either StoreError RcvFile
-> IO (Maybe RcvFile)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO (Maybe RcvFile) -> StoreError -> IO (Maybe RcvFile)
forall a b. a -> b -> a
const (IO (Maybe RcvFile) -> StoreError -> IO (Maybe RcvFile))
-> IO (Maybe RcvFile) -> StoreError -> IO (Maybe RcvFile)
forall a b. (a -> b) -> a -> b
$ Maybe RcvFile -> IO (Maybe RcvFile)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RcvFile
forall a. Maybe a
Nothing) (Maybe RcvFile -> IO (Maybe RcvFile)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RcvFile -> IO (Maybe RcvFile))
-> (RcvFile -> Maybe RcvFile) -> RcvFile -> IO (Maybe RcvFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RcvFile -> Maybe RcvFile
forall a. a -> Maybe a
Just)

lockRcvFileForUpdate :: DB.Connection -> DBRcvFileId -> IO ()
lockRcvFileForUpdate :: Connection -> Int64 -> IO ()
lockRcvFileForUpdate Connection
db Int64
rcvFileId = do
#if defined(dbPostgres)
  _ :: [Only Int] <- DB.query db "SELECT 1 FROM rcv_files WHERE rcv_file_id = ? FOR UPDATE" (Only rcvFileId)
#endif
  () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

getRcvFile :: DB.Connection -> DBRcvFileId -> IO (Either StoreError RcvFile)
getRcvFile :: Connection -> Int64 -> IO (Either StoreError RcvFile)
getRcvFile Connection
db Int64
rcvFileId = ExceptT StoreError IO RcvFile -> IO (Either StoreError RcvFile)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO RcvFile -> IO (Either StoreError RcvFile))
-> ExceptT StoreError IO RcvFile -> IO (Either StoreError RcvFile)
forall a b. (a -> b) -> a -> b
$ do
  f :: RcvFile
f@RcvFile {SndFileId
rcvFileEntityId :: SndFileId
$sel:rcvFileEntityId:RcvFile :: RcvFile -> SndFileId
rcvFileEntityId, Int64
userId :: Int64
$sel:userId:RcvFile :: RcvFile -> Int64
userId, Maybe ServiceName
tmpPath :: Maybe ServiceName
$sel:tmpPath:RcvFile :: RcvFile -> Maybe ServiceName
tmpPath} <- IO (Either StoreError RcvFile) -> ExceptT StoreError IO RcvFile
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT IO (Either StoreError RcvFile)
getFile
  [RcvFileChunk]
chunks <- ExceptT StoreError IO [RcvFileChunk]
-> (ServiceName -> ExceptT StoreError IO [RcvFileChunk])
-> Maybe ServiceName
-> ExceptT StoreError IO [RcvFileChunk]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([RcvFileChunk] -> ExceptT StoreError IO [RcvFileChunk]
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [RcvFileChunk] -> ExceptT StoreError IO [RcvFileChunk]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [RcvFileChunk] -> ExceptT StoreError IO [RcvFileChunk])
-> (ServiceName -> IO [RcvFileChunk])
-> ServiceName
-> ExceptT StoreError IO [RcvFileChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Int64 -> ServiceName -> IO [RcvFileChunk]
getChunks SndFileId
rcvFileEntityId Int64
userId) Maybe ServiceName
tmpPath
  RcvFile -> ExceptT StoreError IO RcvFile
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RcvFile
f {chunks} :: RcvFile)
  where
    getFile :: IO (Either StoreError RcvFile)
    getFile :: IO (Either StoreError RcvFile)
getFile = do
      (((SndFileId, Int64, FileSize Int64, FileDigest, SbKey, CbNonce,
   FileSize Word32, ServiceName, Maybe ServiceName)
  :. (ServiceName, Maybe SbKey, Maybe CbNonce, RcvFileStatus,
      BoolInt, Maybe Int64, Maybe SndFileId, Maybe (FileSize Int64),
      Maybe FileDigest))
 -> RcvFile)
-> StoreError
-> IO
     [(SndFileId, Int64, FileSize Int64, FileDigest, SbKey, CbNonce,
       FileSize Word32, ServiceName, Maybe ServiceName)
      :. (ServiceName, Maybe SbKey, Maybe CbNonce, RcvFileStatus,
          BoolInt, Maybe Int64, Maybe SndFileId, Maybe (FileSize Int64),
          Maybe FileDigest)]
-> IO (Either StoreError RcvFile)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((SndFileId, Int64, FileSize Int64, FileDigest, SbKey, CbNonce,
  FileSize Word32, ServiceName, Maybe ServiceName)
 :. (ServiceName, Maybe SbKey, Maybe CbNonce, RcvFileStatus,
     BoolInt, Maybe Int64, Maybe SndFileId, Maybe (FileSize Int64),
     Maybe FileDigest))
-> RcvFile
toFile StoreError
SEFileNotFound (IO
   [(SndFileId, Int64, FileSize Int64, FileDigest, SbKey, CbNonce,
     FileSize Word32, ServiceName, Maybe ServiceName)
    :. (ServiceName, Maybe SbKey, Maybe CbNonce, RcvFileStatus,
        BoolInt, Maybe Int64, Maybe SndFileId, Maybe (FileSize Int64),
        Maybe FileDigest)]
 -> IO (Either StoreError RcvFile))
-> IO
     [(SndFileId, Int64, FileSize Int64, FileDigest, SbKey, CbNonce,
       FileSize Word32, ServiceName, Maybe ServiceName)
      :. (ServiceName, Maybe SbKey, Maybe CbNonce, RcvFileStatus,
          BoolInt, Maybe Int64, Maybe SndFileId, Maybe (FileSize Int64),
          Maybe FileDigest)]
-> IO (Either StoreError RcvFile)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> Only Int64
-> IO
     [(SndFileId, Int64, FileSize Int64, FileDigest, SbKey, CbNonce,
       FileSize Word32, ServiceName, Maybe ServiceName)
      :. (ServiceName, Maybe SbKey, Maybe CbNonce, RcvFileStatus,
          BoolInt, Maybe Int64, Maybe SndFileId, Maybe (FileSize Int64),
          Maybe FileDigest)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          ( [sql|
              SELECT rcv_file_entity_id, user_id, size, digest, key, nonce, chunk_size, prefix_path, tmp_path, save_path, save_file_key, save_file_nonce, status, deleted, redirect_id, redirect_entity_id, redirect_size, redirect_digest
              FROM rcv_files
              WHERE rcv_file_id = ?
            |]
#if defined(dbPostgres)
              <> " FOR UPDATE"
#endif
          )
          (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
rcvFileId)
      where
        toFile :: (RcvFileId, UserId, FileSize Int64, FileDigest, C.SbKey, C.CbNonce, FileSize Word32, FilePath, Maybe FilePath) :. (FilePath, Maybe C.SbKey, Maybe C.CbNonce, RcvFileStatus, BoolInt, Maybe DBRcvFileId, Maybe RcvFileId, Maybe (FileSize Int64), Maybe FileDigest) -> RcvFile
        toFile :: ((SndFileId, Int64, FileSize Int64, FileDigest, SbKey, CbNonce,
  FileSize Word32, ServiceName, Maybe ServiceName)
 :. (ServiceName, Maybe SbKey, Maybe CbNonce, RcvFileStatus,
     BoolInt, Maybe Int64, Maybe SndFileId, Maybe (FileSize Int64),
     Maybe FileDigest))
-> RcvFile
toFile ((SndFileId
rcvFileEntityId, Int64
userId, FileSize Int64
size, FileDigest
digest, SbKey
key, CbNonce
nonce, FileSize Word32
chunkSize, ServiceName
prefixPath, Maybe ServiceName
tmpPath) :. (ServiceName
savePath, Maybe SbKey
saveKey_, Maybe CbNonce
saveNonce_, RcvFileStatus
status, BI Bool
deleted, Maybe Int64
redirectDbId, Maybe SndFileId
redirectEntityId, Maybe (FileSize Int64)
redirectSize_, Maybe FileDigest
redirectDigest_)) =
          let cfArgs :: Maybe CryptoFileArgs
cfArgs = SbKey -> CbNonce -> CryptoFileArgs
CFArgs (SbKey -> CbNonce -> CryptoFileArgs)
-> Maybe SbKey -> Maybe (CbNonce -> CryptoFileArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SbKey
saveKey_ Maybe (CbNonce -> CryptoFileArgs)
-> Maybe CbNonce -> Maybe CryptoFileArgs
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe CbNonce
saveNonce_
              saveFile :: CryptoFile
saveFile = ServiceName -> Maybe CryptoFileArgs -> CryptoFile
CryptoFile ServiceName
savePath Maybe CryptoFileArgs
cfArgs
              redirect :: Maybe RcvFileRedirect
redirect =
                Int64 -> SndFileId -> RedirectFileInfo -> RcvFileRedirect
RcvFileRedirect
                  (Int64 -> SndFileId -> RedirectFileInfo -> RcvFileRedirect)
-> Maybe Int64
-> Maybe (SndFileId -> RedirectFileInfo -> RcvFileRedirect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
redirectDbId
                  Maybe (SndFileId -> RedirectFileInfo -> RcvFileRedirect)
-> Maybe SndFileId -> Maybe (RedirectFileInfo -> RcvFileRedirect)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe SndFileId
redirectEntityId
                  Maybe (RedirectFileInfo -> RcvFileRedirect)
-> Maybe RedirectFileInfo -> Maybe RcvFileRedirect
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FileSize Int64 -> FileDigest -> RedirectFileInfo
RedirectFileInfo (FileSize Int64 -> FileDigest -> RedirectFileInfo)
-> Maybe (FileSize Int64) -> Maybe (FileDigest -> RedirectFileInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FileSize Int64)
redirectSize_ Maybe (FileDigest -> RedirectFileInfo)
-> Maybe FileDigest -> Maybe RedirectFileInfo
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe FileDigest
redirectDigest_)
           in RcvFile {Int64
rcvFileId :: Int64
$sel:rcvFileId:RcvFile :: Int64
rcvFileId, SndFileId
$sel:rcvFileEntityId:RcvFile :: SndFileId
rcvFileEntityId :: SndFileId
rcvFileEntityId, Int64
$sel:userId:RcvFile :: Int64
userId :: Int64
userId, FileSize Int64
size :: FileSize Int64
$sel:size:RcvFile :: FileSize Int64
size, FileDigest
digest :: FileDigest
$sel:digest:RcvFile :: FileDigest
digest, SbKey
key :: SbKey
$sel:key:RcvFile :: SbKey
key, CbNonce
nonce :: CbNonce
$sel:nonce:RcvFile :: CbNonce
nonce, FileSize Word32
chunkSize :: FileSize Word32
$sel:chunkSize:RcvFile :: FileSize Word32
chunkSize, Maybe RcvFileRedirect
redirect :: Maybe RcvFileRedirect
$sel:redirect:RcvFile :: Maybe RcvFileRedirect
redirect, ServiceName
prefixPath :: ServiceName
$sel:prefixPath:RcvFile :: ServiceName
prefixPath, Maybe ServiceName
$sel:tmpPath:RcvFile :: Maybe ServiceName
tmpPath :: Maybe ServiceName
tmpPath, CryptoFile
saveFile :: CryptoFile
$sel:saveFile:RcvFile :: CryptoFile
saveFile, RcvFileStatus
status :: RcvFileStatus
$sel:status:RcvFile :: RcvFileStatus
status, Bool
deleted :: Bool
$sel:deleted:RcvFile :: Bool
deleted, $sel:chunks:RcvFile :: [RcvFileChunk]
chunks = []}
    getChunks :: RcvFileId -> UserId -> FilePath -> IO [RcvFileChunk]
    getChunks :: SndFileId -> Int64 -> ServiceName -> IO [RcvFileChunk]
getChunks SndFileId
rcvFileEntityId Int64
userId ServiceName
fileTmpPath = do
      [RcvFileChunk]
chunks <-
        ((Int64, Int, FileSize Word32, FileDigest, Maybe ServiceName)
 -> RcvFileChunk)
-> [(Int64, Int, FileSize Word32, FileDigest, Maybe ServiceName)]
-> [RcvFileChunk]
forall a b. (a -> b) -> [a] -> [b]
map (Int64, Int, FileSize Word32, FileDigest, Maybe ServiceName)
-> RcvFileChunk
toChunk
          ([(Int64, Int, FileSize Word32, FileDigest, Maybe ServiceName)]
 -> [RcvFileChunk])
-> IO
     [(Int64, Int, FileSize Word32, FileDigest, Maybe ServiceName)]
-> IO [RcvFileChunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only Int64
-> IO
     [(Int64, Int, FileSize Word32, FileDigest, Maybe ServiceName)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
            Connection
db
            [sql|
              SELECT rcv_file_chunk_id, chunk_no, chunk_size, digest, tmp_path
              FROM rcv_file_chunks
              WHERE rcv_file_id = ?
              ORDER BY chunk_no ASC
            |]
            (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
rcvFileId)
      [RcvFileChunk]
-> (RcvFileChunk -> IO RcvFileChunk) -> IO [RcvFileChunk]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [RcvFileChunk]
chunks ((RcvFileChunk -> IO RcvFileChunk) -> IO [RcvFileChunk])
-> (RcvFileChunk -> IO RcvFileChunk) -> IO [RcvFileChunk]
forall a b. (a -> b) -> a -> b
$ \chunk :: RcvFileChunk
chunk@RcvFileChunk {Int64
rcvChunkId :: Int64
$sel:rcvChunkId:RcvFileChunk :: RcvFileChunk -> Int64
rcvChunkId} -> do
        [RcvFileChunkReplica]
replicas' <- Int64 -> IO [RcvFileChunkReplica]
getChunkReplicas Int64
rcvChunkId
        RcvFileChunk -> IO RcvFileChunk
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RcvFileChunk
chunk {replicas = replicas'} :: RcvFileChunk)
      where
        toChunk :: (Int64, Int, FileSize Word32, FileDigest, Maybe FilePath) -> RcvFileChunk
        toChunk :: (Int64, Int, FileSize Word32, FileDigest, Maybe ServiceName)
-> RcvFileChunk
toChunk (Int64
rcvChunkId, Int
chunkNo, FileSize Word32
chunkSize, FileDigest
digest, Maybe ServiceName
chunkTmpPath) =
          RcvFileChunk {Int64
rcvFileId :: Int64
$sel:rcvFileId:RcvFileChunk :: Int64
rcvFileId, SndFileId
rcvFileEntityId :: SndFileId
$sel:rcvFileEntityId:RcvFileChunk :: SndFileId
rcvFileEntityId, Int64
userId :: Int64
$sel:userId:RcvFileChunk :: Int64
userId, Int64
$sel:rcvChunkId:RcvFileChunk :: Int64
rcvChunkId :: Int64
rcvChunkId, Int
chunkNo :: Int
$sel:chunkNo:RcvFileChunk :: Int
chunkNo, FileSize Word32
chunkSize :: FileSize Word32
$sel:chunkSize:RcvFileChunk :: FileSize Word32
chunkSize, FileDigest
digest :: FileDigest
$sel:digest:RcvFileChunk :: FileDigest
digest, ServiceName
fileTmpPath :: ServiceName
$sel:fileTmpPath:RcvFileChunk :: ServiceName
fileTmpPath, Maybe ServiceName
chunkTmpPath :: Maybe ServiceName
$sel:chunkTmpPath:RcvFileChunk :: Maybe ServiceName
chunkTmpPath, $sel:replicas:RcvFileChunk :: [RcvFileChunkReplica]
replicas = []}
    getChunkReplicas :: Int64 -> IO [RcvFileChunkReplica]
    getChunkReplicas :: Int64 -> IO [RcvFileChunkReplica]
getChunkReplicas Int64
chunkId = do
      ((Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64,
  Int, NonEmpty TransportHost, ServiceName, KeyHash)
 -> RcvFileChunkReplica)
-> [(Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64,
     Int, NonEmpty TransportHost, ServiceName, KeyHash)]
-> [RcvFileChunkReplica]
forall a b. (a -> b) -> [a] -> [b]
map (Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64, Int,
 NonEmpty TransportHost, ServiceName, KeyHash)
-> RcvFileChunkReplica
toReplica
        ([(Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64,
   Int, NonEmpty TransportHost, ServiceName, KeyHash)]
 -> [RcvFileChunkReplica])
-> IO
     [(Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64,
       Int, NonEmpty TransportHost, ServiceName, KeyHash)]
-> IO [RcvFileChunkReplica]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only Int64
-> IO
     [(Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64,
       Int, NonEmpty TransportHost, ServiceName, KeyHash)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT
              r.rcv_file_chunk_replica_id, r.replica_id, r.replica_key, r.received, r.delay, r.retries,
              s.xftp_host, s.xftp_port, s.xftp_key_hash
            FROM rcv_file_chunk_replicas r
            JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
            WHERE r.rcv_file_chunk_id = ?
          |]
          (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
chunkId)
      where
        toReplica :: (Int64, ChunkReplicaId, C.APrivateAuthKey, BoolInt, Maybe Int64, Int, NonEmpty TransportHost, ServiceName, C.KeyHash) -> RcvFileChunkReplica
        toReplica :: (Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64, Int,
 NonEmpty TransportHost, ServiceName, KeyHash)
-> RcvFileChunkReplica
toReplica (Int64
rcvChunkReplicaId, ChunkReplicaId
replicaId, APrivateAuthKey
replicaKey, BI Bool
received, Maybe Int64
delay, Int
retries, NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash) =
          let server :: XFTPServer
server = NonEmpty TransportHost -> ServiceName -> KeyHash -> XFTPServer
XFTPServer NonEmpty TransportHost
host ServiceName
port KeyHash
keyHash
           in RcvFileChunkReplica {Int64
rcvChunkReplicaId :: Int64
$sel:rcvChunkReplicaId:RcvFileChunkReplica :: Int64
rcvChunkReplicaId, XFTPServer
server :: XFTPServer
$sel:server:RcvFileChunkReplica :: XFTPServer
server, ChunkReplicaId
replicaId :: ChunkReplicaId
$sel:replicaId:RcvFileChunkReplica :: ChunkReplicaId
replicaId, APrivateAuthKey
replicaKey :: APrivateAuthKey
$sel:replicaKey:RcvFileChunkReplica :: APrivateAuthKey
replicaKey, Bool
received :: Bool
$sel:received:RcvFileChunkReplica :: Bool
received, Maybe Int64
delay :: Maybe Int64
$sel:delay:RcvFileChunkReplica :: Maybe Int64
delay, Int
retries :: Int
$sel:retries:RcvFileChunkReplica :: Int
retries}

updateRcvChunkReplicaDelay :: DB.Connection -> Int64 -> Int64 -> IO ()
updateRcvChunkReplicaDelay :: Connection -> Int64 -> Int64 -> IO ()
updateRcvChunkReplicaDelay Connection
db Int64
replicaId Int64
delay = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (Int64, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_file_chunk_replicas SET delay = ?, retries = retries + 1, updated_at = ? WHERE rcv_file_chunk_replica_id = ?" (Int64
delay, UTCTime
updatedAt, Int64
replicaId)

updateRcvFileChunkReceived :: DB.Connection -> Int64 -> Int64 -> FilePath -> IO ()
updateRcvFileChunkReceived :: Connection -> Int64 -> Int64 -> ServiceName -> IO ()
updateRcvFileChunkReceived Connection
db Int64
replicaId Int64
chunkId ServiceName
chunkTmpPath = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_file_chunk_replicas SET received = 1, updated_at = ? WHERE rcv_file_chunk_replica_id = ?" (UTCTime
updatedAt, Int64
replicaId)
  Connection -> Query -> (ServiceName, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_file_chunks SET tmp_path = ?, updated_at = ? WHERE rcv_file_chunk_id = ?" (ServiceName
chunkTmpPath, UTCTime
updatedAt, Int64
chunkId)

updateRcvFileStatus :: DB.Connection -> DBRcvFileId -> RcvFileStatus -> IO ()
updateRcvFileStatus :: Connection -> Int64 -> RcvFileStatus -> IO ()
updateRcvFileStatus Connection
db Int64
rcvFileId RcvFileStatus
status = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (RcvFileStatus, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_files SET status = ?, updated_at = ? WHERE rcv_file_id = ?" (RcvFileStatus
status, UTCTime
updatedAt, Int64
rcvFileId)

updateRcvFileError :: DB.Connection -> DBRcvFileId -> String -> IO ()
updateRcvFileError :: Connection -> Int64 -> ServiceName -> IO ()
updateRcvFileError Connection
db Int64
rcvFileId ServiceName
errStr = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (ServiceName, RcvFileStatus, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_files SET tmp_path = NULL, error = ?, status = ?, updated_at = ? WHERE rcv_file_id = ?" (ServiceName
errStr, RcvFileStatus
RFSError, UTCTime
updatedAt, Int64
rcvFileId)

updateRcvFileComplete :: DB.Connection -> DBRcvFileId -> IO ()
updateRcvFileComplete :: Connection -> Int64 -> IO ()
updateRcvFileComplete Connection
db Int64
rcvFileId = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (RcvFileStatus, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_files SET tmp_path = NULL, status = ?, updated_at = ? WHERE rcv_file_id = ?" (RcvFileStatus
RFSComplete, UTCTime
updatedAt, Int64
rcvFileId)

updateRcvFileRedirect :: DB.Connection -> DBRcvFileId -> FileDescription 'FRecipient -> IO (Either StoreError ())
updateRcvFileRedirect :: Connection
-> Int64
-> FileDescription 'FRecipient
-> IO (Either StoreError ())
updateRcvFileRedirect Connection
db Int64
rcvFileId FileDescription {SbKey
$sel:key:FileDescription :: forall (p :: FileParty). FileDescription p -> SbKey
key :: SbKey
key, CbNonce
$sel:nonce:FileDescription :: forall (p :: FileParty). FileDescription p -> CbNonce
nonce :: CbNonce
nonce, FileSize Word32
$sel:chunkSize:FileDescription :: forall (p :: FileParty). FileDescription p -> FileSize Word32
chunkSize :: FileSize Word32
chunkSize, [FileChunk]
$sel:chunks:FileDescription :: forall (p :: FileParty). FileDescription p -> [FileChunk]
chunks :: [FileChunk]
chunks} = ExceptT StoreError IO () -> IO (Either StoreError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO () -> IO (Either StoreError ()))
-> ExceptT StoreError IO () -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ do
  UTCTime
updatedAt <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> Query
-> (SbKey, CbNonce, FileSize Word32, UTCTime, Int64)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_files SET key = ?, nonce = ?, chunk_size = ?, updated_at = ? WHERE rcv_file_id = ?" (SbKey
key, CbNonce
nonce, FileSize Word32
chunkSize, UTCTime
updatedAt, Int64
rcvFileId)
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ [FileChunk] -> (FileChunk -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FileChunk]
chunks ((FileChunk -> IO ()) -> IO ()) -> (FileChunk -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \fc :: FileChunk
fc@FileChunk {[FileChunkReplica]
$sel:replicas:FileChunk :: FileChunk -> [FileChunkReplica]
replicas :: [FileChunkReplica]
replicas} -> do
    Int64
chunkId <- Connection -> FileChunk -> Int64 -> IO Int64
insertRcvFileChunk Connection
db FileChunk
fc Int64
rcvFileId
    [(Int, FileChunkReplica)]
-> ((Int, FileChunkReplica) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [FileChunkReplica] -> [(Int, FileChunkReplica)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [FileChunkReplica]
replicas) (((Int, FileChunkReplica) -> IO ()) -> IO ())
-> ((Int, FileChunkReplica) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
rno, FileChunkReplica
replica) -> Connection -> Int -> FileChunkReplica -> Int64 -> IO ()
insertRcvFileChunkReplica Connection
db Int
rno FileChunkReplica
replica Int64
chunkId

updateRcvFileNoTmpPath :: DB.Connection -> DBRcvFileId -> IO ()
updateRcvFileNoTmpPath :: Connection -> Int64 -> IO ()
updateRcvFileNoTmpPath Connection
db Int64
rcvFileId = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_files SET tmp_path = NULL, updated_at = ? WHERE rcv_file_id = ?" (UTCTime
updatedAt, Int64
rcvFileId)

updateRcvFileDeleted :: DB.Connection -> DBRcvFileId -> IO ()
updateRcvFileDeleted :: Connection -> Int64 -> IO ()
updateRcvFileDeleted Connection
db Int64
rcvFileId = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_files SET deleted = 1, updated_at = ? WHERE rcv_file_id = ?" (UTCTime
updatedAt, Int64
rcvFileId)

deleteRcvFile' :: DB.Connection -> DBRcvFileId -> IO ()
deleteRcvFile' :: Connection -> Int64 -> IO ()
deleteRcvFile' Connection
db Int64
rcvFileId =
  Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM rcv_files WHERE rcv_file_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
rcvFileId)

getNextRcvChunkToDownload :: DB.Connection -> XFTPServer -> NominalDiffTime -> IO (Either StoreError (Maybe (RcvFileChunk, Bool, Maybe RcvFileId)))
getNextRcvChunkToDownload :: Connection
-> XFTPServer
-> NominalDiffTime
-> IO
     (Either StoreError (Maybe (RcvFileChunk, Bool, Maybe SndFileId)))
getNextRcvChunkToDownload Connection
db server :: XFTPServer
server@ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port, KeyHash
$sel:keyHash:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> KeyHash
keyHash :: KeyHash
keyHash} NominalDiffTime
ttl = do
  ServiceName
-> IO (Maybe (Int64, Int64))
-> ((Int64, Int64)
    -> IO (Either StoreError (RcvFileChunk, Bool, Maybe SndFileId)))
-> ((Int64, Int64) -> IO ())
-> IO
     (Either StoreError (Maybe (RcvFileChunk, Bool, Maybe SndFileId)))
forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> IO (Maybe i)
-> (i -> IO (Either e a))
-> (i -> IO ())
-> IO (Either e (Maybe a))
getWorkItem ServiceName
"rcv_file_download" IO (Maybe (Int64, Int64))
getReplicaId (Int64, Int64)
-> IO (Either StoreError (RcvFileChunk, Bool, Maybe SndFileId))
getChunkData (Connection -> Int64 -> IO ()
markRcvFileFailed Connection
db (Int64 -> IO ())
-> ((Int64, Int64) -> Int64) -> (Int64, Int64) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64, Int64) -> Int64
forall a b. (a, b) -> b
snd)
  where
    getReplicaId :: IO (Maybe (Int64, DBRcvFileId))
    getReplicaId :: IO (Maybe (Int64, Int64))
getReplicaId = do
      UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
      ((Int64, Int64) -> (Int64, Int64))
-> IO [(Int64, Int64)] -> IO (Maybe (Int64, Int64))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (Int64, Int64) -> (Int64, Int64)
forall a. a -> a
id (IO [(Int64, Int64)] -> IO (Maybe (Int64, Int64)))
-> IO [(Int64, Int64)] -> IO (Maybe (Int64, Int64))
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, KeyHash, RcvFileStatus,
    UTCTime)
-> IO [(Int64, Int64)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT r.rcv_file_chunk_replica_id, f.rcv_file_id
            FROM rcv_file_chunk_replicas r
            JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
            JOIN rcv_file_chunks c ON c.rcv_file_chunk_id = r.rcv_file_chunk_id
            JOIN rcv_files f ON f.rcv_file_id = c.rcv_file_id
            WHERE s.xftp_host = ? AND s.xftp_port = ? AND s.xftp_key_hash = ?
              AND r.received = 0 AND r.replica_number = 1
              AND f.status = ? AND f.deleted = 0 AND f.created_at >= ?
              AND f.failed = 0
            ORDER BY r.retries ASC, r.created_at ASC
            LIMIT 1
          |]
          (NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash, RcvFileStatus
RFSReceiving, UTCTime
cutoffTs)
    getChunkData :: (Int64, DBRcvFileId) -> IO (Either StoreError (RcvFileChunk, Bool, Maybe RcvFileId))
    getChunkData :: (Int64, Int64)
-> IO (Either StoreError (RcvFileChunk, Bool, Maybe SndFileId))
getChunkData (Int64
rcvFileChunkReplicaId, Int64
_fileId) =
      (((Int64, SndFileId, Int64, Int64, Int, FileSize Word32,
   FileDigest, ServiceName, Maybe ServiceName)
  :. ((Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64,
       Int)
      :. (BoolInt, Maybe SndFileId)))
 -> (RcvFileChunk, Bool, Maybe SndFileId))
-> StoreError
-> IO
     [(Int64, SndFileId, Int64, Int64, Int, FileSize Word32, FileDigest,
       ServiceName, Maybe ServiceName)
      :. ((Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64,
           Int)
          :. (BoolInt, Maybe SndFileId))]
-> IO (Either StoreError (RcvFileChunk, Bool, Maybe SndFileId))
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((Int64, SndFileId, Int64, Int64, Int, FileSize Word32, FileDigest,
  ServiceName, Maybe ServiceName)
 :. ((Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64,
      Int)
     :. (BoolInt, Maybe SndFileId)))
-> (RcvFileChunk, Bool, Maybe SndFileId)
toChunk StoreError
SEFileNotFound (IO
   [(Int64, SndFileId, Int64, Int64, Int, FileSize Word32, FileDigest,
     ServiceName, Maybe ServiceName)
    :. ((Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64,
         Int)
        :. (BoolInt, Maybe SndFileId))]
 -> IO (Either StoreError (RcvFileChunk, Bool, Maybe SndFileId)))
-> IO
     [(Int64, SndFileId, Int64, Int64, Int, FileSize Word32, FileDigest,
       ServiceName, Maybe ServiceName)
      :. ((Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64,
           Int)
          :. (BoolInt, Maybe SndFileId))]
-> IO (Either StoreError (RcvFileChunk, Bool, Maybe SndFileId))
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> Only Int64
-> IO
     [(Int64, SndFileId, Int64, Int64, Int, FileSize Word32, FileDigest,
       ServiceName, Maybe ServiceName)
      :. ((Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64,
           Int)
          :. (BoolInt, Maybe SndFileId))]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT
              f.rcv_file_id, f.rcv_file_entity_id, f.user_id, c.rcv_file_chunk_id, c.chunk_no, c.chunk_size, c.digest, f.tmp_path, c.tmp_path,
              r.rcv_file_chunk_replica_id, r.replica_id, r.replica_key, r.received, r.delay, r.retries,
              f.approved_relays, f.redirect_entity_id
            FROM rcv_file_chunk_replicas r
            JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
            JOIN rcv_file_chunks c ON c.rcv_file_chunk_id = r.rcv_file_chunk_id
            JOIN rcv_files f ON f.rcv_file_id = c.rcv_file_id
            WHERE r.rcv_file_chunk_replica_id = ?
          |]
          (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
rcvFileChunkReplicaId)
      where
        toChunk :: ((DBRcvFileId, RcvFileId, UserId, Int64, Int, FileSize Word32, FileDigest, FilePath, Maybe FilePath) :. (Int64, ChunkReplicaId, C.APrivateAuthKey, BoolInt, Maybe Int64, Int) :. (BoolInt, Maybe RcvFileId)) -> (RcvFileChunk, Bool, Maybe RcvFileId)
        toChunk :: ((Int64, SndFileId, Int64, Int64, Int, FileSize Word32, FileDigest,
  ServiceName, Maybe ServiceName)
 :. ((Int64, ChunkReplicaId, APrivateAuthKey, BoolInt, Maybe Int64,
      Int)
     :. (BoolInt, Maybe SndFileId)))
-> (RcvFileChunk, Bool, Maybe SndFileId)
toChunk ((Int64
rcvFileId, SndFileId
rcvFileEntityId, Int64
userId, Int64
rcvChunkId, Int
chunkNo, FileSize Word32
chunkSize, FileDigest
digest, ServiceName
fileTmpPath, Maybe ServiceName
chunkTmpPath) :. (Int64
rcvChunkReplicaId, ChunkReplicaId
replicaId, APrivateAuthKey
replicaKey, BI Bool
received, Maybe Int64
delay, Int
retries) :. (BI Bool
approvedRelays, Maybe SndFileId
redirectEntityId_)) =
          ( RcvFileChunk
              { Int64
$sel:rcvFileId:RcvFileChunk :: Int64
rcvFileId :: Int64
rcvFileId,
                SndFileId
$sel:rcvFileEntityId:RcvFileChunk :: SndFileId
rcvFileEntityId :: SndFileId
rcvFileEntityId,
                Int64
$sel:userId:RcvFileChunk :: Int64
userId :: Int64
userId,
                Int64
$sel:rcvChunkId:RcvFileChunk :: Int64
rcvChunkId :: Int64
rcvChunkId,
                Int
$sel:chunkNo:RcvFileChunk :: Int
chunkNo :: Int
chunkNo,
                FileSize Word32
$sel:chunkSize:RcvFileChunk :: FileSize Word32
chunkSize :: FileSize Word32
chunkSize,
                FileDigest
$sel:digest:RcvFileChunk :: FileDigest
digest :: FileDigest
digest,
                ServiceName
$sel:fileTmpPath:RcvFileChunk :: ServiceName
fileTmpPath :: ServiceName
fileTmpPath,
                Maybe ServiceName
$sel:chunkTmpPath:RcvFileChunk :: Maybe ServiceName
chunkTmpPath :: Maybe ServiceName
chunkTmpPath,
                $sel:replicas:RcvFileChunk :: [RcvFileChunkReplica]
replicas = [RcvFileChunkReplica {Int64
$sel:rcvChunkReplicaId:RcvFileChunkReplica :: Int64
rcvChunkReplicaId :: Int64
rcvChunkReplicaId, XFTPServer
$sel:server:RcvFileChunkReplica :: XFTPServer
server :: XFTPServer
server, ChunkReplicaId
$sel:replicaId:RcvFileChunkReplica :: ChunkReplicaId
replicaId :: ChunkReplicaId
replicaId, APrivateAuthKey
$sel:replicaKey:RcvFileChunkReplica :: APrivateAuthKey
replicaKey :: APrivateAuthKey
replicaKey, Bool
$sel:received:RcvFileChunkReplica :: Bool
received :: Bool
received, Maybe Int64
$sel:delay:RcvFileChunkReplica :: Maybe Int64
delay :: Maybe Int64
delay, Int
$sel:retries:RcvFileChunkReplica :: Int
retries :: Int
retries}]
              },
            Bool
approvedRelays,
            Maybe SndFileId
redirectEntityId_
          )

getNextRcvFileToDecrypt :: DB.Connection -> NominalDiffTime -> IO (Either StoreError (Maybe RcvFile))
getNextRcvFileToDecrypt :: Connection
-> NominalDiffTime -> IO (Either StoreError (Maybe RcvFile))
getNextRcvFileToDecrypt Connection
db NominalDiffTime
ttl =
  ServiceName
-> IO (Maybe Int64)
-> (Int64 -> IO (Either StoreError RcvFile))
-> (Int64 -> IO ())
-> IO (Either StoreError (Maybe RcvFile))
forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> IO (Maybe i)
-> (i -> IO (Either e a))
-> (i -> IO ())
-> IO (Either e (Maybe a))
getWorkItem ServiceName
"rcv_file_decrypt" IO (Maybe Int64)
getFileId (Connection -> Int64 -> IO (Either StoreError RcvFile)
getRcvFile Connection
db) (Connection -> Int64 -> IO ()
markRcvFileFailed Connection
db)
  where
    getFileId :: IO (Maybe DBRcvFileId)
    getFileId :: IO (Maybe Int64)
getFileId = do
      UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
      (Only Int64 -> Int64) -> IO [Only Int64] -> IO (Maybe Int64)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly (IO [Only Int64] -> IO (Maybe Int64))
-> IO [Only Int64] -> IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (RcvFileStatus, RcvFileStatus, UTCTime)
-> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT rcv_file_id
            FROM rcv_files
            WHERE status IN (?,?) AND deleted = 0 AND created_at >= ?
              AND failed = 0
            ORDER BY created_at ASC LIMIT 1
          |]
          (RcvFileStatus
RFSReceived, RcvFileStatus
RFSDecrypting, UTCTime
cutoffTs)

markRcvFileFailed :: DB.Connection -> DBRcvFileId -> IO ()
markRcvFileFailed :: Connection -> Int64 -> IO ()
markRcvFileFailed Connection
db Int64
fileId = do
  Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_files SET failed = 1 WHERE rcv_file_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
fileId)

getPendingRcvFilesServers :: DB.Connection -> NominalDiffTime -> IO [XFTPServer]
getPendingRcvFilesServers :: Connection -> NominalDiffTime -> IO [XFTPServer]
getPendingRcvFilesServers Connection
db NominalDiffTime
ttl = do
  UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  ((NonEmpty TransportHost, ServiceName, KeyHash) -> XFTPServer)
-> [(NonEmpty TransportHost, ServiceName, KeyHash)] -> [XFTPServer]
forall a b. (a -> b) -> [a] -> [b]
map (NonEmpty TransportHost, ServiceName, KeyHash) -> XFTPServer
toXFTPServer
    ([(NonEmpty TransportHost, ServiceName, KeyHash)] -> [XFTPServer])
-> IO [(NonEmpty TransportHost, ServiceName, KeyHash)]
-> IO [XFTPServer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (RcvFileStatus, UTCTime)
-> IO [(NonEmpty TransportHost, ServiceName, KeyHash)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT DISTINCT
          s.xftp_host, s.xftp_port, s.xftp_key_hash
        FROM rcv_file_chunk_replicas r
        JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
        JOIN rcv_file_chunks c ON c.rcv_file_chunk_id = r.rcv_file_chunk_id
        JOIN rcv_files f ON f.rcv_file_id = c.rcv_file_id
        WHERE r.received = 0 AND r.replica_number = 1
          AND f.status = ? AND f.deleted = 0 AND f.created_at >= ?
      |]
      (RcvFileStatus
RFSReceiving, UTCTime
cutoffTs)

toXFTPServer :: (NonEmpty TransportHost, ServiceName, C.KeyHash) -> XFTPServer
toXFTPServer :: (NonEmpty TransportHost, ServiceName, KeyHash) -> XFTPServer
toXFTPServer (NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash) = NonEmpty TransportHost -> ServiceName -> KeyHash -> XFTPServer
XFTPServer NonEmpty TransportHost
host ServiceName
port KeyHash
keyHash

getCleanupRcvFilesTmpPaths :: DB.Connection -> IO [(DBRcvFileId, RcvFileId, FilePath)]
getCleanupRcvFilesTmpPaths :: Connection -> IO [(Int64, SndFileId, ServiceName)]
getCleanupRcvFilesTmpPaths Connection
db =
  Connection
-> Query
-> (RcvFileStatus, RcvFileStatus)
-> IO [(Int64, SndFileId, ServiceName)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
    Connection
db
    [sql|
      SELECT rcv_file_id, rcv_file_entity_id, tmp_path
      FROM rcv_files
      WHERE status IN (?,?) AND tmp_path IS NOT NULL
    |]
    (RcvFileStatus
RFSComplete, RcvFileStatus
RFSError)

getCleanupRcvFilesDeleted :: DB.Connection -> IO [(DBRcvFileId, RcvFileId, FilePath)]
getCleanupRcvFilesDeleted :: Connection -> IO [(Int64, SndFileId, ServiceName)]
getCleanupRcvFilesDeleted Connection
db =
  Connection -> Query -> IO [(Int64, SndFileId, ServiceName)]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_
    Connection
db
    [sql|
      SELECT rcv_file_id, rcv_file_entity_id, prefix_path
      FROM rcv_files
      WHERE deleted = 1
    |]

getRcvFilesExpired :: DB.Connection -> NominalDiffTime -> IO [(DBRcvFileId, RcvFileId, FilePath)]
getRcvFilesExpired :: Connection
-> NominalDiffTime -> IO [(Int64, SndFileId, ServiceName)]
getRcvFilesExpired Connection
db NominalDiffTime
ttl = do
  UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  Connection
-> Query -> Only UTCTime -> IO [(Int64, SndFileId, ServiceName)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
    Connection
db
    [sql|
      SELECT rcv_file_id, rcv_file_entity_id, prefix_path
      FROM rcv_files
      WHERE created_at < ?
    |]
    (UTCTime -> Only UTCTime
forall a. a -> Only a
Only UTCTime
cutoffTs)

createSndFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> CryptoFile -> Int -> FilePath -> C.SbKey -> C.CbNonce -> Maybe RedirectFileInfo -> IO (Either StoreError SndFileId)
createSndFile :: Connection
-> TVar ChaChaDRG
-> Int64
-> CryptoFile
-> Int
-> ServiceName
-> SbKey
-> CbNonce
-> Maybe RedirectFileInfo
-> IO (Either StoreError SndFileId)
createSndFile Connection
db TVar ChaChaDRG
gVar Int64
userId (CryptoFile ServiceName
path Maybe CryptoFileArgs
cfArgs) Int
numRecipients ServiceName
prefixPath SbKey
key CbNonce
nonce Maybe RedirectFileInfo
redirect_ =
  Connection
-> TVar ChaChaDRG
-> (SndFileId -> IO ())
-> IO (Either StoreError SndFileId)
createWithRandomId Connection
db TVar ChaChaDRG
gVar ((SndFileId -> IO ()) -> IO (Either StoreError SndFileId))
-> (SndFileId -> IO ()) -> IO (Either StoreError SndFileId)
forall a b. (a -> b) -> a -> b
$ \SndFileId
sndFileEntityId ->
    Connection
-> Query
-> ((Binary SndFileId, Int64, ServiceName, Maybe SbKey,
     Maybe CbNonce, Int)
    :. (ServiceName, SbKey, CbNonce, SndFileStatus,
        Maybe (FileSize Int64), Maybe FileDigest))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT INTO snd_files (snd_file_entity_id, user_id, path, src_file_key, src_file_nonce, num_recipients, prefix_path, key, nonce, status, redirect_size, redirect_digest) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)"
      ((SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
sndFileEntityId, Int64
userId, ServiceName
path, CryptoFileArgs -> SbKey
fileKey (CryptoFileArgs -> SbKey) -> Maybe CryptoFileArgs -> Maybe SbKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CryptoFileArgs
cfArgs, CryptoFileArgs -> CbNonce
fileNonce (CryptoFileArgs -> CbNonce)
-> Maybe CryptoFileArgs -> Maybe CbNonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CryptoFileArgs
cfArgs, Int
numRecipients) (Binary SndFileId, Int64, ServiceName, Maybe SbKey, Maybe CbNonce,
 Int)
-> (ServiceName, SbKey, CbNonce, SndFileStatus,
    Maybe (FileSize Int64), Maybe FileDigest)
-> (Binary SndFileId, Int64, ServiceName, Maybe SbKey,
    Maybe CbNonce, Int)
   :. (ServiceName, SbKey, CbNonce, SndFileStatus,
       Maybe (FileSize Int64), Maybe FileDigest)
forall h t. h -> t -> h :. t
:. (ServiceName
prefixPath, SbKey
key, CbNonce
nonce, SndFileStatus
SFSNew, Maybe (FileSize Int64)
redirectSize_, Maybe FileDigest
redirectDigest_))
  where
    (Maybe (FileSize Int64)
redirectSize_, Maybe FileDigest
redirectDigest_) =
      case Maybe RedirectFileInfo
redirect_ of
        Maybe RedirectFileInfo
Nothing -> (Maybe (FileSize Int64)
forall a. Maybe a
Nothing, Maybe FileDigest
forall a. Maybe a
Nothing)
        Just RedirectFileInfo {FileSize Int64
$sel:size:RedirectFileInfo :: RedirectFileInfo -> FileSize Int64
size :: FileSize Int64
size, FileDigest
$sel:digest:RedirectFileInfo :: RedirectFileInfo -> FileDigest
digest :: FileDigest
digest} -> (FileSize Int64 -> Maybe (FileSize Int64)
forall a. a -> Maybe a
Just FileSize Int64
size, FileDigest -> Maybe FileDigest
forall a. a -> Maybe a
Just FileDigest
digest)

getSndFileByEntityId :: DB.Connection -> SndFileId -> IO (Either StoreError SndFile)
getSndFileByEntityId :: Connection -> SndFileId -> IO (Either StoreError SndFile)
getSndFileByEntityId Connection
db SndFileId
sndFileEntityId = ExceptT StoreError IO SndFile -> IO (Either StoreError SndFile)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO SndFile -> IO (Either StoreError SndFile))
-> ExceptT StoreError IO SndFile -> IO (Either StoreError SndFile)
forall a b. (a -> b) -> a -> b
$ do
  Int64
sndFileId <- IO (Either StoreError Int64) -> ExceptT StoreError IO Int64
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError Int64) -> ExceptT StoreError IO Int64)
-> IO (Either StoreError Int64) -> ExceptT StoreError IO Int64
forall a b. (a -> b) -> a -> b
$ Connection -> SndFileId -> IO (Either StoreError Int64)
getSndFileIdByEntityId_ Connection
db SndFileId
sndFileEntityId
  IO (Either StoreError SndFile) -> ExceptT StoreError IO SndFile
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError SndFile) -> ExceptT StoreError IO SndFile)
-> IO (Either StoreError SndFile) -> ExceptT StoreError IO SndFile
forall a b. (a -> b) -> a -> b
$ Connection -> Int64 -> IO (Either StoreError SndFile)
getSndFile Connection
db Int64
sndFileId

getSndFileIdByEntityId_ :: DB.Connection -> SndFileId -> IO (Either StoreError DBSndFileId)
getSndFileIdByEntityId_ :: Connection -> SndFileId -> IO (Either StoreError Int64)
getSndFileIdByEntityId_ Connection
db SndFileId
sndFileEntityId =
  (Only Int64 -> Int64)
-> StoreError -> IO [Only Int64] -> IO (Either StoreError Int64)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly StoreError
SEFileNotFound (IO [Only Int64] -> IO (Either StoreError Int64))
-> IO [Only Int64] -> IO (Either StoreError Int64)
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> Only (Binary SndFileId) -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT snd_file_id FROM snd_files WHERE snd_file_entity_id = ?" (Binary SndFileId -> Only (Binary SndFileId)
forall a. a -> Only a
Only (SndFileId -> Binary SndFileId
forall a. a -> Binary a
Binary SndFileId
sndFileEntityId))

lockSndFileForUpdate :: DB.Connection -> DBSndFileId -> IO ()
lockSndFileForUpdate :: Connection -> Int64 -> IO ()
lockSndFileForUpdate Connection
db Int64
sndFileId = do
#if defined(dbPostgres)
  _ :: [Only Int] <- DB.query db "SELECT 1 FROM snd_files WHERE snd_file_id = ? FOR UPDATE" (Only sndFileId)
#endif
  () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

getSndFile :: DB.Connection -> DBSndFileId -> IO (Either StoreError SndFile)
getSndFile :: Connection -> Int64 -> IO (Either StoreError SndFile)
getSndFile Connection
db Int64
sndFileId = ExceptT StoreError IO SndFile -> IO (Either StoreError SndFile)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO SndFile -> IO (Either StoreError SndFile))
-> ExceptT StoreError IO SndFile -> IO (Either StoreError SndFile)
forall a b. (a -> b) -> a -> b
$ do
  f :: SndFile
f@SndFile {SndFileId
sndFileEntityId :: SndFileId
$sel:sndFileEntityId:SndFile :: SndFile -> SndFileId
sndFileEntityId, Int64
userId :: Int64
$sel:userId:SndFile :: SndFile -> Int64
userId, Int
numRecipients :: Int
$sel:numRecipients:SndFile :: SndFile -> Int
numRecipients, Maybe ServiceName
prefixPath :: Maybe ServiceName
$sel:prefixPath:SndFile :: SndFile -> Maybe ServiceName
prefixPath} <- IO (Either StoreError SndFile) -> ExceptT StoreError IO SndFile
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT IO (Either StoreError SndFile)
getFile
  [SndFileChunk]
chunks <- ExceptT StoreError IO [SndFileChunk]
-> (ServiceName -> ExceptT StoreError IO [SndFileChunk])
-> Maybe ServiceName
-> ExceptT StoreError IO [SndFileChunk]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([SndFileChunk] -> ExceptT StoreError IO [SndFileChunk]
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [SndFileChunk] -> ExceptT StoreError IO [SndFileChunk]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SndFileChunk] -> ExceptT StoreError IO [SndFileChunk])
-> (ServiceName -> IO [SndFileChunk])
-> ServiceName
-> ExceptT StoreError IO [SndFileChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndFileId -> Int64 -> Int -> ServiceName -> IO [SndFileChunk]
getChunks SndFileId
sndFileEntityId Int64
userId Int
numRecipients) Maybe ServiceName
prefixPath
  SndFile -> ExceptT StoreError IO SndFile
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SndFile
f {chunks} :: SndFile)
  where
    getFile :: IO (Either StoreError SndFile)
    getFile :: IO (Either StoreError SndFile)
getFile = do
      (((SndFileId, Int64, ServiceName, Maybe SbKey, Maybe CbNonce, Int,
   Maybe FileDigest, Maybe ServiceName, SbKey, CbNonce)
  :. (SndFileStatus, BoolInt, Maybe (FileSize Int64),
      Maybe FileDigest))
 -> SndFile)
-> StoreError
-> IO
     [(SndFileId, Int64, ServiceName, Maybe SbKey, Maybe CbNonce, Int,
       Maybe FileDigest, Maybe ServiceName, SbKey, CbNonce)
      :. (SndFileStatus, BoolInt, Maybe (FileSize Int64),
          Maybe FileDigest)]
-> IO (Either StoreError SndFile)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((SndFileId, Int64, ServiceName, Maybe SbKey, Maybe CbNonce, Int,
  Maybe FileDigest, Maybe ServiceName, SbKey, CbNonce)
 :. (SndFileStatus, BoolInt, Maybe (FileSize Int64),
     Maybe FileDigest))
-> SndFile
toFile StoreError
SEFileNotFound (IO
   [(SndFileId, Int64, ServiceName, Maybe SbKey, Maybe CbNonce, Int,
     Maybe FileDigest, Maybe ServiceName, SbKey, CbNonce)
    :. (SndFileStatus, BoolInt, Maybe (FileSize Int64),
        Maybe FileDigest)]
 -> IO (Either StoreError SndFile))
-> IO
     [(SndFileId, Int64, ServiceName, Maybe SbKey, Maybe CbNonce, Int,
       Maybe FileDigest, Maybe ServiceName, SbKey, CbNonce)
      :. (SndFileStatus, BoolInt, Maybe (FileSize Int64),
          Maybe FileDigest)]
-> IO (Either StoreError SndFile)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> Only Int64
-> IO
     [(SndFileId, Int64, ServiceName, Maybe SbKey, Maybe CbNonce, Int,
       Maybe FileDigest, Maybe ServiceName, SbKey, CbNonce)
      :. (SndFileStatus, BoolInt, Maybe (FileSize Int64),
          Maybe FileDigest)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          ( [sql|
              SELECT snd_file_entity_id, user_id, path, src_file_key, src_file_nonce, num_recipients, digest, prefix_path, key, nonce, status, deleted, redirect_size, redirect_digest
              FROM snd_files
              WHERE snd_file_id = ?
            |]
#if defined(dbPostgres)
              <> " FOR UPDATE"
#endif
          )
          (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
sndFileId)
      where
        toFile :: (SndFileId, UserId, FilePath, Maybe C.SbKey, Maybe C.CbNonce, Int, Maybe FileDigest, Maybe FilePath, C.SbKey, C.CbNonce) :. (SndFileStatus, BoolInt, Maybe (FileSize Int64), Maybe FileDigest) -> SndFile
        toFile :: ((SndFileId, Int64, ServiceName, Maybe SbKey, Maybe CbNonce, Int,
  Maybe FileDigest, Maybe ServiceName, SbKey, CbNonce)
 :. (SndFileStatus, BoolInt, Maybe (FileSize Int64),
     Maybe FileDigest))
-> SndFile
toFile ((SndFileId
sndFileEntityId, Int64
userId, ServiceName
srcPath, Maybe SbKey
srcKey_, Maybe CbNonce
srcNonce_, Int
numRecipients, Maybe FileDigest
digest, Maybe ServiceName
prefixPath, SbKey
key, CbNonce
nonce) :. (SndFileStatus
status, BI Bool
deleted, Maybe (FileSize Int64)
redirectSize_, Maybe FileDigest
redirectDigest_)) =
          let cfArgs :: Maybe CryptoFileArgs
cfArgs = SbKey -> CbNonce -> CryptoFileArgs
CFArgs (SbKey -> CbNonce -> CryptoFileArgs)
-> Maybe SbKey -> Maybe (CbNonce -> CryptoFileArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SbKey
srcKey_ Maybe (CbNonce -> CryptoFileArgs)
-> Maybe CbNonce -> Maybe CryptoFileArgs
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe CbNonce
srcNonce_
              srcFile :: CryptoFile
srcFile = ServiceName -> Maybe CryptoFileArgs -> CryptoFile
CryptoFile ServiceName
srcPath Maybe CryptoFileArgs
cfArgs
              redirect :: Maybe RedirectFileInfo
redirect = FileSize Int64 -> FileDigest -> RedirectFileInfo
RedirectFileInfo (FileSize Int64 -> FileDigest -> RedirectFileInfo)
-> Maybe (FileSize Int64) -> Maybe (FileDigest -> RedirectFileInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FileSize Int64)
redirectSize_ Maybe (FileDigest -> RedirectFileInfo)
-> Maybe FileDigest -> Maybe RedirectFileInfo
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe FileDigest
redirectDigest_
           in SndFile {Int64
sndFileId :: Int64
$sel:sndFileId:SndFile :: Int64
sndFileId, SndFileId
$sel:sndFileEntityId:SndFile :: SndFileId
sndFileEntityId :: SndFileId
sndFileEntityId, Int64
$sel:userId:SndFile :: Int64
userId :: Int64
userId, CryptoFile
srcFile :: CryptoFile
$sel:srcFile:SndFile :: CryptoFile
srcFile, Int
$sel:numRecipients:SndFile :: Int
numRecipients :: Int
numRecipients, Maybe FileDigest
digest :: Maybe FileDigest
$sel:digest:SndFile :: Maybe FileDigest
digest, Maybe ServiceName
$sel:prefixPath:SndFile :: Maybe ServiceName
prefixPath :: Maybe ServiceName
prefixPath, SbKey
key :: SbKey
$sel:key:SndFile :: SbKey
key, CbNonce
nonce :: CbNonce
$sel:nonce:SndFile :: CbNonce
nonce, SndFileStatus
status :: SndFileStatus
$sel:status:SndFile :: SndFileStatus
status, Bool
deleted :: Bool
$sel:deleted:SndFile :: Bool
deleted, Maybe RedirectFileInfo
redirect :: Maybe RedirectFileInfo
$sel:redirect:SndFile :: Maybe RedirectFileInfo
redirect, $sel:chunks:SndFile :: [SndFileChunk]
chunks = []}
    getChunks :: SndFileId -> UserId -> Int -> FilePath -> IO [SndFileChunk]
    getChunks :: SndFileId -> Int64 -> Int -> ServiceName -> IO [SndFileChunk]
getChunks SndFileId
sndFileEntityId Int64
userId Int
numRecipients ServiceName
filePrefixPath = do
      [SndFileChunk]
chunks <-
        ((Int64, Int, Int64, Word32, FileDigest) -> SndFileChunk)
-> [(Int64, Int, Int64, Word32, FileDigest)] -> [SndFileChunk]
forall a b. (a -> b) -> [a] -> [b]
map (Int64, Int, Int64, Word32, FileDigest) -> SndFileChunk
toChunk
          ([(Int64, Int, Int64, Word32, FileDigest)] -> [SndFileChunk])
-> IO [(Int64, Int, Int64, Word32, FileDigest)]
-> IO [SndFileChunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only Int64
-> IO [(Int64, Int, Int64, Word32, FileDigest)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
            Connection
db
            [sql|
              SELECT snd_file_chunk_id, chunk_no, chunk_offset, chunk_size, digest
              FROM snd_file_chunks
              WHERE snd_file_id = ?
            |]
            (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
sndFileId)
      [SndFileChunk]
-> (SndFileChunk -> IO SndFileChunk) -> IO [SndFileChunk]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SndFileChunk]
chunks ((SndFileChunk -> IO SndFileChunk) -> IO [SndFileChunk])
-> (SndFileChunk -> IO SndFileChunk) -> IO [SndFileChunk]
forall a b. (a -> b) -> a -> b
$ \chunk :: SndFileChunk
chunk@SndFileChunk {Int64
sndChunkId :: Int64
$sel:sndChunkId:SndFileChunk :: SndFileChunk -> Int64
sndChunkId} -> do
        [SndFileChunkReplica]
replicas' <- Int64 -> IO [SndFileChunkReplica]
getChunkReplicas Int64
sndChunkId
        SndFileChunk -> IO SndFileChunk
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SndFileChunk
chunk {replicas = replicas'} :: SndFileChunk)
      where
        toChunk :: (Int64, Int, Int64, Word32, FileDigest) -> SndFileChunk
        toChunk :: (Int64, Int, Int64, Word32, FileDigest) -> SndFileChunk
toChunk (Int64
sndChunkId, Int
chunkNo, Int64
chunkOffset, Word32
chunkSize, FileDigest
digest) =
          let chunkSpec :: XFTPChunkSpec
chunkSpec = XFTPChunkSpec {$sel:filePath:XFTPChunkSpec :: ServiceName
filePath = ServiceName -> ServiceName
sndFileEncPath ServiceName
filePrefixPath, Int64
chunkOffset :: Int64
$sel:chunkOffset:XFTPChunkSpec :: Int64
chunkOffset, Word32
chunkSize :: Word32
$sel:chunkSize:XFTPChunkSpec :: Word32
chunkSize}
           in SndFileChunk {Int64
sndFileId :: Int64
$sel:sndFileId:SndFileChunk :: Int64
sndFileId, SndFileId
sndFileEntityId :: SndFileId
$sel:sndFileEntityId:SndFileChunk :: SndFileId
sndFileEntityId, Int64
userId :: Int64
$sel:userId:SndFileChunk :: Int64
userId, Int
numRecipients :: Int
$sel:numRecipients:SndFileChunk :: Int
numRecipients, Int64
$sel:sndChunkId:SndFileChunk :: Int64
sndChunkId :: Int64
sndChunkId, Int
chunkNo :: Int
$sel:chunkNo:SndFileChunk :: Int
chunkNo, XFTPChunkSpec
chunkSpec :: XFTPChunkSpec
$sel:chunkSpec:SndFileChunk :: XFTPChunkSpec
chunkSpec, ServiceName
filePrefixPath :: ServiceName
$sel:filePrefixPath:SndFileChunk :: ServiceName
filePrefixPath, FileDigest
digest :: FileDigest
$sel:digest:SndFileChunk :: FileDigest
digest, $sel:replicas:SndFileChunk :: [SndFileChunkReplica]
replicas = []}
    getChunkReplicas :: Int64 -> IO [SndFileChunkReplica]
    getChunkReplicas :: Int64 -> IO [SndFileChunkReplica]
getChunkReplicas Int64
chunkId = do
      [SndFileChunkReplica]
replicas <-
        ((Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
  Maybe Int64, Int, NonEmpty TransportHost, ServiceName, KeyHash)
 -> SndFileChunkReplica)
-> [(Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
     Maybe Int64, Int, NonEmpty TransportHost, ServiceName, KeyHash)]
-> [SndFileChunkReplica]
forall a b. (a -> b) -> [a] -> [b]
map (Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
 Maybe Int64, Int, NonEmpty TransportHost, ServiceName, KeyHash)
-> SndFileChunkReplica
toReplica
          ([(Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
   Maybe Int64, Int, NonEmpty TransportHost, ServiceName, KeyHash)]
 -> [SndFileChunkReplica])
-> IO
     [(Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
       Maybe Int64, Int, NonEmpty TransportHost, ServiceName, KeyHash)]
-> IO [SndFileChunkReplica]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only Int64
-> IO
     [(Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
       Maybe Int64, Int, NonEmpty TransportHost, ServiceName, KeyHash)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
            Connection
db
            [sql|
              SELECT
                r.snd_file_chunk_replica_id, r.replica_id, r.replica_key, r.replica_status, r.delay, r.retries,
                s.xftp_host, s.xftp_port, s.xftp_key_hash
              FROM snd_file_chunk_replicas r
              JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
              WHERE r.snd_file_chunk_id = ?
            |]
            (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
chunkId)
      [SndFileChunkReplica]
-> (SndFileChunkReplica -> IO SndFileChunkReplica)
-> IO [SndFileChunkReplica]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SndFileChunkReplica]
replicas ((SndFileChunkReplica -> IO SndFileChunkReplica)
 -> IO [SndFileChunkReplica])
-> (SndFileChunkReplica -> IO SndFileChunkReplica)
-> IO [SndFileChunkReplica]
forall a b. (a -> b) -> a -> b
$ \replica :: SndFileChunkReplica
replica@SndFileChunkReplica {Int64
sndChunkReplicaId :: Int64
$sel:sndChunkReplicaId:SndFileChunkReplica :: SndFileChunkReplica -> Int64
sndChunkReplicaId} -> do
        [(ChunkReplicaId, APrivateAuthKey)]
rcvIdsKeys <- Connection -> Int64 -> IO [(ChunkReplicaId, APrivateAuthKey)]
getChunkReplicaRecipients_ Connection
db Int64
sndChunkReplicaId
        SndFileChunkReplica -> IO SndFileChunkReplica
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SndFileChunkReplica
replica :: SndFileChunkReplica) {rcvIdsKeys}
      where
        toReplica :: (Int64, ChunkReplicaId, C.APrivateAuthKey, SndFileReplicaStatus, Maybe Int64, Int, NonEmpty TransportHost, ServiceName, C.KeyHash) -> SndFileChunkReplica
        toReplica :: (Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
 Maybe Int64, Int, NonEmpty TransportHost, ServiceName, KeyHash)
-> SndFileChunkReplica
toReplica (Int64
sndChunkReplicaId, ChunkReplicaId
replicaId, APrivateAuthKey
replicaKey, SndFileReplicaStatus
replicaStatus, Maybe Int64
delay, Int
retries, NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash) =
          let server :: XFTPServer
server = NonEmpty TransportHost -> ServiceName -> KeyHash -> XFTPServer
XFTPServer NonEmpty TransportHost
host ServiceName
port KeyHash
keyHash
           in SndFileChunkReplica {Int64
$sel:sndChunkReplicaId:SndFileChunkReplica :: Int64
sndChunkReplicaId :: Int64
sndChunkReplicaId, XFTPServer
server :: XFTPServer
$sel:server:SndFileChunkReplica :: XFTPServer
server, ChunkReplicaId
replicaId :: ChunkReplicaId
$sel:replicaId:SndFileChunkReplica :: ChunkReplicaId
replicaId, APrivateAuthKey
replicaKey :: APrivateAuthKey
$sel:replicaKey:SndFileChunkReplica :: APrivateAuthKey
replicaKey, SndFileReplicaStatus
replicaStatus :: SndFileReplicaStatus
$sel:replicaStatus:SndFileChunkReplica :: SndFileReplicaStatus
replicaStatus, Maybe Int64
delay :: Maybe Int64
$sel:delay:SndFileChunkReplica :: Maybe Int64
delay, Int
retries :: Int
$sel:retries:SndFileChunkReplica :: Int
retries, $sel:rcvIdsKeys:SndFileChunkReplica :: [(ChunkReplicaId, APrivateAuthKey)]
rcvIdsKeys = []}

getChunkReplicaRecipients_ :: DB.Connection -> Int64 -> IO [(ChunkReplicaId, C.APrivateAuthKey)]
getChunkReplicaRecipients_ :: Connection -> Int64 -> IO [(ChunkReplicaId, APrivateAuthKey)]
getChunkReplicaRecipients_ Connection
db Int64
replicaId =
  Connection
-> Query -> Only Int64 -> IO [(ChunkReplicaId, APrivateAuthKey)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
    Connection
db
    [sql|
      SELECT rcv_replica_id, rcv_replica_key
      FROM snd_file_chunk_replica_recipients
      WHERE snd_file_chunk_replica_id = ?
    |]
    (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
replicaId)

getNextSndFileToPrepare :: DB.Connection -> NominalDiffTime -> IO (Either StoreError (Maybe SndFile))
getNextSndFileToPrepare :: Connection
-> NominalDiffTime -> IO (Either StoreError (Maybe SndFile))
getNextSndFileToPrepare Connection
db NominalDiffTime
ttl =
  ServiceName
-> IO (Maybe Int64)
-> (Int64 -> IO (Either StoreError SndFile))
-> (Int64 -> IO ())
-> IO (Either StoreError (Maybe SndFile))
forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> IO (Maybe i)
-> (i -> IO (Either e a))
-> (i -> IO ())
-> IO (Either e (Maybe a))
getWorkItem ServiceName
"snd_file_prepare" IO (Maybe Int64)
getFileId (Connection -> Int64 -> IO (Either StoreError SndFile)
getSndFile Connection
db) (Connection -> Int64 -> IO ()
markSndFileFailed Connection
db)
  where
    getFileId :: IO (Maybe DBSndFileId)
    getFileId :: IO (Maybe Int64)
getFileId = do
      UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
      (Only Int64 -> Int64) -> IO [Only Int64] -> IO (Maybe Int64)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly (IO [Only Int64] -> IO (Maybe Int64))
-> IO [Only Int64] -> IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (SndFileStatus, SndFileStatus, SndFileStatus, UTCTime)
-> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT snd_file_id
            FROM snd_files
            WHERE status IN (?,?,?) AND deleted = 0 AND created_at >= ?
              AND failed = 0
            ORDER BY created_at ASC LIMIT 1
          |]
          (SndFileStatus
SFSNew, SndFileStatus
SFSEncrypting, SndFileStatus
SFSEncrypted, UTCTime
cutoffTs)

markSndFileFailed :: DB.Connection -> DBSndFileId -> IO ()
markSndFileFailed :: Connection -> Int64 -> IO ()
markSndFileFailed Connection
db Int64
fileId =
  Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_files SET failed = 1 WHERE snd_file_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
fileId)

updateSndFileError :: DB.Connection -> DBSndFileId -> String -> IO ()
updateSndFileError :: Connection -> Int64 -> ServiceName -> IO ()
updateSndFileError Connection
db Int64
sndFileId ServiceName
errStr = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (ServiceName, SndFileStatus, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_files SET prefix_path = NULL, error = ?, status = ?, updated_at = ? WHERE snd_file_id = ?" (ServiceName
errStr, SndFileStatus
SFSError, UTCTime
updatedAt, Int64
sndFileId)

updateSndFileStatus :: DB.Connection -> DBSndFileId -> SndFileStatus -> IO ()
updateSndFileStatus :: Connection -> Int64 -> SndFileStatus -> IO ()
updateSndFileStatus Connection
db Int64
sndFileId SndFileStatus
status = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (SndFileStatus, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_files SET status = ?, updated_at = ? WHERE snd_file_id = ?" (SndFileStatus
status, UTCTime
updatedAt, Int64
sndFileId)

updateSndFileEncrypted :: DB.Connection -> DBSndFileId -> FileDigest -> [(XFTPChunkSpec, FileDigest)] -> IO ()
updateSndFileEncrypted :: Connection
-> Int64 -> FileDigest -> [(XFTPChunkSpec, FileDigest)] -> IO ()
updateSndFileEncrypted Connection
db Int64
sndFileId FileDigest
digest [(XFTPChunkSpec, FileDigest)]
chunkSpecsDigests = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (SndFileStatus, FileDigest, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_files SET status = ?, digest = ?, updated_at = ? WHERE snd_file_id = ?" (SndFileStatus
SFSEncrypted, FileDigest
digest, UTCTime
updatedAt, Int64
sndFileId)
  [(Int, (XFTPChunkSpec, FileDigest))]
-> ((Int, (XFTPChunkSpec, FileDigest)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int]
-> [(XFTPChunkSpec, FileDigest)]
-> [(Int, (XFTPChunkSpec, FileDigest))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [(XFTPChunkSpec, FileDigest)]
chunkSpecsDigests) (((Int, (XFTPChunkSpec, FileDigest)) -> IO ()) -> IO ())
-> ((Int, (XFTPChunkSpec, FileDigest)) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
chunkNo :: Int, (XFTPChunkSpec {Int64
$sel:chunkOffset:XFTPChunkSpec :: XFTPChunkSpec -> Int64
chunkOffset :: Int64
chunkOffset, Word32
$sel:chunkSize:XFTPChunkSpec :: XFTPChunkSpec -> Word32
chunkSize :: Word32
chunkSize}, FileDigest
chunkDigest)) ->
    Connection
-> Query -> (Int64, Int, Int64, Word32, FileDigest) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"INSERT INTO snd_file_chunks (snd_file_id, chunk_no, chunk_offset, chunk_size, digest) VALUES (?,?,?,?,?)" (Int64
sndFileId, Int
chunkNo, Int64
chunkOffset, Word32
chunkSize, FileDigest
chunkDigest)

updateSndFileComplete :: DB.Connection -> DBSndFileId -> IO ()
updateSndFileComplete :: Connection -> Int64 -> IO ()
updateSndFileComplete Connection
db Int64
sndFileId = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (SndFileStatus, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_files SET prefix_path = NULL, status = ?, updated_at = ? WHERE snd_file_id = ?" (SndFileStatus
SFSComplete, UTCTime
updatedAt, Int64
sndFileId)

updateSndFileNoPrefixPath :: DB.Connection -> DBSndFileId -> IO ()
updateSndFileNoPrefixPath :: Connection -> Int64 -> IO ()
updateSndFileNoPrefixPath Connection
db Int64
sndFileId = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_files SET prefix_path = NULL, updated_at = ? WHERE snd_file_id = ?" (UTCTime
updatedAt, Int64
sndFileId)

updateSndFileDeleted :: DB.Connection -> DBSndFileId -> IO ()
updateSndFileDeleted :: Connection -> Int64 -> IO ()
updateSndFileDeleted Connection
db Int64
sndFileId = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_files SET deleted = 1, updated_at = ? WHERE snd_file_id = ?" (UTCTime
updatedAt, Int64
sndFileId)

deleteSndFile' :: DB.Connection -> DBSndFileId -> IO ()
deleteSndFile' :: Connection -> Int64 -> IO ()
deleteSndFile' Connection
db Int64
sndFileId =
  Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM snd_files WHERE snd_file_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
sndFileId)

getSndFileDeleted :: DB.Connection -> DBSndFileId -> IO Bool
getSndFileDeleted :: Connection -> Int64 -> IO Bool
getSndFileDeleted Connection
db Int64
sndFileId =
  Bool -> (Only BoolInt -> Bool) -> IO [Only BoolInt] -> IO Bool
forall (f :: * -> *) b a.
Functor f =>
b -> (a -> b) -> f [a] -> f b
maybeFirstRow' Bool
True Only BoolInt -> Bool
fromOnlyBI (IO [Only BoolInt] -> IO Bool) -> IO [Only BoolInt] -> IO Bool
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> Only Int64 -> IO [Only BoolInt]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT deleted FROM snd_files WHERE snd_file_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
sndFileId)

createSndFileReplica :: DB.Connection -> SndFileChunk -> NewSndChunkReplica -> IO ()
createSndFileReplica :: Connection -> SndFileChunk -> NewSndChunkReplica -> IO ()
createSndFileReplica Connection
db SndFileChunk {Int64
$sel:sndChunkId:SndFileChunk :: SndFileChunk -> Int64
sndChunkId :: Int64
sndChunkId} = Connection -> Int64 -> NewSndChunkReplica -> IO ()
createSndFileReplica_ Connection
db Int64
sndChunkId

createSndFileReplica_ :: DB.Connection -> Int64 -> NewSndChunkReplica -> IO ()
createSndFileReplica_ :: Connection -> Int64 -> NewSndChunkReplica -> IO ()
createSndFileReplica_ Connection
db Int64
sndChunkId NewSndChunkReplica {XFTPServer
server :: XFTPServer
$sel:server:NewSndChunkReplica :: NewSndChunkReplica -> XFTPServer
server, ChunkReplicaId
replicaId :: ChunkReplicaId
$sel:replicaId:NewSndChunkReplica :: NewSndChunkReplica -> ChunkReplicaId
replicaId, APrivateAuthKey
replicaKey :: APrivateAuthKey
$sel:replicaKey:NewSndChunkReplica :: NewSndChunkReplica -> APrivateAuthKey
replicaKey, [(ChunkReplicaId, APrivateAuthKey)]
rcvIdsKeys :: [(ChunkReplicaId, APrivateAuthKey)]
$sel:rcvIdsKeys:NewSndChunkReplica :: NewSndChunkReplica -> [(ChunkReplicaId, APrivateAuthKey)]
rcvIdsKeys} = do
  Int64
srvId <- Connection -> XFTPServer -> IO Int64
createXFTPServer_ Connection
db XFTPServer
server
  Connection
-> Query
-> (Int64, Int, Int64, ChunkReplicaId, APrivateAuthKey,
    SndFileReplicaStatus)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO snd_file_chunk_replicas
        (snd_file_chunk_id, replica_number, xftp_server_id, replica_id, replica_key, replica_status)
      VALUES (?,?,?,?,?,?)
    |]
    (Int64
sndChunkId, Int
1 :: Int, Int64
srvId, ChunkReplicaId
replicaId, APrivateAuthKey
replicaKey, SndFileReplicaStatus
SFRSCreated)
  Int64
rId <- Connection -> IO Int64
insertedRowId Connection
db
  [(ChunkReplicaId, APrivateAuthKey)]
-> ((ChunkReplicaId, APrivateAuthKey) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ChunkReplicaId, APrivateAuthKey)]
rcvIdsKeys (((ChunkReplicaId, APrivateAuthKey) -> IO ()) -> IO ())
-> ((ChunkReplicaId, APrivateAuthKey) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(ChunkReplicaId
rcvId, APrivateAuthKey
rcvKey) -> do
    Connection
-> Query -> (Int64, ChunkReplicaId, APrivateAuthKey) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        INSERT INTO snd_file_chunk_replica_recipients
          (snd_file_chunk_replica_id, rcv_replica_id, rcv_replica_key)
        VALUES (?,?,?)
      |]
      (Int64
rId, ChunkReplicaId
rcvId, APrivateAuthKey
rcvKey)

getNextSndChunkToUpload :: DB.Connection -> XFTPServer -> NominalDiffTime -> IO (Either StoreError (Maybe SndFileChunk))
getNextSndChunkToUpload :: Connection
-> XFTPServer
-> NominalDiffTime
-> IO (Either StoreError (Maybe SndFileChunk))
getNextSndChunkToUpload Connection
db server :: XFTPServer
server@ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port, KeyHash
$sel:keyHash:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> KeyHash
keyHash :: KeyHash
keyHash} NominalDiffTime
ttl = do
  ServiceName
-> IO (Maybe (Int64, Int64))
-> ((Int64, Int64) -> IO (Either StoreError SndFileChunk))
-> ((Int64, Int64) -> IO ())
-> IO (Either StoreError (Maybe SndFileChunk))
forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> IO (Maybe i)
-> (i -> IO (Either e a))
-> (i -> IO ())
-> IO (Either e (Maybe a))
getWorkItem ServiceName
"snd_file_upload" IO (Maybe (Int64, Int64))
getReplicaId (Int64, Int64) -> IO (Either StoreError SndFileChunk)
getChunkData (Connection -> Int64 -> IO ()
markSndFileFailed Connection
db (Int64 -> IO ())
-> ((Int64, Int64) -> Int64) -> (Int64, Int64) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64, Int64) -> Int64
forall a b. (a, b) -> b
snd)
  where
    getReplicaId :: IO (Maybe (Int64, DBSndFileId))
    getReplicaId :: IO (Maybe (Int64, Int64))
getReplicaId = do
      UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
      ((Int64, Int64) -> (Int64, Int64))
-> IO [(Int64, Int64)] -> IO (Maybe (Int64, Int64))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (Int64, Int64) -> (Int64, Int64)
forall a. a -> a
id (IO [(Int64, Int64)] -> IO (Maybe (Int64, Int64)))
-> IO [(Int64, Int64)] -> IO (Maybe (Int64, Int64))
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, KeyHash,
    SndFileReplicaStatus, SndFileStatus, SndFileStatus, UTCTime)
-> IO [(Int64, Int64)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT r.snd_file_chunk_replica_id, f.snd_file_id
            FROM snd_file_chunk_replicas r
            JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
            JOIN snd_file_chunks c ON c.snd_file_chunk_id = r.snd_file_chunk_id
            JOIN snd_files f ON f.snd_file_id = c.snd_file_id
            WHERE s.xftp_host = ? AND s.xftp_port = ? AND s.xftp_key_hash = ?
              AND r.replica_status = ? AND r.replica_number = 1
              AND (f.status = ? OR f.status = ?) AND f.deleted = 0 AND f.created_at >= ?
              AND f.failed = 0
            ORDER BY r.retries ASC, r.created_at ASC
            LIMIT 1
          |]
          (NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash, SndFileReplicaStatus
SFRSCreated, SndFileStatus
SFSEncrypted, SndFileStatus
SFSUploading, UTCTime
cutoffTs)
    getChunkData :: (Int64, DBSndFileId) -> IO (Either StoreError SndFileChunk)
    getChunkData :: (Int64, Int64) -> IO (Either StoreError SndFileChunk)
getChunkData (Int64
sndFileChunkReplicaId, Int64
_fileId) = do
      Either StoreError SndFileChunk
chunk_ <-
        (((Int64, SndFileId, Int64, Int, ServiceName)
  :. ((Int64, Int, Int64, Word32, FileDigest)
      :. (Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
          Maybe Int64, Int)))
 -> SndFileChunk)
-> StoreError
-> IO
     [(Int64, SndFileId, Int64, Int, ServiceName)
      :. ((Int64, Int, Int64, Word32, FileDigest)
          :. (Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
              Maybe Int64, Int))]
-> IO (Either StoreError SndFileChunk)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((Int64, SndFileId, Int64, Int, ServiceName)
 :. ((Int64, Int, Int64, Word32, FileDigest)
     :. (Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
         Maybe Int64, Int)))
-> SndFileChunk
toChunk StoreError
SEFileNotFound (IO
   [(Int64, SndFileId, Int64, Int, ServiceName)
    :. ((Int64, Int, Int64, Word32, FileDigest)
        :. (Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
            Maybe Int64, Int))]
 -> IO (Either StoreError SndFileChunk))
-> IO
     [(Int64, SndFileId, Int64, Int, ServiceName)
      :. ((Int64, Int, Int64, Word32, FileDigest)
          :. (Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
              Maybe Int64, Int))]
-> IO (Either StoreError SndFileChunk)
forall a b. (a -> b) -> a -> b
$
          Connection
-> Query
-> Only Int64
-> IO
     [(Int64, SndFileId, Int64, Int, ServiceName)
      :. ((Int64, Int, Int64, Word32, FileDigest)
          :. (Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
              Maybe Int64, Int))]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
            Connection
db
            [sql|
              SELECT
                f.snd_file_id, f.snd_file_entity_id, f.user_id, f.num_recipients, f.prefix_path,
                c.snd_file_chunk_id, c.chunk_no, c.chunk_offset, c.chunk_size, c.digest,
                r.snd_file_chunk_replica_id, r.replica_id, r.replica_key, r.replica_status, r.delay, r.retries
              FROM snd_file_chunk_replicas r
              JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
              JOIN snd_file_chunks c ON c.snd_file_chunk_id = r.snd_file_chunk_id
              JOIN snd_files f ON f.snd_file_id = c.snd_file_id
              WHERE r.snd_file_chunk_replica_id = ?
            |]
            (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
sndFileChunkReplicaId)
      Either StoreError SndFileChunk
-> (SndFileChunk -> IO SndFileChunk)
-> IO (Either StoreError SndFileChunk)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Either StoreError SndFileChunk
chunk_ ((SndFileChunk -> IO SndFileChunk)
 -> IO (Either StoreError SndFileChunk))
-> (SndFileChunk -> IO SndFileChunk)
-> IO (Either StoreError SndFileChunk)
forall a b. (a -> b) -> a -> b
$ \chunk :: SndFileChunk
chunk@SndFileChunk {[SndFileChunkReplica]
$sel:replicas:SndFileChunk :: SndFileChunk -> [SndFileChunkReplica]
replicas :: [SndFileChunkReplica]
replicas} -> do
        [SndFileChunkReplica]
replicas' <- [SndFileChunkReplica]
-> (SndFileChunkReplica -> IO SndFileChunkReplica)
-> IO [SndFileChunkReplica]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SndFileChunkReplica]
replicas ((SndFileChunkReplica -> IO SndFileChunkReplica)
 -> IO [SndFileChunkReplica])
-> (SndFileChunkReplica -> IO SndFileChunkReplica)
-> IO [SndFileChunkReplica]
forall a b. (a -> b) -> a -> b
$ \replica :: SndFileChunkReplica
replica@SndFileChunkReplica {Int64
$sel:sndChunkReplicaId:SndFileChunkReplica :: SndFileChunkReplica -> Int64
sndChunkReplicaId :: Int64
sndChunkReplicaId} -> do
          [(ChunkReplicaId, APrivateAuthKey)]
rcvIdsKeys <- Connection -> Int64 -> IO [(ChunkReplicaId, APrivateAuthKey)]
getChunkReplicaRecipients_ Connection
db Int64
sndChunkReplicaId
          SndFileChunkReplica -> IO SndFileChunkReplica
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SndFileChunkReplica
replica :: SndFileChunkReplica) {rcvIdsKeys}
        SndFileChunk -> IO SndFileChunk
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SndFileChunk
chunk {replicas = replicas'} :: SndFileChunk)
      where
        toChunk :: ((DBSndFileId, SndFileId, UserId, Int, FilePath) :. (Int64, Int, Int64, Word32, FileDigest) :. (Int64, ChunkReplicaId, C.APrivateAuthKey, SndFileReplicaStatus, Maybe Int64, Int)) -> SndFileChunk
        toChunk :: ((Int64, SndFileId, Int64, Int, ServiceName)
 :. ((Int64, Int, Int64, Word32, FileDigest)
     :. (Int64, ChunkReplicaId, APrivateAuthKey, SndFileReplicaStatus,
         Maybe Int64, Int)))
-> SndFileChunk
toChunk ((Int64
sndFileId, SndFileId
sndFileEntityId, Int64
userId, Int
numRecipients, ServiceName
filePrefixPath) :. (Int64
sndChunkId, Int
chunkNo, Int64
chunkOffset, Word32
chunkSize, FileDigest
digest) :. (Int64
sndChunkReplicaId, ChunkReplicaId
replicaId, APrivateAuthKey
replicaKey, SndFileReplicaStatus
replicaStatus, Maybe Int64
delay, Int
retries)) =
          let chunkSpec :: XFTPChunkSpec
chunkSpec = XFTPChunkSpec {$sel:filePath:XFTPChunkSpec :: ServiceName
filePath = ServiceName -> ServiceName
sndFileEncPath ServiceName
filePrefixPath, Int64
$sel:chunkOffset:XFTPChunkSpec :: Int64
chunkOffset :: Int64
chunkOffset, Word32
$sel:chunkSize:XFTPChunkSpec :: Word32
chunkSize :: Word32
chunkSize}
           in SndFileChunk
                { Int64
$sel:sndFileId:SndFileChunk :: Int64
sndFileId :: Int64
sndFileId,
                  SndFileId
$sel:sndFileEntityId:SndFileChunk :: SndFileId
sndFileEntityId :: SndFileId
sndFileEntityId,
                  Int64
$sel:userId:SndFileChunk :: Int64
userId :: Int64
userId,
                  Int
$sel:numRecipients:SndFileChunk :: Int
numRecipients :: Int
numRecipients,
                  Int64
$sel:sndChunkId:SndFileChunk :: Int64
sndChunkId :: Int64
sndChunkId,
                  Int
$sel:chunkNo:SndFileChunk :: Int
chunkNo :: Int
chunkNo,
                  XFTPChunkSpec
$sel:chunkSpec:SndFileChunk :: XFTPChunkSpec
chunkSpec :: XFTPChunkSpec
chunkSpec,
                  FileDigest
$sel:digest:SndFileChunk :: FileDigest
digest :: FileDigest
digest,
                  ServiceName
$sel:filePrefixPath:SndFileChunk :: ServiceName
filePrefixPath :: ServiceName
filePrefixPath,
                  $sel:replicas:SndFileChunk :: [SndFileChunkReplica]
replicas = [SndFileChunkReplica {Int64
$sel:sndChunkReplicaId:SndFileChunkReplica :: Int64
sndChunkReplicaId :: Int64
sndChunkReplicaId, XFTPServer
$sel:server:SndFileChunkReplica :: XFTPServer
server :: XFTPServer
server, ChunkReplicaId
$sel:replicaId:SndFileChunkReplica :: ChunkReplicaId
replicaId :: ChunkReplicaId
replicaId, APrivateAuthKey
$sel:replicaKey:SndFileChunkReplica :: APrivateAuthKey
replicaKey :: APrivateAuthKey
replicaKey, SndFileReplicaStatus
$sel:replicaStatus:SndFileChunkReplica :: SndFileReplicaStatus
replicaStatus :: SndFileReplicaStatus
replicaStatus, Maybe Int64
$sel:delay:SndFileChunkReplica :: Maybe Int64
delay :: Maybe Int64
delay, Int
$sel:retries:SndFileChunkReplica :: Int
retries :: Int
retries, $sel:rcvIdsKeys:SndFileChunkReplica :: [(ChunkReplicaId, APrivateAuthKey)]
rcvIdsKeys = []}]
                }

updateSndChunkReplicaDelay :: DB.Connection -> Int64 -> Int64 -> IO ()
updateSndChunkReplicaDelay :: Connection -> Int64 -> Int64 -> IO ()
updateSndChunkReplicaDelay Connection
db Int64
replicaId Int64
delay = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (Int64, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_file_chunk_replicas SET delay = ?, retries = retries + 1, updated_at = ? WHERE snd_file_chunk_replica_id = ?" (Int64
delay, UTCTime
updatedAt, Int64
replicaId)

addSndChunkReplicaRecipients :: DB.Connection -> SndFileChunkReplica -> [(ChunkReplicaId, C.APrivateAuthKey)] -> IO SndFileChunkReplica
addSndChunkReplicaRecipients :: Connection
-> SndFileChunkReplica
-> [(ChunkReplicaId, APrivateAuthKey)]
-> IO SndFileChunkReplica
addSndChunkReplicaRecipients Connection
db r :: SndFileChunkReplica
r@SndFileChunkReplica {Int64
$sel:sndChunkReplicaId:SndFileChunkReplica :: SndFileChunkReplica -> Int64
sndChunkReplicaId :: Int64
sndChunkReplicaId} [(ChunkReplicaId, APrivateAuthKey)]
rcvIdsKeys = do
  [(ChunkReplicaId, APrivateAuthKey)]
-> ((ChunkReplicaId, APrivateAuthKey) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ChunkReplicaId, APrivateAuthKey)]
rcvIdsKeys (((ChunkReplicaId, APrivateAuthKey) -> IO ()) -> IO ())
-> ((ChunkReplicaId, APrivateAuthKey) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(ChunkReplicaId
rcvId, APrivateAuthKey
rcvKey) -> do
    Connection
-> Query -> (Int64, ChunkReplicaId, APrivateAuthKey) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        INSERT INTO snd_file_chunk_replica_recipients
          (snd_file_chunk_replica_id, rcv_replica_id, rcv_replica_key)
        VALUES (?,?,?)
      |]
      (Int64
sndChunkReplicaId, ChunkReplicaId
rcvId, APrivateAuthKey
rcvKey)
  [(ChunkReplicaId, APrivateAuthKey)]
rcvIdsKeys' <- Connection -> Int64 -> IO [(ChunkReplicaId, APrivateAuthKey)]
getChunkReplicaRecipients_ Connection
db Int64
sndChunkReplicaId
  SndFileChunkReplica -> IO SndFileChunkReplica
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SndFileChunkReplica
r :: SndFileChunkReplica) {rcvIdsKeys = rcvIdsKeys'}

updateSndChunkReplicaStatus :: DB.Connection -> Int64 -> SndFileReplicaStatus -> IO ()
updateSndChunkReplicaStatus :: Connection -> Int64 -> SndFileReplicaStatus -> IO ()
updateSndChunkReplicaStatus Connection
db Int64
replicaId SndFileReplicaStatus
status = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (SndFileReplicaStatus, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_file_chunk_replicas SET replica_status = ?, updated_at = ? WHERE snd_file_chunk_replica_id = ?" (SndFileReplicaStatus
status, UTCTime
updatedAt, Int64
replicaId)

getPendingSndFilesServers :: DB.Connection -> NominalDiffTime -> IO [XFTPServer]
getPendingSndFilesServers :: Connection -> NominalDiffTime -> IO [XFTPServer]
getPendingSndFilesServers Connection
db NominalDiffTime
ttl = do
  UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  ((NonEmpty TransportHost, ServiceName, KeyHash) -> XFTPServer)
-> [(NonEmpty TransportHost, ServiceName, KeyHash)] -> [XFTPServer]
forall a b. (a -> b) -> [a] -> [b]
map (NonEmpty TransportHost, ServiceName, KeyHash) -> XFTPServer
toXFTPServer
    ([(NonEmpty TransportHost, ServiceName, KeyHash)] -> [XFTPServer])
-> IO [(NonEmpty TransportHost, ServiceName, KeyHash)]
-> IO [XFTPServer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (SndFileReplicaStatus, SndFileStatus, SndFileStatus, UTCTime)
-> IO [(NonEmpty TransportHost, ServiceName, KeyHash)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT DISTINCT
          s.xftp_host, s.xftp_port, s.xftp_key_hash
        FROM snd_file_chunk_replicas r
        JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
        JOIN snd_file_chunks c ON c.snd_file_chunk_id = r.snd_file_chunk_id
        JOIN snd_files f ON f.snd_file_id = c.snd_file_id
        WHERE r.replica_status = ? AND r.replica_number = 1
          AND (f.status = ? OR f.status = ?) AND f.deleted = 0 AND f.created_at >= ?
      |]
      (SndFileReplicaStatus
SFRSCreated, SndFileStatus
SFSEncrypted, SndFileStatus
SFSUploading, UTCTime
cutoffTs)

getCleanupSndFilesPrefixPaths :: DB.Connection -> IO [(DBSndFileId, SndFileId, FilePath)]
getCleanupSndFilesPrefixPaths :: Connection -> IO [(Int64, SndFileId, ServiceName)]
getCleanupSndFilesPrefixPaths Connection
db =
  Connection
-> Query
-> (SndFileStatus, SndFileStatus)
-> IO [(Int64, SndFileId, ServiceName)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
    Connection
db
    [sql|
      SELECT snd_file_id, snd_file_entity_id, prefix_path
      FROM snd_files
      WHERE status IN (?,?) AND prefix_path IS NOT NULL
    |]
    (SndFileStatus
SFSComplete, SndFileStatus
SFSError)

getCleanupSndFilesDeleted :: DB.Connection -> IO [(DBSndFileId, SndFileId, Maybe FilePath)]
getCleanupSndFilesDeleted :: Connection -> IO [(Int64, SndFileId, Maybe ServiceName)]
getCleanupSndFilesDeleted Connection
db =
  Connection -> Query -> IO [(Int64, SndFileId, Maybe ServiceName)]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_
    Connection
db
    [sql|
      SELECT snd_file_id, snd_file_entity_id, prefix_path
      FROM snd_files
      WHERE deleted = 1
    |]

getSndFilesExpired :: DB.Connection -> NominalDiffTime -> IO [(DBSndFileId, SndFileId, Maybe FilePath)]
getSndFilesExpired :: Connection
-> NominalDiffTime -> IO [(Int64, SndFileId, Maybe ServiceName)]
getSndFilesExpired Connection
db NominalDiffTime
ttl = do
  UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  Connection
-> Query
-> Only UTCTime
-> IO [(Int64, SndFileId, Maybe ServiceName)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
    Connection
db
    [sql|
      SELECT snd_file_id, snd_file_entity_id, prefix_path
      FROM snd_files
      WHERE created_at < ?
    |]
    (UTCTime -> Only UTCTime
forall a. a -> Only a
Only UTCTime
cutoffTs)

createDeletedSndChunkReplica :: DB.Connection -> UserId -> FileChunkReplica -> FileDigest -> IO ()
createDeletedSndChunkReplica :: Connection -> Int64 -> FileChunkReplica -> FileDigest -> IO ()
createDeletedSndChunkReplica Connection
db Int64
userId FileChunkReplica {XFTPServer
$sel:server:FileChunkReplica :: FileChunkReplica -> XFTPServer
server :: XFTPServer
server, ChunkReplicaId
$sel:replicaId:FileChunkReplica :: FileChunkReplica -> ChunkReplicaId
replicaId :: ChunkReplicaId
replicaId, APrivateAuthKey
$sel:replicaKey:FileChunkReplica :: FileChunkReplica -> APrivateAuthKey
replicaKey :: APrivateAuthKey
replicaKey} FileDigest
chunkDigest = do
  Int64
srvId <- Connection -> XFTPServer -> IO Int64
createXFTPServer_ Connection
db XFTPServer
server
  Connection
-> Query
-> (Int64, Int64, ChunkReplicaId, APrivateAuthKey, FileDigest)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"INSERT INTO deleted_snd_chunk_replicas (user_id, xftp_server_id, replica_id, replica_key, chunk_digest) VALUES (?,?,?,?,?)"
    (Int64
userId, Int64
srvId, ChunkReplicaId
replicaId, APrivateAuthKey
replicaKey, FileDigest
chunkDigest)

getDeletedSndChunkReplica :: DB.Connection -> DBSndFileId -> IO (Either StoreError DeletedSndChunkReplica)
getDeletedSndChunkReplica :: Connection
-> Int64 -> IO (Either StoreError DeletedSndChunkReplica)
getDeletedSndChunkReplica Connection
db Int64
deletedSndChunkReplicaId =
  ((Int64, ChunkReplicaId, APrivateAuthKey, FileDigest, Maybe Int64,
  Int, NonEmpty TransportHost, ServiceName, KeyHash)
 -> DeletedSndChunkReplica)
-> StoreError
-> IO
     [(Int64, ChunkReplicaId, APrivateAuthKey, FileDigest, Maybe Int64,
       Int, NonEmpty TransportHost, ServiceName, KeyHash)]
-> IO (Either StoreError DeletedSndChunkReplica)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (Int64, ChunkReplicaId, APrivateAuthKey, FileDigest, Maybe Int64,
 Int, NonEmpty TransportHost, ServiceName, KeyHash)
-> DeletedSndChunkReplica
toReplica StoreError
SEDeletedSndChunkReplicaNotFound (IO
   [(Int64, ChunkReplicaId, APrivateAuthKey, FileDigest, Maybe Int64,
     Int, NonEmpty TransportHost, ServiceName, KeyHash)]
 -> IO (Either StoreError DeletedSndChunkReplica))
-> IO
     [(Int64, ChunkReplicaId, APrivateAuthKey, FileDigest, Maybe Int64,
       Int, NonEmpty TransportHost, ServiceName, KeyHash)]
-> IO (Either StoreError DeletedSndChunkReplica)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> Only Int64
-> IO
     [(Int64, ChunkReplicaId, APrivateAuthKey, FileDigest, Maybe Int64,
       Int, NonEmpty TransportHost, ServiceName, KeyHash)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT
          r.user_id, r.replica_id, r.replica_key, r.chunk_digest, r.delay, r.retries,
          s.xftp_host, s.xftp_port, s.xftp_key_hash
        FROM deleted_snd_chunk_replicas r
        JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
        WHERE r.deleted_snd_chunk_replica_id = ?
      |]
      (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
deletedSndChunkReplicaId)
  where
    toReplica :: (UserId, ChunkReplicaId, C.APrivateAuthKey, FileDigest, Maybe Int64, Int, NonEmpty TransportHost, ServiceName, C.KeyHash) -> DeletedSndChunkReplica
    toReplica :: (Int64, ChunkReplicaId, APrivateAuthKey, FileDigest, Maybe Int64,
 Int, NonEmpty TransportHost, ServiceName, KeyHash)
-> DeletedSndChunkReplica
toReplica (Int64
userId, ChunkReplicaId
replicaId, APrivateAuthKey
replicaKey, FileDigest
chunkDigest, Maybe Int64
delay, Int
retries, NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash) =
      let server :: XFTPServer
server = NonEmpty TransportHost -> ServiceName -> KeyHash -> XFTPServer
XFTPServer NonEmpty TransportHost
host ServiceName
port KeyHash
keyHash
       in DeletedSndChunkReplica {Int64
deletedSndChunkReplicaId :: Int64
$sel:deletedSndChunkReplicaId:DeletedSndChunkReplica :: Int64
deletedSndChunkReplicaId, Int64
userId :: Int64
$sel:userId:DeletedSndChunkReplica :: Int64
userId, XFTPServer
server :: XFTPServer
$sel:server:DeletedSndChunkReplica :: XFTPServer
server, ChunkReplicaId
replicaId :: ChunkReplicaId
$sel:replicaId:DeletedSndChunkReplica :: ChunkReplicaId
replicaId, APrivateAuthKey
replicaKey :: APrivateAuthKey
$sel:replicaKey:DeletedSndChunkReplica :: APrivateAuthKey
replicaKey, FileDigest
chunkDigest :: FileDigest
$sel:chunkDigest:DeletedSndChunkReplica :: FileDigest
chunkDigest, Maybe Int64
delay :: Maybe Int64
$sel:delay:DeletedSndChunkReplica :: Maybe Int64
delay, Int
retries :: Int
$sel:retries:DeletedSndChunkReplica :: Int
retries}

getNextDeletedSndChunkReplica :: DB.Connection -> XFTPServer -> NominalDiffTime -> IO (Either StoreError (Maybe DeletedSndChunkReplica))
getNextDeletedSndChunkReplica :: Connection
-> XFTPServer
-> NominalDiffTime
-> IO (Either StoreError (Maybe DeletedSndChunkReplica))
getNextDeletedSndChunkReplica Connection
db ProtocolServer {NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host :: NonEmpty TransportHost
host, ServiceName
$sel:port:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> ServiceName
port :: ServiceName
port, KeyHash
$sel:keyHash:ProtocolServer :: forall (p :: ProtocolType). ProtocolServer p -> KeyHash
keyHash :: KeyHash
keyHash} NominalDiffTime
ttl =
  ServiceName
-> IO (Maybe Int64)
-> (Int64 -> IO (Either StoreError DeletedSndChunkReplica))
-> (Int64 -> IO ())
-> IO (Either StoreError (Maybe DeletedSndChunkReplica))
forall i e a.
(Show i, AnyStoreError e) =>
ServiceName
-> IO (Maybe i)
-> (i -> IO (Either e a))
-> (i -> IO ())
-> IO (Either e (Maybe a))
getWorkItem ServiceName
"deleted replica" IO (Maybe Int64)
getReplicaId (Connection
-> Int64 -> IO (Either StoreError DeletedSndChunkReplica)
getDeletedSndChunkReplica Connection
db) Int64 -> IO ()
markReplicaFailed
  where
    getReplicaId :: IO (Maybe Int64)
    getReplicaId :: IO (Maybe Int64)
getReplicaId = do
      UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
      (Only Int64 -> Int64) -> IO [Only Int64] -> IO (Maybe Int64)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly (IO [Only Int64] -> IO (Maybe Int64))
-> IO [Only Int64] -> IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (NonEmpty TransportHost, ServiceName, KeyHash, UTCTime)
-> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT r.deleted_snd_chunk_replica_id
            FROM deleted_snd_chunk_replicas r
            JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
            WHERE s.xftp_host = ? AND s.xftp_port = ? AND s.xftp_key_hash = ?
              AND r.created_at >= ?
              AND failed = 0
            ORDER BY r.retries ASC, r.created_at ASC
            LIMIT 1
          |]
          (NonEmpty TransportHost
host, ServiceName
port, KeyHash
keyHash, UTCTime
cutoffTs)
    markReplicaFailed :: Int64 -> IO ()
    markReplicaFailed :: Int64 -> IO ()
markReplicaFailed Int64
replicaId = do
      Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE deleted_snd_chunk_replicas SET failed = 1 WHERE deleted_snd_chunk_replica_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
replicaId)

updateDeletedSndChunkReplicaDelay :: DB.Connection -> Int64 -> Int64 -> IO ()
updateDeletedSndChunkReplicaDelay :: Connection -> Int64 -> Int64 -> IO ()
updateDeletedSndChunkReplicaDelay Connection
db Int64
deletedSndChunkReplicaId Int64
delay = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (Int64, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE deleted_snd_chunk_replicas SET delay = ?, retries = retries + 1, updated_at = ? WHERE deleted_snd_chunk_replica_id = ?" (Int64
delay, UTCTime
updatedAt, Int64
deletedSndChunkReplicaId)

deleteDeletedSndChunkReplica :: DB.Connection -> Int64 -> IO ()
deleteDeletedSndChunkReplica :: Connection -> Int64 -> IO ()
deleteDeletedSndChunkReplica Connection
db Int64
deletedSndChunkReplicaId =
  Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM deleted_snd_chunk_replicas WHERE deleted_snd_chunk_replica_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
deletedSndChunkReplicaId)

getPendingDelFilesServers :: DB.Connection -> NominalDiffTime -> IO [XFTPServer]
getPendingDelFilesServers :: Connection -> NominalDiffTime -> IO [XFTPServer]
getPendingDelFilesServers Connection
db NominalDiffTime
ttl = do
  UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  ((NonEmpty TransportHost, ServiceName, KeyHash) -> XFTPServer)
-> [(NonEmpty TransportHost, ServiceName, KeyHash)] -> [XFTPServer]
forall a b. (a -> b) -> [a] -> [b]
map (NonEmpty TransportHost, ServiceName, KeyHash) -> XFTPServer
toXFTPServer
    ([(NonEmpty TransportHost, ServiceName, KeyHash)] -> [XFTPServer])
-> IO [(NonEmpty TransportHost, ServiceName, KeyHash)]
-> IO [XFTPServer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only UTCTime
-> IO [(NonEmpty TransportHost, ServiceName, KeyHash)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT DISTINCT
          s.xftp_host, s.xftp_port, s.xftp_key_hash
        FROM deleted_snd_chunk_replicas r
        JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
        WHERE r.created_at >= ?
      |]
      (UTCTime -> Only UTCTime
forall a. a -> Only a
Only UTCTime
cutoffTs)

deleteDeletedSndChunkReplicasExpired :: DB.Connection -> NominalDiffTime -> IO ()
deleteDeletedSndChunkReplicasExpired :: Connection -> NominalDiffTime -> IO ()
deleteDeletedSndChunkReplicasExpired Connection
db NominalDiffTime
ttl = do
  UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
ttl) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  Connection -> Query -> Only UTCTime -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM deleted_snd_chunk_replicas WHERE created_at < ?" (UTCTime -> Only UTCTime
forall a. a -> Only a
Only UTCTime
cutoffTs)

updateServersStats :: DB.Connection -> AgentPersistedServerStats -> IO ()
updateServersStats :: Connection -> AgentPersistedServerStats -> IO ()
updateServersStats Connection
db AgentPersistedServerStats
stats = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (AgentPersistedServerStats, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE servers_stats SET servers_stats = ?, updated_at = ? WHERE servers_stats_id = 1" (AgentPersistedServerStats
stats, UTCTime
updatedAt)

getServersStats :: DB.Connection -> IO (Either StoreError (UTCTime, Maybe AgentPersistedServerStats))
getServersStats :: Connection
-> IO
     (Either StoreError (UTCTime, Maybe AgentPersistedServerStats))
getServersStats Connection
db =
  ((UTCTime, Maybe AgentPersistedServerStats)
 -> (UTCTime, Maybe AgentPersistedServerStats))
-> StoreError
-> IO [(UTCTime, Maybe AgentPersistedServerStats)]
-> IO
     (Either StoreError (UTCTime, Maybe AgentPersistedServerStats))
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (UTCTime, Maybe AgentPersistedServerStats)
-> (UTCTime, Maybe AgentPersistedServerStats)
forall a. a -> a
id StoreError
SEServersStatsNotFound (IO [(UTCTime, Maybe AgentPersistedServerStats)]
 -> IO
      (Either StoreError (UTCTime, Maybe AgentPersistedServerStats)))
-> IO [(UTCTime, Maybe AgentPersistedServerStats)]
-> IO
     (Either StoreError (UTCTime, Maybe AgentPersistedServerStats))
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> IO [(UTCTime, Maybe AgentPersistedServerStats)]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_ Connection
db Query
"SELECT started_at, servers_stats FROM servers_stats WHERE servers_stats_id = 1"

resetServersStats :: DB.Connection -> UTCTime -> IO ()
resetServersStats :: Connection -> UTCTime -> IO ()
resetServersStats Connection
db UTCTime
startedAt =
  Connection -> Query -> (UTCTime, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE servers_stats SET servers_stats = NULL, started_at = ?, updated_at = ? WHERE servers_stats_id = 1" (UTCTime
startedAt, UTCTime
startedAt)