[config] more refactoring of Settings into GargConfig (jwt)

bin/gargantext-cli/CLI/Ini.hs

@@ -56,7 +56,8 @@ ini_p = fmap CCMD_ini $ IniArgs
 convertConfigs :: Ini.GargConfig -> IniMail.MailConfig -> IniNLP.NLPConfig -> PGS.ConnectInfo -> Config.GargConfig
 convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
   Config.GargConfig { _gc_secrets = CTypes.SecretsConfig { _s_master_user = _gc_masteruser
-                                                         , _s_secret_key = _gc_secretkey }
+                                                         , _s_secret_key = _gc_secretkey
+                                                         , _s_jwk_file = CTypes.JWKFile "dev.jwk" }
                     , _gc_datafilepath
                     , _gc_mail_config = iniMail
                     , _gc_nlp_config = nlpConfig
@@ -82,7 +83,6 @@ mkFrontendConfig (Ini.GargConfig { .. }) =
   CTypes.FrontendConfig { _fc_url = _gc_url
                         , _fc_backend_name = _gc_backend_name
                         , _fc_url_backend_api = _gc_url_backend_api
-                        , _fc_jwt_settings = "TODO"
                         , _fc_cors
                         , _fc_microservices
                         , _fc_appPort = 3000 }

gargantext-settings.toml_toModify

@@ -47,6 +47,9 @@ master_user = "gargantua"
 # frame_id seeds are computed.
 secret_key      = "something_speciaL"
 
+# JWK token
+jwk_file = "dev.jwk"
+
 
 [paths]
 

src/Gargantext/API.hs

@@ -44,9 +44,9 @@ import Data.Text.Encoding qualified as TE
 import Data.Text.IO (putStrLn)
 import Data.Validity
 import Gargantext.API.Admin.Auth.Types (AuthContext)
-import Gargantext.API.Admin.EnvTypes (Env, Mode(..), env_config)
+import Gargantext.API.Admin.EnvTypes (Env, Mode(..), env_config, env_jwt_settings)
 import Gargantext.API.Admin.Settings (newEnv)
-import Gargantext.API.Admin.Types (FireWall(..), cookieSettings, jwtSettings, settings)
+import Gargantext.API.Admin.Types (FireWall(..), cookieSettings, settings)
 import Gargantext.API.Middleware (logStdoutDevSanitised)
 import Gargantext.API.Routes.Named (API)
 import Gargantext.API.Routes.Named.EKG
@@ -204,7 +204,7 @@ makeApp env = do
     --          })
   where
     cfg :: Servant.Context AuthContext
-    cfg = env ^. settings . jwtSettings
+    cfg = env ^. env_jwt_settings
        :. env ^. settings . cookieSettings
        :. EmptyContext
 

src/Gargantext/API/Admin/Auth.hs

@@ -55,6 +55,7 @@ import Gargantext.API.Admin.Types
 import Gargantext.API.Auth.PolicyCheck
 import Gargantext.API.Errors
 import Gargantext.API.Prelude (authenticationError, HasServerError, GargServerC, _ServerError, GargM, IsGargServer)
+import Gargantext.Core.Config (HasJWTSettings(..))
 import Gargantext.Core.Mail (MailModel(..), mail)
 import Gargantext.Core.Mail.Types (mailSettings)
 import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
@@ -81,18 +82,18 @@ import qualified Gargantext.API.Routes.Named as Named
 
 -- | Main functions of authorization
 
-makeTokenForUser :: (HasSettings env, HasAuthenticationError err)
+makeTokenForUser :: (HasJWTSettings env, HasAuthenticationError err)
                  => NodeId
                  -> UserId
                  -> Cmd' env err Token
 makeTokenForUser nodeId userId = do
-  jwtS <- view $ settings . jwtSettings
+  jwtS <- view jwtSettings
   e <- liftBase $ makeJWT (AuthenticatedUser nodeId userId) jwtS Nothing
   -- TODO-SECURITY here we can implement token expiration ^^.
   either (authenticationError . LoginFailed nodeId userId) (pure . toStrict . LE.decodeUtf8) e
   -- TODO not sure about the encoding...
 
