Commit 8db51b6a authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[mail] use ini config for mail server settings

parent 35b09629
...@@ -4,7 +4,7 @@ cabal-version: 1.12 ...@@ -4,7 +4,7 @@ cabal-version: 1.12
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: b57ed500a19dd72c1f7cf70ee61accb0235eb575fdaaf0c9a291093db2a99d34 -- hash: 90040862e681d50b9cbc9f20134bd721bfae96f7bb944a458e70f910a2e0a988
name: gargantext-prelude name: gargantext-prelude
version: 0.1.0.0 version: 0.1.0.0
...@@ -37,6 +37,7 @@ library ...@@ -37,6 +37,7 @@ library
Gargantext.Prelude.Crypto.Share Gargantext.Prelude.Crypto.Share
Gargantext.Prelude.Fibonacci Gargantext.Prelude.Fibonacci
Gargantext.Prelude.Mail Gargantext.Prelude.Mail
Gargantext.Prelude.Mail.Types
Gargantext.Prelude.Utils Gargantext.Prelude.Utils
other-modules: other-modules:
Paths_gargantext_prelude Paths_gargantext_prelude
...@@ -49,9 +50,11 @@ library ...@@ -49,9 +50,11 @@ library
FlexibleInstances FlexibleInstances
GeneralizedNewtypeDeriving GeneralizedNewtypeDeriving
MultiParamTypeClasses MultiParamTypeClasses
NamedFieldPuns
NoImplicitPrelude NoImplicitPrelude
OverloadedStrings OverloadedStrings
RankNTypes RankNTypes
RecordWildCards
build-depends: build-depends:
MonadRandom MonadRandom
, SHA , SHA
...@@ -72,6 +75,7 @@ library ...@@ -72,6 +75,7 @@ library
, located-base , located-base
, mime-mail , mime-mail
, mtl , mtl
, network
, password , password
, protolude , protolude
, random , random
...@@ -98,9 +102,11 @@ executable gargantext-prelude-exe ...@@ -98,9 +102,11 @@ executable gargantext-prelude-exe
FlexibleInstances FlexibleInstances
GeneralizedNewtypeDeriving GeneralizedNewtypeDeriving
MultiParamTypeClasses MultiParamTypeClasses
NamedFieldPuns
NoImplicitPrelude NoImplicitPrelude
OverloadedStrings OverloadedStrings
RankNTypes RankNTypes
RecordWildCards
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
MonadRandom MonadRandom
...@@ -123,6 +129,7 @@ executable gargantext-prelude-exe ...@@ -123,6 +129,7 @@ executable gargantext-prelude-exe
, located-base , located-base
, mime-mail , mime-mail
, mtl , mtl
, network
, password , password
, protolude , protolude
, random , random
...@@ -150,9 +157,11 @@ test-suite gargantext-prelude-test ...@@ -150,9 +157,11 @@ test-suite gargantext-prelude-test
FlexibleInstances FlexibleInstances
GeneralizedNewtypeDeriving GeneralizedNewtypeDeriving
MultiParamTypeClasses MultiParamTypeClasses
NamedFieldPuns
NoImplicitPrelude NoImplicitPrelude
OverloadedStrings OverloadedStrings
RankNTypes RankNTypes
RecordWildCards
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
MonadRandom MonadRandom
...@@ -175,6 +184,7 @@ test-suite gargantext-prelude-test ...@@ -175,6 +184,7 @@ test-suite gargantext-prelude-test
, located-base , located-base
, mime-mail , mime-mail
, mtl , mtl
, network
, password , password
, protolude , protolude
, random , random
......
...@@ -37,6 +37,7 @@ dependencies: ...@@ -37,6 +37,7 @@ dependencies:
- located-base - located-base
- mime-mail - mime-mail
- mtl - mtl
- network
- password - password
- protolude - protolude
- random - random
...@@ -58,9 +59,11 @@ default-extensions: ...@@ -58,9 +59,11 @@ default-extensions:
- FlexibleInstances - FlexibleInstances
- GeneralizedNewtypeDeriving - GeneralizedNewtypeDeriving
- MultiParamTypeClasses - MultiParamTypeClasses
- NamedFieldPuns
- NoImplicitPrelude - NoImplicitPrelude
- OverloadedStrings - OverloadedStrings
- RankNTypes - RankNTypes
- RecordWildCards
library: library:
source-dirs: src source-dirs: src
......
...@@ -13,15 +13,16 @@ Portability : POSIX ...@@ -13,15 +13,16 @@ Portability : POSIX
module Gargantext.Prelude.Config where module Gargantext.Prelude.Config where
import Prelude (read) import Control.Lens (makeLenses)
import System.IO (FilePath)
import Data.Ini (readIniFile, lookupValue)
import Data.Either.Extra (Either(Left, Right)) import Data.Either.Extra (Either(Left, Right))
import Data.Ini (readIniFile, lookupValue, Ini)
import Data.Text as T import Data.Text as T
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Control.Lens (makeLenses) import Prelude (read)
import System.IO (FilePath)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Mail.Types (MailConfig(..))
-- | strip a given character from end of string -- | strip a given character from end of string
...@@ -51,42 +52,37 @@ data GargConfig = GargConfig { _gc_url :: !T.Text ...@@ -51,42 +52,37 @@ data GargConfig = GargConfig { _gc_url :: !T.Text
makeLenses ''GargConfig makeLenses ''GargConfig
readConfig :: FilePath -> IO GargConfig readIniFile' :: FilePath -> IO Ini
readConfig fp = do readIniFile' fp = do
ini <- readIniFile fp ini <- readIniFile fp
let ini'' = case ini of case ini of
Left e -> panic (T.pack $ "gargantext.ini not found" <> show e) Left e -> panic $ T.pack $ "ini file not found " <> show e
Right ini' -> ini' Right ini' -> pure ini'
let val x = case (lookupValue (T.pack "gargantext") (T.pack x) ini'') of val :: Ini -> Text -> Text -> Text
Left _ -> panic (T.pack $ "ERROR: add " <> x <> " to your gargantext.ini") 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' Right p' -> p'
pure $ GargConfig (stripRight '/' $ val "URL") readConfig :: FilePath -> IO GargConfig
(stripRight '/' $ val "URL_BACKEND_API") readConfig fp = do
(val "MASTER_USER") ini <- readIniFile' fp
(val "SECRET_KEY")
(cs $ val "DATA_FILEPATH") let val' = val ini "gargantext"
(cs $ val "REPO_FILEPATH")
(stripRight '/' $ val "FRAME_WRITE_URL") pure $ GargConfig
(stripRight '/' $ val "FRAME_CALC_URL") { _gc_url = stripRight '/' $ val' "URL"
(stripRight '/' $ val "FRAME_VISIO_URL") , _gc_url_backend_api = stripRight '/' $ val' "URL_BACKEND_API"
(stripRight '/' $ val "FRAME_SEARX_URL") , _gc_masteruser = val' "MASTER_USER"
(stripRight '/' $ val "FRAME_ISTEX_URL") , _gc_secretkey = val' "SECRET_KEY"
(read $ cs $ val "MAX_DOCS_PARSERS") , _gc_datafilepath = cs $ val' "DATA_FILEPATH"
(read $ cs $ val "MAX_DOCS_SCRAPERS") , _gc_repofilepath = cs $ val' "REPO_FILEPATH"
, _gc_frame_write_url = stripRight '/' $ val' "FRAME_WRITE_URL"
{- UNUSED , _gc_frame_calc_url = stripRight '/' $ val' "FRAME_CALC_URL"
defaultConfig :: GargConfig , _gc_frame_visio_url = stripRight '/' $ val' "FRAME_VISIO_URL"
defaultConfig = GargConfig "https://localhost" , _gc_frame_searx_url = stripRight '/' $ val' "FRAME_SEARX_URL"
"https://localhost:8008/api/v1.0" , _gc_frame_istex_url = stripRight '/' $ val' "FRAME_ISTEX_URL"
"gargantua" , _gc_max_docs_parsers = read $ cs $ val' "MAX_DOCS_PARSERS"
"secret" , _gc_max_docs_scrapers = read $ cs $ val' "MAX_DOCS_SCRAPERS"
"data" }
"repos/"
"https://frame_write.url"
"https://frame_calc.url"
"https://frame_searx.url"
"https://frame_istex.url"
1000
-}
...@@ -9,23 +9,37 @@ Portability : POSIX ...@@ -9,23 +9,37 @@ Portability : POSIX
-} -}
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Prelude.Mail module Gargantext.Prelude.Mail
(gargMail, GargMail(..)) (gargMail, GargMail(..), readConfig)
where where
-- import Data.Text.Internal.Lazy (Text) -- import Data.Text.Internal.Lazy (Text)
import Data.Text (Text) import Data.Text (Text, unpack)
import Data.Maybe import Data.Maybe
import Network.Mail.SMTP hiding (htmlPart) import Network.Mail.SMTP hiding (htmlPart, STARTTLS)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Config (readIniFile', val)
import Gargantext.Prelude.Mail.Types (LoginType(..), MailConfig(..))
import Network.Mail.Mime (plainPart) import Network.Mail.Mime (plainPart)
import Prelude (read)
import System.IO (FilePath)
type Email = Text type Email = Text
type Name = 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 data GargMail = GargMail { gm_to :: Email
, gm_name :: Maybe Name , gm_name :: Maybe Name
, gm_subject :: Text , gm_subject :: Text
...@@ -33,8 +47,16 @@ data GargMail = GargMail { gm_to :: Email ...@@ -33,8 +47,16 @@ data GargMail = GargMail { gm_to :: Email
} }
-- | TODO add parameters to gargantext.ini -- | TODO add parameters to gargantext.ini
gargMail :: GargMail -> IO () gargMail :: MailConfig -> GargMail -> IO ()
gargMail (GargMail to' name subject body) = sendMail "localhost" mail 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 where
mail = simpleMail from to cc bcc subject [plainPart $ cs body] mail = simpleMail from to cc bcc subject [plainPart $ cs body]
...@@ -43,4 +65,4 @@ gargMail (GargMail to' name subject body) = sendMail "localhost" mail ...@@ -43,4 +65,4 @@ gargMail (GargMail to' name subject body) = sendMail "localhost" mail
cc = [] cc = []
bcc = [] bcc = []
--readConfig :: FilePath -> IO GargConfig
{-|
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
...@@ -67,3 +67,4 @@ extra-deps: ...@@ -67,3 +67,4 @@ extra-deps:
# #
# Allow a newer minor version of GHC than the snapshot specifies # Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor # compiler-check: newer-minor
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment