Merge branch 'master' into v5-ghc844

package.yaml

@@ -23,7 +23,7 @@ extra-source-files:
   - migrations/*.*
 
 dependencies:
-  - ansi-terminal >= 0.10 && < 0.12
+  - ansi-terminal >= 0.8 && < 0.12
   - asn1-encoding == 0.9.*
   - asn1-types == 0.3.*
   - async == 2.2.*
@@ -32,31 +32,31 @@ dependencies:
   - base64-bytestring >= 1.0 && < 1.3
   - bytestring == 0.10.*
   - composition == 1.0.*
-  - constraints >= 0.12 && < 0.14
-  - containers == 0.6.*
-  - cryptonite >= 0.27 && < 0.30
+  - constraints >= 0.10 && < 0.14
+  - containers >= 0.5 && < 0.7
+  - cryptonite >= 0.25 && < 0.30
   - direct-sqlite == 2.3.*
   - directory == 1.3.*
-  - file-embed >= 0.0.14.0 && <= 0.0.15.0
+  - file-embed >= 0.0.10.0 && <= 0.0.15.0
   - filepath == 1.4.*
   - http-types == 0.12.*
-  - generic-random >= 1.3 && < 1.5
+  - generic-random >= 1.2 && < 1.5
   - iso8601-time == 0.1.*
-  - memory == 0.15.*
+  - memory >= 0.14 && < 0.16
   - mtl == 2.2.*
-  - network == 3.1.*
+  - network >= 2.6 && < 3.2
   - network-transport == 0.5.*
-  - QuickCheck == 2.14.*
+  - QuickCheck >= 2.11 && < 2.15
   - random >= 1.1 && < 1.3
-  - simple-logger == 0.1.*
+  - simple-logger == 0.0.4
   - sqlite-simple == 0.4.*
-  - stm == 2.5.*
-  - template-haskell == 2.16.*
+  - stm >= 2.4 && < 2.6
+  - template-haskell >= 2.13 && < 2.17
   - text == 1.2.*
-  - time == 1.9.*
+  - time >= 1.8 && < 1.10
   - transformers == 0.5.*
   - unliftio == 0.2.*
-  - unliftio-core == 0.2.*
+  - unliftio-core >= 0.1 && < 0.3
   - websockets == 0.12.*
   - x509 == 1.7.*
 
@@ -69,8 +69,8 @@ executables:
     main: Main.hs
     dependencies:
       - cryptostore == 0.2.*
-      - ini == 0.4.*
-      - optparse-applicative >= 0.15 && < 0.17
+      - ini >= 0.3 && < 0.5 
+      - optparse-applicative >= 0.14 && < 0.17
       - simplexmq
     ghc-options:
       - -threaded
@@ -89,10 +89,10 @@ tests:
     main: Test.hs
     dependencies:
       - simplexmq
-      - hspec == 2.7.*
-      - hspec-core == 2.7.*
+      - hspec >= 2.5 && < 2.8
+      - hspec-core >= 2.5 && < 2.8
       - HUnit == 1.6.*
-      - QuickCheck == 2.14.*
+      - QuickCheck >= 2.11 && < 2.15
       - timeit == 2.0.*
 
 ghc-options:

simplexmq.cabal

@@ -3,8 +3,6 @@ cabal-version: 1.12
 -- This file has been generated from package.yaml by hpack version 0.34.4.
 --
 -- see: https://github.com/sol/hpack
---
--- hash: 3bdb491a0318dc4b53cba4131f192e4c4e17b42e88043495666d1688a1f95443
 
 name:           simplexmq
 version:        0.5.0
@@ -64,8 +62,8 @@ library
       src
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
   build-depends:
-      QuickCheck ==2.14.*
-    , ansi-terminal >=0.10 && <0.12
+      QuickCheck >=2.11 && <2.15
+    , ansi-terminal >=0.8 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
@@ -74,30 +72,30 @@ library
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
     , composition ==1.0.*
-    , constraints >=0.12 && <0.14
-    , containers ==0.6.*
-    , cryptonite >=0.27 && <0.30
+    , constraints >=0.10 && <0.14
+    , containers >=0.5 && <0.7
+    , cryptonite >=0.25 && <0.30
     , direct-sqlite ==2.3.*
     , directory ==1.3.*
-    , file-embed >=0.0.14.0 && <=0.0.15.0
+    , file-embed >=0.0.10.0 && <=0.0.15.0
     , filepath ==1.4.*
-    , generic-random >=1.3 && <1.5
+    , generic-random >=1.2 && <1.5
     , http-types ==0.12.*
     , iso8601-time ==0.1.*
-    , memory ==0.15.*
+    , memory >=0.14 && <0.16
     , mtl ==2.2.*
-    , network ==3.1.*
+    , network >=2.6 && <3.2
     , network-transport ==0.5.*
     , random >=1.1 && <1.3
-    , simple-logger ==0.1.*
+    , simple-logger ==0.0.4
     , sqlite-simple ==0.4.*
-    , stm ==2.5.*
-    , template-haskell ==2.16.*
+    , stm >=2.4 && <2.6
+    , template-haskell >=2.13 && <2.17
     , text ==1.2.*
-    , time ==1.9.*
+    , time >=1.8 && <1.10
     , transformers ==0.5.*
     , unliftio ==0.2.*
-    , unliftio-core ==0.2.*
+    , unliftio-core >=0.1 && <0.3
     , websockets ==0.12.*
     , x509 ==1.7.*
   default-language: Haskell2010
@@ -110,8 +108,8 @@ executable smp-agent
       apps/smp-agent
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
-      QuickCheck ==2.14.*
-    , ansi-terminal >=0.10 && <0.12
+      QuickCheck >=2.11 && <2.15
+    , ansi-terminal >=0.8 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
@@ -120,31 +118,31 @@ executable smp-agent
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
     , composition ==1.0.*
-    , constraints >=0.12 && <0.14
-    , containers ==0.6.*
-    , cryptonite >=0.27 && <0.30
+    , constraints >=0.10 && <0.14
+    , containers >=0.5 && <0.7
+    , cryptonite >=0.25 && <0.30
     , direct-sqlite ==2.3.*
     , directory ==1.3.*
-    , file-embed >=0.0.14.0 && <=0.0.15.0
+    , file-embed >=0.0.10.0 && <=0.0.15.0
     , filepath ==1.4.*
-    , generic-random >=1.3 && <1.5
+    , generic-random >=1.2 && <1.5
     , http-types ==0.12.*
     , iso8601-time ==0.1.*
-    , memory ==0.15.*
+    , memory >=0.14 && <0.16
     , mtl ==2.2.*
-    , network ==3.1.*
+    , network >=2.6 && <3.2
     , network-transport ==0.5.*
     , random >=1.1 && <1.3
-    , simple-logger ==0.1.*
+    , simple-logger ==0.0.4
     , simplexmq
     , sqlite-simple ==0.4.*
-    , stm ==2.5.*
-    , template-haskell ==2.16.*
+    , stm >=2.4 && <2.6
+    , template-haskell >=2.13 && <2.17
     , text ==1.2.*
-    , time ==1.9.*
+    , time >=1.8 && <1.10
     , transformers ==0.5.*
     , unliftio ==0.2.*
-    , unliftio-core ==0.2.*
+    , unliftio-core >=0.1 && <0.3
     , websockets ==0.12.*
     , x509 ==1.7.*
   default-language: Haskell2010
@@ -157,8 +155,8 @@ executable smp-server
       apps/smp-server
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
-      QuickCheck ==2.14.*
-    , ansi-terminal >=0.10 && <0.12
+      QuickCheck >=2.11 && <2.15
+    , ansi-terminal >=0.8 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
@@ -167,34 +165,34 @@ executable smp-server
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
     , composition ==1.0.*
-    , constraints >=0.12 && <0.14
-    , containers ==0.6.*
-    , cryptonite >=0.27 && <0.30
+    , constraints >=0.10 && <0.14
+    , containers >=0.5 && <0.7
+    , cryptonite >=0.25 && <0.30
     , cryptostore ==0.2.*
     , direct-sqlite ==2.3.*
     , directory ==1.3.*
-    , file-embed >=0.0.14.0 && <=0.0.15.0
+    , file-embed >=0.0.10.0 && <=0.0.15.0
     , filepath ==1.4.*
-    , generic-random >=1.3 && <1.5
+    , generic-random >=1.2 && <1.5
     , http-types ==0.12.*
-    , ini ==0.4.*
+    , ini >=0.3 && <0.5
     , iso8601-time ==0.1.*
-    , memory ==0.15.*
+    , memory >=0.14 && <0.16
     , mtl ==2.2.*
-    , network ==3.1.*
+    , network >=2.6 && <3.2
     , network-transport ==0.5.*
-    , optparse-applicative >=0.15 && <0.17
+    , optparse-applicative >=0.14 && <0.17
     , random >=1.1 && <1.3
-    , simple-logger ==0.1.*
+    , simple-logger ==0.0.4
     , simplexmq
     , sqlite-simple ==0.4.*
-    , stm ==2.5.*
-    , template-haskell ==2.16.*
+    , stm >=2.4 && <2.6
+    , template-haskell >=2.13 && <2.17
     , text ==1.2.*
-    , time ==1.9.*
+    , time >=1.8 && <1.10
     , transformers ==0.5.*
     , unliftio ==0.2.*
-    , unliftio-core ==0.2.*
+    , unliftio-core >=0.1 && <0.3
     , websockets ==0.12.*
     , x509 ==1.7.*
   default-language: Haskell2010
@@ -217,8 +215,8 @@ test-suite smp-server-test
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
   build-depends:
       HUnit ==1.6.*
-    , QuickCheck ==2.14.*
-    , ansi-terminal >=0.10 && <0.12
+    , QuickCheck >=2.11 && <2.15
+    , ansi-terminal >=0.8 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
@@ -227,34 +225,34 @@ test-suite smp-server-test
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
     , composition ==1.0.*
-    , constraints >=0.12 && <0.14
-    , containers ==0.6.*
-    , cryptonite >=0.27 && <0.30
+    , constraints >=0.10 && <0.14
+    , containers >=0.5 && <0.7
+    , cryptonite >=0.25 && <0.30
     , direct-sqlite ==2.3.*
     , directory ==1.3.*
-    , file-embed >=0.0.14.0 && <=0.0.15.0
+    , file-embed >=0.0.10.0 && <=0.0.15.0
     , filepath ==1.4.*
-    , generic-random >=1.3 && <1.5
-    , hspec ==2.7.*
-    , hspec-core ==2.7.*
+    , generic-random >=1.2 && <1.5
+    , hspec >=2.5 && <2.8
+    , hspec-core >=2.5 && <2.8
     , http-types ==0.12.*
     , iso8601-time ==0.1.*
-    , memory ==0.15.*
+    , memory >=0.14 && <0.16
     , mtl ==2.2.*
-    , network ==3.1.*
+    , network >=2.6 && <3.2
     , network-transport ==0.5.*
     , random >=1.1 && <1.3
-    , simple-logger ==0.1.*
+    , simple-logger ==0.0.4
     , simplexmq
     , sqlite-simple ==0.4.*
-    , stm ==2.5.*
-    , template-haskell ==2.16.*
+    , stm >=2.4 && <2.6
+    , template-haskell >=2.13 && <2.17
     , text ==1.2.*
-    , time ==1.9.*
+    , time >=1.8 && <1.10
     , timeit ==2.0.*
     , transformers ==0.5.*
     , unliftio ==0.2.*
-    , unliftio-core ==0.2.*
+    , unliftio-core >=0.1 && <0.3
     , websockets ==0.12.*
     , x509 ==1.7.*
   default-language: Haskell2010

src/Simplex/Messaging/Agent.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
@@ -56,7 +55,6 @@ module Simplex.Messaging.Agent
   )
 where
 
-import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple (logInfo, showText)
 import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
@@ -86,7 +84,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (MsgBody, SenderPublicKey)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), currentSMPVersionStr, runTransportServer)
-import Simplex.Messaging.Util (bshow, tryError, unlessM)
+import Simplex.Messaging.Util (bshow, stateTVar, tryError, unlessM)
 import System.Random (randomR)
 import UnliftIO.Async (async, race_)
 import qualified UnliftIO.Exception as E
@@ -361,7 +359,7 @@ subscribeConnection' c connId =
     resumeInterval :: m RetryInterval
     resumeInterval = do
       r <- asks $ retryInterval . config
-      pure r {initialInterval = 5_000_000}
+      pure r {initialInterval = 5000000}
 
 -- | Send message to the connection (SEND command) in Reader monad
 sendMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> MsgBody -> m AgentMsgId

src/Simplex/Messaging/Agent/Client.hs

@@ -37,7 +37,6 @@ module Simplex.Messaging.Agent.Client
 where
 
 import Control.Concurrent.Async (Async, async, uninterruptibleCancel)
-import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
@@ -60,7 +59,7 @@ import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgBody, QueueId, SenderPublicKey)
-import Simplex.Messaging.Util (bshow, liftEitherError, liftError)
+import Simplex.Messaging.Util (bshow, liftEitherError, liftError, stateTVar)
 import UnliftIO.Exception (IOException)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
@@ -86,9 +85,9 @@ data AgentClient = AgentClient
 newAgentClient :: Env -> STM AgentClient
 newAgentClient agentEnv = do
   let qSize = tbqSize $ config agentEnv
-  rcvQ <- newTBQueue qSize
-  subQ <- newTBQueue qSize
-  msgQ <- newTBQueue qSize
+  rcvQ <- newTBQueue $ fromIntegral qSize
+  subQ <- newTBQueue $ fromIntegral qSize
+  msgQ <- newTBQueue $ fromIntegral qSize
   smpClients <- newTVar M.empty
   subscrSrvrs <- newTVar M.empty
   subscrConns <- newTVar M.empty

src/Simplex/Messaging/Agent/Env/SQLite.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
 module Simplex.Messaging.Agent.Env.SQLite where
@@ -35,7 +34,7 @@ data AgentConfig = AgentConfig
   }
 
 minute :: Int
-minute = 60_000_000
+minute = 60000000
 
 defaultAgentConfig :: AgentConfig
 defaultAgentConfig =
@@ -51,15 +50,15 @@ defaultAgentConfig =
       smpCfg = smpDefaultConfig,
       retryInterval =
         RetryInterval
-          { initialInterval = 1_000_000,
+          { initialInterval = 1000000,
             increaseAfter = minute,
             maxInterval = 10 * minute
           },
       reconnectInterval =
         RetryInterval
-          { initialInterval = 1_000_000,
-            increaseAfter = 10_000_000,
-            maxInterval = 10_000_000
+          { initialInterval = 1000000,
+            increaseAfter = 10000000,
+            maxInterval = 10000000
           }
     }
 

src/Simplex/Messaging/Agent/Protocol.hs

@@ -804,7 +804,7 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
       return (corrId, connId, fullCmd)
 
     fromParty :: ACmd -> Either AgentErrorType (ACommand p)
-    fromParty (ACmd (p :: p1) cmd) = case testEquality party p of
+    fromParty (ACmd p cmd) = case testEquality party p of
       Just Refl -> Right cmd
       _ -> Left $ CMD PROHIBITED
 

src/Simplex/Messaging/Agent/Store.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MultiParamTypeClasses #-}

src/Simplex/Messaging/Agent/Store/SQLite.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -56,7 +55,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers (blobFieldParser)
 import Simplex.Messaging.Protocol (MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Util (bshow, liftIOEither)
+import Simplex.Messaging.Util (bshow, liftIOEither, stateTVar)
 import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
 import System.Exit (exitFailure)
 import System.FilePath (takeDirectory)
@@ -140,7 +139,7 @@ withConnection SQLiteStore {dbConnPool} =
     (atomically . writeTBQueue dbConnPool)
 
 withTransaction :: forall a. SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withTransaction st action = withConnection st $ loop 100 100_000
+withTransaction st action = withConnection st $ loop 100 100000
   where
     loop :: Int -> Int -> DB.Connection -> IO a
     loop t tLim db =

src/Simplex/Messaging/Client.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -66,7 +65,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Transport (ATransport (..), TCP, THandle (..), TProxy, Transport (..), TransportError, clientHandshake, runTransportClient)
 import Simplex.Messaging.Transport.WebSockets (WS)
-import Simplex.Messaging.Util (bshow, liftError, raceAny_)
+import Simplex.Messaging.Util (bshow, liftError, raceAny_, stateTVar)
 import System.Timeout (timeout)
 
 -- | 'SMPClient' is a handle used to send commands to a specific SMP server.
@@ -115,8 +114,8 @@ smpDefaultConfig =
   SMPClientConfig
     { qSize = 16,
       defaultTransport = ("5223", transport @TCP),
-      tcpTimeout = 4_000_000,
-      smpPing = 30_000_000,
+      tcpTimeout = 4000000,
+      smpPing = 30000000,
       smpBlockSize = Just 8192,
       smpCommandSize = 256
     }
@@ -142,8 +141,8 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlock
       connected <- newTVar False
       clientCorrId <- newTVar 0
       sentCommands <- newTVar M.empty
-      sndQ <- newTBQueue qSize
-      rcvQ <- newTBQueue qSize
+      sndQ <- newTBQueue $ fromIntegral qSize
+      rcvQ <- newTBQueue $ fromIntegral qSize
       return
         SMPClient
           { action = undefined,

src/Simplex/Messaging/Crypto.hs

@@ -789,7 +789,7 @@ decrypt' :: PrivateKey a -> ByteString -> ExceptT CryptoError IO ByteString
 decrypt' pk@(PrivateKeyRSA _) msg'' = do
   let (encHeader, msg') = B.splitAt (keySize pk) msg''
   header <- decryptOAEP pk encHeader
-  Header {aesKey, ivBytes, authTag, msgSize} <- except $ parseHeader header
+  Header {aesKey, ivBytes, authTag, msgSize} <- ExceptT $ pure $ parseHeader header
   msg <- decryptAES aesKey ivBytes msg' authTag
   return $ B.take msgSize msg
 decrypt' _ _ = throwE UnsupportedAlgorithm

src/Simplex/Messaging/Server.hs

@@ -25,7 +25,6 @@
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
 module Simplex.Messaging.Server (runSMPServer, runSMPServerBlocking) where
 
-import Control.Concurrent.STM (stateTVar)
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift

src/Simplex/Messaging/Server/Env/STM.hs

@@ -67,9 +67,9 @@ data Sub = Sub
 
 newServer :: Natural -> STM Server
 newServer qSize = do
-  subscribedQ <- newTBQueue qSize
+  subscribedQ <- newTBQueue $ fromIntegral qSize
   subscribers <- newTVar M.empty
-  ntfSubscribedQ <- newTBQueue qSize
+  ntfSubscribedQ <- newTBQueue $ fromIntegral qSize
   notifiers <- newTVar M.empty
   return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers}
 
@@ -77,8 +77,8 @@ newClient :: Natural -> STM Client
 newClient qSize = do
   subscriptions <- newTVar M.empty
   ntfSubscriptions <- newTVar M.empty
-  rcvQ <- newTBQueue qSize
-  sndQ <- newTBQueue qSize
+  rcvQ <- newTBQueue $ fromIntegral qSize
+  sndQ <- newTBQueue $ fromIntegral qSize
   return Client {subscriptions, ntfSubscriptions, rcvQ, sndQ}
 
 newSubscription :: STM Sub

src/Simplex/Messaging/Server/MsgStore/STM.hs

@@ -29,7 +29,7 @@ instance MonadMsgStore STMMsgStore MsgQueue STM where
     maybe (newQ m) return $ M.lookup rId m
     where
       newQ m' = do
-        q <- MsgQueue <$> newTBQueue quota
+        q <- MsgQueue <$> newTBQueue (fromIntegral quota)
         writeTVar store . MsgStoreData $ M.insert rId q m'
         return q
 

src/Simplex/Messaging/Transport.hs

@@ -150,7 +150,8 @@ startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
     open addr = do
       sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
       setSocketOption sock ReuseAddr 1
-      withFdSocket sock setCloseOnExecIfNeeded
+      -- removed for GHC 8.4.4
+      -- withFdSocket sock setCloseOnExecIfNeeded
       bind sock $ addrAddress addr
       listen sock 1024
       return sock

src/Simplex/Messaging/Util.hs

@@ -5,6 +5,8 @@
 
 module Simplex.Messaging.Util where
 
+import Control.Concurrent.STM
+import Control.Monad.Fail (MonadFail)
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Data.Bifunctor (first)
@@ -63,3 +65,11 @@ ifM ba t f = ba >>= \b -> if b then t else f
 
 unlessM :: Monad m => m Bool -> m () -> m ()
 unlessM b = ifM b $ pure ()
+
+stateTVar :: TVar s -> (s -> (a, s)) -> STM a
+stateTVar var f = do
+   s <- readTVar var
+   let (a, s') = f s -- since we destructure this, we are strict in f
+   writeTVar var s'
+   return a
+{-# INLINE stateTVar #-}

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-18.13
+resolver: lts-12.26
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -35,9 +35,9 @@ packages:
 # forks / in-progress versions pinned to a git hash. For example:
 #
 extra-deps:
-  - cryptostore-0.2.1.0@sha256:9896e2984f36a1c8790f057fd5ce3da4cbcaf8aa73eb2d9277916886978c5b19,3881
+  - cryptostore-0.2.0.0
   - direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718
-  - simple-logger-0.1.0@sha256:be8ede4bd251a9cac776533bae7fb643369ebd826eb948a9a18df1a8dd252ff8,1079
+  - simple-logger-0.0.4
   - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002
 # - network-run-0.2.4@sha256:7dbb06def522dab413bce4a46af476820bffdff2071974736b06f52f4ab57c96,885
 # - git: https://github.com/commercialhaskell/stack.git

tests/AgentTests/FunctionalAPITests.hs

@@ -12,7 +12,7 @@ import Control.Monad.IO.Unlift
 import SMPAgentClient
 import SMPClient (withSmpServer)
 import Simplex.Messaging.Agent
-import Simplex.Messaging.Agent.Env.SQLite (dbFile)
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import Simplex.Messaging.Transport (ATransport (..))

tests/SMPAgentClient.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -163,9 +162,9 @@ cfg =
         smpDefaultConfig
           { qSize = 1,
             defaultTransport = (testPort, transport @TCP),
-            tcpTimeout = 500_000
+            tcpTimeout = 500000
           },
-      retryInterval = (retryInterval defaultAgentConfig) {initialInterval = 50_000}
+      retryInterval = (retryInterval defaultAgentConfig) {initialInterval = 50000}
     }
 
 withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m () -> (ThreadId -> m a) -> m a

tests/SMPClient.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -22,6 +22,7 @@ import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.StoreLog (openReadStoreLog)
 import Simplex.Messaging.Transport
 import Test.Hspec
+import qualified Control.Concurrent as CC
 import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM (TMVar, atomically, newEmptyTMVarIO, takeTMVar)
@@ -111,6 +112,11 @@ withSmpServerThreadOn t port =
     (\started -> runSMPServerBlocking started cfg {transports = [(port, t)]})
     (pure ())
 
+forkIOWithUnmask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m ()) -> m ThreadId
+forkIOWithUnmask m =
+  withRunInIO $ \run -> CC.forkIOWithUnmask $ \unmask -> run $ m $ liftIO . unmask . run
+{-# INLINABLE forkIOWithUnmask #-}
+
 serverBracket :: MonadUnliftIO m => (TMVar Bool -> m ()) -> m () -> (ThreadId -> m a) -> m a
 serverBracket process afterProcess f = do
   started <- newEmptyTMVarIO
@@ -120,7 +126,7 @@ serverBracket process afterProcess f = do
     (\t -> waitFor started "start" >> f t)
   where
     waitFor started s =
-      5_000_000 `timeout` atomically (takeTMVar started) >>= \case
+      5000000 `timeout` atomically (takeTMVar started) >>= \case
         Nothing -> error $ "server did not " <> s
         _ -> pure ()