From 18ab9650b471f608d9aa222e627c50e8f7ffe982 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 27 Dec 2020 12:47:39 +0000
Subject: [PATCH] move queries to code

---
 package.yaml                                  |   1 -
 smp-agent.db                                  | Bin 8192 -> 8192 bytes
 src/Simplex/Messaging/Agent.hs                |  13 +++---
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |   2 +-
 .../Messaging/Agent/Store/SQLite/Schema.hs    |  38 ++++++++++++------
 5 files changed, 32 insertions(+), 22 deletions(-)

diff --git a/package.yaml b/package.yaml
index 4bcec591e..fb4aa6269 100644
--- a/package.yaml
+++ b/package.yaml
@@ -22,7 +22,6 @@ dependencies:
   - network == 3.1.*
   - sqlite-simple == 0.4.*
   - stm
-  - text == 1.2.*
   - time == 1.9.*
   - unliftio == 0.2.*
   - unliftio-core == 0.1.*
diff --git a/smp-agent.db b/smp-agent.db
index d16a954f9488b90fa1f265ecb8879fc4ffeba239..f063759a198b3357c4f05ac69278c0120cda2c76 100644
GIT binary patch
delta 40
wcmZp0XmFSy&B!!S#+i|6W5N=CHb(w$4E*0V3ktm9=i*>wW)ROv&B@6J0OidK2LJ#7

delta 28
kcmZp0XmFSy&B!=W#+i|EW5N=CCI*4cf&x$ZCpL%z0CB7b<NyEw

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 03f399513..9c787a1b5 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -35,9 +35,10 @@ runClient :: MonadUnliftIO m => AgentClient -> m ()
 runClient c = race_ (respond c) (process c)
 
 receive :: MonadUnliftIO m => Handle -> AgentClient -> m ()
-receive h AgentClient {rcvQ} = forever $ do
-  cmdOrError <- aCmdGet SUser h
-  atomically $ writeTBQueue rcvQ cmdOrError
+receive h AgentClient {rcvQ, sndQ} = forever $ do
+  aCmdGet SUser h >>= \case
+    Right cmd -> atomically $ writeTBQueue rcvQ cmd
+    Left e -> atomically $ writeTBQueue sndQ $ ERR e
 
 send :: MonadUnliftIO m => Handle -> AgentClient -> m ()
 send h AgentClient {sndQ} = forever $ do
@@ -46,10 +47,8 @@ send h AgentClient {sndQ} = forever $ do
 
 process :: MonadUnliftIO m => AgentClient -> m ()
 process AgentClient {rcvQ, respQ} = forever $ do
-  atomically (readTBQueue rcvQ)
-    >>= \case
-      Left e -> liftIO $ print e
-      Right cmd -> liftIO $ print cmd
+  cmd <- atomically (readTBQueue rcvQ)
+  liftIO $ print cmd
   atomically $ writeTBQueue respQ ()
 
 respond :: MonadUnliftIO m => AgentClient -> m ()
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index 2d57ec7d7..c10c7f9eb 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -31,7 +31,7 @@ data Env = Env
   }
 
 data AgentClient = AgentClient
-  { rcvQ :: TBQueue (Either ErrorType (ACommand User)),
+  { rcvQ :: TBQueue (ACommand User),
     sndQ :: TBQueue (ACommand Agent),
     respQ :: TBQueue (),
     servers :: Map (HostName, ServiceName) ServerClient
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs
index 602c31977..3ef9c35a0 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs
@@ -1,20 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Simplex.Messaging.Agent.Store.SQLite.Schema where
 
-import Control.Monad.IO.Unlift
-import qualified Data.Text as T
 import Database.SQLite.Simple
 
-createSchema :: MonadUnliftIO m => Connection -> m ()
+createSchema :: Connection -> IO ()
 createSchema conn = do
-  sql "recipient_queues"
-  -- sql "sender_queues"
-  -- sql "connections"
-  -- sql "messages"
-  return ()
-  where
-    sql name = liftIO $ do
-      q <- readFile $ "./src/Simplex/Messaging/Agent/Store/SQLite/sql/" <> name <> ".sql"
-      putStrLn q
-      execute_ conn . Query . T.pack $ q
+  map
+    (execute_ conn)
+    [ recipientQueues --,
+    -- senderQueues,
+    -- connections,
+    -- messages
+    ]
+
+recipientQueues :: Query
+recipientQueues =
+  "CREATE TABLE IF NOT EXISTS recipient_queues\
+  \ ( id INTEGER PRIMARY KEY,\
+  \   rcvId TEXT\
+  \ )"
+
+senderQueues :: Query
+senderQueues = ""
+
+connections :: Query
+connections = ""
+
+messages :: Query
+messages = ""