[mail] use ini config for mail server settings

gargantext-prelude.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: b57ed500a19dd72c1f7cf70ee61accb0235eb575fdaaf0c9a291093db2a99d34
+-- hash: 90040862e681d50b9cbc9f20134bd721bfae96f7bb944a458e70f910a2e0a988
 
 name:           gargantext-prelude
 version:        0.1.0.0
@@ -37,6 +37,7 @@ library
       Gargantext.Prelude.Crypto.Share
       Gargantext.Prelude.Fibonacci
       Gargantext.Prelude.Mail
+      Gargantext.Prelude.Mail.Types
       Gargantext.Prelude.Utils
   other-modules:
       Paths_gargantext_prelude
@@ -49,9 +50,11 @@ library
       FlexibleInstances
       GeneralizedNewtypeDeriving
       MultiParamTypeClasses
+      NamedFieldPuns
       NoImplicitPrelude
       OverloadedStrings
       RankNTypes
+      RecordWildCards
   build-depends:
       MonadRandom
     , SHA
@@ -72,6 +75,7 @@ library
     , located-base
     , mime-mail
     , mtl
+    , network
     , password
     , protolude
     , random
@@ -98,9 +102,11 @@ executable gargantext-prelude-exe
       FlexibleInstances
       GeneralizedNewtypeDeriving
       MultiParamTypeClasses
+      NamedFieldPuns
       NoImplicitPrelude
       OverloadedStrings
       RankNTypes
+      RecordWildCards
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       MonadRandom
@@ -123,6 +129,7 @@ executable gargantext-prelude-exe
     , located-base
     , mime-mail
     , mtl
+    , network
     , password
     , protolude
     , random
@@ -150,9 +157,11 @@ test-suite gargantext-prelude-test
       FlexibleInstances
       GeneralizedNewtypeDeriving
       MultiParamTypeClasses
+      NamedFieldPuns
       NoImplicitPrelude
       OverloadedStrings
       RankNTypes
+      RecordWildCards
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       MonadRandom
@@ -175,6 +184,7 @@ test-suite gargantext-prelude-test
     , located-base
     , mime-mail
     , mtl
+    , network
     , password
     , protolude
     , random

package.yaml

@@ -37,6 +37,7 @@ dependencies:
 - located-base
 - mime-mail
 - mtl
+- network
 - password
 - protolude
 - random
@@ -58,9 +59,11 @@ default-extensions:
   - FlexibleInstances
   - GeneralizedNewtypeDeriving
   - MultiParamTypeClasses
+  - NamedFieldPuns
   - NoImplicitPrelude
   - OverloadedStrings
   - RankNTypes
+  - RecordWildCards
 
 library:
   source-dirs: src

src/Gargantext/Prelude/Config.hs

@@ -13,80 +13,76 @@ Portability : POSIX
 
 module Gargantext.Prelude.Config where
 
-import Prelude (read)
-import System.IO (FilePath)
-import Data.Ini (readIniFile, lookupValue)
+import Control.Lens (makeLenses)
 import Data.Either.Extra (Either(Left, Right))
+import Data.Ini (readIniFile, lookupValue, Ini)
 import Data.Text as T
 import GHC.Generics (Generic)
-import Control.Lens (makeLenses)
+import Prelude (read)
+import System.IO (FilePath)
 
 import Gargantext.Prelude
+import Gargantext.Prelude.Mail.Types (MailConfig(..))
 
 
 -- | strip a given character from end of string
 stripRight :: Char -> T.Text -> T.Text
 stripRight c s = if T.last s == c then stripRight c (T.take (T.length s - 1) s) else s
 
