ldap-scim-bridge 0.9 → 0.10
raw patch · 6 files changed
+186/−94 lines, 6 filesdep ~basedep ~bytestringdep ~email-validate
Dependency ranges changed: base, bytestring, email-validate, hscim, ldap-client, network, servant, servant-client, servant-client-core, text, yaml
Files
- CHANGELOG.md +4/−0
- README.md +7/−0
- examples/wire-server/run.sh +3/−3
- ldap-scim-bridge.cabal +33/−33
- src/LdapScimBridge.hs +96/−48
- test/Spec.hs +43/−10
CHANGELOG.md view
@@ -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)
README.md view
@@ -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
examples/wire-server/run.sh view
@@ -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 "<EntityDescriptor xmlns:samlp=\"urn:oasis:names:tc:SAML:2.0:protocol\" xmlns:samla=\"urn:oasis:names:tc:SAML:2.0:assertion\" xmlns:samlm=\"urn:oasis:names:tc:SAML:2.0:metadata\" xmlns:ds=\"http://www.w3.org/2000/09/xmldsig#\" ID=\"_0c29ba62-a541-11e8-8042-873ef87bdcba\" entityID=\"https://issuer.net/_$(uuidgen)\" xmlns=\"urn:oasis:names:tc:SAML:2.0:metadata\"><IDPSSODescriptor protocolSupportEnumeration=\"urn:oasis:names:tc:SAML:2.0:protocol\"><KeyDescriptor use=\"signing\"><ds:KeyInfo><ds:X509Data><ds:X509Certificate>MIIBOTCBxKADAgECAg4TIFmNatMeqaAE8BWQBTANBgkqhkiG9w0BAQsFADAAMB4XDTIxMDkwMzEzMjUyMVoXDTQxMDgyOTEzMjUyMVowADB6MA0GCSqGSIb3DQEBAQUAA2kAMGYCYQDPAqTk/nq2B/J0WH2FtiRh6nB8BvOc6M7d4K2KV0kXrePjeRPh+cDDf9mYrpntnjBa2LGAc0S4gjUXdvnt1Fxg2YYXYJ+N7+jxV36jUng7cGz1tEOB5RIj28Mv8/eXnjUCAREwDQYJKoZIhvcNAQELBQADYQBaIWDz832gg5jZPIy5z0CV1rWbUQALy6SUodWMezbzVF86hycUvZqAzd5Pir8084Mk/6FQK2Hbbml2LaHS8JnZpYxlgNIRNNonzScAUFclDi4NNmcxPuB6ycu9kK/0l+A=</ds:X509Certificate></ds:X509Data></ds:KeyInfo></KeyDescriptor><SingleSignOnService Binding=\"urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST\" Location=\"https://requri.net/fb9e3c14-25eb-482a-8df3-c71e3e83110b\"/></IDPSSODescriptor></EntityDescriptor>" \+ -d "<EntityDescriptor xmlns:samlp=\"urn:oasis:names:tc:SAML:2.0:protocol\" xmlns:samla=\"urn:oasis:names:tc:SAML:2.0:assertion\" xmlns:samlm=\"urn:oasis:names:tc:SAML:2.0:metadata\" xmlns:ds=\"http://www.w3.org/2000/09/xmldsig#\" ID=\"_0c29ba62-a541-11e8-8042-873ef87bdcba\" entityID=\"https://issuer.net/_$(uuid)\" xmlns=\"urn:oasis:names:tc:SAML:2.0:metadata\"><IDPSSODescriptor protocolSupportEnumeration=\"urn:oasis:names:tc:SAML:2.0:protocol\"><KeyDescriptor use=\"signing\"><ds:KeyInfo><ds:X509Data><ds:X509Certificate>MIIBOTCBxKADAgECAg4TIFmNatMeqaAE8BWQBTANBgkqhkiG9w0BAQsFADAAMB4XDTIxMDkwMzEzMjUyMVoXDTQxMDgyOTEzMjUyMVowADB6MA0GCSqGSIb3DQEBAQUAA2kAMGYCYQDPAqTk/nq2B/J0WH2FtiRh6nB8BvOc6M7d4K2KV0kXrePjeRPh+cDDf9mYrpntnjBa2LGAc0S4gjUXdvnt1Fxg2YYXYJ+N7+jxV36jUng7cGz1tEOB5RIj28Mv8/eXnjUCAREwDQYJKoZIhvcNAQELBQADYQBaIWDz832gg5jZPIy5z0CV1rWbUQALy6SUodWMezbzVF86hycUvZqAzd5Pir8084Mk/6FQK2Hbbml2LaHS8JnZpYxlgNIRNNonzScAUFclDi4NNmcxPuB6ycu9kK/0l+A=</ds:X509Certificate></ds:X509Data></ds:KeyInfo></KeyDescriptor><SingleSignOnService Binding=\"urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST\" Location=\"https://requri.net/fb9e3c14-25eb-482a-8df3-c71e3e83110b\"/></IDPSSODescriptor></EntityDescriptor>" \ ${SPAR_URL}/identity-providers | jq .) if [ "$(echo "$WIRE_SAMLIDP" | jq .id)" == "null" ]; then echo "could not create idp: $WIRE_SAMLIDP"
ldap-scim-bridge.cabal view
@@ -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 <mf@zerobuzz.net>-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
src/LdapScimBridge.hs view
@@ -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
test/Spec.hs view
@@ -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 = [],