Handler: add json attachment to chargeMail & improve chargeMail body

1 files changed, 34 insertions, 37 deletions

diff --git a/src/Shop/Handler.hs b/src/Shop/Handler.hs
index 0e2225f..a6bd2f4 100644
--- a/src/Shop/Handler.hs
+++ b/src/Shop/Handler.hs
@@ -25,11 +25,11 @@ import           Lucid
 import           Network.HaskellNet.SMTP     (AuthType(..), sendMail, closeSMTP)
 import           Network.HaskellNet.SMTP.SSL (Settings(..), authenticate,
                                               defaultSettingsSMTPSTARTTLS,
-                                              doSMTPSTARTTLSWithSettings,
                                               connectSMTPSTARTTLSWithSettings)
 import           Network.HTTP.Req
 import           Network.Mail.Mime       (Address(..), Mail(..),
-                                          renderAddress, renderMail')
+                                          addAttachmentBS, renderAddress,
+                                          renderMail')
 import           Network.Mail.SMTP       (simpleMail, plainTextPart, htmlPart)
 import           Network.Socket          (HostName, PortNumber)
 import           Protolude               hiding ((%))
@@ -60,9 +60,10 @@ charge chargeform = do
     sendSMS $ SMS (getConfigSMSApiUser cfg) (getConfigSMSApiPassword cfg) (toS $ Yaml.encode chargeform)
     $(logInfo) $ toS "SMS sent: <"
         <> phone chargeform <> "> (" <> a <> ")"
-    sendCustomMail' cfg (chmail cfg)
+    uuid <- liftIO nextRandom
+    sendCustomMail' cfg (chmail uuid cfg)
     $(logInfo) $ toS "Admin email sent: <"
-        <> email chargeform <> "> (" <> a <> ")"
+        <> email chargeform <> "> (" <> a <> ") " <> toS (UUID.toString uuid)
     sendCustomMail' cfg (comail cfg)
     $(logInfo) $ toS "Client email sent: <"
         <> email chargeform <> "> (" <> a <> ")"
@@ -81,49 +82,45 @@ charge chargeform = do
         (Address (Just $ firstname chargeform <> " " <> lastname chargeform) (email chargeform))
         chargeform
         (showPrice (amount chargeform))
-    chmail cfg = chargeMail
+    chmail uuid cfg = chargeMail
         (Address (getConfigSMTPFromName cfg) (getConfigSMTPFromEmail cfg))
         (Address (getConfigSMTPFromName cfg) (getConfigSMTPFromEmail cfg))
         chargeform
         (showPrice (amount chargeform))
+        uuid
     sendCustomMail' cfg = sendCustomMail (getConfigSMTPServer cfg) (getConfigSMTPPort cfg) (getConfigSMTPUser cfg) (getConfigSMTPPassword cfg)
 
 showPrice :: Int -> Text
 showPrice p = toS $ format (fixed 2) (fromIntegral p / 100) <> "€"
 
-chargeMail :: Address -> Address -> ChargeForm -> Text -> Mail
-chargeMail from to chargeform stotal = simpleMail
-    from
-    [to]
-    []
-    []
-    ("[fermedegouet-api] Nouveau prêt de " <> lastname chargeform <> " (" <> stotal <> ")")
-    [ plainTextPart $ toS $ T.unlines
-        [ "Nom : " <> lastname chargeform
-        , "Email : " <> email chargeform
-        , "Téléphone : " <> phone chargeform
-        , "Date de naissance : " <> birthdate chargeform
-        , "Total : " <> stotal
+chargeMail :: Address -> Address -> ChargeForm -> Text -> UUID.UUID -> Mail
+chargeMail from to chargeform stotal uuid = addAttachmentBS
+    "application/json"
+    (toS (UUID.toString uuid) <> ".json")
+    (toS (encode chargeform))
+    $ simpleMail
+        from
+        [to]
+        []
+        []
+        ("[fermedegouet-api] Nouveau prêt de " <> lastname chargeform <> " (" <> stotal <> ")")
+        [ plainTextPart $ toS $ T.unlines
+            [ "Prénom : " <> firstname chargeform
+            , "Nom : " <> lastname chargeform
+            , "Date de naissance : " <> birthdate chargeform
+            , "Lieu de naissance : " <> birthcity chargeform
+            , "Adresse : " <> address chargeform
+            , "Code postal : " <> postalcode chargeform
+            , "Ville : " <> city chargeform
+            , "Pays : " <> country chargeform
+            , "Email : " <> email chargeform
+            , "Téléphone : " <> phone chargeform
+            , "Montant : " <> stotal
+            , "Taux : " <> show (rate chargeform)
+            , "Colis de viande : " <> if meat chargeform then "true" else "false"
+            , "Message : " <> fromMaybe "" (message chargeform)
+            ]
         ]
-    , htmlPart $ renderText $ htmlContent "fermedegouet.fr: Nouveau prêt" $
-        table_ $
-            tbody_ $ do
-                tr_ $ do
-                    td_ "Nom"
-                    td_ (toHtml $ lastname chargeform)
-                tr_ $ do
-                    td_ "Email"
-                    td_ (toHtml $ email chargeform)
-                tr_ $ do
-                    td_ "Téléphone"
-                    td_ (toHtml $ phone chargeform)
-                tr_ $ do
-                    td_ "Date de naissance"
-                    td_ (toHtml $ birthdate chargeform)
-                tr_ $ do
-                    td_ "Total"
-                    td_ (toHtml stotal)
-    ]
 
 confirmationMail :: Address -> Address -> ChargeForm -> Text -> Mail
 confirmationMail from to chargeform stotal = simpleMail