Skip to content

Commit

Permalink
Make test *almost* green.
Browse files Browse the repository at this point in the history
  • Loading branch information
fisx committed Nov 21, 2024
1 parent a7923f8 commit b029d2f
Showing 1 changed file with 21 additions and 6 deletions.
27 changes: 21 additions & 6 deletions src/LdapScimBridge.hs
Original file line number Diff line number Diff line change
Expand Up @@ -168,6 +168,7 @@ instance Aeson.FromJSON BridgeConf

data MappingError
= MissingAttr Text
| MissingMandatoryValue Text
| WrongNumberOfAttrValues Text String Int
| CouldNotParseEmail Text String
deriving stock (Eq, Show)
Expand Down Expand Up @@ -297,23 +298,37 @@ type User = Scim.User ScimTag

type StoredUser = ScimClass.StoredUser ScimTag

-- | the 'undefined' is ok, the mapping is guaranteed to contain a filler for this, or the
-- mapping parser would have failed.
-- | Note that the `userName` field is mandatory in SCIM, but we gloss over this by setting it
-- to an empty Text here.
emptyScimUser :: User
emptyScimUser =
Scim.empty scimSchemas (error "undefined") Scim.NoUserExtra
Scim.empty scimSchemas "" Scim.NoUserExtra

scimSchemas :: [Scim.Schema]
scimSchemas = [Scim.User20]

data RequireUserName = Lenient | Strict
deriving stock (Eq, Show)

-- | Translate an ldap record into a scim record. If username is not provided in the ldap
-- record, behavior is defined by the first argument: if `Lenient`, just fill in an empty
-- Text; if `Strict`, throw an error.
ldapToScim ::
forall m.
(m ~ Either [(SearchEntry, MappingError)]) =>
RequireUserName ->
BridgeConf ->
SearchEntry ->
m (SearchEntry, User)
ldapToScim conf entry@(SearchEntry _ attrs) = (entry,) <$> Foldable.foldl' go (Right emptyScimUser) attrs
ldapToScim reqUserName conf entry@(SearchEntry _ attrs) = do
guardUserName
(entry,) <$> Foldable.foldl' go (Right emptyScimUser) attrs
where
guardUserName =
if reqUserName == Strict && Attr "userName" `notElem` (fst <$> toList attrs)
then Left [(entry, MissingMandatoryValue "userName")]
else Right ()

codec = case ldapCodec (ldapSource conf) of
Utf8 -> Text.decodeUtf8
Latin1 -> Text.decodeLatin1
Expand Down Expand Up @@ -366,7 +381,7 @@ updateScimPeer lgr conf = do
lgr Info "[post/put: started]"
let ldapKeepees = filter (not . isDeletee (ldapSource conf)) ldaps
scims :: [(SearchEntry, User)] <-
mapM (either (throwIO . ErrorCall . show) pure) (ldapToScim conf <$> ldapKeepees)
mapM (either (throwIO . ErrorCall . show) pure) (ldapToScim Strict conf <$> ldapKeepees)
lgr Debug $ "Pulled the following ldap users for post/put:\n" <> show (fst <$> scims)
lgr Debug . cs $ "Translated to scim:\n" <> Aeson.encodePretty (snd <$> scims)
updateScimPeerPostPut lgr clientEnv tok (snd <$> scims)
Expand All @@ -382,7 +397,7 @@ updateScimPeer lgr conf = do
pure mempty

scims :: [(SearchEntry, User)] <-
mapM (either (throwIO . ErrorCall . show) pure) (ldapToScim conf <$> (ldapDeleteesAttr <> ldapDeleteesDirectory))
mapM (either (throwIO . ErrorCall . show) pure) (ldapToScim Lenient conf <$> (ldapDeleteesAttr <> ldapDeleteesDirectory))
lgr Debug $ "Pulled the following ldap users for delete:\n" <> show (fst <$> scims)
lgr Debug . cs $ "Translated to scim:\n" <> Aeson.encodePretty (snd <$> scims)
updateScimPeerDelete lgr clientEnv tok (snd <$> scims)
Expand Down

0 comments on commit b029d2f

Please sign in to comment.