From fa5a8cb5cd9aed374906c92e641968f8e5883ca5 Mon Sep 17 00:00:00 2001
From: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com>
Date: Sun, 9 May 2021 13:24:02 +0400
Subject: [PATCH] agent: change sqlite busy retry handling; set journal_mode =
 WAL (#132)

* agent: change sqlite busy retry handling; set journal_mode = WAL

* fix accumulation

* add exponential back-off (*1.5) to transaction retries

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 src/Simplex/Messaging/Agent/Store/SQLite.hs | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index a8ccfb213..42ad1ad1e 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -82,7 +83,7 @@ connectSQLiteStore dbFilePath = do
       dbConn
       [sql|
         PRAGMA foreign_keys = ON;
-        PRAGMA busy_timeout = 300;
+        PRAGMA journal_mode = WAL;
       |]
   return SQLiteStore {dbFilePath, dbConn}
 
@@ -95,14 +96,15 @@ checkDuplicate action = liftIOEither $ first handleError <$> E.try action
       | otherwise = SEInternal $ bshow e
 
 withTransaction :: forall a. DB.Connection -> IO a -> IO a
-withTransaction db a = loop 5 50000
+withTransaction db a = loop 100 100_000
   where
     loop :: Int -> Int -> IO a
-    loop n t =
-      DB.withImmediateTransaction db a `E.catch` \(e :: SQLError) -> do
-        threadDelay t
-        if n > 1 && DB.sqlError e == DB.ErrorBusy
-          then loop (n - 1) (t * 3 `div` 2)
+    loop t tLim =
+      DB.withImmediateTransaction db a `E.catch` \(e :: SQLError) ->
+        if tLim > t && DB.sqlError e == DB.ErrorBusy
+          then do
+            threadDelay t
+            loop (t * 3 `div` 2) (tLim - t)
           else E.throwIO e
 
 instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteStore m where