From 5e85eae82539b1937a36a24b470d0e11e08cf127 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 12 Jan 2024 23:24:58 +0100 Subject: [PATCH] refactor(settings): move ResourcePool, Ldap and OAuth2 settings to separate modules --- src/Settings.hs | 78 ++++++------------------------------ src/Settings/Ldap.hs | 64 +++++++++++++++++++++++++++++ src/Settings/OAuth2.hs | 32 +++++++++++++++ src/Settings/ResourcePool.hs | 30 ++++++++++++++ 4 files changed, 138 insertions(+), 66 deletions(-) create mode 100644 src/Settings/Ldap.hs create mode 100644 src/Settings/OAuth2.hs create mode 100644 src/Settings/ResourcePool.hs diff --git a/src/Settings.hs b/src/Settings.hs index 96a5eb4da..3e1790b2e 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Steffen Jost +-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel , Gregor Kleen , Sarah Vaupel , Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later @@ -13,10 +13,13 @@ module Settings ( module Settings , module Settings.Cluster - , module Settings.Mime , module Settings.Cookies + , module Settings.Ldap , module Settings.Log , module Settings.Locale + , module Settings.Mime + , module Settings.OAuth2 + , module Settings.ResourcePool ) where import Import.NoModel @@ -44,7 +47,6 @@ import qualified Data.Scientific as Scientific import Data.Word (Word16) import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text import qualified Ldap.Client as Ldap @@ -56,11 +58,15 @@ import Network.Mail.Mime.Instances () import qualified Database.Memcached.Binary.Types as Memcached import Model + import Settings.Cluster -import Settings.Mime import Settings.Cookies +import Settings.Ldap import Settings.Log import Settings.Locale +import Settings.Mime +import Settings.OAuth2 +import Settings.ResourcePool import qualified System.FilePath as FilePath @@ -135,35 +141,8 @@ instance FromJSON PWHashConf where return PWHashConf{..} -data ResourcePoolConf = ResourcePoolConf - { poolStripes :: Int - , poolTimeout :: NominalDiffTime - , poolLimit :: Int - } deriving (Show) -data LdapConf = LdapConf - { ldapHost :: Ldap.Host, ldapPort :: Ldap.PortNumber - , ldapDn :: Ldap.Dn, ldapPassword :: Ldap.Password - , ldapBase :: Ldap.Dn - , ldapScope :: Ldap.Scope - , ldapTimeout :: NominalDiffTime - , ldapSearchTimeout :: Int32 - , ldapPool :: ResourcePoolConf - } deriving (Show) - -makeLenses_ ''LdapConf - --- TODO: use better types -data OAuthConf = OAuthConf - { oauthClientId :: Text - , oauthCientSecret :: Text - , oauthTenantId :: Text - , oauthScopes :: Set Text - } deriving (Show) - -makeLenses_ ''OAuthConf - -data UserDbConf = UserDbLdap LdapConf | UserDbOAuth OAuthConf +data UserDbConf = UserDbLdap LdapConf | UserDbOAuth2 OAuth2Conf deriving (Show) makePrisms ''UserDbConf @@ -292,7 +271,6 @@ deriveJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 2 } ''TokenBucketConf -deriveFromJSON defaultOptions ''Ldap.Scope deriveFromJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 2 } ''UserDefaultConf @@ -319,38 +297,6 @@ pathPieceJSONKey ''SettingBotMitigation makePrisms ''JobMode makeLenses_ ''JobMode - -deriveFromJSON defaultOptions - { fieldLabelModifier = intercalate "-" . map toLower . drop 1 . splitCamel - } ''ResourcePoolConf - -instance FromJSON LdapConf where - parseJSON = withObject "LdapConf" $ \o -> do - ldapTls <- o .:? "tls" - tlsSettings <- case ldapTls :: Maybe String of - Just spec - | spec == "insecure" -> return $ Just Ldap.insecureTlsSettings - | spec == "default" -> return $ Just Ldap.defaultTlsSettings - | spec == "none" -> return Nothing - | spec == "notls" -> return Nothing - | null spec -> return Nothing - Nothing -> return Nothing - _otherwise -> fail "Could not parse LDAP TLSSettings" - ldapHost <- maybe Ldap.Plain (flip Ldap.Tls) tlsSettings <$> o .:? "host" .!= "" - ldapPort <- (fromIntegral :: Int -> Ldap.PortNumber) <$> o .: "port" - ldapDn <- Ldap.Dn <$> o .:? "user" .!= "" - ldapPassword <- Ldap.Password . Text.encodeUtf8 <$> o .:? "pass" .!= "" - ldapBase <- Ldap.Dn <$> o .:? "baseDN" .!= "" - ldapScope <- o .: "scope" - ldapTimeout <- o .: "timeout" - ldapSearchTimeout <- o .: "search-timeout" - ldapPool <- o .: "pool" - return LdapConf{..} - -deriveFromJSON defaultOptions - { fieldLabelModifier = camelToPathPiece' 1 - } ''OAuthConf - deriveFromJSON defaultOptions { constructorTagModifier = camelToPathPiece' 2 , sumEncoding = TaggedObject "type" "config" @@ -657,7 +603,7 @@ instance FromJSON AppSettings where let nonEmptyHost (UserDbLdap LdapConf{..}) = case ldapHost of Ldap.Tls host _ -> not $ null host Ldap.Plain host -> not $ null host - nonEmptyHost (UserDbOAuth OAuthConf{..}) = not $ or [ null oauthTenantId, null oauthClientId, null oauthCientSecret ] + nonEmptyHost (UserDbOAuth2 OAuth2Conf{..}) = not $ or [ null oauth2TenantId, null oauth2ClientId, null oauth2ClientSecret ] appUserDbConf <- P.fromList . mapMaybe (assertM nonEmptyHost) <$> o .:? "user-db" .!= [] appLmsConf <- o .: "lms-direct" appAvsConf <- assertM (not . null . avsPass) <$> o .:? "avs" diff --git a/src/Settings/Ldap.hs b/src/Settings/Ldap.hs new file mode 100644 index 000000000..0a3bdea23 --- /dev/null +++ b/src/Settings/Ldap.hs @@ -0,0 +1,64 @@ +-- SPDX-FileCopyrightText: 2024 Sarah Vaupel +-- +-- SPDX-License-Identifier: AGPL-3.0-or-later + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Settings.Ldap + ( LdapConf(..) + , _ldapHost, _ldapDn, _ldapBase, _ldapScope, _ldapTimeout, _ldapSearchTimeout, _ldapPool + ) where + +import ClassyPrelude + +import Settings.ResourcePool +import Utils.Lens.TH + +import Control.Monad.Fail (fail) + +import Data.Aeson +import Data.Aeson.TH +import qualified Data.Text.Encoding as Text +import Data.Time.Clock + +import qualified Ldap.Client as Ldap + + +data LdapConf = LdapConf + { ldapHost :: Ldap.Host + , ldapPort :: Ldap.PortNumber + , ldapDn :: Ldap.Dn + , ldapPassword :: Ldap.Password + , ldapBase :: Ldap.Dn + , ldapScope :: Ldap.Scope + , ldapTimeout :: NominalDiffTime + , ldapSearchTimeout :: Int32 + , ldapPool :: ResourcePoolConf + } deriving (Show) + +makeLenses_ ''LdapConf + +deriveFromJSON defaultOptions ''Ldap.Scope + +instance FromJSON LdapConf where + parseJSON = withObject "LdapConf" $ \o -> do + ldapTls <- o .:? "tls" + tlsSettings <- case ldapTls :: Maybe String of + Just spec + | spec == "insecure" -> return $ Just Ldap.insecureTlsSettings + | spec == "default" -> return $ Just Ldap.defaultTlsSettings + | spec == "none" -> return Nothing + | spec == "notls" -> return Nothing + | null spec -> return Nothing + Nothing -> return Nothing + _otherwise -> fail "Could not parse LDAP TLSSettings" + ldapHost <- maybe Ldap.Plain (flip Ldap.Tls) tlsSettings <$> o .:? "host" .!= "" + ldapPort <- (fromIntegral :: Int -> Ldap.PortNumber) <$> o .: "port" + ldapDn <- Ldap.Dn <$> o .:? "user" .!= "" + ldapPassword <- Ldap.Password . Text.encodeUtf8 <$> o .:? "pass" .!= "" + ldapBase <- Ldap.Dn <$> o .:? "baseDN" .!= "" + ldapScope <- o .: "scope" + ldapTimeout <- o .: "timeout" + ldapSearchTimeout <- o .: "search-timeout" + ldapPool <- o .: "pool" + return LdapConf{..} diff --git a/src/Settings/OAuth2.hs b/src/Settings/OAuth2.hs new file mode 100644 index 000000000..53877b0dd --- /dev/null +++ b/src/Settings/OAuth2.hs @@ -0,0 +1,32 @@ +-- SPDX-FileCopyrightText: 2024 Sarah Vaupel +-- +-- SPDX-License-Identifier: AGPL-3.0-or-later + +module Settings.OAuth2 + ( OAuth2Conf(..) + , _oauth2ClientId, _oauth2ClientSecret, _oauth2TenantId, _oauth2Scopes + ) where + +import ClassyPrelude + +import Utils.Lens.TH +import Utils.PathPiece (camelToPathPiece') + +import Data.Aeson +import Data.Aeson.TH + + + +-- TODO: use better types +data OAuth2Conf = OAuth2Conf + { oauth2ClientId :: Text + , oauth2ClientSecret :: Text + , oauth2TenantId :: Text + , oauth2Scopes :: Set Text + } deriving (Show) + +makeLenses_ ''OAuth2Conf + +deriveFromJSON defaultOptions + { fieldLabelModifier = camelToPathPiece' 1 + } ''OAuth2Conf diff --git a/src/Settings/ResourcePool.hs b/src/Settings/ResourcePool.hs new file mode 100644 index 000000000..df3fa3156 --- /dev/null +++ b/src/Settings/ResourcePool.hs @@ -0,0 +1,30 @@ +-- SPDX-FileCopyrightText: 2024 Sarah Vaupel +-- +-- SPDX-License-Identifier: AGPL-3.0-or-later + +module Settings.ResourcePool + ( ResourcePoolConf(..) + , _poolStripes, _poolTimeout, _poolLimit + ) where + +import ClassyPrelude + +import Utils.Lens.TH +import Utils.PathPiece (camelToPathPiece') + +import Data.Aeson +import Data.Aeson.TH +import Data.Time.Clock + + +data ResourcePoolConf = ResourcePoolConf + { poolStripes :: Int + , poolTimeout :: NominalDiffTime + , poolLimit :: Int + } deriving (Show) + +makeLenses_ ''ResourcePoolConf + +deriveFromJSON defaultOptions + { fieldLabelModifier = camelToPathPiece' 1 + } ''ResourcePoolConf