From 394803b3cfdb47b8cc60a914cca0d6db6be33847 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 9 Jan 2021 20:48:07 +0000
Subject: [PATCH] remove/fix compiler warnings

---
 src/Simplex/Messaging/Agent.hs              | 13 +++++++------
 src/Simplex/Messaging/Agent/Env/SQLite.hs   |  2 --
 src/Simplex/Messaging/Agent/Store/SQLite.hs |  7 ++++---
 src/Simplex/Messaging/Util.hs               |  1 +
 4 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 34f7d90e4..853cce7d6 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -20,6 +20,7 @@ import Network.Socket
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.ServerClient (ServerClient (..), newServerClient)
 import Simplex.Messaging.Agent.Store
+import Simplex.Messaging.Agent.Store.SQLite
 import Simplex.Messaging.Agent.Store.Types
 import Simplex.Messaging.Agent.Transmission
 import Simplex.Messaging.Server (randomBytes)
@@ -68,11 +69,12 @@ client c@AgentClient {rcvQ, sndQ} = forever $ do
     Right _ -> return ()
 
 withStore ::
-  (MonadUnliftIO m, MonadError ErrorType m) =>
-  (forall n. (MonadUnliftIO n, MonadError StoreError n) => n a) ->
+  (MonadUnliftIO m, MonadReader Env m, MonadError ErrorType m) =>
+  (forall m'. (MonadUnliftIO m', MonadError StoreError m') => SQLiteStore -> m' a) ->
   m a
-withStore action =
-  runExceptT (action `E.catch` handleInternal) >>= \case
+withStore action = do
+  store <- asks db
+  runExceptT (action store `E.catch` handleInternal) >>= \case
     Right c -> return c
     Left e -> throwError $ STORE e
   where
@@ -163,10 +165,9 @@ processResponse
             (NEW _ _, NEWRequestState {connAlias, smpServer, rcvPrivateKey}) -> do
               -- TODO all good - process response
               g <- asks idsDrg
-              st <- asks db
               encryptKey <- atomically $ randomBytes 16 g -- TODO replace with cryptographic key pair
               let decryptKey = encryptKey
-              withStore $
+              withStore $ \st ->
                 createRcvConn st connAlias $
                   ReceiveQueue
                     { server = smpServer,
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index 646b5461a..4a9f4f3f0 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -9,14 +9,12 @@ import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import qualified Database.SQLite.Simple as DB
 import Network.Socket (HostName, ServiceName)
 import Numeric.Natural
 import Simplex.Messaging.Agent.ServerClient
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
 import Simplex.Messaging.Agent.Transmission
-import Simplex.Messaging.Server.Transmission (PublicKey)
 import qualified Simplex.Messaging.Server.Transmission as SMP
 import UnliftIO.STM
 
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 8db42cebc..9648e2c01 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -12,6 +12,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Simplex.Messaging.Agent.Store.SQLite where
 
@@ -81,10 +82,10 @@ type ConnectionRowId = Int64
 fromFieldToReadable :: forall a. (Read a, E.Typeable a) => Field -> Ok a
 fromFieldToReadable = \case
   f@(Field (SQLText t) _) ->
-    let s = T.unpack t
-     in case readMaybe s of
+    let str = T.unpack t
+     in case readMaybe str of
           Just x -> Ok x
-          _ -> returnError ConversionFailed f ("invalid string: " ++ s)
+          _ -> returnError ConversionFailed f ("invalid string: " <> str)
   f -> returnError ConversionFailed f "expecting SQLText column type"
 
 withLock :: MonadUnliftIO m => SQLiteStore -> (SQLiteStore -> TMVar ()) -> (DB.Connection -> m a) -> m a
diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs
index 88efef4cd..e8e21672c 100644
--- a/src/Simplex/Messaging/Util.hs
+++ b/src/Simplex/Messaging/Util.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE RankNTypes #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Simplex.Messaging.Util where