{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Simplex.Messaging.Agent.Store.SQLite
  ( SQLiteStore (..),
    createSQLiteStore,
    connectSQLiteStore,
    withConnection,
    withTransaction,
    fromTextField_,
  )
where

import Control.Concurrent (threadDelay)
import Control.Concurrent.STM
import Control.Exception (bracket)
import Control.Monad.Except
import Control.Monad.IO.Unlift (MonadUnliftIO)
import Crypto.Random (ChaChaDRG, randomBytesGenerate)
import Data.ByteString (ByteString)
import Data.ByteString.Base64 (encode)
import Data.Char (toLower)
import Data.List (find)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1)
import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), SQLData (..), SQLError, ToRow, field)
import qualified Database.SQLite.Simple as DB
import Database.SQLite.Simple.FromField
import Database.SQLite.Simple.Internal (Field (..))
import Database.SQLite.Simple.Ok (Ok (Ok))
import Database.SQLite.Simple.QQ (sql)
import Database.SQLite.Simple.ToField (ToField (..))
import Network.Socket (ServiceName)
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.Store
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration)
import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
import Simplex.Messaging.Parsers (blobFieldParser)
import Simplex.Messaging.Protocol (MsgBody)
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Util (bshow, liftIOEither)
import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
import System.Exit (exitFailure)
import System.FilePath (takeDirectory)
import System.IO (hFlush, stdout)
import Text.Read (readMaybe)
import qualified UnliftIO.Exception as E

-- * SQLite Store implementation

data SQLiteStore = SQLiteStore
  { SQLiteStore -> FilePath
dbFilePath :: FilePath,
    SQLiteStore -> TBQueue Connection
dbConnPool :: TBQueue DB.Connection,
    SQLiteStore -> Bool
dbNew :: Bool
  }

createSQLiteStore :: FilePath -> Int -> [Migration] -> IO SQLiteStore
createSQLiteStore :: FilePath -> Int -> [Migration] -> IO SQLiteStore
createSQLiteStore FilePath
dbFilePath Int
poolSize [Migration]
migrations = do
  let dbDir :: FilePath
dbDir = FilePath -> FilePath
takeDirectory FilePath
dbFilePath
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
False FilePath
dbDir
  SQLiteStore
st <- FilePath -> Int -> IO SQLiteStore
connectSQLiteStore FilePath
dbFilePath Int
poolSize
  SQLiteStore -> IO ()
checkThreadsafe SQLiteStore
st
  SQLiteStore -> [Migration] -> IO ()
migrateSchema SQLiteStore
st [Migration]
migrations
  SQLiteStore -> IO SQLiteStore
forall (f :: * -> *) a. Applicative f => a -> f a
pure SQLiteStore
st

checkThreadsafe :: SQLiteStore -> IO ()
checkThreadsafe :: SQLiteStore -> IO ()
checkThreadsafe SQLiteStore
st = SQLiteStore -> (Connection -> IO ()) -> IO ()
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withConnection SQLiteStore
st ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
  [[Text]]
compileOptions <- Connection -> Query -> IO [[Text]]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_ Connection
db Query
"pragma COMPILE_OPTIONS;" :: IO [[Text]]
  let threadsafeOption :: Maybe Text
threadsafeOption = (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Text -> Bool
T.isPrefixOf Text
"THREADSAFE=") ([[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text]]
compileOptions)
  case Maybe Text
threadsafeOption of
    Just Text
"THREADSAFE=0" -> FilePath -> IO ()
confirmOrExit FilePath
"SQLite compiled with non-threadsafe code."
    Maybe Text
Nothing -> FilePath -> IO ()
putStrLn FilePath
"Warning: SQLite THREADSAFE compile option not found"
    Maybe Text
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

migrateSchema :: SQLiteStore -> [Migration] -> IO ()
migrateSchema :: SQLiteStore -> [Migration] -> IO ()
migrateSchema SQLiteStore
st [Migration]
migrations = SQLiteStore -> (Connection -> IO ()) -> IO ()
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withConnection SQLiteStore
st ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
  Connection -> IO ()
Migrations.initialize Connection
db
  Connection -> [Migration] -> IO (Either FilePath [Migration])
Migrations.get Connection
db [Migration]
migrations IO (Either FilePath [Migration])
-> (Either FilePath [Migration] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left FilePath
e -> FilePath -> IO ()
confirmOrExit (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Database error: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
e
    Right [] -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Right [Migration]
ms -> do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SQLiteStore -> Bool
dbNew SQLiteStore
st) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        FilePath -> IO ()
confirmOrExit FilePath
"The app has a newer version than the database - it will be backed up and upgraded."
        let f :: FilePath
f = SQLiteStore -> FilePath
dbFilePath SQLiteStore
st
        FilePath -> FilePath -> IO ()
copyFile FilePath
f (FilePath
f FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".bak")
      Connection -> [Migration] -> IO ()
Migrations.run Connection
db [Migration]
ms

confirmOrExit :: String -> IO ()
confirmOrExit :: FilePath -> IO ()
confirmOrExit FilePath
s = do
  FilePath -> IO ()
putStrLn FilePath
s
  FilePath -> IO ()
putStr FilePath
"Continue (y/N): "
  Handle -> IO ()
hFlush Handle
stdout
  FilePath
ok <- IO FilePath
getLine
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
ok FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"y") IO ()
forall a. IO a
exitFailure

connectSQLiteStore :: FilePath -> Int -> IO SQLiteStore
connectSQLiteStore :: FilePath -> Int -> IO SQLiteStore
connectSQLiteStore FilePath
dbFilePath Int
poolSize = do
  Bool
dbNew <- Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist FilePath
dbFilePath
  TBQueue Connection
dbConnPool <- Natural -> IO (TBQueue Connection)
forall a. Natural -> IO (TBQueue a)
newTBQueueIO (Natural -> IO (TBQueue Connection))
-> Natural -> IO (TBQueue Connection)
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a. Enum a => Int -> a
toEnum Int
poolSize
  Int -> IO () -> IO ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
poolSize (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath -> IO Connection
connectDB FilePath
dbFilePath IO Connection -> (Connection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> (Connection -> STM ()) -> Connection -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TBQueue Connection -> Connection -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue Connection
dbConnPool
  SQLiteStore -> IO SQLiteStore
forall (f :: * -> *) a. Applicative f => a -> f a
pure SQLiteStore :: FilePath -> TBQueue Connection -> Bool -> SQLiteStore
SQLiteStore {FilePath
dbFilePath :: FilePath
$sel:dbFilePath:SQLiteStore :: FilePath
dbFilePath, TBQueue Connection
dbConnPool :: TBQueue Connection
$sel:dbConnPool:SQLiteStore :: TBQueue Connection
dbConnPool, Bool
dbNew :: Bool
$sel:dbNew:SQLiteStore :: Bool
dbNew}

connectDB :: FilePath -> IO DB.Connection
connectDB :: FilePath -> IO Connection
connectDB FilePath
path = do
  Connection
dbConn <- FilePath -> IO Connection
DB.open FilePath
path
  Connection -> Query -> IO ()
DB.execute_ Connection
dbConn Query
"PRAGMA foreign_keys = ON; PRAGMA journal_mode = WAL;"
  Connection -> IO Connection
forall (f :: * -> *) a. Applicative f => a -> f a
pure Connection
dbConn

checkConstraint :: StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
checkConstraint :: 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 (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
handleSQLError :: StoreError -> SQLError -> StoreError
handleSQLError StoreError
err SQLError
e
  | SQLError -> Error
DB.sqlError SQLError
e Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
DB.ErrorConstraint = StoreError
err
  | Bool
otherwise = ByteString -> StoreError
SEInternal (ByteString -> StoreError) -> ByteString -> StoreError
forall a b. (a -> b) -> a -> b
$ SQLError -> ByteString
forall a. Show a => a -> ByteString
bshow SQLError
e

withConnection :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
withConnection :: SQLiteStore -> (Connection -> IO a) -> IO a
withConnection SQLiteStore {TBQueue Connection
dbConnPool :: TBQueue Connection
$sel:dbConnPool:SQLiteStore :: SQLiteStore -> TBQueue Connection
dbConnPool} =
  IO Connection
-> (Connection -> IO ()) -> (Connection -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (STM Connection -> IO Connection
forall a. STM a -> IO a
atomically (STM Connection -> IO Connection)
-> STM Connection -> IO Connection
forall a b. (a -> b) -> a -> b
$ TBQueue Connection -> STM Connection
forall a. TBQueue a -> STM a
readTBQueue TBQueue Connection
dbConnPool)
    (STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> (Connection -> STM ()) -> Connection -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TBQueue Connection -> Connection -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue Connection
dbConnPool)

withTransaction :: forall a. SQLiteStore -> (DB.Connection -> IO a) -> IO a
withTransaction :: SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st Connection -> IO a
action = SQLiteStore -> (Connection -> IO a) -> IO a
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withConnection SQLiteStore
st ((Connection -> IO a) -> IO a) -> (Connection -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Connection -> IO a
loop Int
100 Int
100_000
  where
    loop :: Int -> Int -> DB.Connection -> IO a
    loop :: Int -> Int -> Connection -> IO a
loop Int
t Int
tLim Connection
db =
      Connection -> IO a -> IO a
forall a. Connection -> IO a -> IO a
DB.withImmediateTransaction Connection
db (Connection -> IO a
action Connection
db) IO a -> (SQLError -> IO a) -> IO a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catch` \(SQLError
e :: SQLError) ->
        if Int
tLim Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
t Bool -> Bool -> Bool
&& SQLError -> Error
DB.sqlError SQLError
e Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
DB.ErrorBusy
          then do
            Int -> IO ()
threadDelay Int
t
            Int -> Int -> Connection -> IO a
loop (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
9 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) (Int
tLim Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
t) Connection
db
          else SQLError -> IO a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO SQLError
e

instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteStore m where
  createRcvConn :: SQLiteStore -> TVar ChaChaDRG -> ConnData -> RcvQueue -> SConnectionMode c -> m ConnId
  createRcvConn :: SQLiteStore
-> TVar ChaChaDRG
-> ConnData
-> RcvQueue
-> SConnectionMode c
-> m ByteString
createRcvConn SQLiteStore
st TVar ChaChaDRG
gVar ConnData
cData q :: RcvQueue
q@RcvQueue {SMPServer
$sel:server:RcvQueue :: RcvQueue -> SMPServer
server :: SMPServer
server} SConnectionMode c
cMode =
    -- TODO if schema has to be restarted, this function can be refactored
    -- to create connection first using createWithRandomId
    IO (Either StoreError ByteString) -> m ByteString
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError ByteString) -> m ByteString)
-> ((Connection -> IO (Either StoreError ByteString))
    -> IO (Either StoreError ByteString))
-> (Connection -> IO (Either StoreError ByteString))
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError
-> IO (Either StoreError ByteString)
-> IO (Either StoreError ByteString)
forall a.
StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
checkConstraint StoreError
SEConnDuplicate (IO (Either StoreError ByteString)
 -> IO (Either StoreError ByteString))
-> ((Connection -> IO (Either StoreError ByteString))
    -> IO (Either StoreError ByteString))
-> (Connection -> IO (Either StoreError ByteString))
-> IO (Either StoreError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError ByteString))
-> IO (Either StoreError ByteString)
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError ByteString)) -> m ByteString)
-> (Connection -> IO (Either StoreError ByteString))
-> m ByteString
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      Connection
-> TVar ChaChaDRG -> ConnData -> IO (Either StoreError ByteString)
getConnId_ Connection
db TVar ChaChaDRG
gVar ConnData
cData IO (Either StoreError ByteString)
-> (Either StoreError ByteString
    -> IO (Either StoreError ByteString))
-> IO (Either StoreError ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> IO ByteString)
-> Either StoreError ByteString
-> IO (Either StoreError ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Connection -> ByteString -> IO ByteString
create Connection
db)
    where
      create :: DB.Connection -> ConnId -> IO ConnId
      create :: Connection -> ByteString -> IO ByteString
create Connection
db ByteString
connId = do
        Connection -> SMPServer -> IO ()
upsertServer_ Connection
db SMPServer
server
        Connection -> ByteString -> RcvQueue -> IO ()
insertRcvQueue_ Connection
db ByteString
connId RcvQueue
q
        Connection -> ConnData -> RcvQueue -> SConnectionMode c -> IO ()
forall (c :: ConnectionMode).
Connection -> ConnData -> RcvQueue -> SConnectionMode c -> IO ()
insertRcvConnection_ Connection
db ConnData
cData {ByteString
$sel:connId:ConnData :: ByteString
connId :: ByteString
connId} RcvQueue
q SConnectionMode c
cMode
        ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
connId

  createSndConn :: SQLiteStore -> TVar ChaChaDRG -> ConnData -> SndQueue -> m ConnId
  createSndConn :: SQLiteStore
-> TVar ChaChaDRG -> ConnData -> SndQueue -> m ByteString
createSndConn SQLiteStore
st TVar ChaChaDRG
gVar ConnData
cData q :: SndQueue
q@SndQueue {SMPServer
$sel:server:SndQueue :: SndQueue -> SMPServer
server :: SMPServer
server} =
    -- TODO if schema has to be restarted, this function can be refactored
    -- to create connection first using createWithRandomId
    IO (Either StoreError ByteString) -> m ByteString
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError ByteString) -> m ByteString)
-> ((Connection -> IO (Either StoreError ByteString))
    -> IO (Either StoreError ByteString))
-> (Connection -> IO (Either StoreError ByteString))
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError
-> IO (Either StoreError ByteString)
-> IO (Either StoreError ByteString)
forall a.
StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
checkConstraint StoreError
SEConnDuplicate (IO (Either StoreError ByteString)
 -> IO (Either StoreError ByteString))
-> ((Connection -> IO (Either StoreError ByteString))
    -> IO (Either StoreError ByteString))
-> (Connection -> IO (Either StoreError ByteString))
-> IO (Either StoreError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError ByteString))
-> IO (Either StoreError ByteString)
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError ByteString)) -> m ByteString)
-> (Connection -> IO (Either StoreError ByteString))
-> m ByteString
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      Connection
-> TVar ChaChaDRG -> ConnData -> IO (Either StoreError ByteString)
getConnId_ Connection
db TVar ChaChaDRG
gVar ConnData
cData IO (Either StoreError ByteString)
-> (Either StoreError ByteString
    -> IO (Either StoreError ByteString))
-> IO (Either StoreError ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> IO ByteString)
-> Either StoreError ByteString
-> IO (Either StoreError ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Connection -> ByteString -> IO ByteString
create Connection
db)
    where
      create :: DB.Connection -> ConnId -> IO ConnId
      create :: Connection -> ByteString -> IO ByteString
create Connection
db ByteString
connId = do
        Connection -> SMPServer -> IO ()
upsertServer_ Connection
db SMPServer
server
        Connection -> ByteString -> SndQueue -> IO ()
insertSndQueue_ Connection
db ByteString
connId SndQueue
q
        Connection -> ConnData -> SndQueue -> IO ()
insertSndConnection_ Connection
db ConnData
cData {ByteString
connId :: ByteString
$sel:connId:ConnData :: ByteString
connId} SndQueue
q
        ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
connId

  getConn :: SQLiteStore -> ConnId -> m SomeConn
  getConn :: SQLiteStore -> ByteString -> m SomeConn
getConn SQLiteStore
st ByteString
connId =
    IO (Either StoreError SomeConn) -> m SomeConn
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError SomeConn) -> m SomeConn)
-> ((Connection -> IO (Either StoreError SomeConn))
    -> IO (Either StoreError SomeConn))
-> (Connection -> IO (Either StoreError SomeConn))
-> m SomeConn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError SomeConn))
-> IO (Either StoreError SomeConn)
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError SomeConn)) -> m SomeConn)
-> (Connection -> IO (Either StoreError SomeConn)) -> m SomeConn
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      Connection -> ByteString -> IO (Either StoreError SomeConn)
getConn_ Connection
db ByteString
connId

  getAllConnIds :: SQLiteStore -> m [ConnId]
  getAllConnIds :: SQLiteStore -> m [ByteString]
getAllConnIds SQLiteStore
st =
    IO [ByteString] -> m [ByteString]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ByteString] -> m [ByteString])
-> ((Connection -> IO [ByteString]) -> IO [ByteString])
-> (Connection -> IO [ByteString])
-> m [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore -> (Connection -> IO [ByteString]) -> IO [ByteString]
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO [ByteString]) -> m [ByteString])
-> (Connection -> IO [ByteString]) -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      [[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ByteString]] -> [ByteString])
-> IO [[ByteString]] -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> Query -> IO [[ByteString]]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_ Connection
db Query
"SELECT conn_alias FROM connections;" :: IO [[ConnId]])

  getRcvConn :: SQLiteStore -> SMPServer -> SMP.RecipientId -> m SomeConn
  getRcvConn :: SQLiteStore -> SMPServer -> ByteString -> m SomeConn
getRcvConn SQLiteStore
st SMPServer {FilePath
host :: SMPServer -> FilePath
host :: FilePath
host, Maybe FilePath
port :: SMPServer -> Maybe FilePath
port :: Maybe FilePath
port} ByteString
rcvId =
    IO (Either StoreError SomeConn) -> m SomeConn
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError SomeConn) -> m SomeConn)
-> ((Connection -> IO (Either StoreError SomeConn))
    -> IO (Either StoreError SomeConn))
-> (Connection -> IO (Either StoreError SomeConn))
-> m SomeConn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError SomeConn))
-> IO (Either StoreError SomeConn)
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError SomeConn)) -> m SomeConn)
-> (Connection -> IO (Either StoreError SomeConn)) -> m SomeConn
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      Connection -> Query -> [NamedParam] -> IO [Only ByteString]
forall r.
FromRow r =>
Connection -> Query -> [NamedParam] -> IO [r]
DB.queryNamed
        Connection
db
        [sql|
          SELECT q.conn_alias
          FROM rcv_queues q
          WHERE q.host = :host AND q.port = :port AND q.rcv_id = :rcv_id;
        |]
        [Text
":host" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= FilePath
host, Text
":port" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= Maybe FilePath -> FilePath
serializePort_ Maybe FilePath
port, Text
":rcv_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
rcvId]
        IO [Only ByteString]
-> ([Only ByteString] -> IO (Either StoreError SomeConn))
-> IO (Either StoreError SomeConn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          [Only ByteString
connId] -> Connection -> ByteString -> IO (Either StoreError SomeConn)
getConn_ Connection
db ByteString
connId
          [Only ByteString]
_ -> Either StoreError SomeConn -> IO (Either StoreError SomeConn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError SomeConn -> IO (Either StoreError SomeConn))
-> Either StoreError SomeConn -> IO (Either StoreError SomeConn)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError SomeConn
forall a b. a -> Either a b
Left StoreError
SEConnNotFound

  deleteConn :: SQLiteStore -> ConnId -> m ()
  deleteConn :: SQLiteStore -> ByteString -> m ()
deleteConn SQLiteStore
st ByteString
connId =
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Connection -> IO ()) -> IO ())
-> (Connection -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore -> (Connection -> IO ()) -> IO ()
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO ()) -> m ()) -> (Connection -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
        Connection
db
        Query
"DELETE FROM connections WHERE conn_alias = :conn_alias;"
        [Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId]

  upgradeRcvConnToDuplex :: SQLiteStore -> ConnId -> SndQueue -> m ()
  upgradeRcvConnToDuplex :: SQLiteStore -> ByteString -> SndQueue -> m ()
upgradeRcvConnToDuplex SQLiteStore
st ByteString
connId sq :: SndQueue
sq@SndQueue {SMPServer
server :: SMPServer
$sel:server:SndQueue :: SndQueue -> SMPServer
server} =
    IO (Either StoreError ()) -> m ()
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError ()) -> m ())
-> ((Connection -> IO (Either StoreError ()))
    -> IO (Either StoreError ()))
-> (Connection -> IO (Either StoreError ()))
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError ()))
-> IO (Either StoreError ())
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError ())) -> m ())
-> (Connection -> IO (Either StoreError ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      Connection -> ByteString -> IO (Either StoreError SomeConn)
getConn_ Connection
db ByteString
connId IO (Either StoreError SomeConn)
-> (Either StoreError SomeConn -> IO (Either StoreError ()))
-> IO (Either StoreError ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right (SomeConn SConnType d
_ RcvConnection {}) -> do
          Connection -> SMPServer -> IO ()
upsertServer_ Connection
db SMPServer
server
          Connection -> ByteString -> SndQueue -> IO ()
insertSndQueue_ Connection
db ByteString
connId SndQueue
sq
          Connection -> ByteString -> SndQueue -> IO ()
updateConnWithSndQueue_ Connection
db ByteString
connId SndQueue
sq
          Either StoreError () -> IO (Either StoreError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError () -> IO (Either StoreError ()))
-> Either StoreError () -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ () -> Either StoreError ()
forall a b. b -> Either a b
Right ()
        Right (SomeConn SConnType d
c Connection d
_) -> Either StoreError () -> IO (Either StoreError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError () -> IO (Either StoreError ()))
-> (ConnType -> Either StoreError ())
-> ConnType
-> IO (Either StoreError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError ()
forall a b. a -> Either a b
Left (StoreError -> Either StoreError ())
-> (ConnType -> StoreError) -> ConnType -> Either StoreError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnType -> StoreError
SEBadConnType (ConnType -> IO (Either StoreError ()))
-> ConnType -> IO (Either StoreError ())
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 () -> IO (Either StoreError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError () -> IO (Either StoreError ()))
-> Either StoreError () -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ()
forall a b. a -> Either a b
Left StoreError
SEConnNotFound

  upgradeSndConnToDuplex :: SQLiteStore -> ConnId -> RcvQueue -> m ()
  upgradeSndConnToDuplex :: SQLiteStore -> ByteString -> RcvQueue -> m ()
upgradeSndConnToDuplex SQLiteStore
st ByteString
connId rq :: RcvQueue
rq@RcvQueue {SMPServer
server :: SMPServer
$sel:server:RcvQueue :: RcvQueue -> SMPServer
server} =
    IO (Either StoreError ()) -> m ()
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError ()) -> m ())
-> ((Connection -> IO (Either StoreError ()))
    -> IO (Either StoreError ()))
-> (Connection -> IO (Either StoreError ()))
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError ()))
-> IO (Either StoreError ())
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError ())) -> m ())
-> (Connection -> IO (Either StoreError ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      Connection -> ByteString -> IO (Either StoreError SomeConn)
getConn_ Connection
db ByteString
connId IO (Either StoreError SomeConn)
-> (Either StoreError SomeConn -> IO (Either StoreError ()))
-> IO (Either StoreError ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right (SomeConn SConnType d
_ SndConnection {}) -> do
          Connection -> SMPServer -> IO ()
upsertServer_ Connection
db SMPServer
server
          Connection -> ByteString -> RcvQueue -> IO ()
insertRcvQueue_ Connection
db ByteString
connId RcvQueue
rq
          Connection -> ByteString -> RcvQueue -> IO ()
updateConnWithRcvQueue_ Connection
db ByteString
connId RcvQueue
rq
          Either StoreError () -> IO (Either StoreError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError () -> IO (Either StoreError ()))
-> Either StoreError () -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ () -> Either StoreError ()
forall a b. b -> Either a b
Right ()
        Right (SomeConn SConnType d
c Connection d
_) -> Either StoreError () -> IO (Either StoreError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError () -> IO (Either StoreError ()))
-> (ConnType -> Either StoreError ())
-> ConnType
-> IO (Either StoreError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError ()
forall a b. a -> Either a b
Left (StoreError -> Either StoreError ())
-> (ConnType -> StoreError) -> ConnType -> Either StoreError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnType -> StoreError
SEBadConnType (ConnType -> IO (Either StoreError ()))
-> ConnType -> IO (Either StoreError ())
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 () -> IO (Either StoreError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError () -> IO (Either StoreError ()))
-> Either StoreError () -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ()
forall a b. a -> Either a b
Left StoreError
SEConnNotFound

  setRcvQueueStatus :: SQLiteStore -> RcvQueue -> QueueStatus -> m ()
  setRcvQueueStatus :: SQLiteStore -> RcvQueue -> QueueStatus -> m ()
setRcvQueueStatus SQLiteStore
st RcvQueue {ByteString
$sel:rcvId:RcvQueue :: RcvQueue -> ByteString
rcvId :: ByteString
rcvId, $sel:server:RcvQueue :: RcvQueue -> SMPServer
server = SMPServer {FilePath
host :: FilePath
host :: SMPServer -> FilePath
host, Maybe FilePath
port :: Maybe FilePath
port :: SMPServer -> Maybe FilePath
port}} QueueStatus
status =
    -- ? throw error if queue does not exist?
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Connection -> IO ()) -> IO ())
-> (Connection -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore -> (Connection -> IO ()) -> IO ()
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO ()) -> m ()) -> (Connection -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
        Connection
db
        [sql|
          UPDATE rcv_queues
          SET status = :status
          WHERE host = :host AND port = :port AND rcv_id = :rcv_id;
        |]
        [Text
":status" Text -> QueueStatus -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= QueueStatus
status, Text
":host" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= FilePath
host, Text
":port" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= Maybe FilePath -> FilePath
serializePort_ Maybe FilePath
port, Text
":rcv_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
rcvId]

  setRcvQueueActive :: SQLiteStore -> RcvQueue -> VerificationKey -> m ()
  setRcvQueueActive :: SQLiteStore -> RcvQueue -> VerificationKey -> m ()
setRcvQueueActive SQLiteStore
st RcvQueue {ByteString
rcvId :: ByteString
$sel:rcvId:RcvQueue :: RcvQueue -> ByteString
rcvId, $sel:server:RcvQueue :: RcvQueue -> SMPServer
server = SMPServer {FilePath
host :: FilePath
host :: SMPServer -> FilePath
host, Maybe FilePath
port :: Maybe FilePath
port :: SMPServer -> Maybe FilePath
port}} VerificationKey
verifyKey =
    -- ? throw error if queue does not exist?
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Connection -> IO ()) -> IO ())
-> (Connection -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore -> (Connection -> IO ()) -> IO ()
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO ()) -> m ()) -> (Connection -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
        Connection
db
        [sql|
          UPDATE rcv_queues
          SET verify_key = :verify_key, status = :status
          WHERE host = :host AND port = :port AND rcv_id = :rcv_id;
        |]
        [ Text
":verify_key" Text -> Maybe VerificationKey -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= VerificationKey -> Maybe VerificationKey
forall a. a -> Maybe a
Just VerificationKey
verifyKey,
          Text
":status" Text -> QueueStatus -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= QueueStatus
Active,
          Text
":host" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= FilePath
host,
          Text
":port" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= Maybe FilePath -> FilePath
serializePort_ Maybe FilePath
port,
          Text
":rcv_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
rcvId
        ]

  setSndQueueStatus :: SQLiteStore -> SndQueue -> QueueStatus -> m ()
  setSndQueueStatus :: SQLiteStore -> SndQueue -> QueueStatus -> m ()
setSndQueueStatus SQLiteStore
st SndQueue {ByteString
$sel:sndId:SndQueue :: SndQueue -> ByteString
sndId :: ByteString
sndId, $sel:server:SndQueue :: SndQueue -> SMPServer
server = SMPServer {FilePath
host :: FilePath
host :: SMPServer -> FilePath
host, Maybe FilePath
port :: Maybe FilePath
port :: SMPServer -> Maybe FilePath
port}} QueueStatus
status =
    -- ? throw error if queue does not exist?
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Connection -> IO ()) -> IO ())
-> (Connection -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore -> (Connection -> IO ()) -> IO ()
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO ()) -> m ()) -> (Connection -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
        Connection
db
        [sql|
          UPDATE snd_queues
          SET status = :status
          WHERE host = :host AND port = :port AND snd_id = :snd_id;
        |]
        [Text
":status" Text -> QueueStatus -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= QueueStatus
status, Text
":host" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= FilePath
host, Text
":port" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= Maybe FilePath -> FilePath
serializePort_ Maybe FilePath
port, Text
":snd_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
sndId]

  updateSignKey :: SQLiteStore -> SndQueue -> SignatureKey -> m ()
  updateSignKey :: SQLiteStore -> SndQueue -> SignatureKey -> m ()
updateSignKey SQLiteStore
st SndQueue {ByteString
sndId :: ByteString
$sel:sndId:SndQueue :: SndQueue -> ByteString
sndId, $sel:server:SndQueue :: SndQueue -> SMPServer
server = SMPServer {FilePath
host :: FilePath
host :: SMPServer -> FilePath
host, Maybe FilePath
port :: Maybe FilePath
port :: SMPServer -> Maybe FilePath
port}} SignatureKey
signatureKey =
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Connection -> IO ()) -> IO ())
-> (Connection -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore -> (Connection -> IO ()) -> IO ()
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO ()) -> m ()) -> (Connection -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
        Connection
db
        [sql|
          UPDATE snd_queues
          SET sign_key = :sign_key
          WHERE host = :host AND port = :port AND snd_id = :snd_id;
        |]
        [Text
":sign_key" Text -> SignatureKey -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= SignatureKey
signatureKey, Text
":host" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= FilePath
host, Text
":port" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= Maybe FilePath -> FilePath
serializePort_ Maybe FilePath
port, Text
":snd_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
sndId]

  createConfirmation :: SQLiteStore -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId
  createConfirmation :: SQLiteStore -> TVar ChaChaDRG -> NewConfirmation -> m ByteString
createConfirmation SQLiteStore
st TVar ChaChaDRG
gVar NewConfirmation {ByteString
$sel:connId:NewConfirmation :: NewConfirmation -> ByteString
connId :: ByteString
connId, VerificationKey
$sel:senderKey:NewConfirmation :: NewConfirmation -> VerificationKey
senderKey :: VerificationKey
senderKey, ByteString
$sel:senderConnInfo:NewConfirmation :: NewConfirmation -> ByteString
senderConnInfo :: ByteString
senderConnInfo} =
    IO (Either StoreError ByteString) -> m ByteString
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError ByteString) -> m ByteString)
-> ((Connection -> IO (Either StoreError ByteString))
    -> IO (Either StoreError ByteString))
-> (Connection -> IO (Either StoreError ByteString))
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError ByteString))
-> IO (Either StoreError ByteString)
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError ByteString)) -> m ByteString)
-> (Connection -> IO (Either StoreError ByteString))
-> m ByteString
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      TVar ChaChaDRG
-> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
createWithRandomId TVar ChaChaDRG
gVar ((ByteString -> IO ()) -> IO (Either StoreError ByteString))
-> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ \ByteString
confirmationId ->
        Connection
-> Query
-> (ByteString, ByteString, VerificationKey, ByteString)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          [sql|
            INSERT INTO conn_confirmations
            (confirmation_id, conn_alias, sender_key, sender_conn_info, accepted) VALUES (?, ?, ?, ?, 0);
          |]
          (ByteString
confirmationId, ByteString
connId, VerificationKey
senderKey, ByteString
senderConnInfo)

  acceptConfirmation :: SQLiteStore -> ConfirmationId -> ConnInfo -> m AcceptedConfirmation
  acceptConfirmation :: SQLiteStore -> ByteString -> ByteString -> m AcceptedConfirmation
acceptConfirmation SQLiteStore
st ByteString
confirmationId ByteString
ownConnInfo =
    IO (Either StoreError AcceptedConfirmation)
-> m AcceptedConfirmation
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError AcceptedConfirmation)
 -> m AcceptedConfirmation)
-> ((Connection -> IO (Either StoreError AcceptedConfirmation))
    -> IO (Either StoreError AcceptedConfirmation))
-> (Connection -> IO (Either StoreError AcceptedConfirmation))
-> m AcceptedConfirmation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError AcceptedConfirmation))
-> IO (Either StoreError AcceptedConfirmation)
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError AcceptedConfirmation))
 -> m AcceptedConfirmation)
-> (Connection -> IO (Either StoreError AcceptedConfirmation))
-> m AcceptedConfirmation
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
        Connection
db
        [sql|
          UPDATE conn_confirmations
          SET accepted = 1,
              own_conn_info = :own_conn_info
          WHERE confirmation_id = :confirmation_id;
        |]
        [ Text
":own_conn_info" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
ownConnInfo,
          Text
":confirmation_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
confirmationId
        ]
      [(ByteString, VerificationKey, ByteString)]
-> Either StoreError AcceptedConfirmation
confirmation
        ([(ByteString, VerificationKey, ByteString)]
 -> Either StoreError AcceptedConfirmation)
-> IO [(ByteString, VerificationKey, ByteString)]
-> IO (Either StoreError AcceptedConfirmation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only ByteString
-> IO [(ByteString, VerificationKey, ByteString)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT conn_alias, sender_key, sender_conn_info
            FROM conn_confirmations
            WHERE confirmation_id = ?;
          |]
          (ByteString -> Only ByteString
forall a. a -> Only a
Only ByteString
confirmationId)
    where
      confirmation :: [(ByteString, VerificationKey, ByteString)]
-> Either StoreError AcceptedConfirmation
confirmation [(ByteString
connId, VerificationKey
senderKey, ByteString
senderConnInfo)] =
        AcceptedConfirmation -> Either StoreError AcceptedConfirmation
forall a b. b -> Either a b
Right (AcceptedConfirmation -> Either StoreError AcceptedConfirmation)
-> AcceptedConfirmation -> Either StoreError AcceptedConfirmation
forall a b. (a -> b) -> a -> b
$ AcceptedConfirmation :: ByteString
-> ByteString
-> VerificationKey
-> ByteString
-> ByteString
-> AcceptedConfirmation
AcceptedConfirmation {ByteString
$sel:confirmationId:AcceptedConfirmation :: ByteString
confirmationId :: ByteString
confirmationId, ByteString
$sel:connId:AcceptedConfirmation :: ByteString
connId :: ByteString
connId, VerificationKey
$sel:senderKey:AcceptedConfirmation :: VerificationKey
senderKey :: VerificationKey
senderKey, ByteString
$sel:senderConnInfo:AcceptedConfirmation :: ByteString
senderConnInfo :: ByteString
senderConnInfo, ByteString
$sel:ownConnInfo:AcceptedConfirmation :: ByteString
ownConnInfo :: ByteString
ownConnInfo}
      confirmation [(ByteString, VerificationKey, ByteString)]
_ = StoreError -> Either StoreError AcceptedConfirmation
forall a b. a -> Either a b
Left StoreError
SEConfirmationNotFound

  getAcceptedConfirmation :: SQLiteStore -> ConnId -> m AcceptedConfirmation
  getAcceptedConfirmation :: SQLiteStore -> ByteString -> m AcceptedConfirmation
getAcceptedConfirmation SQLiteStore
st ByteString
connId =
    IO (Either StoreError AcceptedConfirmation)
-> m AcceptedConfirmation
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError AcceptedConfirmation)
 -> m AcceptedConfirmation)
-> ((Connection -> IO (Either StoreError AcceptedConfirmation))
    -> IO (Either StoreError AcceptedConfirmation))
-> (Connection -> IO (Either StoreError AcceptedConfirmation))
-> m AcceptedConfirmation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError AcceptedConfirmation))
-> IO (Either StoreError AcceptedConfirmation)
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError AcceptedConfirmation))
 -> m AcceptedConfirmation)
-> (Connection -> IO (Either StoreError AcceptedConfirmation))
-> m AcceptedConfirmation
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      [(ByteString, VerificationKey, ByteString, ByteString)]
-> Either StoreError AcceptedConfirmation
confirmation
        ([(ByteString, VerificationKey, ByteString, ByteString)]
 -> Either StoreError AcceptedConfirmation)
-> IO [(ByteString, VerificationKey, ByteString, ByteString)]
-> IO (Either StoreError AcceptedConfirmation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only ByteString
-> IO [(ByteString, VerificationKey, ByteString, ByteString)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT confirmation_id, sender_key, sender_conn_info, own_conn_info
            FROM conn_confirmations
            WHERE conn_alias = ? AND accepted = 1;
          |]
          (ByteString -> Only ByteString
forall a. a -> Only a
Only ByteString
connId)
    where
      confirmation :: [(ByteString, VerificationKey, ByteString, ByteString)]
-> Either StoreError AcceptedConfirmation
confirmation [(ByteString
confirmationId, VerificationKey
senderKey, ByteString
senderConnInfo, ByteString
ownConnInfo)] =
        AcceptedConfirmation -> Either StoreError AcceptedConfirmation
forall a b. b -> Either a b
Right (AcceptedConfirmation -> Either StoreError AcceptedConfirmation)
-> AcceptedConfirmation -> Either StoreError AcceptedConfirmation
forall a b. (a -> b) -> a -> b
$ AcceptedConfirmation :: ByteString
-> ByteString
-> VerificationKey
-> ByteString
-> ByteString
-> AcceptedConfirmation
AcceptedConfirmation {ByteString
confirmationId :: ByteString
$sel:confirmationId:AcceptedConfirmation :: ByteString
confirmationId, ByteString
connId :: ByteString
$sel:connId:AcceptedConfirmation :: ByteString
connId, VerificationKey
senderKey :: VerificationKey
$sel:senderKey:AcceptedConfirmation :: VerificationKey
senderKey, ByteString
senderConnInfo :: ByteString
$sel:senderConnInfo:AcceptedConfirmation :: ByteString
senderConnInfo, ByteString
ownConnInfo :: ByteString
$sel:ownConnInfo:AcceptedConfirmation :: ByteString
ownConnInfo}
      confirmation [(ByteString, VerificationKey, ByteString, ByteString)]
_ = StoreError -> Either StoreError AcceptedConfirmation
forall a b. a -> Either a b
Left StoreError
SEConfirmationNotFound

  removeConfirmations :: SQLiteStore -> ConnId -> m ()
  removeConfirmations :: SQLiteStore -> ByteString -> m ()
removeConfirmations SQLiteStore
st ByteString
connId =
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Connection -> IO ()) -> IO ())
-> (Connection -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore -> (Connection -> IO ()) -> IO ()
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO ()) -> m ()) -> (Connection -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
        Connection
db
        [sql|
          DELETE FROM conn_confirmations
          WHERE conn_alias = :conn_alias;
        |]
        [Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId]

  createInvitation :: SQLiteStore -> TVar ChaChaDRG -> NewInvitation -> m InvitationId
  createInvitation :: SQLiteStore -> TVar ChaChaDRG -> NewInvitation -> m ByteString
createInvitation SQLiteStore
st TVar ChaChaDRG
gVar NewInvitation {ByteString
$sel:contactConnId:NewInvitation :: NewInvitation -> ByteString
contactConnId :: ByteString
contactConnId, ConnectionRequest 'CMInvitation
$sel:connReq:NewInvitation :: NewInvitation -> ConnectionRequest 'CMInvitation
connReq :: ConnectionRequest 'CMInvitation
connReq, ByteString
$sel:recipientConnInfo:NewInvitation :: NewInvitation -> ByteString
recipientConnInfo :: ByteString
recipientConnInfo} =
    IO (Either StoreError ByteString) -> m ByteString
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError ByteString) -> m ByteString)
-> ((Connection -> IO (Either StoreError ByteString))
    -> IO (Either StoreError ByteString))
-> (Connection -> IO (Either StoreError ByteString))
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError ByteString))
-> IO (Either StoreError ByteString)
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError ByteString)) -> m ByteString)
-> (Connection -> IO (Either StoreError ByteString))
-> m ByteString
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      TVar ChaChaDRG
-> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
createWithRandomId TVar ChaChaDRG
gVar ((ByteString -> IO ()) -> IO (Either StoreError ByteString))
-> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ \ByteString
invitationId ->
        Connection
-> Query
-> (ByteString, ByteString, ConnectionRequest 'CMInvitation,
    ByteString)
-> 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);
          |]
          (ByteString
invitationId, ByteString
contactConnId, ConnectionRequest 'CMInvitation
connReq, ByteString
recipientConnInfo)

  getInvitation :: SQLiteStore -> InvitationId -> m Invitation
  getInvitation :: SQLiteStore -> ByteString -> m Invitation
getInvitation SQLiteStore
st ByteString
invitationId =
    IO (Either StoreError Invitation) -> m Invitation
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError Invitation) -> m Invitation)
-> ((Connection -> IO (Either StoreError Invitation))
    -> IO (Either StoreError Invitation))
-> (Connection -> IO (Either StoreError Invitation))
-> m Invitation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError Invitation))
-> IO (Either StoreError Invitation)
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError Invitation)) -> m Invitation)
-> (Connection -> IO (Either StoreError Invitation))
-> m Invitation
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      [(ByteString, ConnectionRequest 'CMInvitation, ByteString,
  Maybe ByteString, Bool)]
-> Either StoreError Invitation
invitation
        ([(ByteString, ConnectionRequest 'CMInvitation, ByteString,
   Maybe ByteString, Bool)]
 -> Either StoreError Invitation)
-> IO
     [(ByteString, ConnectionRequest 'CMInvitation, ByteString,
       Maybe ByteString, Bool)]
-> IO (Either StoreError Invitation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only ByteString
-> IO
     [(ByteString, ConnectionRequest 'CMInvitation, ByteString,
       Maybe ByteString, Bool)]
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
          |]
          (ByteString -> Only ByteString
forall a. a -> Only a
Only ByteString
invitationId)
    where
      invitation :: [(ByteString, ConnectionRequest 'CMInvitation, ByteString,
  Maybe ByteString, Bool)]
-> Either StoreError Invitation
invitation [(ByteString
contactConnId, ConnectionRequest 'CMInvitation
connReq, ByteString
recipientConnInfo, Maybe ByteString
ownConnInfo, Bool
accepted)] =
        Invitation -> Either StoreError Invitation
forall a b. b -> Either a b
Right Invitation :: ByteString
-> ByteString
-> ConnectionRequest 'CMInvitation
-> ByteString
-> Maybe ByteString
-> Bool
-> Invitation
Invitation {ByteString
$sel:invitationId:Invitation :: ByteString
invitationId :: ByteString
invitationId, ByteString
$sel:contactConnId:Invitation :: ByteString
contactConnId :: ByteString
contactConnId, ConnectionRequest 'CMInvitation
$sel:connReq:Invitation :: ConnectionRequest 'CMInvitation
connReq :: ConnectionRequest 'CMInvitation
connReq, ByteString
$sel:recipientConnInfo:Invitation :: ByteString
recipientConnInfo :: ByteString
recipientConnInfo, Maybe ByteString
$sel:ownConnInfo:Invitation :: Maybe ByteString
ownConnInfo :: Maybe ByteString
ownConnInfo, Bool
$sel:accepted:Invitation :: Bool
accepted :: Bool
accepted}
      invitation [(ByteString, ConnectionRequest 'CMInvitation, ByteString,
  Maybe ByteString, Bool)]
_ = StoreError -> Either StoreError Invitation
forall a b. a -> Either a b
Left StoreError
SEInvitationNotFound

  acceptInvitation :: SQLiteStore -> InvitationId -> ConnInfo -> m ()
  acceptInvitation :: SQLiteStore -> ByteString -> ByteString -> m ()
acceptInvitation SQLiteStore
st ByteString
invitationId ByteString
ownConnInfo =
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Connection -> IO ()) -> IO ())
-> (Connection -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore -> (Connection -> IO ()) -> IO ()
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO ()) -> m ()) -> (Connection -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
        Connection
db
        [sql|
          UPDATE conn_invitations
          SET accepted = 1,
              own_conn_info = :own_conn_info
          WHERE invitation_id = :invitation_id
        |]
        [ Text
":own_conn_info" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
ownConnInfo,
          Text
":invitation_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
invitationId
        ]

  deleteInvitation :: SQLiteStore -> ConnId -> InvitationId -> m ()
  deleteInvitation :: SQLiteStore -> ByteString -> ByteString -> m ()
deleteInvitation SQLiteStore
st ByteString
contactConnId ByteString
invId =
    IO (Either StoreError ()) -> m ()
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError ()) -> m ())
-> ((Connection -> IO (Either StoreError ()))
    -> IO (Either StoreError ()))
-> (Connection -> IO (Either StoreError ()))
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError ()))
-> IO (Either StoreError ())
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError ())) -> m ())
-> (Connection -> IO (Either StoreError ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      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
$
        IO (Either StoreError SomeConn) -> ExceptT StoreError IO SomeConn
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Connection -> ByteString -> IO (Either StoreError SomeConn)
getConn_ Connection
db ByteString
contactConnId) ExceptT StoreError IO SomeConn
-> (SomeConn -> ExceptT StoreError IO ())
-> ExceptT StoreError IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          SomeConn SConnType d
SCContact Connection d
_ ->
            IO () -> ExceptT StoreError IO ()
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 -> (ByteString, ByteString) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM conn_invitations WHERE contact_conn_id = ? AND invitation_id = ?" (ByteString
contactConnId, ByteString
invId)
          SomeConn
_ -> StoreError -> ExceptT StoreError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StoreError
SEConnNotFound

  updateRcvIds :: SQLiteStore -> ConnId -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
  updateRcvIds :: SQLiteStore
-> ByteString
-> m (InternalId, InternalRcvId, PrevExternalSndId, ByteString)
updateRcvIds SQLiteStore
st ByteString
connId =
    IO (InternalId, InternalRcvId, PrevExternalSndId, ByteString)
-> m (InternalId, InternalRcvId, PrevExternalSndId, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InternalId, InternalRcvId, PrevExternalSndId, ByteString)
 -> m (InternalId, InternalRcvId, PrevExternalSndId, ByteString))
-> ((Connection
     -> IO (InternalId, InternalRcvId, PrevExternalSndId, ByteString))
    -> IO (InternalId, InternalRcvId, PrevExternalSndId, ByteString))
-> (Connection
    -> IO (InternalId, InternalRcvId, PrevExternalSndId, ByteString))
-> m (InternalId, InternalRcvId, PrevExternalSndId, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection
    -> IO (InternalId, InternalRcvId, PrevExternalSndId, ByteString))
-> IO (InternalId, InternalRcvId, PrevExternalSndId, ByteString)
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection
  -> IO (InternalId, InternalRcvId, PrevExternalSndId, ByteString))
 -> m (InternalId, InternalRcvId, PrevExternalSndId, ByteString))
-> (Connection
    -> IO (InternalId, InternalRcvId, PrevExternalSndId, ByteString))
-> m (InternalId, InternalRcvId, PrevExternalSndId, ByteString)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      (InternalId
lastInternalId, InternalRcvId
lastInternalRcvId, PrevExternalSndId
lastExternalSndId, ByteString
lastRcvHash) <- Connection
-> ByteString
-> IO (InternalId, InternalRcvId, PrevExternalSndId, ByteString)
retrieveLastIdsAndHashRcv_ Connection
db ByteString
connId
      let internalId :: InternalId
internalId = PrevExternalSndId -> InternalId
InternalId (PrevExternalSndId -> InternalId)
-> PrevExternalSndId -> InternalId
forall a b. (a -> b) -> a -> b
$ InternalId -> PrevExternalSndId
unId InternalId
lastInternalId PrevExternalSndId -> PrevExternalSndId -> PrevExternalSndId
forall a. Num a => a -> a -> a
+ PrevExternalSndId
1
          internalRcvId :: InternalRcvId
internalRcvId = PrevExternalSndId -> InternalRcvId
InternalRcvId (PrevExternalSndId -> InternalRcvId)
-> PrevExternalSndId -> InternalRcvId
forall a b. (a -> b) -> a -> b
$ InternalRcvId -> PrevExternalSndId
unRcvId InternalRcvId
lastInternalRcvId PrevExternalSndId -> PrevExternalSndId -> PrevExternalSndId
forall a. Num a => a -> a -> a
+ PrevExternalSndId
1
      Connection -> ByteString -> InternalId -> InternalRcvId -> IO ()
updateLastIdsRcv_ Connection
db ByteString
connId InternalId
internalId InternalRcvId
internalRcvId
      (InternalId, InternalRcvId, PrevExternalSndId, ByteString)
-> IO (InternalId, InternalRcvId, PrevExternalSndId, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InternalId
internalId, InternalRcvId
internalRcvId, PrevExternalSndId
lastExternalSndId, ByteString
lastRcvHash)

  createRcvMsg :: SQLiteStore -> ConnId -> RcvMsgData -> m ()
  createRcvMsg :: SQLiteStore -> ByteString -> RcvMsgData -> m ()
createRcvMsg SQLiteStore
st ByteString
connId RcvMsgData
rcvMsgData =
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Connection -> IO ()) -> IO ())
-> (Connection -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore -> (Connection -> IO ()) -> IO ()
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO ()) -> m ()) -> (Connection -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      Connection -> ByteString -> RcvMsgData -> IO ()
insertRcvMsgBase_ Connection
db ByteString
connId RcvMsgData
rcvMsgData
      Connection -> ByteString -> RcvMsgData -> IO ()
insertRcvMsgDetails_ Connection
db ByteString
connId RcvMsgData
rcvMsgData
      Connection -> ByteString -> RcvMsgData -> IO ()
updateHashRcv_ Connection
db ByteString
connId RcvMsgData
rcvMsgData

  updateSndIds :: SQLiteStore -> ConnId -> m (InternalId, InternalSndId, PrevSndMsgHash)
  updateSndIds :: SQLiteStore
-> ByteString -> m (InternalId, InternalSndId, ByteString)
updateSndIds SQLiteStore
st ByteString
connId =
    IO (InternalId, InternalSndId, ByteString)
-> m (InternalId, InternalSndId, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InternalId, InternalSndId, ByteString)
 -> m (InternalId, InternalSndId, ByteString))
-> ((Connection -> IO (InternalId, InternalSndId, ByteString))
    -> IO (InternalId, InternalSndId, ByteString))
-> (Connection -> IO (InternalId, InternalSndId, ByteString))
-> m (InternalId, InternalSndId, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (InternalId, InternalSndId, ByteString))
-> IO (InternalId, InternalSndId, ByteString)
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (InternalId, InternalSndId, ByteString))
 -> m (InternalId, InternalSndId, ByteString))
-> (Connection -> IO (InternalId, InternalSndId, ByteString))
-> m (InternalId, InternalSndId, ByteString)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      (InternalId
lastInternalId, InternalSndId
lastInternalSndId, ByteString
prevSndHash) <- Connection
-> ByteString -> IO (InternalId, InternalSndId, ByteString)
retrieveLastIdsAndHashSnd_ Connection
db ByteString
connId
      let internalId :: InternalId
internalId = PrevExternalSndId -> InternalId
InternalId (PrevExternalSndId -> InternalId)
-> PrevExternalSndId -> InternalId
forall a b. (a -> b) -> a -> b
$ InternalId -> PrevExternalSndId
unId InternalId
lastInternalId PrevExternalSndId -> PrevExternalSndId -> PrevExternalSndId
forall a. Num a => a -> a -> a
+ PrevExternalSndId
1
          internalSndId :: InternalSndId
internalSndId = PrevExternalSndId -> InternalSndId
InternalSndId (PrevExternalSndId -> InternalSndId)
-> PrevExternalSndId -> InternalSndId
forall a b. (a -> b) -> a -> b
$ InternalSndId -> PrevExternalSndId
unSndId InternalSndId
lastInternalSndId PrevExternalSndId -> PrevExternalSndId -> PrevExternalSndId
forall a. Num a => a -> a -> a
+ PrevExternalSndId
1
      Connection -> ByteString -> InternalId -> InternalSndId -> IO ()
updateLastIdsSnd_ Connection
db ByteString
connId InternalId
internalId InternalSndId
internalSndId
      (InternalId, InternalSndId, ByteString)
-> IO (InternalId, InternalSndId, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InternalId
internalId, InternalSndId
internalSndId, ByteString
prevSndHash)

  createSndMsg :: SQLiteStore -> ConnId -> SndMsgData -> m ()
  createSndMsg :: SQLiteStore -> ByteString -> SndMsgData -> m ()
createSndMsg SQLiteStore
st ByteString
connId SndMsgData
sndMsgData =
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Connection -> IO ()) -> IO ())
-> (Connection -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore -> (Connection -> IO ()) -> IO ()
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO ()) -> m ()) -> (Connection -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      Connection -> ByteString -> SndMsgData -> IO ()
insertSndMsgBase_ Connection
db ByteString
connId SndMsgData
sndMsgData
      Connection -> ByteString -> SndMsgData -> IO ()
insertSndMsgDetails_ Connection
db ByteString
connId SndMsgData
sndMsgData
      Connection -> ByteString -> SndMsgData -> IO ()
updateHashSnd_ Connection
db ByteString
connId SndMsgData
sndMsgData

  updateSndMsgStatus :: SQLiteStore -> ConnId -> InternalId -> SndMsgStatus -> m ()
  updateSndMsgStatus :: SQLiteStore -> ByteString -> InternalId -> SndMsgStatus -> m ()
updateSndMsgStatus SQLiteStore
st ByteString
connId InternalId
msgId SndMsgStatus
msgStatus =
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Connection -> IO ()) -> IO ())
-> (Connection -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore -> (Connection -> IO ()) -> IO ()
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO ()) -> m ()) -> (Connection -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
        Connection
db
        [sql|
          UPDATE snd_messages
          SET snd_status = :snd_status
          WHERE conn_alias = :conn_alias AND internal_id = :internal_id
        |]
        [ Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId,
          Text
":internal_id" Text -> InternalId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= InternalId
msgId,
          Text
":snd_status" Text -> SndMsgStatus -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= SndMsgStatus
msgStatus
        ]

  getPendingMsgData :: SQLiteStore -> ConnId -> InternalId -> m MsgBody
  getPendingMsgData :: SQLiteStore -> ByteString -> InternalId -> m ByteString
getPendingMsgData SQLiteStore
st ByteString
connId InternalId
msgId =
    IO (Either StoreError ByteString) -> m ByteString
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError ByteString) -> m ByteString)
-> ((Connection -> IO (Either StoreError ByteString))
    -> IO (Either StoreError ByteString))
-> (Connection -> IO (Either StoreError ByteString))
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError ByteString))
-> IO (Either StoreError ByteString)
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError ByteString)) -> m ByteString)
-> (Connection -> IO (Either StoreError ByteString))
-> m ByteString
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      [Only ByteString] -> Either StoreError ByteString
sndMsgData
        ([Only ByteString] -> Either StoreError ByteString)
-> IO [Only ByteString] -> IO (Either StoreError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> (ByteString, InternalId) -> IO [Only ByteString]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT m.msg_body
            FROM messages m
            JOIN snd_messages s ON s.conn_alias = m.conn_alias AND s.internal_id = m.internal_id
            WHERE m.conn_alias = ? AND m.internal_id = ?
          |]
          (ByteString
connId, InternalId
msgId)
    where
      sndMsgData :: [Only MsgBody] -> Either StoreError MsgBody
      sndMsgData :: [Only ByteString] -> Either StoreError ByteString
sndMsgData [Only ByteString
msgBody] = ByteString -> Either StoreError ByteString
forall a b. b -> Either a b
Right ByteString
msgBody
      sndMsgData [Only ByteString]
_ = StoreError -> Either StoreError ByteString
forall a b. a -> Either a b
Left StoreError
SEMsgNotFound

  getPendingMsgs :: SQLiteStore -> ConnId -> m [InternalId]
  getPendingMsgs :: SQLiteStore -> ByteString -> m [InternalId]
getPendingMsgs SQLiteStore
st ByteString
connId =
    IO [InternalId] -> m [InternalId]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [InternalId] -> m [InternalId])
-> ((Connection -> IO [InternalId]) -> IO [InternalId])
-> (Connection -> IO [InternalId])
-> m [InternalId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore -> (Connection -> IO [InternalId]) -> IO [InternalId]
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO [InternalId]) -> m [InternalId])
-> (Connection -> IO [InternalId]) -> m [InternalId]
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      (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 -> (ByteString, SndMsgStatus) -> IO [Only InternalId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT internal_id FROM snd_messages WHERE conn_alias = ? AND snd_status = ?" (ByteString
connId, SndMsgStatus
SndMsgCreated)

  getMsg :: SQLiteStore -> ConnId -> InternalId -> m Msg
  getMsg :: SQLiteStore -> ByteString -> InternalId -> m Msg
getMsg SQLiteStore
_st ByteString
_connId InternalId
_id = StoreError -> m Msg
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StoreError
SENotImplemented

  checkRcvMsg :: SQLiteStore -> ConnId -> InternalId -> m ()
  checkRcvMsg :: SQLiteStore -> ByteString -> InternalId -> m ()
checkRcvMsg SQLiteStore
st ByteString
connId InternalId
msgId =
    IO (Either StoreError ()) -> m ()
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either StoreError ()) -> m ())
-> ((Connection -> IO (Either StoreError ()))
    -> IO (Either StoreError ()))
-> (Connection -> IO (Either StoreError ()))
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore
-> (Connection -> IO (Either StoreError ()))
-> IO (Either StoreError ())
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO (Either StoreError ())) -> m ())
-> (Connection -> IO (Either StoreError ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      [(ByteString, InternalId)] -> Either StoreError ()
hasMsg
        ([(ByteString, InternalId)] -> Either StoreError ())
-> IO [(ByteString, InternalId)] -> IO (Either StoreError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ByteString, InternalId)
-> IO [(ByteString, InternalId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT conn_alias, internal_id
            FROM rcv_messages
            WHERE conn_alias = ? AND internal_id = ?
          |]
          (ByteString
connId, InternalId
msgId)
    where
      hasMsg :: [(ConnId, InternalId)] -> Either StoreError ()
      hasMsg :: [(ByteString, InternalId)] -> Either StoreError ()
hasMsg [(ByteString, InternalId)]
r = if [(ByteString, InternalId)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ByteString, InternalId)]
r then StoreError -> Either StoreError ()
forall a b. a -> Either a b
Left StoreError
SEMsgNotFound else () -> Either StoreError ()
forall a b. b -> Either a b
Right ()

  updateRcvMsgAck :: SQLiteStore -> ConnId -> InternalId -> m ()
  updateRcvMsgAck :: SQLiteStore -> ByteString -> InternalId -> m ()
updateRcvMsgAck SQLiteStore
st ByteString
connId InternalId
msgId =
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Connection -> IO ()) -> IO ())
-> (Connection -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLiteStore -> (Connection -> IO ()) -> IO ()
forall a. SQLiteStore -> (Connection -> IO a) -> IO a
withTransaction SQLiteStore
st ((Connection -> IO ()) -> m ()) -> (Connection -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      Connection
-> Query -> (RcvMsgStatus, ByteString, InternalId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          UPDATE rcv_messages
          SET rcv_status = ?, ack_brocker_ts = datetime('now')
          WHERE conn_alias = ? AND internal_id = ?
        |]
        (RcvMsgStatus
AcknowledgedToBroker, ByteString
connId, InternalId
msgId)

-- * Auxiliary helpers

-- ? replace with ToField? - it's easy to forget to use this
serializePort_ :: Maybe ServiceName -> ServiceName
serializePort_ :: Maybe FilePath -> FilePath
serializePort_ = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"_"

deserializePort_ :: ServiceName -> Maybe ServiceName
deserializePort_ :: FilePath -> Maybe FilePath
deserializePort_ FilePath
"_" = Maybe FilePath
forall a. Maybe a
Nothing
deserializePort_ FilePath
port = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
port

instance ToField QueueStatus where toField :: QueueStatus -> SQLData
toField = FilePath -> SQLData
forall a. ToField a => a -> SQLData
toField (FilePath -> SQLData)
-> (QueueStatus -> FilePath) -> QueueStatus -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueueStatus -> FilePath
forall a. Show a => a -> FilePath
show

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) -> FieldParser QueueStatus)
-> (Text -> Maybe QueueStatus) -> FieldParser QueueStatus
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe QueueStatus
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe QueueStatus)
-> (Text -> FilePath) -> Text -> Maybe QueueStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack

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

instance FromField InternalRcvId where fromField :: FieldParser InternalRcvId
fromField Field
x = PrevExternalSndId -> InternalRcvId
InternalRcvId (PrevExternalSndId -> InternalRcvId)
-> Ok PrevExternalSndId -> Ok InternalRcvId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser PrevExternalSndId
forall a. FromField a => FieldParser a
fromField Field
x

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

instance FromField InternalSndId where fromField :: FieldParser InternalSndId
fromField Field
x = PrevExternalSndId -> InternalSndId
InternalSndId (PrevExternalSndId -> InternalSndId)
-> Ok PrevExternalSndId -> Ok InternalSndId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser PrevExternalSndId
forall a. FromField a => FieldParser a
fromField Field
x

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

instance FromField InternalId where fromField :: FieldParser InternalId
fromField Field
x = PrevExternalSndId -> InternalId
InternalId (PrevExternalSndId -> InternalId)
-> Ok PrevExternalSndId -> Ok InternalId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser PrevExternalSndId
forall a. FromField a => FieldParser a
fromField Field
x

instance ToField RcvMsgStatus where toField :: RcvMsgStatus -> SQLData
toField = FilePath -> SQLData
forall a. ToField a => a -> SQLData
toField (FilePath -> SQLData)
-> (RcvMsgStatus -> FilePath) -> RcvMsgStatus -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RcvMsgStatus -> FilePath
forall a. Show a => a -> FilePath
show

instance ToField SndMsgStatus where toField :: SndMsgStatus -> SQLData
toField = FilePath -> SQLData
forall a. ToField a => a -> SQLData
toField (FilePath -> SQLData)
-> (SndMsgStatus -> FilePath) -> SndMsgStatus -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndMsgStatus -> FilePath
forall a. Show a => a -> FilePath
show

instance ToField MsgIntegrity where toField :: MsgIntegrity -> SQLData
toField = ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (ByteString -> SQLData)
-> (MsgIntegrity -> ByteString) -> MsgIntegrity -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgIntegrity -> ByteString
serializeMsgIntegrity

instance FromField MsgIntegrity where fromField :: FieldParser MsgIntegrity
fromField = Parser MsgIntegrity -> FieldParser MsgIntegrity
forall k. Typeable k => Parser k -> FieldParser k
blobFieldParser Parser MsgIntegrity
msgIntegrityP

instance ToField SMPQueueUri where toField :: SMPQueueUri -> SQLData
toField = ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (ByteString -> SQLData)
-> (SMPQueueUri -> ByteString) -> SMPQueueUri -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMPQueueUri -> ByteString
serializeSMPQueueUri

instance FromField SMPQueueUri where fromField :: FieldParser SMPQueueUri
fromField = Parser SMPQueueUri -> FieldParser SMPQueueUri
forall k. Typeable k => Parser k -> FieldParser k
blobFieldParser Parser SMPQueueUri
smpQueueUriP

instance ToField AConnectionRequest where toField :: AConnectionRequest -> SQLData
toField = ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (ByteString -> SQLData)
-> (AConnectionRequest -> ByteString)
-> AConnectionRequest
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AConnectionRequest -> ByteString
serializeConnReq

instance FromField AConnectionRequest where fromField :: FieldParser AConnectionRequest
fromField = Parser AConnectionRequest -> FieldParser AConnectionRequest
forall k. Typeable k => Parser k -> FieldParser k
blobFieldParser Parser AConnectionRequest
connReqP

instance ToField (ConnectionRequest c) where toField :: ConnectionRequest c -> SQLData
toField = ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (ByteString -> SQLData)
-> (ConnectionRequest c -> ByteString)
-> ConnectionRequest c
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionRequest c -> ByteString
forall (m :: ConnectionMode). ConnectionRequest m -> ByteString
serializeConnReq'

instance (E.Typeable c, ConnectionModeI c) => FromField (ConnectionRequest c) where fromField :: FieldParser (ConnectionRequest c)
fromField = Parser (ConnectionRequest c) -> FieldParser (ConnectionRequest c)
forall k. Typeable k => Parser k -> FieldParser k
blobFieldParser Parser (ConnectionRequest c)
forall (m :: ConnectionMode).
ConnectionModeI m =>
Parser (ConnectionRequest m)
connReqP'

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
. ByteString -> Text
decodeLatin1 (ByteString -> Text)
-> (ConnectionMode -> ByteString) -> ConnectionMode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionMode -> ByteString
serializeConnMode'

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 (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

fromTextField_ :: (E.Typeable a) => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ :: (Text -> Maybe a) -> Field -> Ok a
fromTextField_ Text -> Maybe a
fromText = \case
  f :: Field
f@(Field (SQLText Text
t) Int
_) ->
    case Text -> Maybe a
fromText Text
t of
      Just a
x -> a -> Ok a
forall a. a -> Ok a
Ok a
x
      Maybe a
_ -> (FilePath -> FilePath -> FilePath -> ResultError)
-> Field -> FilePath -> Ok a
forall a err.
(Typeable a, Exception err) =>
(FilePath -> FilePath -> FilePath -> err)
-> Field -> FilePath -> Ok a
returnError FilePath -> FilePath -> FilePath -> ResultError
ConversionFailed Field
f (FilePath
"invalid text: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
t)
  Field
f -> (FilePath -> FilePath -> FilePath -> ResultError)
-> Field -> FilePath -> Ok a
forall a err.
(Typeable a, Exception err) =>
(FilePath -> FilePath -> FilePath -> err)
-> Field -> FilePath -> Ok a
returnError FilePath -> FilePath -> FilePath -> ResultError
ConversionFailed Field
f FilePath
"expecting SQLText column type"

{- 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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 -}

-- * Server upsert helper

upsertServer_ :: DB.Connection -> SMPServer -> IO ()
upsertServer_ :: Connection -> SMPServer -> IO ()
upsertServer_ Connection
dbConn SMPServer {FilePath
host :: FilePath
host :: SMPServer -> FilePath
host, Maybe FilePath
port :: Maybe FilePath
port :: SMPServer -> Maybe FilePath
port, Maybe KeyHash
keyHash :: SMPServer -> Maybe KeyHash
keyHash :: Maybe KeyHash
keyHash} = do
  let port_ :: FilePath
port_ = Maybe FilePath -> FilePath
serializePort_ Maybe FilePath
port
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    [sql|
      INSERT INTO servers (host, port, key_hash) VALUES (:host,:port,:key_hash)
      ON CONFLICT (host, port) DO UPDATE SET
        host=excluded.host,
        port=excluded.port,
        key_hash=excluded.key_hash;
    |]
    [Text
":host" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= FilePath
host, Text
":port" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= FilePath
port_, Text
":key_hash" Text -> Maybe KeyHash -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= Maybe KeyHash
keyHash]

-- * createRcvConn helpers

insertRcvQueue_ :: DB.Connection -> ConnId -> RcvQueue -> IO ()
insertRcvQueue_ :: Connection -> ByteString -> RcvQueue -> IO ()
insertRcvQueue_ Connection
dbConn ByteString
connId RcvQueue {Maybe ByteString
Maybe VerificationKey
ByteString
DecryptionKey
QueueStatus
SMPServer
$sel:status:RcvQueue :: RcvQueue -> QueueStatus
$sel:verifyKey:RcvQueue :: RcvQueue -> Maybe VerificationKey
$sel:decryptKey:RcvQueue :: RcvQueue -> DecryptionKey
$sel:sndId:RcvQueue :: RcvQueue -> Maybe ByteString
$sel:rcvPrivateKey:RcvQueue :: RcvQueue -> DecryptionKey
status :: QueueStatus
verifyKey :: Maybe VerificationKey
decryptKey :: DecryptionKey
sndId :: Maybe ByteString
rcvPrivateKey :: DecryptionKey
rcvId :: ByteString
server :: SMPServer
$sel:rcvId:RcvQueue :: RcvQueue -> ByteString
$sel:server:RcvQueue :: RcvQueue -> SMPServer
..} = do
  let port_ :: FilePath
port_ = Maybe FilePath -> FilePath
serializePort_ (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ SMPServer -> Maybe FilePath
port SMPServer
server
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    [sql|
      INSERT INTO rcv_queues
        ( host, port, rcv_id, conn_alias, rcv_private_key, snd_id, decrypt_key, verify_key, status)
      VALUES
        (:host,:port,:rcv_id,:conn_alias,:rcv_private_key,:snd_id,:decrypt_key,:verify_key,:status);
    |]
    [ Text
":host" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= SMPServer -> FilePath
host SMPServer
server,
      Text
":port" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= FilePath
port_,
      Text
":rcv_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
rcvId,
      Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId,
      Text
":rcv_private_key" Text -> DecryptionKey -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= DecryptionKey
rcvPrivateKey,
      Text
":snd_id" Text -> Maybe ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= Maybe ByteString
sndId,
      Text
":decrypt_key" Text -> DecryptionKey -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= DecryptionKey
decryptKey,
      Text
":verify_key" Text -> Maybe VerificationKey -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= Maybe VerificationKey
verifyKey,
      Text
":status" Text -> QueueStatus -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= QueueStatus
status
    ]

insertRcvConnection_ :: DB.Connection -> ConnData -> RcvQueue -> SConnectionMode c -> IO ()
insertRcvConnection_ :: Connection -> ConnData -> RcvQueue -> SConnectionMode c -> IO ()
insertRcvConnection_ Connection
dbConn ConnData {ByteString
connId :: ByteString
$sel:connId:ConnData :: ConnData -> ByteString
connId} RcvQueue {SMPServer
server :: SMPServer
$sel:server:RcvQueue :: RcvQueue -> SMPServer
server, ByteString
rcvId :: ByteString
$sel:rcvId:RcvQueue :: RcvQueue -> ByteString
rcvId} SConnectionMode c
cMode = do
  let port_ :: FilePath
port_ = Maybe FilePath -> FilePath
serializePort_ (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ SMPServer -> Maybe FilePath
port SMPServer
server
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    [sql|
      INSERT INTO connections
        ( conn_alias, rcv_host, rcv_port, rcv_id, snd_host, snd_port, snd_id, last_internal_msg_id, last_internal_rcv_msg_id, last_internal_snd_msg_id, last_external_snd_msg_id, last_rcv_msg_hash, last_snd_msg_hash,
          conn_mode )
      VALUES
        (:conn_alias,:rcv_host,:rcv_port,:rcv_id, NULL,     NULL,     NULL, 0, 0, 0, 0, x'', x'',
         :conn_mode );
    |]
    [ Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId,
      Text
":rcv_host" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= SMPServer -> FilePath
host SMPServer
server,
      Text
":rcv_port" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= FilePath
port_,
      Text
":rcv_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
rcvId,
      Text
":conn_mode" Text -> SConnectionMode c -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= SConnectionMode c
cMode
    ]

-- * createSndConn helpers

insertSndQueue_ :: DB.Connection -> ConnId -> SndQueue -> IO ()
insertSndQueue_ :: Connection -> ByteString -> SndQueue -> IO ()
insertSndQueue_ Connection
dbConn ByteString
connId SndQueue {ByteString
SignatureKey
DecryptionKey
VerificationKey
QueueStatus
SMPServer
$sel:status:SndQueue :: SndQueue -> QueueStatus
$sel:signKey:SndQueue :: SndQueue -> SignatureKey
$sel:encryptKey:SndQueue :: SndQueue -> VerificationKey
$sel:sndPrivateKey:SndQueue :: SndQueue -> DecryptionKey
status :: QueueStatus
signKey :: SignatureKey
encryptKey :: VerificationKey
sndPrivateKey :: DecryptionKey
sndId :: ByteString
server :: SMPServer
$sel:sndId:SndQueue :: SndQueue -> ByteString
$sel:server:SndQueue :: SndQueue -> SMPServer
..} = do
  let port_ :: FilePath
port_ = Maybe FilePath -> FilePath
serializePort_ (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ SMPServer -> Maybe FilePath
port SMPServer
server
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    [sql|
      INSERT INTO snd_queues
        ( host, port, snd_id, conn_alias, snd_private_key, encrypt_key, sign_key, status)
      VALUES
        (:host,:port,:snd_id,:conn_alias,:snd_private_key,:encrypt_key,:sign_key,:status);
    |]
    [ Text
":host" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= SMPServer -> FilePath
host SMPServer
server,
      Text
":port" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= FilePath
port_,
      Text
":snd_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
sndId,
      Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId,
      Text
":snd_private_key" Text -> DecryptionKey -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= DecryptionKey
sndPrivateKey,
      Text
":encrypt_key" Text -> VerificationKey -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= VerificationKey
encryptKey,
      Text
":sign_key" Text -> SignatureKey -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= SignatureKey
signKey,
      Text
":status" Text -> QueueStatus -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= QueueStatus
status
    ]

insertSndConnection_ :: DB.Connection -> ConnData -> SndQueue -> IO ()
insertSndConnection_ :: Connection -> ConnData -> SndQueue -> IO ()
insertSndConnection_ Connection
dbConn ConnData {ByteString
connId :: ByteString
$sel:connId:ConnData :: ConnData -> ByteString
connId} SndQueue {SMPServer
server :: SMPServer
$sel:server:SndQueue :: SndQueue -> SMPServer
server, ByteString
sndId :: ByteString
$sel:sndId:SndQueue :: SndQueue -> ByteString
sndId} = do
  let port_ :: FilePath
port_ = Maybe FilePath -> FilePath
serializePort_ (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ SMPServer -> Maybe FilePath
port SMPServer
server
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    [sql|
      INSERT INTO connections
        ( conn_alias, rcv_host, rcv_port, rcv_id, snd_host, snd_port, snd_id, last_internal_msg_id, last_internal_rcv_msg_id, last_internal_snd_msg_id, last_external_snd_msg_id, last_rcv_msg_hash, last_snd_msg_hash)
      VALUES
        (:conn_alias, NULL,     NULL,     NULL,  :snd_host,:snd_port,:snd_id, 0, 0, 0, 0, x'', x'');
    |]
    [ Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId,
      Text
":snd_host" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= SMPServer -> FilePath
host SMPServer
server,
      Text
":snd_port" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= FilePath
port_,
      Text
":snd_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
sndId
    ]

-- * getConn helpers

getConn_ :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
getConn_ :: Connection -> ByteString -> IO (Either StoreError SomeConn)
getConn_ Connection
dbConn ByteString
connId =
  Connection -> ByteString -> IO (Maybe (ConnData, ConnectionMode))
getConnData_ Connection
dbConn ByteString
connId IO (Maybe (ConnData, ConnectionMode))
-> (Maybe (ConnData, ConnectionMode)
    -> IO (Either StoreError SomeConn))
-> IO (Either StoreError SomeConn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (ConnData, ConnectionMode)
Nothing -> Either StoreError SomeConn -> IO (Either StoreError SomeConn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError SomeConn -> IO (Either StoreError SomeConn))
-> Either StoreError SomeConn -> IO (Either StoreError SomeConn)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError SomeConn
forall a b. a -> Either a b
Left StoreError
SEConnNotFound
    Just (ConnData
connData, ConnectionMode
cMode) -> do
      Maybe RcvQueue
rQ <- Connection -> ByteString -> IO (Maybe RcvQueue)
getRcvQueueByConnAlias_ Connection
dbConn ByteString
connId
      Maybe SndQueue
sQ <- Connection -> ByteString -> IO (Maybe SndQueue)
getSndQueueByConnAlias_ Connection
dbConn ByteString
connId
      Either StoreError SomeConn -> IO (Either StoreError SomeConn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError SomeConn -> IO (Either StoreError SomeConn))
-> Either StoreError SomeConn -> IO (Either StoreError SomeConn)
forall a b. (a -> b) -> a -> b
$ case (Maybe RcvQueue
rQ, Maybe SndQueue
sQ, ConnectionMode
cMode) of
        (Just RcvQueue
rcvQ, Just SndQueue
sndQ, ConnectionMode
CMInvitation) -> SomeConn -> Either StoreError SomeConn
forall a b. b -> Either a b
Right (SomeConn -> Either StoreError SomeConn)
-> SomeConn -> Either StoreError SomeConn
forall a b. (a -> b) -> a -> b
$ SConnType 'CDuplex -> Connection 'CDuplex -> SomeConn
forall (d :: ConnType). SConnType d -> Connection d -> SomeConn
SomeConn SConnType 'CDuplex
SCDuplex (ConnData -> RcvQueue -> SndQueue -> Connection 'CDuplex
DuplexConnection ConnData
connData RcvQueue
rcvQ SndQueue
sndQ)
        (Just RcvQueue
rcvQ, Maybe SndQueue
Nothing, ConnectionMode
CMInvitation) -> SomeConn -> Either StoreError SomeConn
forall a b. b -> Either a b
Right (SomeConn -> Either StoreError SomeConn)
-> SomeConn -> Either StoreError SomeConn
forall a b. (a -> b) -> a -> b
$ SConnType 'CRcv -> Connection 'CRcv -> SomeConn
forall (d :: ConnType). SConnType d -> Connection d -> SomeConn
SomeConn SConnType 'CRcv
SCRcv (ConnData -> RcvQueue -> Connection 'CRcv
RcvConnection ConnData
connData RcvQueue
rcvQ)
        (Maybe RcvQueue
Nothing, Just SndQueue
sndQ, ConnectionMode
CMInvitation) -> SomeConn -> Either StoreError SomeConn
forall a b. b -> Either a b
Right (SomeConn -> Either StoreError SomeConn)
-> SomeConn -> Either StoreError SomeConn
forall a b. (a -> b) -> a -> b
$ SConnType 'CSnd -> Connection 'CSnd -> SomeConn
forall (d :: ConnType). SConnType d -> Connection d -> SomeConn
SomeConn SConnType 'CSnd
SCSnd (ConnData -> SndQueue -> Connection 'CSnd
SndConnection ConnData
connData SndQueue
sndQ)
        (Just RcvQueue
rcvQ, Maybe SndQueue
Nothing, ConnectionMode
CMContact) -> SomeConn -> Either StoreError SomeConn
forall a b. b -> Either a b
Right (SomeConn -> Either StoreError SomeConn)
-> SomeConn -> Either StoreError SomeConn
forall a b. (a -> b) -> a -> b
$ SConnType 'CContact -> Connection 'CContact -> SomeConn
forall (d :: ConnType). SConnType d -> Connection d -> SomeConn
SomeConn SConnType 'CContact
SCContact (ConnData -> RcvQueue -> Connection 'CContact
ContactConnection ConnData
connData RcvQueue
rcvQ)
        (Maybe RcvQueue, Maybe SndQueue, ConnectionMode)
_ -> StoreError -> Either StoreError SomeConn
forall a b. a -> Either a b
Left StoreError
SEConnNotFound

getConnData_ :: DB.Connection -> ConnId -> IO (Maybe (ConnData, ConnectionMode))
getConnData_ :: Connection -> ByteString -> IO (Maybe (ConnData, ConnectionMode))
getConnData_ Connection
dbConn ByteString
connId' =
  [(ByteString, ConnectionMode)] -> Maybe (ConnData, ConnectionMode)
forall b. [(ByteString, b)] -> Maybe (ConnData, b)
connData
    ([(ByteString, ConnectionMode)]
 -> Maybe (ConnData, ConnectionMode))
-> IO [(ByteString, ConnectionMode)]
-> IO (Maybe (ConnData, ConnectionMode))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> Only ByteString -> IO [(ByteString, ConnectionMode)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
dbConn Query
"SELECT conn_alias, conn_mode FROM connections WHERE conn_alias = ?;" (ByteString -> Only ByteString
forall a. a -> Only a
Only ByteString
connId')
  where
    connData :: [(ByteString, b)] -> Maybe (ConnData, b)
connData [(ByteString
connId, b
cMode)] = (ConnData, b) -> Maybe (ConnData, b)
forall a. a -> Maybe a
Just (ConnData :: ByteString -> ConnData
ConnData {ByteString
connId :: ByteString
$sel:connId:ConnData :: ByteString
connId}, b
cMode)
    connData [(ByteString, b)]
_ = Maybe (ConnData, b)
forall a. Maybe a
Nothing

getRcvQueueByConnAlias_ :: DB.Connection -> ConnId -> IO (Maybe RcvQueue)
getRcvQueueByConnAlias_ :: Connection -> ByteString -> IO (Maybe RcvQueue)
getRcvQueueByConnAlias_ Connection
dbConn ByteString
connId =
  [(Maybe KeyHash, FilePath, FilePath, ByteString, DecryptionKey,
  Maybe ByteString, DecryptionKey, Maybe VerificationKey,
  QueueStatus)]
-> Maybe RcvQueue
rcvQueue
    ([(Maybe KeyHash, FilePath, FilePath, ByteString, DecryptionKey,
   Maybe ByteString, DecryptionKey, Maybe VerificationKey,
   QueueStatus)]
 -> Maybe RcvQueue)
-> IO
     [(Maybe KeyHash, FilePath, FilePath, ByteString, DecryptionKey,
       Maybe ByteString, DecryptionKey, Maybe VerificationKey,
       QueueStatus)]
-> IO (Maybe RcvQueue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only ByteString
-> IO
     [(Maybe KeyHash, FilePath, FilePath, ByteString, DecryptionKey,
       Maybe ByteString, DecryptionKey, Maybe VerificationKey,
       QueueStatus)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
dbConn
      [sql|
        SELECT s.key_hash, q.host, q.port, q.rcv_id, q.rcv_private_key,
          q.snd_id, q.decrypt_key, q.verify_key, q.status
        FROM rcv_queues q
        INNER JOIN servers s ON q.host = s.host AND q.port = s.port
        WHERE q.conn_alias = ?;
      |]
      (ByteString -> Only ByteString
forall a. a -> Only a
Only ByteString
connId)
  where
    rcvQueue :: [(Maybe KeyHash, FilePath, FilePath, ByteString, DecryptionKey,
  Maybe ByteString, DecryptionKey, Maybe VerificationKey,
  QueueStatus)]
-> Maybe RcvQueue
rcvQueue [(Maybe KeyHash
keyHash, FilePath
host, FilePath
port, ByteString
rcvId, DecryptionKey
rcvPrivateKey, Maybe ByteString
sndId, DecryptionKey
decryptKey, Maybe VerificationKey
verifyKey, QueueStatus
status)] =
      let srv :: SMPServer
srv = FilePath -> Maybe FilePath -> Maybe KeyHash -> SMPServer
SMPServer FilePath
host (FilePath -> Maybe FilePath
deserializePort_ FilePath
port) Maybe KeyHash
keyHash
       in RcvQueue -> Maybe RcvQueue
forall a. a -> Maybe a
Just (RcvQueue -> Maybe RcvQueue) -> RcvQueue -> Maybe RcvQueue
forall a b. (a -> b) -> a -> b
$ SMPServer
-> ByteString
-> DecryptionKey
-> Maybe ByteString
-> DecryptionKey
-> Maybe VerificationKey
-> QueueStatus
-> RcvQueue
RcvQueue SMPServer
srv ByteString
rcvId DecryptionKey
rcvPrivateKey Maybe ByteString
sndId DecryptionKey
decryptKey Maybe VerificationKey
verifyKey QueueStatus
status
    rcvQueue [(Maybe KeyHash, FilePath, FilePath, ByteString, DecryptionKey,
  Maybe ByteString, DecryptionKey, Maybe VerificationKey,
  QueueStatus)]
_ = Maybe RcvQueue
forall a. Maybe a
Nothing

getSndQueueByConnAlias_ :: DB.Connection -> ConnId -> IO (Maybe SndQueue)
getSndQueueByConnAlias_ :: Connection -> ByteString -> IO (Maybe SndQueue)
getSndQueueByConnAlias_ Connection
dbConn ByteString
connId =
  [(Maybe KeyHash, FilePath, FilePath, ByteString, DecryptionKey,
  VerificationKey, SignatureKey, QueueStatus)]
-> Maybe SndQueue
sndQueue
    ([(Maybe KeyHash, FilePath, FilePath, ByteString, DecryptionKey,
   VerificationKey, SignatureKey, QueueStatus)]
 -> Maybe SndQueue)
-> IO
     [(Maybe KeyHash, FilePath, FilePath, ByteString, DecryptionKey,
       VerificationKey, SignatureKey, QueueStatus)]
-> IO (Maybe SndQueue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only ByteString
-> IO
     [(Maybe KeyHash, FilePath, FilePath, ByteString, DecryptionKey,
       VerificationKey, SignatureKey, QueueStatus)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
dbConn
      [sql|
        SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_private_key, q.encrypt_key, q.sign_key, q.status
        FROM snd_queues q
        INNER JOIN servers s ON q.host = s.host AND q.port = s.port
        WHERE q.conn_alias = ?;
      |]
      (ByteString -> Only ByteString
forall a. a -> Only a
Only ByteString
connId)
  where
    sndQueue :: [(Maybe KeyHash, FilePath, FilePath, ByteString, DecryptionKey,
  VerificationKey, SignatureKey, QueueStatus)]
-> Maybe SndQueue
sndQueue [(Maybe KeyHash
keyHash, FilePath
host, FilePath
port, ByteString
sndId, DecryptionKey
sndPrivateKey, VerificationKey
encryptKey, SignatureKey
signKey, QueueStatus
status)] =
      let srv :: SMPServer
srv = FilePath -> Maybe FilePath -> Maybe KeyHash -> SMPServer
SMPServer FilePath
host (FilePath -> Maybe FilePath
deserializePort_ FilePath
port) Maybe KeyHash
keyHash
       in SndQueue -> Maybe SndQueue
forall a. a -> Maybe a
Just (SndQueue -> Maybe SndQueue) -> SndQueue -> Maybe SndQueue
forall a b. (a -> b) -> a -> b
$ SMPServer
-> ByteString
-> DecryptionKey
-> VerificationKey
-> SignatureKey
-> QueueStatus
-> SndQueue
SndQueue SMPServer
srv ByteString
sndId DecryptionKey
sndPrivateKey VerificationKey
encryptKey SignatureKey
signKey QueueStatus
status
    sndQueue [(Maybe KeyHash, FilePath, FilePath, ByteString, DecryptionKey,
  VerificationKey, SignatureKey, QueueStatus)]
_ = Maybe SndQueue
forall a. Maybe a
Nothing

-- * upgradeRcvConnToDuplex helpers

updateConnWithSndQueue_ :: DB.Connection -> ConnId -> SndQueue -> IO ()
updateConnWithSndQueue_ :: Connection -> ByteString -> SndQueue -> IO ()
updateConnWithSndQueue_ Connection
dbConn ByteString
connId SndQueue {SMPServer
server :: SMPServer
$sel:server:SndQueue :: SndQueue -> SMPServer
server, ByteString
sndId :: ByteString
$sel:sndId:SndQueue :: SndQueue -> ByteString
sndId} = do
  let port_ :: FilePath
port_ = Maybe FilePath -> FilePath
serializePort_ (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ SMPServer -> Maybe FilePath
port SMPServer
server
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    [sql|
      UPDATE connections
      SET snd_host = :snd_host, snd_port = :snd_port, snd_id = :snd_id
      WHERE conn_alias = :conn_alias;
    |]
    [Text
":snd_host" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= SMPServer -> FilePath
host SMPServer
server, Text
":snd_port" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= FilePath
port_, Text
":snd_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
sndId, Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId]

-- * upgradeSndConnToDuplex helpers

updateConnWithRcvQueue_ :: DB.Connection -> ConnId -> RcvQueue -> IO ()
updateConnWithRcvQueue_ :: Connection -> ByteString -> RcvQueue -> IO ()
updateConnWithRcvQueue_ Connection
dbConn ByteString
connId RcvQueue {SMPServer
server :: SMPServer
$sel:server:RcvQueue :: RcvQueue -> SMPServer
server, ByteString
rcvId :: ByteString
$sel:rcvId:RcvQueue :: RcvQueue -> ByteString
rcvId} = do
  let port_ :: FilePath
port_ = Maybe FilePath -> FilePath
serializePort_ (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ SMPServer -> Maybe FilePath
port SMPServer
server
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    [sql|
      UPDATE connections
      SET rcv_host = :rcv_host, rcv_port = :rcv_port, rcv_id = :rcv_id
      WHERE conn_alias = :conn_alias;
    |]
    [Text
":rcv_host" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= SMPServer -> FilePath
host SMPServer
server, Text
":rcv_port" Text -> FilePath -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= FilePath
port_, Text
":rcv_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
rcvId, Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId]

-- * updateRcvIds helpers

retrieveLastIdsAndHashRcv_ :: DB.Connection -> ConnId -> IO (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
retrieveLastIdsAndHashRcv_ :: Connection
-> ByteString
-> IO (InternalId, InternalRcvId, PrevExternalSndId, ByteString)
retrieveLastIdsAndHashRcv_ Connection
dbConn ByteString
connId = do
  [(InternalId
lastInternalId, InternalRcvId
lastInternalRcvId, PrevExternalSndId
lastExternalSndId, ByteString
lastRcvHash)] <-
    Connection
-> Query
-> [NamedParam]
-> IO [(InternalId, InternalRcvId, PrevExternalSndId, ByteString)]
forall r.
FromRow r =>
Connection -> Query -> [NamedParam] -> IO [r]
DB.queryNamed
      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_alias = :conn_alias;
      |]
      [Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId]
  (InternalId, InternalRcvId, PrevExternalSndId, ByteString)
-> IO (InternalId, InternalRcvId, PrevExternalSndId, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (InternalId
lastInternalId, InternalRcvId
lastInternalRcvId, PrevExternalSndId
lastExternalSndId, ByteString
lastRcvHash)

updateLastIdsRcv_ :: DB.Connection -> ConnId -> InternalId -> InternalRcvId -> IO ()
updateLastIdsRcv_ :: Connection -> ByteString -> InternalId -> InternalRcvId -> IO ()
updateLastIdsRcv_ Connection
dbConn ByteString
connId InternalId
newInternalId InternalRcvId
newInternalRcvId =
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    [sql|
      UPDATE connections
      SET last_internal_msg_id = :last_internal_msg_id,
          last_internal_rcv_msg_id = :last_internal_rcv_msg_id
      WHERE conn_alias = :conn_alias;
    |]
    [ Text
":last_internal_msg_id" Text -> InternalId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= InternalId
newInternalId,
      Text
":last_internal_rcv_msg_id" Text -> InternalRcvId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= InternalRcvId
newInternalRcvId,
      Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId
    ]

-- * createRcvMsg helpers

insertRcvMsgBase_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
insertRcvMsgBase_ :: Connection -> ByteString -> RcvMsgData -> IO ()
insertRcvMsgBase_ Connection
dbConn ByteString
connId RcvMsgData {MsgMeta
$sel:msgMeta:RcvMsgData :: RcvMsgData -> MsgMeta
msgMeta :: MsgMeta
msgMeta, ByteString
$sel:msgBody:RcvMsgData :: RcvMsgData -> ByteString
msgBody :: ByteString
msgBody, InternalRcvId
$sel:internalRcvId:RcvMsgData :: RcvMsgData -> InternalRcvId
internalRcvId :: InternalRcvId
internalRcvId} = do
  let MsgMeta {recipient :: MsgMeta -> (PrevExternalSndId, UTCTime)
recipient = (PrevExternalSndId
internalId, UTCTime
internalTs)} = MsgMeta
msgMeta
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    [sql|
      INSERT INTO messages
        ( conn_alias, internal_id, internal_ts, internal_rcv_id, internal_snd_id, body, msg_body)
      VALUES
        (:conn_alias,:internal_id,:internal_ts,:internal_rcv_id,            NULL,   '',:msg_body);
    |]
    [ Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId,
      Text
":internal_id" Text -> PrevExternalSndId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= PrevExternalSndId
internalId,
      Text
":internal_ts" Text -> UTCTime -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= UTCTime
internalTs,
      Text
":internal_rcv_id" Text -> InternalRcvId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= InternalRcvId
internalRcvId,
      Text
":msg_body" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
msgBody
    ]

insertRcvMsgDetails_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
insertRcvMsgDetails_ :: Connection -> ByteString -> RcvMsgData -> IO ()
insertRcvMsgDetails_ Connection
dbConn ByteString
connId RcvMsgData {MsgMeta
msgMeta :: MsgMeta
$sel:msgMeta:RcvMsgData :: RcvMsgData -> MsgMeta
msgMeta, InternalRcvId
internalRcvId :: InternalRcvId
$sel:internalRcvId:RcvMsgData :: RcvMsgData -> InternalRcvId
internalRcvId, ByteString
$sel:internalHash:RcvMsgData :: RcvMsgData -> ByteString
internalHash :: ByteString
internalHash, ByteString
$sel:externalPrevSndHash:RcvMsgData :: RcvMsgData -> ByteString
externalPrevSndHash :: ByteString
externalPrevSndHash} = do
  let MsgMeta {MsgIntegrity
integrity :: MsgMeta -> MsgIntegrity
integrity :: MsgIntegrity
integrity, (PrevExternalSndId, UTCTime)
recipient :: (PrevExternalSndId, UTCTime)
recipient :: MsgMeta -> (PrevExternalSndId, UTCTime)
recipient, (PrevExternalSndId, UTCTime)
sender :: MsgMeta -> (PrevExternalSndId, UTCTime)
sender :: (PrevExternalSndId, UTCTime)
sender, (ByteString, UTCTime)
broker :: MsgMeta -> (ByteString, UTCTime)
broker :: (ByteString, UTCTime)
broker} = MsgMeta
msgMeta
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    [sql|
      INSERT INTO rcv_messages
        ( conn_alias, internal_rcv_id, internal_id, external_snd_id, external_snd_ts,
          broker_id, broker_ts, rcv_status, ack_brocker_ts, ack_sender_ts,
          internal_hash, external_prev_snd_hash, integrity)
      VALUES
        (:conn_alias,:internal_rcv_id,:internal_id,:external_snd_id,:external_snd_ts,
         :broker_id,:broker_ts,:rcv_status,           NULL,          NULL,
         :internal_hash,:external_prev_snd_hash,:integrity);
    |]
    [ Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId,
      Text
":internal_rcv_id" Text -> InternalRcvId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= InternalRcvId
internalRcvId,
      Text
":internal_id" Text -> PrevExternalSndId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= (PrevExternalSndId, UTCTime) -> PrevExternalSndId
forall a b. (a, b) -> a
fst (PrevExternalSndId, UTCTime)
recipient,
      Text
":external_snd_id" Text -> PrevExternalSndId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= (PrevExternalSndId, UTCTime) -> PrevExternalSndId
forall a b. (a, b) -> a
fst (PrevExternalSndId, UTCTime)
sender,
      Text
":external_snd_ts" Text -> UTCTime -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= (PrevExternalSndId, UTCTime) -> UTCTime
forall a b. (a, b) -> b
snd (PrevExternalSndId, UTCTime)
sender,
      Text
":broker_id" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= (ByteString, UTCTime) -> ByteString
forall a b. (a, b) -> a
fst (ByteString, UTCTime)
broker,
      Text
":broker_ts" Text -> UTCTime -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= (ByteString, UTCTime) -> UTCTime
forall a b. (a, b) -> b
snd (ByteString, UTCTime)
broker,
      Text
":rcv_status" Text -> RcvMsgStatus -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= RcvMsgStatus
Received,
      Text
":internal_hash" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
internalHash,
      Text
":external_prev_snd_hash" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
externalPrevSndHash,
      Text
":integrity" Text -> MsgIntegrity -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= MsgIntegrity
integrity
    ]

updateHashRcv_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
updateHashRcv_ :: Connection -> ByteString -> RcvMsgData -> IO ()
updateHashRcv_ Connection
dbConn ByteString
connId RcvMsgData {MsgMeta
msgMeta :: MsgMeta
$sel:msgMeta:RcvMsgData :: RcvMsgData -> MsgMeta
msgMeta, ByteString
internalHash :: ByteString
$sel:internalHash:RcvMsgData :: RcvMsgData -> ByteString
internalHash, InternalRcvId
internalRcvId :: InternalRcvId
$sel:internalRcvId:RcvMsgData :: RcvMsgData -> InternalRcvId
internalRcvId} =
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    -- 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_external_snd_msg_id,
          last_rcv_msg_hash = :last_rcv_msg_hash
      WHERE conn_alias = :conn_alias
        AND last_internal_rcv_msg_id = :last_internal_rcv_msg_id;
    |]
    [ Text
":last_external_snd_msg_id" Text -> PrevExternalSndId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= (PrevExternalSndId, UTCTime) -> PrevExternalSndId
forall a b. (a, b) -> a
fst (MsgMeta -> (PrevExternalSndId, UTCTime)
sender MsgMeta
msgMeta),
      Text
":last_rcv_msg_hash" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
internalHash,
      Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId,
      Text
":last_internal_rcv_msg_id" Text -> InternalRcvId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= InternalRcvId
internalRcvId
    ]

-- * updateSndIds helpers

retrieveLastIdsAndHashSnd_ :: DB.Connection -> ConnId -> IO (InternalId, InternalSndId, PrevSndMsgHash)
retrieveLastIdsAndHashSnd_ :: Connection
-> ByteString -> IO (InternalId, InternalSndId, ByteString)
retrieveLastIdsAndHashSnd_ Connection
dbConn ByteString
connId = do
  [(InternalId
lastInternalId, InternalSndId
lastInternalSndId, ByteString
lastSndHash)] <-
    Connection
-> Query
-> [NamedParam]
-> IO [(InternalId, InternalSndId, ByteString)]
forall r.
FromRow r =>
Connection -> Query -> [NamedParam] -> IO [r]
DB.queryNamed
      Connection
dbConn
      [sql|
        SELECT last_internal_msg_id, last_internal_snd_msg_id, last_snd_msg_hash
        FROM connections
        WHERE conn_alias = :conn_alias;
      |]
      [Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId]
  (InternalId, InternalSndId, ByteString)
-> IO (InternalId, InternalSndId, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (InternalId
lastInternalId, InternalSndId
lastInternalSndId, ByteString
lastSndHash)

updateLastIdsSnd_ :: DB.Connection -> ConnId -> InternalId -> InternalSndId -> IO ()
updateLastIdsSnd_ :: Connection -> ByteString -> InternalId -> InternalSndId -> IO ()
updateLastIdsSnd_ Connection
dbConn ByteString
connId InternalId
newInternalId InternalSndId
newInternalSndId =
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    [sql|
      UPDATE connections
      SET last_internal_msg_id = :last_internal_msg_id,
          last_internal_snd_msg_id = :last_internal_snd_msg_id
      WHERE conn_alias = :conn_alias;
    |]
    [ Text
":last_internal_msg_id" Text -> InternalId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= InternalId
newInternalId,
      Text
":last_internal_snd_msg_id" Text -> InternalSndId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= InternalSndId
newInternalSndId,
      Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId
    ]

-- * createSndMsg helpers

insertSndMsgBase_ :: DB.Connection -> ConnId -> SndMsgData -> IO ()
insertSndMsgBase_ :: Connection -> ByteString -> SndMsgData -> IO ()
insertSndMsgBase_ Connection
dbConn ByteString
connId SndMsgData {ByteString
UTCTime
InternalId
InternalSndId
$sel:previousMsgHash:SndMsgData :: SndMsgData -> ByteString
$sel:internalHash:SndMsgData :: SndMsgData -> ByteString
$sel:msgBody:SndMsgData :: SndMsgData -> ByteString
$sel:internalTs:SndMsgData :: SndMsgData -> UTCTime
$sel:internalSndId:SndMsgData :: SndMsgData -> InternalSndId
$sel:internalId:SndMsgData :: SndMsgData -> InternalId
previousMsgHash :: ByteString
internalHash :: ByteString
msgBody :: ByteString
internalTs :: UTCTime
internalSndId :: InternalSndId
internalId :: InternalId
..} = do
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    [sql|
      INSERT INTO messages
        ( conn_alias, internal_id, internal_ts, internal_rcv_id, internal_snd_id, body, msg_body)
      VALUES
        (:conn_alias,:internal_id,:internal_ts,            NULL,:internal_snd_id,   '',:msg_body);
    |]
    [ Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId,
      Text
":internal_id" Text -> InternalId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= InternalId
internalId,
      Text
":internal_ts" Text -> UTCTime -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= UTCTime
internalTs,
      Text
":internal_snd_id" Text -> InternalSndId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= InternalSndId
internalSndId,
      Text
":msg_body" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
msgBody
    ]

insertSndMsgDetails_ :: DB.Connection -> ConnId -> SndMsgData -> IO ()
insertSndMsgDetails_ :: Connection -> ByteString -> SndMsgData -> IO ()
insertSndMsgDetails_ Connection
dbConn ByteString
connId SndMsgData {ByteString
UTCTime
InternalId
InternalSndId
previousMsgHash :: ByteString
internalHash :: ByteString
msgBody :: ByteString
internalTs :: UTCTime
internalSndId :: InternalSndId
internalId :: InternalId
$sel:previousMsgHash:SndMsgData :: SndMsgData -> ByteString
$sel:internalHash:SndMsgData :: SndMsgData -> ByteString
$sel:msgBody:SndMsgData :: SndMsgData -> ByteString
$sel:internalTs:SndMsgData :: SndMsgData -> UTCTime
$sel:internalSndId:SndMsgData :: SndMsgData -> InternalSndId
$sel:internalId:SndMsgData :: SndMsgData -> InternalId
..} =
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    [sql|
      INSERT INTO snd_messages
        ( conn_alias, internal_snd_id, internal_id, snd_status, sent_ts, delivered_ts, internal_hash, previous_msg_hash)
      VALUES
        (:conn_alias,:internal_snd_id,:internal_id,:snd_status,    NULL,         NULL,:internal_hash,:previous_msg_hash);
    |]
    [ Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId,
      Text
":internal_snd_id" Text -> InternalSndId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= InternalSndId
internalSndId,
      Text
":internal_id" Text -> InternalId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= InternalId
internalId,
      Text
":snd_status" Text -> SndMsgStatus -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= SndMsgStatus
SndMsgCreated,
      Text
":internal_hash" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
internalHash,
      Text
":previous_msg_hash" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
previousMsgHash
    ]

updateHashSnd_ :: DB.Connection -> ConnId -> SndMsgData -> IO ()
updateHashSnd_ :: Connection -> ByteString -> SndMsgData -> IO ()
updateHashSnd_ Connection
dbConn ByteString
connId SndMsgData {ByteString
UTCTime
InternalId
InternalSndId
previousMsgHash :: ByteString
internalHash :: ByteString
msgBody :: ByteString
internalTs :: UTCTime
internalSndId :: InternalSndId
internalId :: InternalId
$sel:previousMsgHash:SndMsgData :: SndMsgData -> ByteString
$sel:internalHash:SndMsgData :: SndMsgData -> ByteString
$sel:msgBody:SndMsgData :: SndMsgData -> ByteString
$sel:internalTs:SndMsgData :: SndMsgData -> UTCTime
$sel:internalSndId:SndMsgData :: SndMsgData -> InternalSndId
$sel:internalId:SndMsgData :: SndMsgData -> InternalId
..} =
  Connection -> Query -> [NamedParam] -> IO ()
DB.executeNamed
    Connection
dbConn
    -- last_internal_snd_msg_id equality check prevents race condition in case next id was reserved
    [sql|
      UPDATE connections
      SET last_snd_msg_hash = :last_snd_msg_hash
      WHERE conn_alias = :conn_alias
        AND last_internal_snd_msg_id = :last_internal_snd_msg_id;
    |]
    [ Text
":last_snd_msg_hash" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
internalHash,
      Text
":conn_alias" Text -> ByteString -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ByteString
connId,
      Text
":last_internal_snd_msg_id" Text -> InternalSndId -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= InternalSndId
internalSndId
    ]

-- create record with a random ID

getConnId_ :: DB.Connection -> TVar ChaChaDRG -> ConnData -> IO (Either StoreError ConnId)
getConnId_ :: Connection
-> TVar ChaChaDRG -> ConnData -> IO (Either StoreError ByteString)
getConnId_ Connection
dbConn TVar ChaChaDRG
gVar ConnData {$sel:connId:ConnData :: ConnData -> ByteString
connId = ByteString
""} = TVar ChaChaDRG
-> (ByteString -> IO (Maybe (ConnData, ConnectionMode)))
-> IO (Either StoreError ByteString)
forall a.
TVar ChaChaDRG
-> (ByteString -> IO (Maybe a))
-> IO (Either StoreError ByteString)
getUniqueRandomId TVar ChaChaDRG
gVar ((ByteString -> IO (Maybe (ConnData, ConnectionMode)))
 -> IO (Either StoreError ByteString))
-> (ByteString -> IO (Maybe (ConnData, ConnectionMode)))
-> IO (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString -> IO (Maybe (ConnData, ConnectionMode))
getConnData_ Connection
dbConn
getConnId_ Connection
_ TVar ChaChaDRG
_ ConnData {ByteString
connId :: ByteString
$sel:connId:ConnData :: ConnData -> ByteString
connId} = Either StoreError ByteString -> IO (Either StoreError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError ByteString -> IO (Either StoreError ByteString))
-> Either StoreError ByteString
-> IO (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either StoreError ByteString
forall a b. b -> Either a b
Right ByteString
connId

getUniqueRandomId :: TVar ChaChaDRG -> (ByteString -> IO (Maybe a)) -> IO (Either StoreError ByteString)
getUniqueRandomId :: TVar ChaChaDRG
-> (ByteString -> IO (Maybe a))
-> IO (Either StoreError ByteString)
getUniqueRandomId TVar ChaChaDRG
gVar ByteString -> IO (Maybe a)
get = Int -> IO (Either StoreError ByteString)
tryGet Int
3
  where
    tryGet :: Int -> IO (Either StoreError ByteString)
    tryGet :: Int -> IO (Either StoreError ByteString)
tryGet Int
0 = Either StoreError ByteString -> IO (Either StoreError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError ByteString -> IO (Either StoreError ByteString))
-> Either StoreError ByteString
-> IO (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ByteString
forall a b. a -> Either a b
Left StoreError
SEUniqueID
    tryGet Int
n = do
      ByteString
id' <- TVar ChaChaDRG -> Int -> IO ByteString
randomId TVar ChaChaDRG
gVar Int
12
      ByteString -> IO (Maybe a)
get ByteString
id' IO (Maybe a)
-> (Maybe a -> IO (Either StoreError ByteString))
-> IO (Either StoreError ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe a
Nothing -> Either StoreError ByteString -> IO (Either StoreError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError ByteString -> IO (Either StoreError ByteString))
-> Either StoreError ByteString
-> IO (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either StoreError ByteString
forall a b. b -> Either a b
Right ByteString
id'
        Just a
_ -> Int -> IO (Either StoreError ByteString)
tryGet (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

createWithRandomId :: TVar ChaChaDRG -> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
createWithRandomId :: TVar ChaChaDRG
-> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
createWithRandomId TVar ChaChaDRG
gVar ByteString -> IO ()
create = Int -> IO (Either StoreError ByteString)
tryCreate Int
3
  where
    tryCreate :: Int -> IO (Either StoreError ByteString)
    tryCreate :: Int -> IO (Either StoreError ByteString)
tryCreate Int
0 = Either StoreError ByteString -> IO (Either StoreError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError ByteString -> IO (Either StoreError ByteString))
-> Either StoreError ByteString
-> IO (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError ByteString
forall a b. a -> Either a b
Left StoreError
SEUniqueID
    tryCreate Int
n = do
      ByteString
id' <- TVar ChaChaDRG -> Int -> IO ByteString
randomId TVar ChaChaDRG
gVar Int
12
      IO () -> IO (Either SQLError ())
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
E.try (ByteString -> IO ()
create ByteString
id') IO (Either SQLError ())
-> (Either SQLError () -> IO (Either StoreError ByteString))
-> IO (Either StoreError ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right ()
_ -> Either StoreError ByteString -> IO (Either StoreError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError ByteString -> IO (Either StoreError ByteString))
-> Either StoreError ByteString
-> IO (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either StoreError ByteString
forall a b. b -> Either a b
Right ByteString
id'
        Left SQLError
e
          | SQLError -> Error
DB.sqlError SQLError
e Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
DB.ErrorConstraint -> Int -> IO (Either StoreError ByteString)
tryCreate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          | Bool
otherwise -> Either StoreError ByteString -> IO (Either StoreError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError ByteString -> IO (Either StoreError ByteString))
-> (ByteString -> Either StoreError ByteString)
-> ByteString
-> IO (Either StoreError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError ByteString
forall a b. a -> Either a b
Left (StoreError -> Either StoreError ByteString)
-> (ByteString -> StoreError)
-> ByteString
-> Either StoreError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> StoreError
SEInternal (ByteString -> IO (Either StoreError ByteString))
-> ByteString -> IO (Either StoreError ByteString)
forall a b. (a -> b) -> a -> b
$ SQLError -> ByteString
forall a. Show a => a -> ByteString
bshow SQLError
e

randomId :: TVar ChaChaDRG -> Int -> IO ByteString
randomId :: TVar ChaChaDRG -> Int -> IO ByteString
randomId TVar ChaChaDRG
gVar Int
n = ByteString -> ByteString
encode (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (STM ByteString -> IO ByteString
forall a. STM a -> IO a
atomically (STM ByteString -> IO ByteString)
-> ((ChaChaDRG -> (ByteString, ChaChaDRG)) -> STM ByteString)
-> (ChaChaDRG -> (ByteString, ChaChaDRG))
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar ChaChaDRG
-> (ChaChaDRG -> (ByteString, ChaChaDRG)) -> STM ByteString
forall s a. TVar s -> (s -> (a, s)) -> STM a
stateTVar TVar ChaChaDRG
gVar ((ChaChaDRG -> (ByteString, ChaChaDRG)) -> IO ByteString)
-> (ChaChaDRG -> (ByteString, ChaChaDRG)) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ChaChaDRG -> (ByteString, ChaChaDRG)
forall gen byteArray.
(DRG gen, ByteArray byteArray) =>
Int -> gen -> (byteArray, gen)
randomBytesGenerate Int
n)