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