From d224569efc0cfaaa2b981727252cfe5c00e153c2 Mon Sep 17 00:00:00 2001
From: Pere Lev <pere@towards.vision>
Date: Wed, 7 Aug 2024 17:00:12 +0300
Subject: [PATCH] Add sqlite3 extension to per-actor DB files to fix a bug

Vervis tries to open Sqlite's WAL files as databases and thus fails to
launch
---
 src/Web/Actor/Deliver.hs | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

diff --git a/src/Web/Actor/Deliver.hs b/src/Web/Actor/Deliver.hs
index 1cfe059..ab0dec5 100644
--- a/src/Web/Actor/Deliver.hs
+++ b/src/Web/Actor/Deliver.hs
@@ -41,7 +41,9 @@ import Control.Retry
 import Data.ByteString (ByteString)
 import Data.Foldable
 import Data.Hashable
+import Data.List
 import Data.List.NonEmpty (NonEmpty)
+import Data.Maybe
 import Data.Text (Text)
 import Data.Time.Clock
 import Data.Time.Interval
@@ -51,7 +53,7 @@ import Network.HTTP.Client (Manager, HttpException (..), HttpExceptionContent (.
 import Network.HTTP.Types.Header (HeaderName)
 import Network.HTTP.Types.URI (urlEncode, urlDecode)
 import Network.HTTP.Types.Status
-import System.FilePath ((</>))
+import System.FilePath
 import System.Directory
 import Web.Hashids
 
@@ -217,9 +219,18 @@ startDeliveryTheater
     -> OsPath
     -> IO (DeliveryTheater u)
 startDeliveryTheater headers micros manager logFunc dbRootDir = do
+
+    -- We first add the sqlite3 extension as needed
     entries <- listDirectory dbRootDir
-    actors <- for entries $ \ path -> do
-        path' <- T.pack <$> decodeUtf path
+    for_ entries $ \ path ->
+        if takeExtension path == "" && not ("-wal-shm" `isSuffixOf` path) && not ("-wal-wal" `isSuffixOf` path)
+            then renameFile (dbRootDir </> path) (dbRootDir </> path <.> "sqlite3")
+            else return ()
+
+    entries <- listDirectory dbRootDir
+    let dbs = filter ((== ".sqlite3") . takeExtension) entries
+    actors <- for dbs $ \ path -> do
+        path' <- T.pack <$> decodeUtf (dropExtension path)
         path'' <- either throwIO pure $ TE.decodeUtf8' $ urlDecode False $ TE.encodeUtf8 path'
         u <-
             case parseObjURI path'' of