From a3f58fdc6b5b6bc135c6db4c3bc301869174854b Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 17 Sep 2022 15:08:58 +0100
Subject: [PATCH] api to execute any sql query (#529)

* api to execute any sql query

* agent api
---
 src/Simplex/Messaging/Agent.hs              |  8 ++++++++
 src/Simplex/Messaging/Agent/Store/SQLite.hs | 12 ++++++++++++
 2 files changed, 20 insertions(+)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 5c055b2e2..4ebfcdbed 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -71,6 +71,7 @@ module Simplex.Messaging.Agent
     toggleConnectionNtfs,
     activateAgent,
     suspendAgent,
+    execAgentStoreSQL,
     logConnection,
   )
 where
@@ -91,6 +92,7 @@ import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (isJust)
+import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock
 import Data.Time.Clock.System (systemToUTCTime)
@@ -273,6 +275,9 @@ activateAgent c = withAgentEnv c $ activateAgent' c
 suspendAgent :: AgentErrorMonad m => AgentClient -> Int -> m ()
 suspendAgent c = withAgentEnv c . suspendAgent' c
 
+execAgentStoreSQL :: AgentErrorMonad m => AgentClient -> Text -> m [Text]
+execAgentStoreSQL c = withAgentEnv c . execAgentStoreSQL' c
+
 withAgentEnv :: AgentClient -> ReaderT Env m a -> m a
 withAgentEnv c = (`runReaderT` agentEnv c)
 
@@ -1180,6 +1185,9 @@ suspendAgent' c@AgentClient {agentState = as} maxDelay = do
       -- unsafeIOToSTM $ putStrLn $ "in timeout: suspendSendingAndDatabase"
       suspendSendingAndDatabase c
 
+execAgentStoreSQL' :: AgentMonad m => AgentClient -> Text -> m [Text]
+execAgentStoreSQL' c sql = withStore' c (`exexSQL` sql)
+
 getSMPServer :: AgentMonad m => AgentClient -> m SMPServer
 getSMPServer c = readTVarIO (smpServers c) >>= pickServer
 
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index a2ba013e2..fba59486f 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -24,6 +24,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     connectSQLiteStore,
     closeSQLiteStore,
     sqlString,
+    exexSQL,
 
     -- * Queues and connections
     createNewConn,
@@ -240,6 +241,17 @@ sqlString s = quote <> T.replace quote "''" (T.pack s) <> quote
 --   auto_vacuum <- DB.query_ db "PRAGMA auto_vacuum;" :: IO [[Int]]
 --   print $ path <> " auto_vacuum: " <> show auto_vacuum
 
+exexSQL :: DB.Connection -> Text -> IO [Text]
+exexSQL db query = do
+  rs <- newTVarIO []
+  SQLite3.execWithCallback (DB.connectionHandle db) query (addRow rs)
+  reverse <$> readTVarIO rs
+  where
+    addRow rs _count names values = atomically . modifyTVar' rs $ \case
+      [] -> [showValues values, T.intercalate "|" names]
+      rs' -> showValues values : rs'
+    showValues = T.intercalate "|" . map (fromMaybe "")
+
 checkConstraint :: StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
 checkConstraint err action = action `E.catch` (pure . Left . handleSQLError err)