{- Copyright (C) 2022 Yuchen Pei. This file is part of f2md. f2md is free software: you can redistribute it and/or modify it under the terms of the GNU Affero General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. f2md is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more details. You should have received a copy of the GNU Affero General Public License along with f2md. If not, see . -} {-# LANGUAGE OverloadedStrings #-} module F2Md.Export (writeMessage) where import F2Md.Types import Data.Text (Text) import qualified Data.Text as T import System.Posix.Process import System.Posix.Files import Data.Time import Network.HostName import System.Random import System.FilePath formatMessage :: Message -> Text formatMessage (Message from subject date messageId body _) = "MIME-Version: 1.0\n" <> "Date: " <> (T.pack $ show date) <> "\nSubject: " <> subject <> "\nFrom: " <> from <> "\nMessage-ID: " <> messageId <> "\nContent-Type: text/html" <> "\n\n" <> body genFilename :: FilePath -> IO String genFilename root = do epoch <- formatTime defaultTimeLocale "%s" <$> getCurrentTime pid <- getProcessID host <- getHostName rand <- randomRIO (10000, 99999) :: IO Int return $ root "new" epoch <> "." <> show pid <> "." <> host <> "." <> show rand genUniqFilename :: FilePath -> IO String genUniqFilename root = do filename <- genFilename root exists <- fileExist filename if exists then genUniqFilename root else return filename writeMessage :: FilePath -> Message -> IO () writeMessage root msg = genUniqFilename root >>= \filename -> writeFile filename $ T.unpack (formatMessage msg)