From c5e8a38cd72331b0236ae0d4b933850c5539312e Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Mon, 23 May 2022 18:20:59 +0200
Subject: [PATCH] chore(pdf): send PDF with proper file download mechanics

---
 src/Handler/Admin/Test.hs     | 15 +++++++++++----
 src/Handler/Utils/Download.hs | 14 ++++++++++++++
 2 files changed, 25 insertions(+), 4 deletions(-)

diff --git a/src/Handler/Admin/Test.hs b/src/Handler/Admin/Test.hs
index 6fa490349..e24d7d305 100644
--- a/src/Handler/Admin/Test.hs
+++ b/src/Handler/Admin/Test.hs
@@ -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 
\ No newline at end of file
diff --git a/src/Handler/Utils/Download.hs b/src/Handler/Utils/Download.hs
index 28d723bb8..5de16efe5 100644
--- a/src/Handler/Utils/Download.hs
+++ b/src/Handler/Utils/Download.hs
@@ -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