zgo-notifier/app/Main.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Config
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.IO as TIO
import Data.Time.Clock
import Database.MongoDB
import qualified Network.Mail.Mime as M
import Network.Mail.SMTP
import qualified Network.Socket as NS
import Owner
import System.Exit

main :: IO ()
main = do
  now <- getCurrentTime
  loadedConfig <- loadZGoConfig "zgo.cfg"
  pipe <- connect $ host (c_dbHost loadedConfig)
  let db = c_dbName loadedConfig
  x <-
    access
      pipe
      master
      db
      (auth (c_dbUser loadedConfig) (c_dbPassword loadedConfig))
  if x
    then do
      putStrLn "Connected to MongoDB!"
      users <- access pipe master db $ findExpiringOwners now
      putStr "Expiring users: "
      print $ length users
      mapM_ (emailOwner loadedConfig) users
    else die "MongoDB connection failed! :("
  where
    emailOwner :: Config -> Document -> IO ()
    emailOwner config doc = do
      let o = (cast' . Doc) doc
      case o of
        Nothing -> putStrLn "Couldn't parse owner record."
        Just o1 -> do
          msgtmp <- TIO.readFile "email.html"
          txttmp <- TIO.readFile "email.txt"
          let msg =
                L.replace
                  "PLACEHOLDER_EXPIRATION"
                  (L.pack $ show (oexpiration o1)) $
                L.replace "PLACEHOLDER_NAME" (L.fromStrict $ ofirst o1) msgtmp
          let txt =
                L.replace
                  "PLACEHOLDER_EXPIRATION"
                  (L.pack $ show (oexpiration o1)) $
                L.replace "PLACEHOLDER_NAME" (L.fromStrict $ ofirst o1) txttmp
          mail <-
            M.simpleMail
              (Address (Just $ oname o1) (oemail o1))
              (Address (Just "ZGo Support") "contact@zgo.cash")
              "ZGo session about to expire"
              txt
              msg
              []
          sendMailWithLogin'
            (c_smtpHost config)
            (fromInteger (c_smtpPort config) :: NS.PortNumber)
            (c_smtpUser config)
            (c_smtpPwd config)
            mail