-data GargConfig = GargConfig { _gc_url              :: !T.Text
-                             , _gc_url_backend_api  :: !T.Text
+data GargConfig = GargConfig { _gc_url               :: !T.Text
+                             , _gc_url_backend_api   :: !T.Text
 
-                             , _gc_masteruser       :: !T.Text
-                             , _gc_secretkey        :: !T.Text
+                             , _gc_masteruser        :: !T.Text
+                             , _gc_secretkey         :: !T.Text
 
-                             , _gc_datafilepath     :: !FilePath
-                             , _gc_repofilepath     :: !FilePath
+                             , _gc_datafilepath      :: !FilePath
+                             , _gc_repofilepath      :: !FilePath
 
-                             , _gc_frame_write_url  :: !T.Text
-                             , _gc_frame_calc_url   :: !T.Text
-                             , _gc_frame_visio_url  :: !T.Text
+                             , _gc_frame_write_url   :: !T.Text
+                             , _gc_frame_calc_url    :: !T.Text
+                             , _gc_frame_visio_url   :: !T.Text
 
-                             , _gc_frame_searx_url  :: !T.Text
-                             , _gc_frame_istex_url  :: !T.Text
+                             , _gc_frame_searx_url   :: !T.Text
+                             , _gc_frame_istex_url   :: !T.Text
 
-                             , _gc_max_docs_parsers :: !Integer
+                             , _gc_max_docs_parsers  :: !Integer
                              , _gc_max_docs_scrapers :: !Integer
                              }
   deriving (Generic, Show)
 
 makeLenses ''GargConfig
 
+readIniFile' :: FilePath -> IO Ini
+readIniFile' fp = do
+  ini <- readIniFile fp
+  case ini of
+    Left e     -> panic $ T.pack $ "ini file not found " <> show e
+    Right ini' -> pure ini'
+
+val :: Ini -> Text -> Text -> Text
+val ini section key = do
+  case (lookupValue section key ini) of
+    Left e   -> panic $ "ERROR: add " <> key <> " in section \"" <> section <> "\" to your gargantext.ini"
+    Right p' -> p'
+
 readConfig :: FilePath -> IO GargConfig
 readConfig fp = do
-  ini         <- readIniFile fp
-  let ini'' = case ini of
-        Left e     -> panic (T.pack $ "gargantext.ini not found" <> show e)
-        Right ini' -> ini'
-
-  let val x = case (lookupValue (T.pack "gargantext") (T.pack x) ini'') of
-        Left _   -> panic (T.pack $ "ERROR: add " <> x <> " to your gargantext.ini")
-        Right p' -> p'
-
-  pure $ GargConfig (stripRight '/' $ val "URL")
-                    (stripRight '/' $ val "URL_BACKEND_API")
-                    (val "MASTER_USER")
-                    (val "SECRET_KEY")
-                    (cs $ val "DATA_FILEPATH")
-                    (cs $ val "REPO_FILEPATH")
-                    (stripRight '/' $ val "FRAME_WRITE_URL")
-                    (stripRight '/' $ val "FRAME_CALC_URL")
-                    (stripRight '/' $ val "FRAME_VISIO_URL")
-                    (stripRight '/' $ val "FRAME_SEARX_URL")
-                    (stripRight '/' $ val "FRAME_ISTEX_URL")
-                    (read $ cs $ val "MAX_DOCS_PARSERS")
-                    (read $ cs $ val "MAX_DOCS_SCRAPERS")
-
-{- UNUSED
-defaultConfig :: GargConfig
-defaultConfig = GargConfig "https://localhost"
-                           "https://localhost:8008/api/v1.0"
-                           "gargantua"
-                           "secret"
-                           "data"
-                           "repos/"
-                           "https://frame_write.url"
-                           "https://frame_calc.url"
-                           "https://frame_searx.url"
-                           "https://frame_istex.url"
-                           1000
--}
+  ini <- readIniFile' fp
+
+  let val' = val ini "gargantext"
+
+  pure $ GargConfig
+    { _gc_url               = stripRight '/' $ val' "URL"
+    , _gc_url_backend_api   = stripRight '/' $ val' "URL_BACKEND_API"
+    , _gc_masteruser        = val' "MASTER_USER"
+    , _gc_secretkey         = val' "SECRET_KEY"
+    , _gc_datafilepath      = cs $ val' "DATA_FILEPATH"
+    , _gc_repofilepath      = cs $ val' "REPO_FILEPATH"
+    , _gc_frame_write_url   = stripRight '/' $ val' "FRAME_WRITE_URL"
+    , _gc_frame_calc_url    = stripRight '/' $ val' "FRAME_CALC_URL"
+    , _gc_frame_visio_url   = stripRight '/' $ val' "FRAME_VISIO_URL"
+    , _gc_frame_searx_url   = stripRight '/' $ val' "FRAME_SEARX_URL"
+    , _gc_frame_istex_url   = stripRight '/' $ val' "FRAME_ISTEX_URL"
+    , _gc_max_docs_parsers  = read $ cs $ val' "MAX_DOCS_PARSERS"
+    , _gc_max_docs_scrapers = read $ cs $ val' "MAX_DOCS_SCRAPERS"
+    }

src/Gargantext/Prelude/Mail.hs

@@ -9,23 +9,37 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE OverloadedStrings #-}
-
 module Gargantext.Prelude.Mail
-  (gargMail, GargMail(..))
+  (gargMail, GargMail(..), readConfig)
   where
 
 -- import Data.Text.Internal.Lazy (Text)
-import Data.Text (Text)
+import Data.Text (Text, unpack)
 import Data.Maybe
-import Network.Mail.SMTP hiding (htmlPart)
+import Network.Mail.SMTP hiding (htmlPart, STARTTLS)
 import Gargantext.Prelude
+import Gargantext.Prelude.Config (readIniFile', val)
+import Gargantext.Prelude.Mail.Types (LoginType(..), MailConfig(..))
 import Network.Mail.Mime (plainPart)
+import Prelude (read)
+import System.IO (FilePath)
 
 
 type Email = Text
 type Name  = Text
 
+readConfig :: FilePath -> IO MailConfig
+readConfig fp = do
+  ini <- readIniFile' fp
+  let val' = val ini "mail"
+
+  pure $ MailConfig { _mc_mail_host       = cs $ val' "MAIL_HOST"
+                    , _mc_mail_port       = read $ cs $ val' "MAIL_PORT"
+                    , _mc_mail_user       = cs $ val' "MAIL_USER"
+                    , _mc_mail_password   = cs $ val' "MAIL_PASSWORD"
+                    , _mc_mail_login_type = read $ cs $ val' "MAIL_LOGIN_TYPE" }
+
+
 data GargMail = GargMail { gm_to      :: Email
                          , gm_name    :: Maybe Name
                          , gm_subject :: Text
@@ -33,8 +47,16 @@ data GargMail = GargMail { gm_to      :: Email
                          }
 
 -- | TODO add parameters to gargantext.ini
-gargMail :: GargMail -> IO ()
-gargMail (GargMail to' name subject body) = sendMail "localhost" mail
+gargMail :: MailConfig -> GargMail -> IO ()
+gargMail (MailConfig {..}) (GargMail to' name subject body) = do
+  let host = unpack _mc_mail_host
+      user = unpack _mc_mail_user
+      password = unpack _mc_mail_password
+  case _mc_mail_login_type of
+    Normal   -> sendMailWithLogin'         host _mc_mail_port user password mail
+    SSL      -> sendMailWithLoginTLS'      host _mc_mail_port user password mail
+    TLS      -> sendMailWithLoginTLS'      host _mc_mail_port user password mail
+    STARTTLS -> sendMailWithLoginSTARTTLS' host _mc_mail_port user password mail
   where
     mail = simpleMail from to cc bcc subject [plainPart $ cs body]
 
@@ -43,4 +65,4 @@ gargMail (GargMail to' name subject body) = sendMail "localhost" mail
     cc         = []
     bcc        = []
 
-
+--readConfig :: FilePath -> IO GargConfig

src/Gargantext/Prelude/Mail/Types.hs

+{-|
+Module      : Gargantext.Prelude.Mail.Types
+Description : Textmining Collaborative Platform
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE TemplateHaskell     #-}
+
+module Gargantext.Prelude.Mail.Types where
+
+import Control.Lens (makeLenses)
+import qualified Data.Text as T
+import GHC.Generics (Generic)
+import Network.Socket (PortNumber)
+import Protolude
+
+data LoginType = Normal | SSL | TLS | STARTTLS
+  deriving (Generic, Eq, Show, Read)
+
+data MailConfig = MailConfig { _mc_mail_host         :: !T.Text
+                             , _mc_mail_port         :: !PortNumber
+                             , _mc_mail_user         :: !T.Text
+                             , _mc_mail_password     :: !T.Text
+                             , _mc_mail_login_type   :: !LoginType }
+  deriving (Generic, Show)
+
+makeLenses ''MailConfig

stack.yaml

@@ -67,3 +67,4 @@ extra-deps:
 #
 # Allow a newer minor version of GHC than the snapshot specifies
 # compiler-check: newer-minor
+