Commit c3bb34d7 authored by Antoine Fontaine's avatar Antoine Fontaine 👣

Unify naming conventions

parent 40177fe6
Pipeline #1879 canceled with stages
in 42 minutes and 25 seconds
......@@ -57,10 +57,10 @@ runServer :: Arguments -> IO ()
runServer Args{..} = do
createDirectoryIfMissing True pasteDir
setFileMode pasteDir 0o700
db <- runStderrLoggingT $
pool <- runStderrLoggingT $
createSqlitePool (T.pack sqlitePath) 1
_ <- forkIO $ cleanupPastes db (pasteDir<>"/")
let srv = server db (pasteDir<>"/")
_ <- forkIO $ cleanupPastes pool (pasteDir<>"/")
let srv = server pool (pasteDir<>"/")
pasteAPI = Proxy :: Proxy PasteAPI
application = serve pasteAPI srv
run port application
......
......@@ -70,19 +70,19 @@ generateHash pool = do
cleanupPastes :: ConnectionPool -- ^ The 'ConnectionPool' to the database
-> FilePath -- ^ The 'FilePath' to the directory containing uploads.
-> IO ()
cleanupPastes pool uploads = do
cleanupPastes pool pasteDir = do
-- Obtain the list of expired pastes.
now <- getCurrentTime
files <- runSqlPool (selectList [PasteDueAt <. now] []) pool
-- Remove the files and DB references.
sequence_ $ (processFiles pool uploads) <$> files
sequence_ $ (processFiles pool pasteDir) <$> files
-- Wait and recurse.
threadDelay $ 3600 * 24 * 1000000 -- once every day
cleanupPastes pool uploads
cleanupPastes pool pasteDir
-- Remove files from the database and then remove them.
where processFiles :: ConnectionPool -> FilePath -> Entity Paste -> IO ()
processFiles pool uploads (Entity key paste) =
runSqlPool (delete key) pool >> removeFile (uploads ++ T.unpack (pasteHash paste))
processFiles pool pasteDir (Entity key paste) =
runSqlPool (delete key) pool >> removeFile (pasteDir ++ T.unpack (pasteHash paste))
......@@ -39,9 +39,9 @@ import Text.Regex
server :: ConnectionPool -- ^ Database pool.
-> FilePath -- ^ Directory containing uploads.
-> Server PasteAPI
server pool uploads = return homepage
:<|> serveDirectoryWebApp uploads
:<|> processUpload pool uploads
server pool pasteDir = return homepage
:<|> serveDirectoryWebApp pasteDir
:<|> processUpload pool pasteDir
-- | Process a file upload request to our server.
processUpload :: ConnectionPool -- ^ Database pool.
......@@ -50,7 +50,7 @@ processUpload :: ConnectionPool -- ^ Database pool.
-> Maybe Text -- ^ Optional 'X-Forwarded-For' header.
-> MultipartData Tmp -- ^ Data uploaded in the "multipart/formdata".
-> Handler Text
processUpload pool uploads reqAddr mXForward multipData =
processUpload pool pasteDir reqAddr mXForward multipData =
-- Process and check request: first and foremost, do we have a file ?
case head $ files multipData of
Nothing -> throwError err400 { errBody = "You must include a file in the multipart/formdata you upload!" }
......@@ -69,7 +69,7 @@ processUpload pool uploads reqAddr mXForward multipData =
let address = fromMaybe (textifyAddress reqAddr) (mXForward)
-- copy file to "uploads" dir.
liftIO $ copyFile (fdPayload upload) (uploads ++ (T.unpack hash))
liftIO $ copyFile (fdPayload upload) (pasteDir ++ (T.unpack hash))
-- Store info in DB.
liftIO $ insertPaste Paste { pasteHash = hash
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment