chore(lms): email notifications send encrypted pdfs now

messages/uniworx/categories/print/de-de-formal.msg

@@ -1,5 +1,6 @@
 PJActAcknowledge: Druck und Versand bestätigen
 PrintJobName: Bezeichnung
+PrintJobFilename: Dateiname
 PrintJobId !ident-ok: Id 
 PrintJobCreated: Gesendet
 PrintJobAcknowledged: Bestätigt

messages/uniworx/categories/print/en-eu.msg

@@ -1,5 +1,6 @@
 PJActAcknowledge: Acknowledge printing and mailing
 PrintJobName: Description
+PrintJobFilename: Filename
 PrintJobId: Id 
 PrintJobCreated: Created
 PrintJobAcknowledged: Acknowledged

src/Handler/Admin/Test.hs

@@ -306,7 +306,7 @@ getAdminTestPdfR = do
           liftIO $ LBS.writeFile "/tmp/generated.pdf" bs
           mbEncPdf <- encryptPDF "tomatenmarmelade" bs
           case mbEncPdf of 
-            Left err -> sendResponseStatus internalServerError500 $ decodeUtf8 $ LBS.toStrict $ "PDFtk error: \n" <> err
+            Left err -> sendResponseStatus internalServerError500 $ "PDFtk error: \n" <> err
             Right encPdf -> do 
               liftIO $ LBS.writeFile "/tmp/crypted.pdf" encPdf
               sendByteStringAsFile "demoPDF.pdf" (LBS.toStrict bs) now

src/Handler/PrintCenter.hs

@@ -202,9 +202,10 @@ mkPJTable = do
       [ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^. resultPrintJob . _entityVal . _printJobAcknowledged)
       , sortable (Just "pj-created")      (i18nCell MsgPrintJobCreated)       $ \(   view $ resultPrintJob . _entityVal . _printJobCreated      -> t) ->      dateTimeCell t
       , sortable (Just "pj-acknowledged") (i18nCell MsgPrintJobAcknowledged)  $ \(   view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t
+      , sortable (Just "pj-filename")     (i18nCell MsgPrintJobFilename)      $ \(   view $ resultPrintJob . _entityVal . _printJobFilename     -> t) -> textCell t 
       , sortable (toNothingS "pdf")       (i18nCell MsgPrintPDF)              $ \(   view $ resultPrintJob . _entityKey -> k) -> anchorCellM (PrintDownloadR <$> encrypt k)  (showId k)
       -- , sortable (Just "pj-id")           (i18nCell MsgPrintJobId)            $ \(   view $ resultPrintJob . _entityKey                         -> k) -> textCell (tshow . E.unSqlBackendKey $ unPrintJobKey k)
-      -- , sortable (Just "pj-id")           (i18nCell MsgPrintJobId)            $ \(   view $ resultPrintJob . _entityKey                         -> k) -> cell (showId k)
+      -- , sortable (Just "pj-id")           (i18nCell MsgPrintJobId)            $ \(   view $ resultPrintJob . _entityKey                         -> k) -> cell (showId k)      
       , sortable (Just "pj-name")         (i18nCell MsgPrintJobName)          $ \(   view $ resultPrintJob . _entityVal . _printJobName         -> n) -> textCell n      
       , sortable (Just "pj-recipient")    (i18nCell MsgPrintRecipient)        $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR
       , sortable (Just "pj-sender")       (i18nCell MsgPrintSender)           $ \(preview resultSender    -> u) -> maybeCell u $ cellHasUserLink AdminUserR
@@ -213,6 +214,7 @@ mkPJTable = do
       ]
     dbtSorting = mconcat
       [ single ("pj-name"         , SortColumn $ queryPrintJob      >>> (E.^. PrintJobName))
+      , single ("pj-filename"     , SortColumn $ queryPrintJob      >>> (E.^. PrintJobFilename))
       -- , single ("pj-id"           , SortColumn $ queryPrintJob      >>> (E.^. PrintJobId))
       , single ("pj-created"      , SortColumn $ queryPrintJob      >>> (E.^. PrintJobCreated))
       , single ("pj-acknowledged" , SortColumn $ queryPrintJob      >>> (E.^. PrintJobAcknowledged))
@@ -223,6 +225,7 @@ mkPJTable = do
       ]
     dbtFilter = mconcat
       [ single ("pj-name"         , FilterColumn . E.mkContainsFilter          $ views (to queryPrintJob)      (E.^. PrintJobName))
+      , single ("pj-filename"     , FilterColumn . E.mkContainsFilter          $ views (to queryPrintJob)      (E.^. PrintJobFilename))
       , single ("pj-recipient"    , FilterColumn . E.mkContainsFilterWith Just $ views (to queryRecipient)     (E.?. UserDisplayName))
       , single ("pj-sender"       , FilterColumn . E.mkContainsFilterWith Just $ views (to querySender)        (E.?. UserDisplayName))
       , single ("pj-course"       , FilterColumn . E.mkContainsFilterWith Just $ views (to queryCourse)        (E.?. CourseName))
@@ -230,7 +233,8 @@ mkPJTable = do
       , single ("acknowledged"    , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged)))
       ]
     dbtFilterUI mPrev = mconcat
-      [ prismAForm (singletonFilter "pj-name"         . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgPrintJobName)
+      [ prismAForm (singletonFilter "pj-filename"     . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgPrintJobFilename)
+      , prismAForm (singletonFilter "pj-name"         . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgPrintJobName)
       , prismAForm (singletonFilter "pj-recipient"    . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgPrintRecipient)
       , prismAForm (singletonFilter "pj-sender"       . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgPrintSender)
       , prismAForm (singletonFilter "pj-course"       . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgPrintCourse)
@@ -314,10 +318,10 @@ postPrintSendR = do
             -- TODO: continue here with acutal letter sending!
             pure True
           (Nothing, Left err) -> do
-            addMessage Error . toHtml $ P.renderError err
+            addMessage Error $ toHtml err
             pure False
           (Just uid, Left err) -> do
-            addMessage Error . toHtml $ "For uid " <> tshow uid <> ": " <> P.renderError err
+            addMessage Error . toHtml $ "For uid " <> tshow uid <> ": " <> err
             pure False
         when (or oks) $ redirect PrintCenterR
   formResult sendResult procFormSend

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -7,10 +7,12 @@ module Jobs.Handler.SendNotification.Qualification
 
 import Import
 
-
+import Utils.Print
 import Handler.Utils
 import Jobs.Handler.SendNotification.Utils
 
+import qualified Data.ByteString.Lazy as LBS
+
 -- import Handler.Info (FAQItem(..))
 import qualified Data.CaseInsensitive as CI
 import Text.Hamlet
@@ -30,41 +32,56 @@ dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = use
   $logDebugS "LMS" $ "Notify " <> tshow jRecipient <> " about expiry of qualification " <> qname
   replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
   setSubjectI $ MsgMailSubjectQualificationExpiry qname
-  
+
   editNotifications <- mkEditNotifications jRecipient
 
   addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpiry.hamlet")
 
 
 checkEmailOk :: a -> Bool
-checkEmailOk = const True -- TODO 
+checkEmailOk = const True -- TODO
 
 
 dispatchNotificationQualificationRenewal :: QualificationId -> UserId -> Handler ()
-dispatchNotificationQualificationRenewal nQualification jRecipient = do 
+dispatchNotificationQualificationRenewal nQualification jRecipient = do
   (User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- runDB $ (,,)
     <$> getJust jRecipient
     <*> getJust nQualification
     <*> getJustBy (UniqueQualificationUser nQualification jRecipient)
-  let qname = CI.original qualificationName  
+  let qname = CI.original qualificationName
       -- content = $(i18nWidgetFile "qualification/renewal")
   $logDebugS "LMS" $ "Notify " <> tshow jRecipient <> " for renewal of qualifiaction " <> qname
-  if | checkEmailOk userEmail -> userMailT jRecipient $ do
+
-        
+  let pdfMeta = applyMetas [("recipient", userDisplayName)] mempty -- TODO: add more info to interpolate here!
+  pdfRenewal pdfMeta >>= \case
+    Left err -> do
+      let msg = "Notify " <> tshow jRecipient <> " PDF generation failed with error: " <> err
+      $logErrorS "LMS" msg
+      error $ unpack msg
+    Right pdf | checkEmailOk userEmail -> userMailT jRecipient $ do
+
         replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
         setSubjectI $ MsgMailSubjectQualificationRenewal qname
-      
+
-        editNotifications <- mkEditNotifications jRecipient -- TODO: add to hamlet file again         
+        editNotifications <- mkEditNotifications jRecipient -- TODO: add to hamlet file again
         -- let msgrenewal = $(i18nHamletFile "qualification/renewal") -- :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)
         -- addHtmlMarkdownAlternatives' msgrenewal
-          
-        -- TODO: this is just a dummy to continue while i18nHamletFile usage is unclear
-        addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationRenewal.hamlet")        
         
+        now <- liftIO getCurrentTime
+        encryptPDF "tomatenmarmelade" pdf >>= \case
+          Left err -> do
+            let msg = "Notify " <> tshow jRecipient <> "  PDF encryption failed with error: " <> err
+            $logErrorS "LMS" msg
+            error $ unpack msg
+          Right pdffile -> do
+            addPart (File { fileTitle = "Renewal Pin Letter"
+                         , fileModified = now
+                         , fileContent = Just $ yield $ LBS.toStrict pdffile
+                         } :: PureFile)
+            -- TODO: this is just a dummy to continue while i18nHamletFile usage is unclear
+            addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationRenewal.hamlet")
 
-     | otherwise -> do 
+    Right _pdf | otherwise -> do
         let _letterHead = error "TODO"
-        -- makePDF "pdflatex" [] writer woptions pandoc 
+        -- makePDF "pdflatex" [] writer woptions pandoc
         error "TODO"
-
-  

src/Utils/Print.hs

@@ -207,15 +207,16 @@ mdRenewal meta = runExceptT $ do
                        , P.writerTemplate = Just tmpl
                        }
   ExceptT . pure . P.runPure $ P.writeMarkdown writerOpts $ appMeta setIsDeFromLang
-                                                          $ addMeta meta doc
+                                                          $ addMeta meta doc  
 
 
 -- | combines 'mdRenewal' and 'pdfDIN5008'
-pdfRenewal :: P.Meta -> HandlerFor UniWorX (Either P.PandocError LBS.ByteString)
+pdfRenewal :: P.Meta -> HandlerFor UniWorX (Either Text LBS.ByteString)
 pdfRenewal meta = do
   e_txt <- mdRenewal' meta 
   --actRight e_txt (pdfDIN5008 . appMeta setIsDeFromLang . addMeta meta) -- try this
-  actRight e_txt $ pdfDIN5008 meta
+  result <- actRight e_txt $ pdfDIN5008 meta
+  return $ over _Left P.renderError result
 
 -- | like pdfRenewal but without caching
 pdfRenewal' :: P.Meta -> P.PandocIO LBS.ByteString
@@ -240,7 +241,7 @@ sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse prin
       nameCourse    = CI.original . courseShorthand        <$> course 
       nameQuali     = CI.original . qualificationShorthand <$> quali
   let printJobAcknowledged = Nothing
-      printJobFilename = unpack $ (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) <> ".pdf"
+      printJobFilename = unpack $ T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) <> ".pdf"
       -- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf   -- for PrintJobFile :: FileContentReference use this code
       printJobFile = LBS.toStrict pdf
   -- TODO: system call to lpr here!
@@ -248,6 +249,28 @@ sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse prin
   insert_ PrintJob {..}
   return printJobFilename
 
+sendLetter' :: Text -> LBS.ByteString -> Maybe UserId -> Maybe UserId -> Maybe CourseId -> Maybe QualificationId -> DB PureFile
+sendLetter' printJobName pdf printJobRecipient printJobSender printJobCourse printJobQualification = do 
+  recipient <- join <$> mapM get printJobRecipient
+  sender    <- join <$> mapM get printJobSender
+  course    <- join <$> mapM get printJobCourse
+  quali     <- join <$> mapM get printJobQualification
+  let nameRecipient = userDisplayName <$> recipient
+      nameSender    = userDisplayName <$> sender
+      nameCourse    = CI.original . courseShorthand        <$> course 
+      nameQuali     = CI.original . qualificationShorthand <$> quali
+  let printJobAcknowledged = Nothing
+      printJobFilename = unpack $ T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) <> ".pdf"
+      -- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf   -- for PrintJobFile :: FileContentReference use this code
+      printJobFile = LBS.toStrict pdf
+  -- TODO: system call to lpr here!
+  printJobCreated <- liftIO getCurrentTime
+  insert_ PrintJob {..}
+  return $ File { fileTitle = printJobFilename
+                , fileModified = printJobCreated
+                , fileContent = Just $ yield printJobFile
+                } 
+
 
 -----------
 -- pdftk --
@@ -259,17 +282,19 @@ sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse prin
 --  > pdftk - output - user_pw tomatenmarmelade
 --
 
-encryptPDF :: MonadIO m => String -> LBS.ByteString -> m (Either LBS.ByteString LBS.ByteString)
+encryptPDF :: MonadIO m => String -> LBS.ByteString -> m (Either Text LBS.ByteString)
-encryptPDF pw bs = exit2either <$> readProcess pc
+encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> readProcess pc
   where 
     pc =  setStdin (byteStringInput bs) $
-          proc "pdftk"  ["-"                  -- read from stdin
+          proc "pdftk"  [ "-"                 -- read from stdin
                         , "output", "-"       -- write to stdout
                         , "user_pw", pw       -- encrypt pdf content
                         , "dont_ask"          -- no interaction
                         , "allow", "Printing" -- allow printing despite encryption
                         ]
-
+    -- Note that pdftk will issue a warning, which will be ignored:
+    --    Warning: Using a password on the command line interface can be insecure.
+    --    Use the keyword PROMPT to supply a password via standard input instead.
     exit2either :: (ExitCode, a, b) -> Either b a
-    exit2either (ExitSuccess   , ok,   _) = Right ok 
+    exit2either (ExitSuccess   , ok,   _) = Right ok   -- warnings are ignored here!
-    exit2either (ExitFailure _ ,  _, err) = Left  err 
+    exit2either (ExitFailure _ ,  _, err) = Left err