module Email ( Template, Configuration, compileTemplate, getConfiguration, sendMail) where import qualified Data.ByteString.Char8 as B import qualified Data.Text as T import qualified Data.Map as M import qualified Network.Mail.SMTP as Mail import qualified Data.Text.Lazy as L import qualified Network.Mail.Mime as Mime import Data.Word import Network.Socket.Internal import Data.List -- | An alias for the template contents type Template = T.Text -- | A user identifier (not DB id) like a username or JMBAG type UserIdentifier = String data Role = Student Integer -- Academic Year shorthand (2015 for 2015/16) | TA Integer Integer -- AY shorthand range (inclusive) | Professor deriving (Eq, Ord, Show) -- | A user (the definition can be bigger) data User = User { identifier :: UserIdentifier , email :: String , pwdHash :: String , role :: Role } deriving (Eq, Show) user1 = User {identifier = "Vienas", email = "medinismolis@gmx.com", pwdHash = "sgsvht", role = Professor}; user2 = User {identifier = "Du", email = "medinismolis@gmx.com", pwdHash = "sgsvht", role = Student {}}; user3 = User {identifier = "Trys", email = "medinismolis@gmx.com", pwdHash = "sgsvht", role = Student {}}; user4 = User {identifier = "Keturi", email = "medinismolis@gmx.com", pwdHash = "sgsvht", role = TA {}}; user5 = User {identifier = "Linas", email = "medinismolis@gmx.com", pwdHash = "sgsvht", role = TA {}}; userList = [user1, user2, user3, user4, user5] -- | Configuration object data Configuration = Configuration { host :: String, port :: PortNumber, emailAddr :: String, username :: String, password :: String, ident :: UserIdentifier } deriving (Show) type Error = String -- | Parses an expression using traslateTags compileTemplate :: Template -> M.Map String String -> Either Error L.Text compileTemplate tmpl tmap = translateTags tmpl tmap -- | Get template text from a file path getTemplate :: FilePath -> IO T.Text getTemplate fp = do contents <- readFile fp return $ T.pack contents -- | Get configuration from a file path getConfiguration :: FilePath -> IO Configuration getConfiguration fp = do contents <- readFile fp return $ confFromStr contents confFromStr :: String -> Configuration confFromStr str = Configuration { host = drop 2 $ dropWhile (/= '=') (lns !! 0), port = toEnum (read (drop 2 $ dropWhile (/= '=') (lns !! 1)) :: Int), emailAddr = drop 2 $ dropWhile (/= '=') (lns !! 2), username = drop 2 $ dropWhile (/= '=') (lns !! 3), password = drop 2 $ dropWhile (/= '=') (lns !! 4), ident = drop 2 $ dropWhile (/= '=') (lns !! 5) } where lns = lines str -- | Sends an e-mail with given text to list of users -- | using given configuration. Throws appropriate error upon failure. -- | Provide subject of the email as the last argument. sendMail :: IO Configuration -> IO T.Text -> [User] -> String -> IO () sendMail iocnfg iotxt list subj = do txt <- iotxt cnfg <- iocnfg let mails = map (\x -> (T.pack $ email x, unwrapEither $ compileTemplate txt (createTemplateMap (ident cnfg) x), identifier x)) list mapM_ (\(x,y,z) -> sendSingleMail x y z cnfg subj) mails -- sends all emails --mapM_ (\(x,y,_) -> putStrLn $ (T.unpack x ++ " -> \n" ++ L.unpack y)) mails -- prints all emails -- | Prepares and sends email sendSingleMail :: T.Text -> L.Text -> String -> Configuration -> String -> IO () sendSingleMail addr txt recipName cnfg subj = do let from = Mime.Address (Just $ T.pack $ ident cnfg) (T.pack $ emailAddr cnfg) let to = [Mime.Address (Just $ T.pack recipName) (addr)] let cc = [] let bcc = [] let subject = T.pack subj let plainTextPart = Mail.plainTextPart txt let parts = [plainTextPart] let simpleMail = Mail.simpleMail from to cc bcc subject parts Mail.sendMailWithLogin' (host cnfg) (port cnfg) (username cnfg) (password cnfg) simpleMail -- | Available tags and booleans have their values stored in a -- | Data.Map and are looked up when needed createTemplateMap :: UserIdentifier -> User -> M.Map String String createTemplateMap authorName user = M.fromList [("<>", authorName) ,("<>", identifier user) ,("isStudent", isStudent user) ,("isTA", isTA user) ,("isProf", isProf user) ,("True", "True") ,("False", "False") ] -- | Traverses the text line by line and word by word to find tags -- | and <> statements. translateTags :: T.Text -> M.Map String String -> Either Error L.Text translateTags txt tmap = Right ( L.pack $ translateTagsLines (lines $ T.unpack txt) []) where translateTagsLines [] t = unlines t translateTagsLines (x:xs) t = if isInfixOf "<>" x then if checkCondition (head xs) tmap then translateTagsLines (drop 2 $ dropWhile (\l -> not $ isInfixOf "<>" l) xs) (t ++ [translateTagsLines (drop 2 $ takeWhile (\l -> not $ isInfixOf "<>" l) xs) []]) else translateTagsLines (drop 2 $ dropWhile (\l -> not $ isInfixOf "<>" l) xs) (t ++ [translateTagsLines (drop 1 $ dropWhile (\l -> not $ isInfixOf "<>" l) $ takeWhile (\l -> not $ isInfixOf "<>" l) xs) []]) else translateTagsLines xs (t ++ [translateTagsWords (words x) []]) translateTagsWords [] t = unwords t translateTagsWords (x:xs) t = translateTagsWords xs (t ++ [checkWord x]) checkWord word = if (length elems) > 0 then (prefx ++ changedWord ++ sufx) else word where elems = M.elems (M.filterWithKey (\k _ -> isInfixOf k word) tmap) changedWord = unwords elems prefx = takeWhile (\l -> l /= '<') word sufx = drop 2 $ dropWhile (\l -> l /= '>') word data Expr = And Expr Expr | Or Expr Expr | Not Expr | Val Bool deriving (Show,Read) eval' :: Expr -> Bool eval' (Val x) = x eval' (Not x) = not $ eval' x eval' (Or x y) = eval' x || eval' y eval' (And x y) = eval' x && eval' y addSpaces :: String -> String addSpaces [] = "" addSpaces ('(':xs) = "( " ++ addSpaces xs addSpaces (')':xs) = " )" ++ addSpaces xs addSpaces (x:xs) = [x] ++ addSpaces xs checkCondition :: String -> M.Map String String -> Bool checkCondition x tmap = eval' (read (cc (words (addSpaces x)) "") :: Expr) where cc [] exp = exp cc (x:xs) exp = if M.member x tmap then cc xs (exp ++ "Val " ++ unwrapMaybe(M.lookup x tmap)) else cc xs (exp ++ x) isStudent :: User -> String isStudent (User _ _ _ (Student _)) = "True" isStudent (User _ _ _ _) = "False" isTA :: User -> String isTA (User _ _ _ (TA _ _)) = "True" isTA (User _ _ _ _) = "False" isProf :: User -> String isProf (User _ _ _ Professor) = "True" isProf (User _ _ _ _) = "False" unwrapMaybe :: Maybe String -> String unwrapMaybe a = case a of Just a -> a Nothing -> "" unwrapEither :: Either a b -> b unwrapEither a = case a of Right x -> x Left err -> error "err"