chore(pdf): send PDF with proper file download mechanics

This commit is contained in:
Steffen Jost 2022-05-23 18:20:59 +02:00
parent 62e1694b6e
commit c5e8a38cd7
2 changed files with 25 additions and 4 deletions

View File

@ -10,6 +10,7 @@ import Jobs
import Data.Char (isDigit)
import qualified Data.Text as Text
import qualified Data.ByteString.Lazy as L
import qualified Data.Set as Set
import qualified Data.Map as Map
@ -274,16 +275,22 @@ postAdminTestR = do
getAdminTestPdfR :: Handler TypedContent
getAdminTestPdfR = do
-- let typePDF = "application/pdf" :: ContentType
-- typePDF = Settings.Mime.mimeLookup "pdfdemo.pdf"
content <- liftIO . P.runIO $ do
let
md = "# Hello \n\n This is some Text." :: Text
tmpl <- P.compileDefaultTemplate "latex"
let
md = "# Hello \n\n This is some *more* Text." :: Text
texopts = []
writeropts = def
writeropts = def { P.writerTemplate = Just tmpl }
doc <- P.readMarkdown def md
res <- P.makePDF "pdflatex" texopts P.writeLaTeX writeropts doc
case res of
Right bs -> return bs
Left err -> return err
case content of
Right bs -> return $ TypedContent typeOctet $ toContent bs
Right bs -> do
-- sendResponse (typePDF, toContent bs) -- works too
now <- liftIO getCurrentTime
sendByteStringAsFile "demoPDF.pdf" (L.toStrict bs) now
Left err -> return $ toTypedContent $ tshow err

View File

@ -1,5 +1,6 @@
module Handler.Utils.Download
( sendThisFile
, sendByteStringAsFile
, sendFileReference
, serveOneFile
, serveSomeFiles
@ -156,6 +157,19 @@ sendThisFile File{..} = do
fileContent' .| C.map toFlushBuilder
| otherwise -> sendResponseStatus noContent204 ()
sendByteStringAsFile :: ( YesodAuthPersist UniWorX
, AuthEntity UniWorX ~ User
, AuthId UniWorX ~ UserId
, YesodPersistRunner UniWorX
, MonadCrypto (HandlerFor UniWorX), MonadCryptoKey (HandlerFor UniWorX) ~ CryptoIDKey
) => FilePath -> ByteString -> UTCTime -> HandlerFor UniWorX TypedContent
sendByteStringAsFile fileTitle content fileModified =
sendThisFile File{..}
where
fileContent
| null content = Nothing
| otherwise = Just $ yield content
sendFileReference :: forall file a.
( HasFileReference file
, BearerAuthSite UniWorX