refactor(settings): move ResourcePool, Ldap and OAuth2 settings to separate modules

src/Settings.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>, Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Steffen Jost <jost@tcs.ifi.lmu.de>
 --
 -- 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
+data UserDbConf = UserDbLdap LdapConf | UserDbOAuth2 OAuth2Conf
-  { 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
   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"

src/Settings/Ldap.hs

@@ -0,0 +1,64 @@
+-- SPDX-FileCopyrightText: 2024 Sarah Vaupel <sarah.vaupel@uniworx.de>
+--
+-- 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{..}

src/Settings/OAuth2.hs

@@ -0,0 +1,32 @@
+-- SPDX-FileCopyrightText: 2024 Sarah Vaupel <sarah.vaupel@uniworx.de>
+--
+-- 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

src/Settings/ResourcePool.hs

@@ -0,0 +1,30 @@
+-- SPDX-FileCopyrightText: 2024 Sarah Vaupel <sarah.vaupel@uniworx.de>
+--
+-- 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