-checkAuthRequest :: ( HasSettings env, HasAuthenticationError err, DbCmd' env err m )
+checkAuthRequest :: ( HasJWTSettings env, HasAuthenticationError err, DbCmd' env err m )
                  => Username
                  -> GargPassword
                  -> m CheckAuth
@@ -117,7 +118,7 @@ checkAuthRequest couldBeEmail (GargPassword p) = do
               token <- makeTokenForUser nodeId userLight_id
               pure $ Valid token nodeId userLight_id
 
-auth :: (HasSettings env, HasAuthenticationError err, DbCmd' env err m)
+auth :: (HasJWTSettings env, HasAuthenticationError err, DbCmd' env err m)
      => AuthRequest -> m AuthResponse
 auth (AuthRequest u p) = do
   checkAuthRequest' <- checkAuthRequest u p

src/Gargantext/API/Admin/EnvTypes.hs

@@ -17,6 +17,8 @@ module Gargantext.API.Admin.EnvTypes (
   , env_self_url
   , env_central_exchange
   , env_dispatcher
+  , env_jwt_settings
+  
   , menv_firewall
   , dev_env_logger
 
@@ -43,18 +45,18 @@ import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
 import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
 import Gargantext.Core.AsyncUpdates.Dispatcher (Dispatcher)
 import Gargantext.Core.AsyncUpdates.Dispatcher.Types (HasDispatcher(..))
+import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..))
 import Gargantext.Core.Mail.Types (HasMail, mailSettings)
-import Gargantext.Core.NLP (NLPServerMap, HasNLPServer(..))
+import Gargantext.Core.NLP (HasNLPServer(..), nlpServerMap)
 import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude (HasConnectionPool(..), HasConfig(..))
-import Gargantext.Prelude
-import Gargantext.Core.Config (GargConfig(..))
-import Gargantext.Core.Config.Mail (MailConfig)
+import Gargantext.Prelude hiding (to)
 import Gargantext.System.Logging
 import Gargantext.Utils.Jobs.Internal (pollJob)
 import Gargantext.Utils.Jobs.Map (LoggerM, J(..), jTask, rjGetLog)
 import Gargantext.Utils.Jobs.Monad qualified as Jobs
 import Network.HTTP.Client (Manager)
+import Servant.Auth.Server (JWTSettings)
 import Servant.Client (BaseUrl)
 import Servant.Job.Async (HasJobEnv(..), Job)
 import Servant.Job.Async qualified as SJ
@@ -121,19 +123,18 @@ data GargJob
 -- having to specify /everything/. This means that when we /construct/ an 'Env',
 -- we need to remember to force the fields to WHNF at that point.
 data Env = Env
-  { _env_settings  :: ~Settings
-  , _env_logger    :: ~(Logger (GargM Env BackendInternalError))
-  , _env_pool      :: ~(Pool Connection)
-  , _env_nodeStory :: ~NodeStoryEnv
-  , _env_manager   :: ~Manager
-  , _env_self_url  :: ~BaseUrl
-  , _env_scrapers  :: ~ScrapersEnv
-  , _env_jobs      :: ~(Jobs.JobEnv GargJob (Seq JobLog) JobLog)
-  , _env_config    :: ~GargConfig
-  , _env_mail      :: ~MailConfig
-  , _env_nlp       :: ~NLPServerMap
+  { _env_settings         :: ~Settings
+  , _env_logger           :: ~(Logger (GargM Env BackendInternalError))
+  , _env_pool             :: ~(Pool Connection)
+  , _env_nodeStory        :: ~NodeStoryEnv
+  , _env_manager          :: ~Manager
+  , _env_self_url         :: ~BaseUrl
+  , _env_scrapers         :: ~ScrapersEnv
+  , _env_jobs             :: ~(Jobs.JobEnv GargJob (Seq JobLog) JobLog)
+  , _env_config           :: ~GargConfig
   , _env_central_exchange :: ~ThreadId
-  , _env_dispatcher :: ~Dispatcher
+  , _env_dispatcher       :: ~Dispatcher
+  , _env_jwt_settings     :: ~JWTSettings
   }
   deriving (Generic)
 
@@ -157,11 +158,14 @@ instance HasNodeArchiveStoryImmediateSaver Env where
 instance HasSettings Env where
   settings = env_settings
 
+instance HasJWTSettings Env where
+  jwtSettings = env_jwt_settings
+
 instance HasMail Env where
-  mailSettings = env_mail
+  mailSettings = env_config . gc_mail_config
 
 instance HasNLPServer Env where
-  nlpServer = env_nlp
+  nlpServer = env_config . gc_nlp_config . (to nlpServerMap)
 
 instance HasDispatcher Env Dispatcher where
   hasDispatcher = env_dispatcher
@@ -294,8 +298,6 @@ data DevEnv = DevEnv
   , _dev_env_logger    :: !(Logger (GargM DevEnv BackendInternalError))
   , _dev_env_pool      :: !(Pool Connection)
   , _dev_env_nodeStory :: !NodeStoryEnv
-  , _dev_env_mail      :: !MailConfig
-  , _dev_env_nlp       :: !NLPServerMap
   }
 
 makeLenses ''DevEnv
@@ -354,10 +356,10 @@ instance HasNodeArchiveStoryImmediateSaver DevEnv where
   hasNodeArchiveStoryImmediateSaver = hasNodeStory . nse_archive_saver_immediate
 
 instance HasMail DevEnv where
-  mailSettings = dev_env_mail
+  mailSettings = dev_env_config . gc_mail_config
 
 instance HasNLPServer DevEnv where
-  nlpServer = dev_env_nlp
+  nlpServer = dev_env_config . gc_nlp_config . (to nlpServerMap)
 
 
 instance IsGargServer Env BackendInternalError (GargM Env BackendInternalError)

src/Gargantext/API/Admin/Settings.hs

@@ -32,9 +32,8 @@ import Gargantext.API.Prelude
 import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
 import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D
 import Gargantext.Core.Config (GargConfig(..), gc_jobs, gc_frontend_config)
-import Gargantext.Core.Config.Types (PortNumber, SettingsFile(..), fc_appPort, jc_js_job_timeout, jc_js_id_timeout)
+import Gargantext.Core.Config.Types (PortNumber, SettingsFile(..), fc_appPort, jc_js_job_timeout, jc_js_id_timeout, jwtSettings)
 import Gargantext.Core.Config.Utils (readConfig)
-import Gargantext.Core.NLP (nlpServerMap)
 import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude (hasConfig)
 import Gargantext.Prelude
@@ -44,10 +43,10 @@ import Gargantext.Utils.Jobs.Monad qualified as Jobs
 import Gargantext.Utils.Jobs.Queue qualified as Jobs
 import Gargantext.Utils.Jobs.Settings qualified as Jobs
 import Network.HTTP.Client.TLS (newTlsManager)
-import Servant.Auth.Server (defaultJWTSettings, CookieSettings(..), XsrfCookieSettings(..), defaultCookieSettings, defaultXsrfCookieSettings, readKey, writeKey)
+import Servant.Auth.Server (CookieSettings(..), XsrfCookieSettings(..), defaultCookieSettings, defaultXsrfCookieSettings)
 import Servant.Client (parseBaseUrl)
 import Servant.Job.Async (newJobEnv, defaultSettings)
-import System.Directory
+import System.Directory (renameFile)
 import System.IO (hClose)
 import System.IO.Temp (withTempFile)
 
@@ -58,20 +57,16 @@ newtype JwkFile = JwkFile { _JwkFile :: FilePath }
 newtype IniFile  = IniFile { _IniFile :: FilePath }
   deriving (Show, Eq, IsString)
 
-devSettings :: JwkFile -> IO Settings
-devSettings (JwkFile jwkFile) = do
-  jwkExists <- doesFileExist jwkFile
-  when (not jwkExists) $ writeKey jwkFile
-  jwk       <- readKey jwkFile
+devSettings :: Settings
+devSettings =
   -- GargTomlSettings{..} <- loadGargTomlSettings settingsFile
-  pure $ Settings
+  Settings
     { -- _corsSettings = _gargCorsSettings
     -- , _microservicesSettings = _gargMicroServicesSettings
 --    , _dbServer = "localhost"
       _sendLoginEmails = LogEmailToConsole
     , _scrapydUrl = fromMaybe (panicTrace "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800"
     , _cookieSettings = defaultCookieSettings { cookieXsrfSetting = Just xsrfCookieSetting } -- TODO-SECURITY tune
-    , _jwtSettings = defaultJWTSettings jwk -- TODO-SECURITY tune
     }
   where
     xsrfCookieSetting = defaultXsrfCookieSettings { xsrfExcludeGet = True }
@@ -181,7 +176,7 @@ devJwkFile = JwkFile "dev.jwk"
 newEnv :: Logger (GargM Env BackendInternalError) -> PortNumber -> SettingsFile -> IO Env
 newEnv logger port settingsFile@(SettingsFile sf) = do
   !manager_env  <- newTlsManager
-  !settings'    <- devSettings devJwkFile
+  let !settings' = devSettings
   !config_env   <- readConfig settingsFile <&> (gc_frontend_config . fc_appPort) .~ port -- TODO read from 'file'
   when (port /= config_env ^. gc_frontend_config . fc_appPort) $
     panicTrace "TODO: conflicting settings of port"
@@ -204,6 +199,8 @@ newEnv logger port settingsFile@(SettingsFile sf) = do
   !central_exchange <- forkIO $ CE.gServer (_gc_notifications_config config_env)
   !dispatcher <- D.newDispatcher (_gc_notifications_config config_env)
 
+  !_env_jwt_settings <- jwtSettings (_gc_secrets config_env)
+
 {-  An 'Env' by default doesn't have strict fields, but when constructing one in production
   we want to force them to WHNF to avoid accumulating unnecessary thunks.
 -}
@@ -217,10 +214,9 @@ newEnv logger port settingsFile@(SettingsFile sf) = do
     , _env_jobs      = jobs_env
     , _env_self_url  = self_url_env
     , _env_config    = config_env
-    , _env_mail      = _gc_mail_config config_env
-    , _env_nlp       = nlpServerMap $ _gc_nlp_config config_env
     , _env_central_exchange = central_exchange
     , _env_dispatcher = dispatcher
+    , _env_jwt_settings
     }
 
 newPool :: ConnectInfo -> IO (Pool Connection)

src/Gargantext/API/Admin/Types.hs

@@ -5,7 +5,7 @@ module Gargantext.API.Admin.Types where
 import Control.Lens
 import GHC.Enum
 import Gargantext.Prelude
-import Servant.Auth.Server (JWTSettings, CookieSettings(..))
+import Servant.Auth.Server (CookieSettings(..))
 import Servant.Client (BaseUrl)
 
 
@@ -19,8 +19,7 @@ data Settings = Settings
     { 
 --    , _dbServer        :: Text
 --    ^ this is not used yet
-      _jwtSettings           :: !JWTSettings
-    , _cookieSettings        :: !CookieSettings
+      _cookieSettings        :: !CookieSettings
     , _sendLoginEmails       :: !SendEmailType
     , _scrapydUrl            :: !BaseUrl
     }

src/Gargantext/API/Dev.hs

@@ -17,12 +17,11 @@ import Control.Monad (fail)
 import Data.Pool (withResource)
 import Database.PostgreSQL.Simple qualified as PGS
 import Gargantext.API.Admin.EnvTypes ( DevEnv(..), Mode(Dev) )
-import Gargantext.API.Admin.Settings ( devJwkFile, devSettings, newPool )
+import Gargantext.API.Admin.Settings ( devSettings, newPool )
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Prelude ( GargM )
-import Gargantext.Core.Config (_gc_database_config, _gc_mail_config, _gc_nlp_config)
+import Gargantext.Core.Config (_gc_database_config)
 import Gargantext.Core.Config.Types (SettingsFile(..))
-import Gargantext.Core.NLP (nlpServerMap)
 import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
 import Gargantext.Database.Prelude (Cmd', Cmd'', connPool, runCmd)
 import Gargantext.Prelude
@@ -42,15 +41,13 @@ withDevEnv settingsFile k = withLoggerHoisted Dev $ \logger -> do
       --nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg)
       pool    <- newPool (_gc_database_config cfg)
       nodeStory_env <- fromDBNodeStoryEnv pool
-      setts   <- devSettings devJwkFile
+      let setts = devSettings
       pure $ DevEnv
         { _dev_env_pool     = pool
         , _dev_env_logger     = logger
         , _dev_env_nodeStory  = nodeStory_env
         , _dev_env_settings = setts
         , _dev_env_config   = cfg
-        , _dev_env_mail     = _gc_mail_config cfg
-        , _dev_env_nlp      = nlpServerMap (_gc_nlp_config cfg)
         }
 
 defaultSettingsFile :: SettingsFile

src/Gargantext/API/GraphQL.hs

@@ -28,7 +28,6 @@ import Data.Morpheus.Types ( GQLRequest, GQLResponse, GQLType, RootResolver(..),
 -- import Data.Proxy
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog)
-import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Auth.PolicyCheck
 import Gargantext.API.Errors.Types
 import Gargantext.API.GraphQL.Annuaire qualified as GQLA
@@ -44,6 +43,7 @@ import Gargantext.API.GraphQL.UserInfo qualified as GQLUserInfo
 import Gargantext.API.Prelude (GargM)
 import Gargantext.API.Prelude (HasJobEnv')
 import Gargantext.API.Types
+import Gargantext.Core.Config (HasJWTSettings)
 import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Database.Prelude (CmdCommon)
 import Gargantext.Prelude hiding (ByteString)
@@ -102,7 +102,7 @@ data Contet m
 -- | The main GraphQL resolver: how queries, mutations and
 -- subscriptions are handled.
 rootResolver
-  :: (CmdCommon env, HasNLPServer env, HasJobEnv' env, HasSettings env)
+  :: (CmdCommon env, HasNLPServer env, HasJobEnv' env, HasJWTSettings env)
   => AuthenticatedUser
   -> AccessPolicyManager
   -> RootResolver (GargM env BackendInternalError) e Query Mutation Undefined
@@ -134,7 +134,7 @@ rootResolver authenticatedUser policyManager =
 
 -- | Main GraphQL "app".
 app
-  :: (Typeable env, CmdCommon env, HasJobEnv' env, HasNLPServer env, HasSettings env)
+  :: (Typeable env, CmdCommon env, HasJobEnv' env, HasNLPServer env, HasJWTSettings env)
   => AuthenticatedUser
   -> AccessPolicyManager
   -> App (EVENT (GargM env BackendInternalError)) (GargM env BackendInternalError)
@@ -172,7 +172,7 @@ data GraphQLAPIEndpoints mode = GraphQLAPIEndpoints
 
 -- | Implementation of our API.
 api
-  :: (Typeable env, CmdCommon env, HasJobEnv' env, HasSettings env)
+  :: (Typeable env, CmdCommon env, HasJobEnv' env, HasJWTSettings env)
   => GraphQLAPI (AsServerT (GargM env BackendInternalError))
 api = GraphQLAPI $ \case
   (SAS.Authenticated auser)

src/Gargantext/API/GraphQL/Context.hs

@@ -25,7 +25,6 @@ import Data.Morpheus.Types
 import Data.Text (pack, unpack)
 import qualified Data.Text as Text
 import Data.Time.Format.ISO8601 (iso8601Show)
-import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Prelude (GargM)
 import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow)
@@ -219,7 +218,7 @@ toHyperdataRowDocumentGQL hyperdata =
                                      }
     HyperdataRowContact { } -> Nothing
 
-updateNodeContextCategory :: (CmdCommon env, HasSettings env)
+updateNodeContextCategory :: (CmdCommon env)
                           => NodeContextCategoryMArgs -> GqlM' e env [Int]
 updateNodeContextCategory NodeContextCategoryMArgs { context_id, node_id, category } = do
   _ <- lift $ DNC.updateNodeContextCategory (UnsafeMkContextId context_id) (UnsafeMkNodeId node_id) category

src/Gargantext/API/GraphQL/Team.hs

@@ -17,11 +17,11 @@ module Gargantext.API.GraphQL.Team where
 import Data.Morpheus.Types (GQLType, ResolverM)
 import Data.Text qualified as T
 import Gargantext.API.Admin.Auth.Types (AuthenticationError(..))
-import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types
 import Gargantext.API.GraphQL.Types (GqlM)
 import Gargantext.API.GraphQL.Utils (authUser, AuthStatus (Invalid, Valid))
 import Gargantext.API.Prelude (GargM)
+import Gargantext.Core.Config (HasJWTSettings)
 import Gargantext.Core.Types (NodeId(..), unNodeId)
 import Gargantext.Core.Types.Individu qualified as Individu
 import Gargantext.Database.Action.Share (membersOf, deleteMemberShip)
@@ -78,7 +78,7 @@ dbTeam nodeId = do
     getUsername ((UserLight {userLight_username}, _):_) = userLight_username
 
 -- TODO: list as argument
-deleteTeamMembership :: (CmdCommon env, HasSettings env) =>
+deleteTeamMembership :: (CmdCommon env, HasJWTSettings env) =>
                         TeamDeleteMArgs -> GqlM' e env [Int]
 deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } = do
   teamNode <- lift $ getNode $ UnsafeMkNodeId team_node_id

src/Gargantext/API/GraphQL/User.hs

@@ -16,7 +16,6 @@ module Gargantext.API.GraphQL.User where
 
 import Data.Morpheus.Types ( GQLType )
 import Gargantext.API.Admin.Auth.Types
-import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Auth.PolicyCheck
 import Gargantext.API.GraphQL.PolicyCheck
 import Gargantext.API.GraphQL.Types
@@ -88,21 +87,21 @@ resolveHyperdata
   => UserId -> GqlM e env (Maybe HyperdataUser)
 resolveHyperdata userid = lift (listToMaybe <$> DBUser.getUserHyperdata (Individu.UserDBId userid))
 
-updateUserPubmedAPIKey :: ( CmdCommon env, HasSettings env) =>
+updateUserPubmedAPIKey :: ( CmdCommon env ) =>
                           UserPubmedAPIKeyMArgs -> GqlM' e env Int
 updateUserPubmedAPIKey UserPubmedAPIKeyMArgs { user_id, api_key } = do
   _ <- lift $ DBUser.updateUserPubmedAPIKey (Individu.RootId $ UnsafeMkNodeId user_id) api_key
 
   pure 1
 
-updateUserEPOAPIUser :: ( CmdCommon env, HasSettings env) =>
+updateUserEPOAPIUser :: ( CmdCommon env ) =>
                         UserEPOAPIUserMArgs -> GqlM' e env Int
 updateUserEPOAPIUser UserEPOAPIUserMArgs { user_id, api_user } = do
   _ <- lift $ DBUser.updateUserEPOAPIUser (Individu.RootId $ UnsafeMkNodeId user_id) api_user
 
   pure 1
 
-updateUserEPOAPIToken :: ( CmdCommon env, HasSettings env) =>
+updateUserEPOAPIToken :: ( CmdCommon env ) =>
                          UserEPOAPITokenMArgs -> GqlM' e env Int
 updateUserEPOAPIToken UserEPOAPITokenMArgs { user_id, api_token } = do
   _ <- lift $ DBUser.updateUserEPOAPIToken (Individu.RootId $ UnsafeMkNodeId user_id) api_token

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -41,11 +41,11 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact
   , hc_who
   , hc_where)
 import Gargantext.API.Admin.Auth.Types hiding (Valid)
-import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Auth.PolicyCheck
 import Gargantext.API.GraphQL.PolicyCheck
 import Gargantext.API.GraphQL.Types
 import Gargantext.API.GraphQL.Utils (AuthStatus(Invalid, Valid), authUser)
+import Gargantext.Core.Config (HasJWTSettings)
 import Gargantext.Core.Types.Individu qualified as Individu
 import Gargantext.Database.Prelude (CmdCommon)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
@@ -117,7 +117,7 @@ resolveUserInfos autUser mgr UserInfoArgs { user_id } =
 
 -- | Mutation for user info
 updateUserInfo
-  :: (CmdCommon env, HasSettings env)
+  :: (CmdCommon env, HasJWTSettings env)
   -- => UserInfoMArgs -> ResolverM e (GargM env err) Int
   => UserInfoMArgs -> GqlM' e env Int
 updateUserInfo (UserInfoMArgs { ui_id, .. }) = do

src/Gargantext/API/GraphQL/Utils.hs

@@ -14,7 +14,7 @@ module Gargantext.API.GraphQL.Utils where
 
 import Control.Lens (view)
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser (..), auth_node_id)
-import Gargantext.API.Admin.Types (jwtSettings, HasSettings (settings))
+import Gargantext.Core.Config (HasJWTSettings(..))
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Prelude (Cmd')
 import Gargantext.Prelude
@@ -22,10 +22,10 @@ import Servant.Auth.Server (verifyJWT, JWTSettings)
 
 data AuthStatus = Valid | Invalid
 
-authUser :: (HasSettings env) => NodeId -> Text -> Cmd' env err AuthStatus
+authUser :: (HasJWTSettings env) => NodeId -> Text -> Cmd' env err AuthStatus
 authUser ui_id token = do
   let token' = encodeUtf8 token
-  jwtS <- view $ settings . jwtSettings
+  jwtS <- view jwtSettings
   u <- liftBase $ getUserFromToken jwtS token'
   case u of
     Nothing -> pure Invalid

src/Gargantext/Core/AsyncUpdates/Dispatcher/Types.hs

@@ -31,7 +31,7 @@ import DeferredFolds.UnfoldlM qualified as UnfoldlM
 import Data.UUID.V4 as UUID
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id))
 import Gargantext.API.Admin.Orchestrator.Types (JobLog)
-import Gargantext.API.Admin.Types (jwtSettings, Settings, jwtSettings)
+import Gargantext.API.Admin.Types (Settings)
 import Gargantext.API.Prelude (IsGargServer)
 import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CETypes
 import Gargantext.Core.Types (NodeId, UserId)

src/Gargantext/Core/AsyncUpdates/Dispatcher/WebSocket.hs

@@ -23,17 +23,17 @@ import Control.Lens (view)
 import Data.Aeson qualified as Aeson
 import Data.UUID.V4 as UUID
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id))
-import Gargantext.API.Admin.Types (HasSettings(settings), Settings, jwtSettings)
 import Gargantext.API.Prelude (IsGargServer)
 import Gargantext.Core.AsyncUpdates.Dispatcher.Subscriptions
 import Gargantext.Core.AsyncUpdates.Dispatcher.Types
 import Gargantext.Core.AsyncUpdates.Dispatcher (Dispatcher, dispatcherSubscriptions)
+import Gargantext.Core.Config (HasJWTSettings(jwtSettings))
 import Gargantext.Prelude
 import Gargantext.System.Logging (LogLevel(DEBUG), logMsg, withLogger)
 import Network.WebSockets qualified as WS
 import Servant
 import Servant.API.WebSocket qualified as WS (WebSocketPending)
-import Servant.Auth.Server (verifyJWT)
+import Servant.Auth.Server (JWTSettings, verifyJWT)
 import Servant.Server.Generic (AsServerT)
 import StmContainers.Set as SSet
 
@@ -43,19 +43,19 @@ newtype WSAPI mode = WSAPI {
   } deriving Generic
 
 
-wsServer :: ( IsGargServer env err m, HasDispatcher env Dispatcher, HasSettings env ) => WSAPI (AsServerT m)
+wsServer :: ( IsGargServer env err m, HasDispatcher env Dispatcher, HasJWTSettings env ) => WSAPI (AsServerT m)
 wsServer = WSAPI { wsAPIServer = streamData }
   where
-    streamData :: ( IsGargServer env err m, HasDispatcher env Dispatcher, HasSettings env )
+    streamData :: ( IsGargServer env err m, HasDispatcher env Dispatcher, HasJWTSettings env )
                => WS.PendingConnection -> m ()
     streamData pc = do
-      authSettings <- view settings
+      jwtS <- view jwtSettings
       d <- view hasDispatcher
       let subscriptions = dispatcherSubscriptions d
       key <- getWSKey pc
       c <- liftBase $ WS.acceptRequest pc
       let ws = WSKeyConnection (key, c)
-      _ <- liftBase $ Async.concurrently (wsLoop authSettings subscriptions ws) (pingLoop ws)
+      _ <- liftBase $ Async.concurrently (wsLoop jwtS subscriptions ws) (pingLoop ws)
       -- _ <- liftIO $ Async.withAsync (pure ()) (\_ -> wsLoop ws)
       pure ()
 
@@ -73,8 +73,8 @@ pingLoop ws = do
     threadDelay $ 10 * 1000000
 
       
-wsLoop :: Settings -> SSet.Set Subscription -> WSKeyConnection -> IO a
-wsLoop authSettings subscriptions ws = flip finally disconnect $ do
+wsLoop :: JWTSettings -> SSet.Set Subscription -> WSKeyConnection -> IO a
+wsLoop jwtS subscriptions ws = flip finally disconnect $ do
   withLogger () $ \ioLogger -> do
     logMsg ioLogger DEBUG "[wsLoop] connecting"
     wsLoop' CUPublic ioLogger
@@ -105,7 +105,6 @@ wsLoop authSettings subscriptions ws = flip finally disconnect $ do
               -- putText $ "[wsLoop] subscriptions: " <> show (showSub <$> ss)
               return user
             Just (WSAuthorize token) -> do
-              let jwtS = authSettings ^. jwtSettings
               mUser <- liftBase $ verifyJWT jwtS (encodeUtf8 token)
 
               logMsg ioLogger DEBUG $ "[wsLoop] authorized user: " <> show mUser

src/Gargantext/Core/Config.hs

@@ -31,8 +31,11 @@ module Gargantext.Core.Config (
   , gc_log_level
 
   , mkProxyUrl
+
+  , HasJWTSettings(..)
   ) where
 
+import Control.Lens (Getter)
 import Control.Monad.Logger (LogLevel(LevelDebug))
 import Data.Text as T
 import Database.PostgreSQL.Simple qualified as PSQL
@@ -40,6 +43,7 @@ import Gargantext.Core.Config.Mail (MailConfig)
 import Gargantext.Core.Config.NLP (NLPConfig)
 import Gargantext.Core.Config.Types
 import Gargantext.Prelude
+import Servant.Auth.Server (JWTSettings)
 import Servant.Client (BaseUrl(..), Scheme(Http), parseBaseUrl)
 import Toml.Schema
 
@@ -51,7 +55,6 @@ import Toml.Schema
 -- Non-strict data so that we can use it in tests
 data GargConfig = GargConfig { _gc_datafilepath         :: ~FilePath
                              -- , _gc_repofilepath      :: ~FilePath
-
                              , _gc_frontend_config      :: ~FrontendConfig
                              , _gc_mail_config          :: ~MailConfig
                              , _gc_database_config      :: ~PSQL.ConnectInfo
@@ -113,3 +116,7 @@ mkProxyUrl GargConfig{..} =
   case parseBaseUrl (T.unpack $ _fc_url _gc_frontend_config) of
     Nothing -> BaseUrl Http "localhost" 80 ""
     Just bh -> bh { baseUrlPort = _msProxyPort $ _fc_microservices _gc_frontend_config }
+
+
+class HasJWTSettings env where
+  jwtSettings :: Getter env JWTSettings

src/Gargantext/Core/Config/Types.hs

@@ -30,7 +30,6 @@ module Gargantext.Core.Config.Types
   , fc_url
   , fc_backend_name
   , fc_url_backend_api
-  , fc_jwt_settings
   , fc_cors
   , fc_microservices
   , fc_appPort
@@ -43,7 +42,9 @@ module Gargantext.Core.Config.Types
   , jc_js_id_timeout
   , MicroServicesSettings(..)
   , NotificationsConfig(..)
+  , JWKFile(..)
   , SecretsConfig(..)
+  , jwtSettings
   , SettingsFile(..)
   , TOMLConnectInfo(..)
   
@@ -58,7 +59,9 @@ import Control.Monad.Fail (fail)
 import Data.Text qualified as T
 import Database.PostgreSQL.Simple qualified as PGS
 import Gargantext.Prelude
+import Servant.Auth.Server (JWTSettings, defaultJWTSettings, readKey, writeKey)
 import Servant.Client.Core (BaseUrl, parseBaseUrl, showBaseUrl)
+import System.Directory (doesFileExist)
 import Toml
 import Toml.Schema
 
@@ -191,7 +194,6 @@ data FrontendConfig =
   FrontendConfig { _fc_url           :: !Text
                  , _fc_backend_name  :: !Text
                  , _fc_url_backend_api :: !Text
-                 , _fc_jwt_settings  :: !Text
                  , _fc_cors          :: !CORSSettings
                  , _fc_microservices :: !MicroServicesSettings
                  , _fc_appPort       :: !PortNumber
@@ -202,7 +204,6 @@ instance FromValue FrontendConfig where
     _fc_url <- reqKey "url"
     _fc_backend_name <- reqKey "backend_name"
     _fc_url_backend_api <- reqKey "url_backend_api"
-    _fc_jwt_settings <- reqKey "jwt_settings"
     _fc_cors <- reqKey "cors"
     _fc_microservices <- reqKey "microservices"
     let _fc_appPort = 3000
@@ -213,7 +214,6 @@ instance ToTable FrontendConfig where
   toTable (FrontendConfig { .. }) = table [ "url" .= _fc_url
                                           , "backend_name" .= _fc_backend_name
                                           , "url_backend_api" .= _fc_url_backend_api
-                                          , "jwt_settings" .= _fc_jwt_settings
                                           , "cors" .= _fc_cors
                                           , "microservices" .= _fc_microservices ]
 
@@ -232,21 +232,36 @@ microServicesProxyStatus fc =
      else PXY_disabled
 
 
+
+newtype JWKFile = JWKFile { unJWKFile :: FilePath }
+  deriving (Show, Eq, Generic)
+
 data SecretsConfig =
   SecretsConfig { _s_master_user :: !Text
                 , _s_secret_key  :: !Text
+                , _s_jwk_file    :: !JWKFile
                }
   deriving (Generic, Show)
 instance FromValue SecretsConfig where
   fromValue = parseTableFromValue $ do
     _s_master_user <- reqKey "master_user"
     _s_secret_key  <- reqKey "secret_key"
+    jwkFile <- reqKey "jwk_file"
+    let _s_jwk_file = JWKFile jwkFile
     return $ SecretsConfig { .. }
 instance ToValue SecretsConfig where
   toValue = defaultTableToValue
 instance ToTable SecretsConfig where
   toTable (SecretsConfig { .. }) = table [ "master_user" .= _s_master_user
-                                         , "secret_key" .= _s_secret_key ]
+                                         , "secret_key" .= _s_secret_key
+                                         , "jwk_file" .= unJWKFile _s_jwk_file ]
+
+jwtSettings :: SecretsConfig -> IO JWTSettings
+jwtSettings (SecretsConfig { _s_jwk_file = JWKFile jwkFile }) = do
+  jwkExists <- doesFileExist jwkFile
+  when (not jwkExists) $ writeKey jwkFile
+  jwk <- readKey jwkFile
+  pure $ defaultJWTSettings jwk
 
 
 data JobsConfig =

src/Gargantext/MicroServices/ReverseProxy.hs

@@ -158,7 +158,7 @@ microServicesProxyApp :: ProxyCache -> Env -> Application
 microServicesProxyApp cache env = genericServeTWithContext identity (server cache env) cfg
   where
     cfg :: Context AuthContext
-    cfg = env ^. settings . jwtSettings
+    cfg = env ^. env_jwt_settings
        :. env ^. settings . cookieSettings
        :. EmptyContext
 

test-data/test_config.toml

@@ -15,6 +15,7 @@ enabled = false
 [secrets]
 master_user = "gargantua"
 secret_key  = "test_key"
+jwk_file = "test.jwk"
 
 [paths]
 data_filepath = "~/.garg"

test/Test/API/Setup.hs

@@ -15,8 +15,8 @@ import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..))
 import Gargantext.API.Admin.Settings
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
-import Gargantext.Core.Config
-import Gargantext.Core.Config.Types (SettingsFile(..), jc_js_job_timeout, jc_js_id_timeout, fc_appPort)
+import Gargantext.Core.Config (_gc_secrets, gc_frontend_config, gc_jobs)
+import Gargantext.Core.Config.Types (SettingsFile(..), jc_js_job_timeout, jc_js_id_timeout, fc_appPort, jwtSettings)
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.NLP
 import Gargantext.Core.NodeStory
@@ -55,7 +55,7 @@ newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port ->
 newTestEnv testEnv logger port = do
   tomlFile@(SettingsFile sf)      <- fakeTomlPath
   !manager_env  <- newTlsManager
-  !settings'    <- devSettings devJwkFile
+  let !settings' = devSettings
 
   !config_env    <- readConfig tomlFile <&> (gc_frontend_config . fc_appPort) .~ port
   prios          <- withLogger () $ \ioLogger -> Jobs.readPrios ioLogger (sf <> ".jobs")
@@ -72,6 +72,7 @@ newTestEnv testEnv logger port = do
                         & Jobs.l_jsJobTimeout .~ (fromIntegral $ config_env ^. hasConfig ^. gc_jobs . jc_js_job_timeout)
                         & Jobs.l_jsIDTimeout  .~ (fromIntegral $ config_env ^. hasConfig ^. gc_jobs . jc_js_id_timeout)
   !jobs_env     <- Jobs.newJobEnv jobs_settings prios' manager_env
+  !_env_jwt_settings <- jwtSettings (_gc_secrets config_env)
 
   -- !central_exchange <- forkIO CE.gServer
   -- !dispatcher <- D.dispatcher
@@ -86,12 +87,11 @@ newTestEnv testEnv logger port = do
     , _env_jobs      = jobs_env
     , _env_self_url  = self_url_env
     , _env_config    = config_env
-    , _env_mail      = _gc_mail_config config_env
-    , _env_nlp       = nlpServerMap $ _gc_nlp_config config_env
     , _env_central_exchange = Prelude.error "central exchange not needed, but forced somewhere (check StrictData)"
     , _env_dispatcher = Prelude.error "dispatcher not needed, but forced somewhere (check StrictData)"
     -- , _env_central_exchange = central_exchange
     -- , _env_dispatcher = dispatcher
+    , _env_jwt_settings
     }
 
 -- | Run the gargantext server on a random port, picked by Warp, which allows

test/Test/Database/Setup.hs

@@ -76,7 +76,7 @@ setup = do
       bootstrapDB db pool gargConfig
       ugen <- emptyCounter
       test_nodeStory <- fromDBNodeStoryEnv pool
-      stgs <- devSettings devJwkFile
+      let stgs = devSettings
       withLoggerHoisted Mock $ \logger -> do
         pure $ TestEnv { test_db = DBHandle pool db
                        , test_config = gargConfig

test/Test/Utils/Jobs.hs

@@ -299,8 +299,6 @@ newTestEnv = do
        , _env_scrapers  = Prelude.error "scrapers not needed, but forced somewhere (check StrictData)"
        , _env_jobs      = myEnv
        , _env_config
-       , _env_mail      = Prelude.error "mail not needed, but forced somewhere (check StrictData)"
-       , _env_nlp       = Prelude.error "nlp not needed, but forced somewhere (check StrictData)"
        , _env_central_exchange = Prelude.error "central exchange not needed, but forced somewhere (check StrictData)"
        , _env_dispatcher = Prelude.error "dispatcher not needed, but forced somewhere (check StrictData)"
        }