Commit bb15d828 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Remove GargConfig from Prelude

See haskell-gargantext#356

It belongs to `gargantext` itself.

It also does some general cleanup by running the code with
`-Wall -Wunused-packages -Werror` to make it mostly warning-free.
parent d4f9bee4
module Main where
import Protolude
main :: IO ()
main = undefined
...@@ -44,10 +44,6 @@ common defaults ...@@ -44,10 +44,6 @@ common defaults
default-language: Haskell2010 default-language: Haskell2010
build-depends: build-depends:
base >=4.17.2.0 && <5 base >=4.17.2.0 && <5
, aeson ^>= 2.1.2.0
, lens >= 5.2.3 && < 5.3
, postgresql-simple ^>= 0.6.5.1
, template-haskell >= 2.19.0.0 && < 2.22
library library
import: import:
...@@ -55,7 +51,6 @@ library ...@@ -55,7 +51,6 @@ library
exposed-modules: exposed-modules:
Gargantext.Prelude Gargantext.Prelude
Gargantext.Prelude.Clock Gargantext.Prelude.Clock
Gargantext.Prelude.Config
Gargantext.Prelude.Crypto.Auth Gargantext.Prelude.Crypto.Auth
Gargantext.Prelude.Crypto.Hash Gargantext.Prelude.Crypto.Hash
Gargantext.Prelude.Crypto.Pass.Machine Gargantext.Prelude.Crypto.Pass.Machine
...@@ -66,10 +61,6 @@ library ...@@ -66,10 +61,6 @@ library
Gargantext.Prelude.Database Gargantext.Prelude.Database
Gargantext.Prelude.Error Gargantext.Prelude.Error
Gargantext.Prelude.Fibonacci Gargantext.Prelude.Fibonacci
Gargantext.Prelude.Mail
Gargantext.Prelude.Mail.Types
Gargantext.Prelude.NLP
Gargantext.Prelude.NLP.Types
Gargantext.Prelude.Utils Gargantext.Prelude.Utils
other-modules: other-modules:
Paths_gargantext_prelude Paths_gargantext_prelude
...@@ -78,128 +69,28 @@ library ...@@ -78,128 +69,28 @@ library
build-depends: build-depends:
MonadRandom MonadRandom
, SHA , SHA
, aeson
, binary , binary
, bytestring , bytestring
, cipher-aes
, clock , clock
, containers , containers
, cprng-aes , cprng-aes
, crypto-random , crypto-random
, cryptonite , cryptonite
, directory , directory
, extra
, filepath , filepath
, formatting , formatting
, ini , lens
, located-base
, memory , memory
, mime-mail
, mtl , mtl
, network
, network-uri
, password , password
, postgresql-simple
, protolude , protolude
, qrcode-core , qrcode-core
, qrcode-juicypixels , qrcode-juicypixels
, random , random
, random-shuffle , random-shuffle
, safe
, smtp-mail
, string-conversions , string-conversions
, text , text
, transformers
, transformers-base
, vector
executable gargantext-prelude-exe
import:
defaults
main-is: Main.hs
other-modules:
Paths_gargantext_prelude
hs-source-dirs:
app
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends:
MonadRandom
, SHA
, binary
, bytestring
, cipher-aes
, clock
, containers
, cprng-aes
, crypto-random
, cryptonite
, directory
, extra
, filepath
, formatting
, gargantext-prelude
, ini
, located-base
, memory
, mime-mail
, mtl
, network
, network-uri
, password
, protolude
, qrcode-core
, qrcode-juicypixels
, random
, random-shuffle
, safe
, smtp-mail
, string-conversions
, text
, transformers
, transformers-base
, vector
test-suite gargantext-prelude-test
import:
defaults
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
Paths_gargantext_prelude
hs-source-dirs:
test
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends:
MonadRandom
, SHA
, binary
, bytestring
, cipher-aes
, clock
, containers
, cprng-aes
, crypto-random
, cryptonite
, directory
, extra
, filepath
, formatting
, gargantext-prelude
, ini
, located-base
, memory
, mime-mail
, mtl
, network
, network-uri
, password
, protolude
, qrcode-core
, qrcode-juicypixels
, random
, random-shuffle
, safe
, smtp-mail
, string-conversions
, text
, transformers
, transformers-base , transformers-base
, vector , vector
...@@ -20,7 +20,7 @@ module Gargantext.Prelude ...@@ -20,7 +20,7 @@ module Gargantext.Prelude
, MonadBase(..) , MonadBase(..)
, module Gargantext.Prelude.Error , module Gargantext.Prelude.Error
, makeLenses, (^.), (.~) , makeLenses, (^.), (.~)
, FromJSON(..), ToJSON(..), fromJSON, toJSON, deriveJSON , FromJSON(..), ToJSON(..), fromJSON, deriveJSON
) )
where where
...@@ -29,22 +29,15 @@ module Gargantext.Prelude ...@@ -29,22 +29,15 @@ module Gargantext.Prelude
import Control.Lens (makeLenses, (^.), (.~)) import Control.Lens (makeLenses, (^.), (.~))
import Control.Monad qualified as M import Control.Monad qualified as M
import Control.Monad.Base (MonadBase(..)) import Control.Monad.Base (MonadBase(..))
import Data.Aeson (FromJSON(..), ToJSON(..), fromJSON, toJSON) import Data.Aeson (FromJSON(..), ToJSON(..), fromJSON)
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import Data.List qualified as L hiding (head, sum) import Data.List qualified as L hiding (head, sum)
import Data.Map.Strict (Map, lookup) import Data.Map.Strict (lookup)
import Data.Map.Strict qualified as M import Data.Map.Strict qualified as M
import Data.Map.Strict (insertWith) import Data.Map.Strict (insertWith)
import Data.Monoid (Monoid, mempty)
import Data.Semigroup (Semigroup, (<>))
import Data.Set (Set)
import Data.Set qualified as Set import Data.Set qualified as Set
import Data.String.Conversions (ConvertibleStrings, cs) import Data.String.Conversions (ConvertibleStrings, cs)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Data.Vector qualified as V import Data.Vector qualified as V
import GHC.Exts (sortWith)
import GHC.Real (round)
import Protolude hiding (panic) import Protolude hiding (panic)
import Protolude qualified as Proto import Protolude qualified as Proto
import Prelude qualified as GHCPrelude import Prelude qualified as GHCPrelude
......
{-|
Module : Gargantext.Prelude.Config
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.Config where
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 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_backend_name :: !T.Text
, _gc_url :: !T.Text
, _gc_url_backend_api :: !T.Text
, _gc_masteruser :: !T.Text
, _gc_secretkey :: !T.Text
, _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_searx_url :: !T.Text
, _gc_frame_istex_url :: !T.Text
, _gc_max_docs_parsers :: !Integer
, _gc_max_docs_scrapers :: !Integer
, _gc_pubmed_api_key :: !T.Text
, _gc_js_job_timeout :: !Integer
, _gc_js_id_timeout :: !Integer
, _gc_epo_api_url :: !T.Text
}
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 val' = val ini "gargantext"
pure $ GargConfig
{ _gc_backend_name = cs $ val' "BACKEND_NAME"
, _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"
, _gc_pubmed_api_key = val' "PUBMED_API_KEY"
, _gc_js_job_timeout = read $ cs $ val' "JS_JOB_TIMEOUT"
, _gc_js_id_timeout = read $ cs $ val' "JS_ID_TIMEOUT"
, _gc_epo_api_url = cs $ val' "EPO_API_URL"
}
...@@ -16,9 +16,7 @@ module Gargantext.Prelude.Crypto.Hash ...@@ -16,9 +16,7 @@ module Gargantext.Prelude.Crypto.Hash
import Data.ByteString.Lazy.Char8 qualified as Char import Data.ByteString.Lazy.Char8 qualified as Char
import Data.Digest.Pure.SHA qualified as SHA (sha256, showDigest) import Data.Digest.Pure.SHA qualified as SHA (sha256, showDigest)
import Data.Set (Set)
import Data.Set qualified as Set import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as Text import Data.Text qualified as Text
import Gargantext.Prelude hiding (Ordering, hash) import Gargantext.Prelude hiding (Ordering, hash)
import Prelude (String) import Prelude (String)
......
...@@ -18,7 +18,7 @@ import Data.Text.Internal.Lazy (Text) ...@@ -18,7 +18,7 @@ import Data.Text.Internal.Lazy (Text)
import Codec.QRCode.Data.ErrorLevel (ErrorLevel(H)) import Codec.QRCode.Data.ErrorLevel (ErrorLevel(H))
import Codec.QRCode.Data.QRCodeOptions (defaultQRCodeOptions) import Codec.QRCode.Data.QRCodeOptions (defaultQRCodeOptions)
import Codec.QRCode.JuicyPixels import Codec.QRCode.JuicyPixels
import Codec.QRCode (QRCodeOptions, TextEncoding(Utf8WithECI)) import Codec.QRCode (TextEncoding(Utf8WithECI))
qrCode :: ToText a => Int -> a -> Maybe Text qrCode :: ToText a => Int -> a -> Maybe Text
......
...@@ -28,7 +28,7 @@ module Gargantext.Prelude.Crypto.Share ...@@ -28,7 +28,7 @@ module Gargantext.Prelude.Crypto.Share
import Data.Maybe import Data.Maybe
import Gargantext.Prelude hiding (Ordering) import Gargantext.Prelude hiding (Ordering)
import Prelude (fromEnum, toEnum, String) import Prelude (String)
import System.Random import System.Random
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -45,7 +45,7 @@ data Ordering = Down | Up ...@@ -45,7 +45,7 @@ data Ordering = Down | Up
-- TODO -- TODO
-- make hash then hash to int -- make hash then hash to int
createSeed :: String -> (Char -> Int) -> Seed createSeed :: String -> (Char -> Int) -> Seed
createSeed = undefined createSeed = panicTrace "unimplemented."
......
...@@ -17,10 +17,9 @@ Portability : POSIX ...@@ -17,10 +17,9 @@ Portability : POSIX
module Gargantext.Prelude.Crypto.Symmetric where module Gargantext.Prelude.Crypto.Symmetric where
import "cryptonite" Crypto.Cipher.AES (AES256) import "cryptonite" Crypto.Cipher.AES (AES256)
import Crypto.Cipher.Types (BlockCipher(..), Cipher(..), nullIV, KeySizeSpecifier(..), IV, makeIV) import Crypto.Cipher.Types (BlockCipher(..), Cipher(..), IV, makeIV)
import Crypto.Error (CryptoFailable(..), CryptoError(..)) import Crypto.Error (CryptoFailable(..), CryptoError(..))
import Data.ByteArray (ByteArray) import Data.ByteArray (ByteArray)
import Data.ByteString (ByteString)
import Data.Either import Data.Either
import Data.Maybe import Data.Maybe
import Protolude -- (IO, Int, show, (++), ($), putStrLn, panic, (<*>), (<$>), (=<<), undefined, return) import Protolude -- (IO, Int, show, (++), ($), putStrLn, panic, (<*>), (<$>), (=<<), undefined, return)
......
...@@ -14,13 +14,8 @@ Portability : POSIX ...@@ -14,13 +14,8 @@ Portability : POSIX
module Gargantext.Prelude.Database module Gargantext.Prelude.Database
where where
import Control.Exception (throw)
import Data.Text (pack)
import Database.PostgreSQL.Simple qualified as PGS import Database.PostgreSQL.Simple qualified as PGS
import Database.PostgreSQL.Simple.FromField (FromField(fromField), fromJSONField)
import Database.PostgreSQL.Simple.SqlQQ (sql) import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.ToField qualified as PGS
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Gargantext.Prelude import Gargantext.Prelude
...@@ -31,8 +26,7 @@ runPGSExecute c qs a = catch (PGS.execute c qs a) printError ...@@ -31,8 +26,7 @@ runPGSExecute c qs a = catch (PGS.execute c qs a) printError
where where
printError (SomeException e) = do printError (SomeException e) = do
--q' <- PGS.formatQuery c qs a --q' <- PGS.formatQuery c qs a
_ <- panic $ pack $ show e throwIO (SomeException e)
throw (SomeException e)
runPGSExecuteMany :: (PGS.ToRow q) runPGSExecuteMany :: (PGS.ToRow q)
=> PGS.Connection -> PGS.Query -> [q] -> IO Int64 => PGS.Connection -> PGS.Query -> [q] -> IO Int64
...@@ -40,8 +34,7 @@ runPGSExecuteMany c qs a = catch (PGS.executeMany c qs a) printError ...@@ -40,8 +34,7 @@ runPGSExecuteMany c qs a = catch (PGS.executeMany c qs a) printError
where where
printError (SomeException e) = do printError (SomeException e) = do
--q' <- PGS.formatQuery c qs a --q' <- PGS.formatQuery c qs a
_ <- panic $ pack $ show e throwIO (SomeException e)
throw (SomeException e)
runPGSReturning :: (PGS.ToRow q, PGS.FromRow r) runPGSReturning :: (PGS.ToRow q, PGS.FromRow r)
=> PGS.Connection -> PGS.Query -> [q] -> IO [r] => PGS.Connection -> PGS.Query -> [q] -> IO [r]
...@@ -49,8 +42,7 @@ runPGSReturning c qs a = catch (PGS.returning c qs a) printError ...@@ -49,8 +42,7 @@ runPGSReturning c qs a = catch (PGS.returning c qs a) printError
where where
printError (SomeException e) = do printError (SomeException e) = do
--q' <- PGS.formatQuery c qs a --q' <- PGS.formatQuery c qs a
_ <- panic $ pack $ show e throwIO (SomeException e)
throw (SomeException e)
runPGSQuery :: (PGS.FromRow r, PGS.ToRow q) runPGSQuery :: (PGS.FromRow r, PGS.ToRow q)
...@@ -60,7 +52,7 @@ runPGSQuery c q a = catch (PGS.query c q a) printError ...@@ -60,7 +52,7 @@ runPGSQuery c q a = catch (PGS.query c q a) printError
printError (SomeException e) = do printError (SomeException e) = do
q' <- PGS.formatQuery c q a q' <- PGS.formatQuery c q a
hPutStrLn stderr q' hPutStrLn stderr q'
throw (SomeException e) throwIO (SomeException e)
runPGSQuery' :: (PGS.FromRow r) runPGSQuery' :: (PGS.FromRow r)
=> PGS.Connection -> PGS.Query -> IO [r] => PGS.Connection -> PGS.Query -> IO [r]
...@@ -69,7 +61,7 @@ runPGSQuery' c q = catch (PGS.query_ c q) printError ...@@ -69,7 +61,7 @@ runPGSQuery' c q = catch (PGS.query_ c q) printError
printError (SomeException e) = do printError (SomeException e) = do
-- q' <- PGS.formatQuery c q [] -- q' <- PGS.formatQuery c q []
hPutStrLn stderr (show q :: Text) hPutStrLn stderr (show q :: Text)
throw (SomeException e) throwIO (SomeException e)
runPGSAdvisoryLock :: PGS.Connection -> Int -> IO () runPGSAdvisoryLock :: PGS.Connection -> Int -> IO ()
runPGSAdvisoryLock c id = do runPGSAdvisoryLock c id = do
......
{-|
Module : Gargantext.Prelude.Mail
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Gargantext.Prelude.Mail
(gargMail, GargMail(..), readConfig)
where
-- import Data.Text.Internal.Lazy (Text)
import Data.Text (unpack)
import Data.Maybe
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)
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_from = cs $ val' "MAIL_FROM"
, _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
, gm_body :: Text
}
-- | TODO add parameters to gargantext.ini
gargMail :: MailConfig -> GargMail -> IO ()
gargMail (MailConfig {..}) (GargMail { .. }) = do
let host = unpack _mc_mail_host
user = unpack _mc_mail_user
password = unpack _mc_mail_password
case _mc_mail_login_type of
NoAuth -> sendMail host mail
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 sender receiver cc bcc gm_subject [plainPart $ cs gm_body]
sender = Address (Just "GarganText Email") _mc_mail_from
receiver = [Address gm_name gm_to]
cc = []
bcc = []
{-|
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 = NoAuth | 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
, _mc_mail_from :: !T.Text
}
deriving (Generic, Show)
makeLenses ''MailConfig
{-|
Module : Gargantext.Prelude.NLP
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Gargantext.Prelude.NLP
(NLPConfig(..), readConfig)
where
import qualified Data.Ini as Ini
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Data.Maybe
import Gargantext.Prelude
import Gargantext.Prelude.Config (readIniFile', val)
import Gargantext.Prelude.NLP.Types (NLPConfig(..))
import Gargantext.Prelude.Utils (listToMaybeAll)
import Network.URI (parseURI)
iniSection :: Text
iniSection = "nlp"
readConfig :: FilePath -> IO NLPConfig
readConfig fp = do
ini <- readIniFile' fp
let val' = val ini iniSection
let lang_default_text = "EN" -- Change this value by one of your choice: "All", "FR", or "EN"
let m_nlp_default = parseURI $ cs $ val' lang_default_text
let m_nlp_keys = filter (\k -> k `notElem` [lang_default_text]) $ fromRight [] $ Ini.keys iniSection ini
let m_nlp_other = listToMaybeAll $ (\k -> (,) k <$> (parseURI $ cs $ val' k)) <$> m_nlp_keys
let mRet = NLPConfig <$> m_nlp_default <*> (Map.fromList <$> m_nlp_other)
case mRet of
Nothing -> panicTrace $ T.concat [ "Cannot read config file: _nlp_default = "
, T.pack $ show m_nlp_default
, ", _nlp_other = "
, T.pack $ show m_nlp_other ]
Just ret -> pure ret
{-|
Module : Gargantext.Prelude.NLP.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.NLP.Types where
import Control.Lens (makeLenses)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import GHC.Generics (Generic)
import Network.Socket (PortNumber)
import Network.URI (URI)
import Protolude
data NLPConfig = NLPConfig { _nlp_default :: URI
, _nlp_languages :: (Map.Map T.Text URI) }
deriving (Generic, Show)
makeLenses ''NLPConfig
main :: IO ()
main = putStrLn "Test suite not yet implemented"
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