forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Fix the bug fix

Browse source
This commit is contained in:
Pere Lev 2024-08-07 17:43:36 +03:00
parent d224569efc
commit a418e21ee2
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
1 changed files with 6 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/Web/Actor/Deliver.hs
View file

@ -223,9 +223,11 @@ startDeliveryTheater headers micros manager logFunc dbRootDir = do
-- We first add the sqlite3 extension as needed
entries <- listDirectory dbRootDir
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 ()
if "-wal-shm" `isSuffixOf` path || "-wal-wal" `isSuffixOf` path
then return ()
else if takeExtension path == ".sqlite3"
then return ()
else renameFile (dbRootDir </> path) (dbRootDir </> path <.> "sqlite3")
entries <- listDirectory dbRootDir
let dbs = filter ((== ".sqlite3") . takeExtension) entries
@ -245,6 +247,6 @@ startDeliveryTheater headers micros manager logFunc dbRootDir = do
sendHttp :: UriMode u => DeliveryTheater u -> ActorMessage (DeliveryActor u) -> [ObjURI u] -> IO ()
sendHttp (DeliveryTheater manager headers micros logFunc root theater) method recips = do
for_ recips $ \ u ->
let makeEnv = either throwIO pure (TE.decodeUtf8' $ urlEncode False $ TE.encodeUtf8 $ renderObjURI u) >>= encodeUtf . (root </>) . T.unpack >>= mkEnv (manager, headers, micros) logFunc
let makeEnv = either throwIO pure (TE.decodeUtf8' $ urlEncode False $ TE.encodeUtf8 $ renderObjURI u) >>= encodeUtf . (<.> "sqlite3") . (root </>) . T.unpack >>= mkEnv (manager, headers, micros) logFunc
in void $ spawnIO theater u makeEnv
sendManyIO theater $ Just (HS.fromList recips, method) `H.HCons` H.HNil