diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,10 @@ `ldap-scim-bridge` uses [PVP][1]-compatible versioning. The changelog is available [on GitHub][2]. +## 0.10 + +- More helpful error messages on bad LDAP input records. + ## 0.9 - Map ldap attribute to SCIM roles (#26) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -73,6 +73,13 @@ ldap-scim-bridge /mnt/config.yaml ``` +## developers + +For running unit tests, try `cabal test`. + +Integration tests is a bit more involved, since we need ldap and +wire-server running. See `./examples/wire-server/run.sh`. + ## future work See https://github.com/wireapp/ldap-scim-bridge/issues diff --git a/examples/wire-server/run.sh b/examples/wire-server/run.sh --- a/examples/wire-server/run.sh +++ b/examples/wire-server/run.sh @@ -29,7 +29,7 @@ export SCIM_TOKEN_ID export SCIM_TOKEN_FULL export WIRE_SAMLIDP -export WIRE_SERVER_PATH="${WIRE_SERVER_PATH:=~/src/wire-server}" +export WIRE_SERVER_PATH="${WIRE_SERVER_PATH:=${HOME}/src/wire-server}" export SPAR_URL=http://localhost:8088 export BRIG_URL=http://localhost:8082 export GALLEY_URL=http://localhost:8085 @@ -69,7 +69,7 @@ WIRE_PASSWD=$(echo "$WIRE_USER" | sed 's/^\([^,]\+\),\([^,]\+\),\([^,]\+\)$/\3/') WIRE_TEAMID=$(curl -s -H'content-type: application/json' -H'Z-User: '"${WIRE_USERID}" "$BRIG_URL/self" | jq .team | xargs echo) - # create a saml idp (if we don't, users will not be created, but invitated, which would make the following more awkward to write down). + # create a saml idp (if we don't, users will not be created, but invited, which would make the following more awkward to write down). curl -s -X PUT \ --header "Z-User: $WIRE_USERID" \ --header 'Content-Type: application/json;charset=utf-8' \ @@ -78,7 +78,7 @@ WIRE_SAMLIDP=$(curl -X POST \ --header "Z-User: $WIRE_USERID" \ --header 'Content-Type: application/xml;charset=utf-8' \ - -d "MIIBOTCBxKADAgECAg4TIFmNatMeqaAE8BWQBTANBgkqhkiG9w0BAQsFADAAMB4XDTIxMDkwMzEzMjUyMVoXDTQxMDgyOTEzMjUyMVowADB6MA0GCSqGSIb3DQEBAQUAA2kAMGYCYQDPAqTk/nq2B/J0WH2FtiRh6nB8BvOc6M7d4K2KV0kXrePjeRPh+cDDf9mYrpntnjBa2LGAc0S4gjUXdvnt1Fxg2YYXYJ+N7+jxV36jUng7cGz1tEOB5RIj28Mv8/eXnjUCAREwDQYJKoZIhvcNAQELBQADYQBaIWDz832gg5jZPIy5z0CV1rWbUQALy6SUodWMezbzVF86hycUvZqAzd5Pir8084Mk/6FQK2Hbbml2LaHS8JnZpYxlgNIRNNonzScAUFclDi4NNmcxPuB6ycu9kK/0l+A=" \ + -d "MIIBOTCBxKADAgECAg4TIFmNatMeqaAE8BWQBTANBgkqhkiG9w0BAQsFADAAMB4XDTIxMDkwMzEzMjUyMVoXDTQxMDgyOTEzMjUyMVowADB6MA0GCSqGSIb3DQEBAQUAA2kAMGYCYQDPAqTk/nq2B/J0WH2FtiRh6nB8BvOc6M7d4K2KV0kXrePjeRPh+cDDf9mYrpntnjBa2LGAc0S4gjUXdvnt1Fxg2YYXYJ+N7+jxV36jUng7cGz1tEOB5RIj28Mv8/eXnjUCAREwDQYJKoZIhvcNAQELBQADYQBaIWDz832gg5jZPIy5z0CV1rWbUQALy6SUodWMezbzVF86hycUvZqAzd5Pir8084Mk/6FQK2Hbbml2LaHS8JnZpYxlgNIRNNonzScAUFclDi4NNmcxPuB6ycu9kK/0l+A=" \ ${SPAR_URL}/identity-providers | jq .) if [ "$(echo "$WIRE_SAMLIDP" | jq .id)" == "null" ]; then echo "could not create idp: $WIRE_SAMLIDP" diff --git a/ldap-scim-bridge.cabal b/ldap-scim-bridge.cabal --- a/ldap-scim-bridge.cabal +++ b/ldap-scim-bridge.cabal @@ -1,15 +1,15 @@ cabal-version: 2.4 name: ldap-scim-bridge -version: 0.9 +version: 0.10 synopsis: See README for synopsis description: See README for description homepage: https://github.com/wireapp/ldap-scim-bridge bug-reports: https://github.com/wireapp/ldap-scim-bridge/issues license: AGPL-3.0-or-later license-file: LICENSE -author: Matthias Fischmann -maintainer: Matthias Fischmann -copyright: (c) 2021 wire.com +author: wire.com +maintainer: backend@wire.com +copyright: (c) 2021 - 2024 wire.com category: System build-type: Simple extra-doc-files: @@ -22,7 +22,7 @@ examples/wire-server/run.sh examples/wire-server/runlog -tested-with: GHC ==8.8.3 +tested-with: GHC ==9.6.6 source-repository head type: git @@ -30,27 +30,27 @@ common common-options build-depends: - , aeson >=2.1.2 && <2.2 - , aeson-pretty >=0.8.10 && <0.9 - , base >=4.17.2 && <4.18 - , bytestring >=0.11.5 && <0.12 - , containers >=0.6.7 && <0.7 - , email-validate >=2.3.2 && <2.4 - , hscim >=0.4.0.2 && <0.5 - , http-client >=0.7.16 && <0.8 - , http-client-tls >=0.3.6 && <0.4 - , http-types >=0.12.4 && <0.13 - , ldap-client >=0.4.2 && <0.5 - , network >=3.1.4 && <3.2 - , relude >=1.2.1 && <1.3 - , servant >=0.19.1 && <0.20 - , servant-client >=0.19 && <0.20 - , servant-client-core >=0.19 && <0.20 - , string-conversions >=0.4.0 && <0.5 - , text >=2.0.2 && <2.1 - , tinylog >=0.15.0 && <0.16 - , unordered-containers >=0.2.20 && <0.3 - , yaml >=0.11.11 && <0.12 + , aeson >= 2.1.2 && < 2.2 + , aeson-pretty >= 0.8.10 && < 0.9 + , base >= 4.17 && < 4.21 + , bytestring >= 0.11.5 && < 0.12 + , containers >= 0.6.7 && < 0.7 + , email-validate >= 2.3.2 && < 2.4 + , hscim >= 0.4.0.6 && < 0.5 + , http-client >= 0.7.16 && < 0.8 + , http-client-tls >= 0.3.6 && < 0.4 + , http-types >= 0.12.4 && < 0.13 + , ldap-client >= 0.4.2 && < 0.5 + , network >= 3.2.6 && < 3.3 + , relude >= 1.2.1 && < 1.3 + , servant >= 0.19 && < 0.21 + , servant-client >= 0.19 && < 0.21 + , servant-client-core >= 0.19 && < 0.21 + , string-conversions >= 0.4.0 && < 0.5 + , text >= 2.0.2 && < 2.1 + , tinylog >= 0.15.0 && < 0.16 + , unordered-containers >= 0.2.20 && < 0.3 + , yaml >= 0.11.11 && < 0.12 mixins: base hiding (Prelude), @@ -60,7 +60,7 @@ -O2 -Wall -Wcompat -Widentities -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path -Wredundant-constraints - -fhide-source-paths -Wmissing-export-lists -Wpartial-fields + -fhide-source-paths -Wpartial-fields -Wmissing-deriving-strategies default-language: Haskell2010 @@ -123,16 +123,16 @@ type: exitcode-stdio-1.0 build-depends: , base - , bytestring >=0.11.5 && <0.12 - , email-validate >=2.3.2 && <2.4 - , hscim >=0.4.0.2 && <0.5 + , bytestring + , email-validate + , hscim , hspec - , ldap-client >=0.4.2 && <0.5 + , ldap-client , ldap-scim-bridge , QuickCheck , string-conversions - , text >=2.0.2 && <2.1 - , yaml >=0.11.11 && <0.12 + , text + , yaml hs-source-dirs: test default-language: Haskell2010 diff --git a/src/LdapScimBridge.hs b/src/LdapScimBridge.hs --- a/src/LdapScimBridge.hs +++ b/src/LdapScimBridge.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wno-orphans -Wno-missing-export-lists #-} module LdapScimBridge where @@ -14,6 +13,7 @@ import qualified Data.Map as Map import Data.String.Conversions (cs) import qualified Data.String.Conversions as SC +import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Yaml as Yaml import qualified GHC.Show @@ -84,7 +84,7 @@ fpassword :: String <- obj Aeson..: "password" fsearch :: LdapSearch <- obj Aeson..: "search" fcodec :: Text <- obj Aeson..: "codec" - fdeleteOnAttribute :: Maybe LdapFilterAttr <- obj Aeson..:? "deleteOnAttribute" -- TODO: this can go into 'fdeleteFromDirectory'. + fdeleteOnAttribute :: Maybe LdapFilterAttr <- obj Aeson..:? "deleteOnAttribute" fdeleteFromDirectory :: Maybe LdapSearch <- obj Aeson..:? "deleteFromDirectory" let vhost :: Host @@ -151,29 +151,49 @@ { ldapSource :: LdapConf, scimTarget :: ScimConf, mapping :: Mapping, - logLevel :: Level + logLevel :: PhantomParent Level } deriving stock (Show, Generic) -instance Aeson.FromJSON Level where - parseJSON "Trace" = pure Trace - parseJSON "Debug" = pure Debug - parseJSON "Info" = pure Info - parseJSON "Warn" = pure Warn - parseJSON "Error" = pure Error - parseJSON "Fatal" = pure Fatal - parseJSON bad = fail $ "unknown Level: " <> show bad +-- | Work around orphan instances. Might not be a phantom, but I like the name. :) +newtype PhantomParent a = PhantomParent {unPhantomParent :: a} + deriving stock (Eq, Ord, Bounded, Show, Generic) +instance Aeson.FromJSON (PhantomParent Level) where + parseJSON = + fmap PhantomParent . \case + "Trace" -> pure Trace + "Debug" -> pure Debug + "Info" -> pure Info + "Warn" -> pure Warn + "Error" -> pure Error + "Fatal" -> pure Fatal + bad -> fail $ "unknown Level: " <> show bad + instance Aeson.FromJSON BridgeConf data MappingError - = MissingAttr Text - | WrongNumberOfAttrValues Text String Int - | CouldNotParseEmail Text String - deriving stock (Eq, Show) + = MissingMandatoryValue Text Text + | WrongNumberOfAttrValues Text Text String Int + | CouldNotParseEmail Text Text Text String + deriving stock (Eq) +renderMappingError :: MappingError -> String +renderMappingError (MissingMandatoryValue ldapAttr scimAttr) = + "MissingMandatoryValue: " <> Text.unpack ldapAttr <> " -> " <> Text.unpack scimAttr +renderMappingError (WrongNumberOfAttrValues ldapAttr scimAttr expected actual) = + ("Wrong number of attribute values: " <> Text.unpack ldapAttr <> " -> " <> Text.unpack scimAttr) + <> (" (got <> " <> show actual <> "; expected " <> expected <> ")") +renderMappingError (CouldNotParseEmail ldapAttr scimAttr bad err) = + ("Could not parse email: " <> Text.unpack ldapAttr <> " -> " <> Text.unpack scimAttr) + <> (" (input: " <> show bad <> "; error: " <> err <> ")") + +renderSearchError :: [(SearchEntry, MappingError)] -> String +renderSearchError = show . fmap (\(s, m) -> (s, renderMappingError m)) + data FieldMapping = FieldMapping - { fieldMappingLabel :: Text, + { -- | This is the SCIM label (the LDAP label is in the key of the `Mapping`) + fieldMappingLabel :: Text, fieldMappingFun :: [Text] -> Either @@ -223,64 +243,65 @@ go mp (k, b) = Map.alter (Just . maybe [b] (b :)) k mp pure . Mapping . listToMap . catMaybes $ - [ (\fdisplayName -> (fdisplayName, mapDisplayName fdisplayName)) <$> mfdisplayName, - Just (fuserName, mapUserName fuserName), - Just (fexternalId, mapExternalId fexternalId), - (\femail -> (femail, mapEmail femail)) <$> mfemail, - (\frole -> (frole, mapRole frole)) <$> mfrole + [ (\fdisplayName -> (fdisplayName, mapDisplayName fdisplayName "displayName")) <$> mfdisplayName, + Just (fuserName, mapUserName fuserName "userName"), + Just (fexternalId, mapExternalId fexternalId "externalId"), + (\femail -> (femail, mapEmail femail "email")) <$> mfemail, + (\frole -> (frole, mapRole frole "roles")) <$> mfrole ] where -- The name that shows for this user in wire. - mapDisplayName :: Text -> FieldMapping - mapDisplayName ldapFieldName = FieldMapping "displayName" $ + mapDisplayName :: Text -> Text -> FieldMapping + mapDisplayName ldapFieldName scimFieldName = FieldMapping scimFieldName $ \case [val] -> Right $ \usr -> usr {Scim.displayName = Just val} - bad -> Left $ WrongNumberOfAttrValues ldapFieldName "1" (Prelude.length bad) + bad -> Left $ WrongNumberOfAttrValues ldapFieldName scimFieldName "1" (Prelude.length bad) - -- Really, not username, but handle. - mapUserName :: Text -> FieldMapping - mapUserName ldapFieldName = FieldMapping "userName" $ + -- Wire user handle (the one with the '@'). + mapUserName :: Text -> Text -> FieldMapping + mapUserName ldapFieldName scimFieldName = FieldMapping scimFieldName $ \case [val] -> Right $ \usr -> usr {Scim.userName = val} - bad -> Left $ WrongNumberOfAttrValues ldapFieldName "1" (Prelude.length bad) + bad -> Left $ WrongNumberOfAttrValues ldapFieldName scimFieldName "1" (Prelude.length bad) - mapExternalId :: Text -> FieldMapping - mapExternalId ldapFieldName = FieldMapping "externalId" $ + mapExternalId :: Text -> Text -> FieldMapping + mapExternalId ldapFieldName scimFieldName = FieldMapping scimFieldName $ \case [val] -> Right $ \usr -> usr {Scim.externalId = Just val} - bad -> Left $ WrongNumberOfAttrValues ldapFieldName "1" (Prelude.length bad) + bad -> Left $ WrongNumberOfAttrValues ldapFieldName scimFieldName "1" (Prelude.length bad) - mapEmail :: Text -> FieldMapping - mapEmail ldapFieldName = FieldMapping "emails" $ + mapEmail :: Text -> Text -> FieldMapping + mapEmail ldapFieldName scimFieldName = FieldMapping scimFieldName $ \case [] -> Right id [val] -> case Text.Email.Validate.validate (SC.cs val) of Right email -> Right $ \usr -> usr { Scim.emails = - [Scim.Email Nothing (Scim.EmailAddress2 email) Nothing] + [Scim.Email Nothing (Scim.EmailAddress email) Nothing] } - Left err -> Left $ CouldNotParseEmail val err + Left err -> Left $ CouldNotParseEmail ldapFieldName scimFieldName val err bad -> Left $ WrongNumberOfAttrValues ldapFieldName + scimFieldName "<=1 (with more than one email, which one should be primary?)" (Prelude.length bad) - mapRole :: Text -> FieldMapping - mapRole ldapFieldName = FieldMapping "roles" $ + mapRole :: Text -> Text -> FieldMapping + mapRole ldapFieldName scimFieldName = FieldMapping scimFieldName $ \case [] -> Right id [val] -> Right $ \usr -> usr {Scim.roles = [val]} - bad -> Left $ WrongNumberOfAttrValues ldapFieldName "1" (Prelude.length bad) + bad -> Left $ WrongNumberOfAttrValues ldapFieldName scimFieldName "1" (Prelude.length bad) type LdapResult a = IO (Either LdapError a) -ldapObjectClassFilter :: Text -> Filter -- TODO: inline? +ldapObjectClassFilter :: Text -> Filter ldapObjectClassFilter = (Attr "objectClass" :=) . cs -ldapFilterAttrToFilter :: LdapFilterAttr -> Filter -- TODO: inline? replace LdapFilterAttr with `Attr` and `:=`? +ldapFilterAttrToFilter :: LdapFilterAttr -> Filter ldapFilterAttrToFilter (LdapFilterAttr key val) = Attr key := cs val listLdapUsers :: LdapConf -> LdapSearch -> LdapResult [SearchEntry] @@ -297,23 +318,50 @@ 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. See 'RequireUserName', 'ldapToScim' if you wonder whether this is a +-- good idea. 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)] => + (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 = do + let raw :: [(Text, [FieldMapping])] + raw = Map.assocs . fromMapping . mapping $ conf + + fltr :: [(Text, [FieldMapping])] -> [(Text, [FieldMapping])] + fltr = filter (\(_, fm) -> (fieldMappingLabel <$> fm) == ["userName"]) + + userNameInLdap = case fltr raw of + [(ldapName, _)] -> ldapName + bad -> + -- `userName` is a mandatory field, the `Mapping` parser guarantees that it's always present. + error $ "impossible: " <> show bad + + if reqUserName == Strict && Attr userNameInLdap `notElem` (fst <$> toList attrs) + then Left [(entry, MissingMandatoryValue userNameInLdap "userName")] + else Right () + codec = case ldapCodec (ldapSource conf) of Utf8 -> Text.decodeUtf8 Latin1 -> Text.decodeLatin1 @@ -366,7 +414,7 @@ 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 . renderSearchError) 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) @@ -382,7 +430,7 @@ pure mempty scims :: [(SearchEntry, User)] <- - mapM (either (throwIO . ErrorCall . show) pure) (ldapToScim conf <$> (ldapDeleteesAttr <> ldapDeleteesDirectory)) + mapM (either (throwIO . ErrorCall . renderSearchError) 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) @@ -506,7 +554,7 @@ main :: IO () main = do myconf :: BridgeConf <- parseCli - lgr :: Logger <- mkLogger (logLevel myconf) + lgr :: Logger <- mkLogger (unPhantomParent $ logLevel myconf) lgr Debug $ show (mapping myconf) updateScimPeer lgr myconf `catch` logErrors lgr where diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,6 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} +import Data.Bifunctor (first) import Data.ByteString (ByteString) +import Data.Function ((&)) +import Data.Maybe (maybeToList) import Data.String.Conversions (cs) import Data.Text import qualified Data.Yaml as Yaml @@ -12,8 +15,6 @@ import Web.Scim.Schema.Schema as Scim import Web.Scim.Schema.User as Scim import Web.Scim.Schema.User.Email as Scim -import Data.Function ((&)) -import Data.Maybe (maybeToList) main :: IO () main = hspec $ do @@ -29,10 +30,10 @@ & addAttr "uidNumber" userName & addAttr "email" email - let expectedScimUser = mkScimUser displayName userName externalId email Nothing + let expectedScimUser = mkExpectedScimUser displayName userName externalId email Nothing conf <- Yaml.decodeThrow confYaml - let Right (actualSearchEntry, actualScimUser) = ldapToScim conf searchEntry + let Right (actualSearchEntry, actualScimUser) = ldapToScim Lenient conf searchEntry actualSearchEntry `shouldBe` searchEntry actualScimUser `shouldBe` expectedScimUser @@ -49,21 +50,53 @@ & addAttr "email" email & addAttr "employeeType" role - let expectedScimUser = mkScimUser displayName userName externalId email (Just role) + let expectedScimUser = mkExpectedScimUser displayName userName externalId email (Just role) conf <- Yaml.decodeThrow confYaml - let Right (actualSearchEntry, actualScimUser) = ldapToScim conf searchEntry + let Right (actualSearchEntry, actualScimUser) = ldapToScim Lenient conf searchEntry actualSearchEntry `shouldBe` searchEntry actualScimUser `shouldBe` expectedScimUser + it "helpful error message if scim userName (wire handle) field is missing" $ do + let displayName = "John Doe" + let userName = "jdoe" + let externalId = "jdoe@nodomain" + let email = "jdoe@nodomain" + let searchEntry = + searchEntryEmpty + & addAttr "displayName" displayName + & addAttr "email" email + + conf <- Yaml.decodeThrow confYaml + (first renderSearchError $ ldapToScim Strict conf searchEntry) + `shouldBe` Left (renderSearchError [(searchEntry, MissingMandatoryValue "uidNumber" "userName")]) + + it "helpful error message if scim userName (wire handle) field occurs twice" $ do + let displayName = "John Doe" + let userName = "jdoe" + let externalId = "jdoe@nodomain" + let email = "jdoe@nodomain" + let searchEntry = + searchEntryEmpty + & addAttr "displayName" displayName + & addAttrs "uidNumber" ["1", "2"] + & addAttr "email" email + + conf <- Yaml.decodeThrow confYaml + (first renderSearchError $ ldapToScim Strict conf searchEntry) + `shouldBe` Left (renderSearchError [(searchEntry, WrongNumberOfAttrValues "uidNumber" "userName" "1" 2)]) + searchEntryEmpty :: SearchEntry searchEntryEmpty = SearchEntry (Dn "") [] addAttr :: Text -> Text -> SearchEntry -> SearchEntry -addAttr key value (SearchEntry dn attrs) = SearchEntry dn ((Attr key, [cs value]) : attrs) +addAttr key value = addAttrs key [value] -mkScimUser :: Text -> Text -> Text -> Text -> Maybe Text -> Scim.User ScimTag -mkScimUser displayName userName externalId email mRole = +addAttrs :: Text -> [Text] -> SearchEntry -> SearchEntry +addAttrs key values (SearchEntry dn attrs) = SearchEntry dn ((Attr key, cs <$> values) : attrs) + +mkExpectedScimUser :: Text -> Text -> Text -> Text -> Maybe Text -> Scim.User ScimTag +mkExpectedScimUser displayName userName externalId email mRole = Scim.User { schemas = [User20], userName = userName, @@ -78,7 +111,7 @@ locale = Nothing, active = Nothing, password = Nothing, - emails = [Email {typ = Nothing, Scim.value = EmailAddress2 {unEmailAddress = unsafeEmailAddress (cs local) (cs domain)}, primary = Nothing}], + emails = [Email {typ = Nothing, Scim.value = EmailAddress {unEmailAddress = unsafeEmailAddress (cs local) (cs domain)}, primary = Nothing}], phoneNumbers = [], ims = [], photos = [],