chore(model): replace auth-source model tables with AuthSourceIdent jsonified unique ids
This commit is contained in:
parent
a2e01e74af
commit
41b14f1ece
@ -2,41 +2,11 @@
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
-- TODO: AuthSourceAzure and AuthSourceLdap to be removed, just use config settings!
|
||||
|
||||
-- | AzureADv2 (Microsoft Graph) user authentication sources, parsed from application settings
|
||||
-- | Note: No host specification is needed since Azure authentication is always requested at https://graph.microsoft.com/ (Microsoft Graph API)
|
||||
AuthSourceAzure
|
||||
clientId UUID -- ^ Azure Client ID of this application
|
||||
clientSecret Text -- ^ Azure Client Secret of this application
|
||||
tenantId UUID -- ^ Azure Tenant ID of the Azure source
|
||||
scopes AzureScopes -- ^ Azure Scopes this application (client) is authorized for
|
||||
UniqueAuthSourceAzure clientId -- TODO rethink!
|
||||
Primary clientId -- TODO rethink!
|
||||
deriving Show Eq Ord Generic
|
||||
|
||||
-- | LDAP user authentication sources, parsed from application settings
|
||||
AuthSourceLdap
|
||||
host Text -- ^ LDAP host destination to connect to
|
||||
-- TODO: switch to url type
|
||||
port Word16 -- ^ Port of the LDAP service to connect to
|
||||
-- TODO: Maybe merge with host and make primary key?
|
||||
tls Bool -- ^ Whether to connect to the host via TLS
|
||||
user LdapDn -- ^ User used for queries
|
||||
pass LdapPass -- ^ Password used for queries
|
||||
base LdapDn -- ^ TODO documentation needed
|
||||
scope LdapScope -- ^ TODO documentation needed
|
||||
timeout NominalDiffTime -- ^ Query timeout
|
||||
searchTimeout Int32 -- ^ Search query timeout -- TODO: why not NominalDiffTime??
|
||||
UniqueAuthSourceLdap host port -- TODO rethink!
|
||||
deriving Show Eq Ord Generic
|
||||
|
||||
|
||||
-- TODO: define AuthenticationSource with json instances to store unique source identifiers per protocol
|
||||
-- | User authentication data fetched from external user sources
|
||||
ExternalAuth
|
||||
user UserId
|
||||
source AuthenticationSourceIdent -- Identifier of the external source in the config
|
||||
source AuthSourceIdent -- Identifier of the external source in the config
|
||||
data Value "default='{}'::jsonb" -- Raw user data from external source
|
||||
lastSync UTCTime -- When was the corresponding User entry last synced with this external source? -- TODO rethink
|
||||
UniqueExternalAuth user source -- At most one entry of this user per source
|
||||
|
||||
@ -42,16 +42,18 @@ import qualified Data.Text as Text
|
||||
import Data.Universe
|
||||
import Data.Universe.Instances.Reverse ()
|
||||
import Data.Universe.Instances.Reverse.MonoTraversable ()
|
||||
import Data.UUID (UUID)
|
||||
import Data.Word (Word16)
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import Database.Persist.Sql
|
||||
|
||||
import qualified Ldap.Client as Ldap
|
||||
import Ldap.Client.Instances ()
|
||||
|
||||
import Servant.Docs (ToSample(..), samples)
|
||||
|
||||
|
||||
----------------------------------
|
||||
----- Authentication Sources -----
|
||||
----------------------------------
|
||||
|
||||
type AzureScopes = Set Text
|
||||
|
||||
-- Note: Ldap.Host also stores TLS settings, which we will generate ad-hoc based on AuthSourceLdapTls field instead. We therefore use Text to store the hostname only
|
||||
@ -68,41 +70,31 @@ type AzureScopes = Set Text
|
||||
-- instance E.SqlString LdapPort
|
||||
-- makeLenses_ ''LdapPort
|
||||
|
||||
newtype LdapPass = LdapPass { ldapPass :: Ldap.Password }
|
||||
deriving (Eq, Ord, Read, Show, Generic, Data)
|
||||
deriving newtype (NFData, PersistField, PersistFieldSql)
|
||||
instance E.SqlString LdapPass
|
||||
makeLenses_ ''LdapPass
|
||||
|
||||
newtype LdapDn = LdapDn { ldapDn :: Ldap.Dn }
|
||||
deriving (Eq, Ord, Read, Show, Generic, Data)
|
||||
deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql)
|
||||
instance E.SqlString LdapDn
|
||||
makeLenses_ ''LdapDn
|
||||
|
||||
newtype LdapScope = LdapScope { ldapScope :: Ldap.Scope }
|
||||
deriving (Eq, Ord, Read, Show, Generic, Data)
|
||||
deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql)
|
||||
instance E.SqlString LdapScope
|
||||
makeLenses_ ''LdapScope
|
||||
|
||||
type UserEduPersonPrincipalName = Text
|
||||
|
||||
-- | Subset of the configuration settings of an authentication source that uniquely identify a given source
|
||||
-- | Used for uniquely storing ExternalAuth entries per user and source
|
||||
data AuthSourceIdent
|
||||
= AuthSourceIdAzure
|
||||
{ authSourceIdAzureClientId :: UUID
|
||||
}
|
||||
| AuthSourceIdLdap
|
||||
{ authSourceIdLdapHost :: Text -- See comment above for why we do not use Ldap.Host directly
|
||||
, authSourceIdLdapPort :: Word16 -- See comment above for why we do not use Ldap.PortNumber directly
|
||||
}
|
||||
deriving (Eq, Ord, Read, Show, Data, Generic)
|
||||
deriving anyclass (NFData)
|
||||
|
||||
-- | Supported protocols for external user sources used for authentication queries
|
||||
-- TODO: deprecated, delete
|
||||
data AuthenticationProtocol
|
||||
= AuthAzure -- ^ Azure ADv2 (OAuth2)
|
||||
| AuthLdap -- ^ LDAP
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Data, Generic)
|
||||
deriving anyclass (Universe, Finite, Hashable, NFData)
|
||||
deriveJSON defaultOptions
|
||||
{ fieldLabelModifier = camelToPathPiece' 3
|
||||
, constructorTagModifier = camelToPathPiece' 3
|
||||
, sumEncoding = UntaggedValue
|
||||
} ''AuthSourceIdent
|
||||
|
||||
nullaryPathPiece ''AuthenticationProtocol $ camelToPathPiece' 1
|
||||
pathPieceJSON ''AuthenticationProtocol
|
||||
derivePersistFieldJSON ''AuthSourceIdent
|
||||
|
||||
|
||||
-- TODO: delete once identification using model table is implemented
|
||||
type AuthenticationSourceIdent = Text
|
||||
makeLenses_ ''AuthSourceIdent
|
||||
makePrisms ''AuthSourceIdent
|
||||
|
||||
|
||||
-------------------
|
||||
@ -220,6 +212,7 @@ _ReducedActiveAuthTags = iso toReducedActiveAuthTags fromReducedActiveAuthTags
|
||||
-------------------
|
||||
----- PredDNF -----
|
||||
-------------------
|
||||
-- TODO: Use external PredDNF instead: https://github.com/savau/haskell-nf
|
||||
|
||||
data PredLiteral a = PLVariable { plVar :: a } | PLNegated { plVar :: a }
|
||||
deriving (Eq, Ord, Read, Show, Data, Generic)
|
||||
|
||||
Reference in New Issue
Block a user