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

parent 8bbeb216
Pipeline #6665 passed with stages
in 79 minutes and 28 seconds
......@@ -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 }
......
......@@ -47,6 +47,9 @@ master_user = "gargantua"
# frame_id seeds are computed.
secret_key = "something_speciaL"
# JWK token
jwk_file = "dev.jwk"
[paths]
......
......@@ -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
......
......@@ -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
......
......@@ -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
......@@ -130,10 +132,9 @@ data Env = Env
, _env_scrapers :: ~ScrapersEnv
, _env_jobs :: ~(Jobs.JobEnv GargJob (Seq JobLog) JobLog)
, _env_config :: ~GargConfig
, _env_mail :: ~MailConfig
, _env_nlp :: ~NLPServerMap
, _env_central_exchange :: ~ThreadId
, _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)
......@@ -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)
......
......@@ -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
}
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......@@ -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 =
......
......@@ -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
......
......@@ -15,6 +15,7 @@ enabled = false
[secrets]
master_user = "gargantua"
secret_key = "test_key"
jwk_file = "test.jwk"
[paths]
data_filepath = "~/.garg"
......
......@@ -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
......
......@@ -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
......
......@@ -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)"
}
......
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