Commit 62248b2c authored by Antoine Fontaine's avatar Antoine Fontaine 🎱
Browse files

Add proper Content-Type support and fixup Debian packaging

parent 325d7dca
Pipeline #1883 failed with stages
in 41 minutes and 21 seconds
# TODO:
* Send mimetype on access.
* Autodetect mimetype if field is empty.
* Good practices testing.
* Check error handling (should be good).
......
gnupaste (2.0.0+rc2) unstable; urgency=medium
gnupaste (2.0.0~rc3) unstable; urgency=medium
* Add proper Content-Type support
* Fixup Debian packaging
-- Antoine Fontaine <antoine.fontaine@epfl.ch> Sun, 22 Dec 2020 14:53:03 +0100
gnupaste (2.0.0~rc2) unstable; urgency=medium
* Add (hardcoded) maximum uploaded file size
-- Antoine Fontaine <antoine.fontaine@epfl.ch> Sun, 20 Dec 2020 15:49:01 +0100
-- Antoine Fontaine <antoine.fontaine@epfl.ch> Sun, 22 Dec 2020 11:03:36 +0100
gnupaste (2.0.0+rc1) unstable; urgency=medium
gnupaste (2.0.0~rc1) unstable; urgency=medium
* Initial release
......
......@@ -2,10 +2,9 @@ Source: gnupaste
Maintainer: Antoine Fontaine <antoine.fontaine@epfl.ch>
Section: haskell
Build-Depends:
debhelper (>= 12~)
${misc:Depends}
Vcs-Browser: https://gitlab.gnugen.ch/gnugen/gnupaste
Vcs-Git: https://gitlab.gnugen.ch/gnugen/gnupaste.git
Standards-Version: 4.5.0
Standards-Version: 4.3.0
Description: GNU Generation's new pastebin software
Package: gnupaste
Architecture: all
......@@ -19,6 +19,7 @@ executables:
- -O2
dependencies:
- blaze-html
- bytestring
- directory
- monad-logger
- network
......
......@@ -30,7 +30,7 @@ import Text.Blaze.Html5
-- A user can either get the homepage with instructions, upload a file with the
-- given form, or ask for a file using it's hash.
type PasteAPI = Get '[HTML] Html
:<|> "raw" :> Raw
:<|> "raw" :> Capture "hash" Text :> Get '[OctetStream] (Headers '[Header "Content-Type" Text] ByteString)
:<|> RemoteHost
:> Header "X-Forwarded-For" Text
:> MultipartForm Tmp (MultipartData Tmp)
......
......@@ -65,6 +65,14 @@ generateHash pool = do
case mExists of Nothing -> return $ T.pack hash
Just _ -> pickElem pasteChars >>= checkHash pool . (: hash)
-- | Returns the mimetype of an entry
lookupFiletype :: ConnectionPool -- ^ The 'ConnectionPool' to the database.
-> Text -- ^ The hash of the file
-> IO (Maybe Text)
lookupFiletype pool hash = do
result <- runSqlPool (selectList [PasteHash ==. hash] []) pool
return (pasteMime <$> entityVal <$> listToMaybe result)
-- | Function to cleanup expired pastes from the database and drive. Do not
-- call outside of the main loop: this function does not terminate!
cleanupPastes :: ConnectionPool -- ^ The 'ConnectionPool' to the database
......
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
......@@ -25,6 +26,7 @@ import Paste.API
import Paste.Database
import Paste.Homepage
import qualified Data.ByteString as B
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.Clock
......@@ -35,13 +37,24 @@ import Servant.Multipart
import System.Directory
import Text.Read
import Text.Regex
-- | Server implementing our API. Contains all the logic.
server :: ConnectionPool -- ^ Database pool.
-> FilePath -- ^ Directory containing uploads.
-> Server PasteAPI
server pool pasteDir = return homepage
:<|> serveDirectoryWebApp pasteDir
:<|> processUpload pool pasteDir
:<|> servePastes pool pasteDir
:<|> processUpload pool pasteDir
servePastes :: ConnectionPool -- ^ Database pool.
-> FilePath -- ^ Directory containing uploads.
-> Text -- ^ Hash of the requested paste
-> Handler (Headers '[Header "Content-Type" Text] ByteString)
servePastes pool pasteDir hash = do
mimetype <- liftIO $ do Just mimetype <- lookupFiletype pool hash
return mimetype
response <- liftIO $ B.readFile (pasteDir ++ T.unpack hash)
return $ addHeader mimetype response
-- | Process a file upload request to our server.
processUpload :: ConnectionPool -- ^ Database pool.
......
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