This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Settings/Ldap.hs

64 lines
2.1 KiB
Haskell

-- SPDX-FileCopyrightText: 2024 Sarah Vaupel <sarah.vaupel@uniworx.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
module Settings.Ldap
( LdapConf(..)
, _ldapConfHost, _ldapConfPort, _ldapConfSourceId, _ldapConfDn, _ldapConfPassword, _ldapConfBase, _ldapConfScope, _ldapConfTimeout, _ldapConfSearchTimeout
) where
import ClassyPrelude
import Utils.Lens.TH
import Control.Monad.Fail (fail)
import Data.Aeson
import qualified Data.Text.Encoding as Text
import Data.Time.Clock
import qualified Ldap.Client as Ldap
import Ldap.Client.Instances ()
data LdapConf = LdapConf
{ ldapConfHost :: Ldap.Host
, ldapConfPort :: Ldap.PortNumber
, ldapConfSourceId :: Text
-- ^ Some unique identifier for this LDAP instance, e.g. hostname or hostname:port
, ldapConfDn :: Ldap.Dn
, ldapConfPassword :: Ldap.Password
, ldapConfBase :: Ldap.Dn
, ldapConfScope :: Ldap.Scope
, ldapConfTimeout :: NominalDiffTime
, ldapConfSearchTimeout :: Int32
} deriving (Show)
makeLenses_ ''LdapConf
instance FromJSON LdapConf where
parseJSON = withObject "LdapConf" $ \o -> do
ldapConfTls <- o .:? "tls"
tlsSettings <- case ldapConfTls :: 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"
hostname :: Text <- o .: "host"
port :: Int <- o .: "port"
let
ldapConfHost = maybe Ldap.Plain (flip Ldap.Tls) tlsSettings $ show hostname
ldapConfPort = fromIntegral port
ldapConfSourceId <- o .:? "source-id" .!= hostname
ldapConfDn <- Ldap.Dn <$> o .:? "user" .!= ""
ldapConfPassword <- Ldap.Password . Text.encodeUtf8 <$> o .:? "pass" .!= ""
ldapConfBase <- Ldap.Dn <$> o .:? "baseDN" .!= ""
ldapConfScope <- o .: "scope"
ldapConfTimeout <- o .: "timeout"
ldapConfSearchTimeout <- o .: "search-timeout"
return LdapConf{..}