ldap-scim-bridge 0.8 → 0.9
raw patch · 6 files changed
+302/−143 lines, 6 filesdep +QuickCheckdep +hspecdep ~aesondep ~aeson-prettydep ~base
Dependencies added: QuickCheck, hspec
Dependency ranges changed: aeson, aeson-pretty, base, bytestring, containers, email-validate, hscim, http-client, http-client-tls, http-types, ldap-client, network, relude, servant, servant-client, servant-client-core, string-conversions, text, tinylog, unordered-containers, yaml
Files
- CHANGELOG.md +5/−0
- examples/wire-server/conf1.yaml +2/−1
- examples/wire-server/run.sh +25/−22
- ldap-scim-bridge.cabal +127/−110
- src/LdapScimBridge.hs +19/−10
- test/Spec.hs +124/−0
CHANGELOG.md view
@@ -3,6 +3,11 @@ `ldap-scim-bridge` uses [PVP][1]-compatible versioning. The changelog is available [on GitHub][2]. +## 0.9++- Map ldap attribute to SCIM roles (#26)+- Bump dependencies (#25)+ ## 0.8 - Fix repo home url in cabal file.
examples/wire-server/conf1.yaml view
@@ -16,8 +16,9 @@ host: "localhost" port: 8088 path: "/scim/v2"- token: "Bearer cznOVEqojRi/bKc6v1iyQ2eGPjp62pPBraOx4eUSsls="+ token: "Bearer OWAWkt1fBGawKWV50+Zh/Uqitmhj1JC5WlWlltYMIcg=" mapping: userName: "uidNumber" externalId: "email" email: "email"+ roles: "employeeType"
examples/wire-server/run.sh view
@@ -28,11 +28,13 @@ export SCIM_TOKEN export SCIM_TOKEN_ID export SCIM_TOKEN_FULL-export WIRE_SERVER_PATH=~/src/wire-server+export WIRE_SAMLIDP+export WIRE_SERVER_PATH="${WIRE_SERVER_PATH:=~/src/wire-server}" export SPAR_URL=http://localhost:8088-export BRIG_URL=http://localhost:8088+export BRIG_URL=http://localhost:8082 export GALLEY_URL=http://localhost:8085 +# FUTUREWORK: install ldap with nix (https://nixos.wiki/wiki/OpenLDAP) or docker function install() { sudo apt-get install ldapscripts ldap-utils slapd }@@ -62,23 +64,23 @@ function scaffolding_spar() { if ( curl -s $BRIG_URL/i/status ); then- WIRE_USER=$(${WIRE_SERVER_PATH}/deploy/services-demo/create_test_team_admins.sh -c)- WIRE_USERID=$(echo $WIRE_USER | sed 's/^\([^,]\+\),\([^,]\+\),\([^,]\+\)$/\1/')- WIRE_PASSWD=$(echo $WIRE_USER | sed 's/^\([^,]\+\),\([^,]\+\),\([^,]\+\)$/\3/')- WIRE_TEAMID=$(curl -s -H'content-type: application/json' -H'Z-User: '"${WIRE_USERID}" http://localhost:8082/self | jq .team | xargs echo)+ WIRE_USER=$("${WIRE_SERVER_PATH}"/hack/bin/create_test_team_admins.sh -c)+ WIRE_USERID=$(echo "$WIRE_USER" | sed 's/^\([^,]\+\),\([^,]\+\),\([^,]\+\)$/\1/')+ 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). curl -s -X PUT \ --header "Z-User: $WIRE_USERID" \ --header 'Content-Type: application/json;charset=utf-8' \ -d '{"status": "enabled"}' \- ${GALLEY_URL}/i/teams/$WIRE_TEAMID/features/sso >/dev/null- export WIRE_SAMLIDP=$(curl -X POST \+ ${GALLEY_URL}/i/teams/"$WIRE_TEAMID"/features/sso >/dev/null+ 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/_"`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>" \+ -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>" \ ${SPAR_URL}/identity-providers | jq .)- if [ "$(echo $WIRE_SAMLIDP | jq .id)" == "null" ]; then+ if [ "$(echo "$WIRE_SAMLIDP" | jq .id)" == "null" ]; then echo "could not create idp: $WIRE_SAMLIDP" false fi@@ -87,24 +89,25 @@ SCIM_TOKEN_FULL=$(curl -X POST \ --header "Z-User: $WIRE_USERID" \ --header 'Content-Type: application/json;charset=utf-8' \- -d '{ "description": "test '"`date`"'", "password": "'"$WIRE_PASSWD"'" }' \+ -d '{ "description": "test '"$(date)"'", "password": "'"$WIRE_PASSWD"'" }' \ ${SPAR_URL}/scim/auth-tokens)- SCIM_TOKEN_ID=$(echo $SCIM_TOKEN_FULL | jq -r .info.id)- SCIM_TOKEN=$(echo $SCIM_TOKEN_FULL | jq -r .token)- ESCAPED_SCIM_TOKEN=$(echo $SCIM_TOKEN | sed 's/\+/\\\+/g;s_/_\\/_g;s/\=/\\=/g')+ SCIM_TOKEN_ID=$(echo "$SCIM_TOKEN_FULL" | jq -r .info.id)+ SCIM_TOKEN=$(echo "$SCIM_TOKEN_FULL" | jq -r .token)+ ESCAPED_SCIM_TOKEN=$(echo "$SCIM_TOKEN" | sed 's/\+/\\\+/g;s_/_\\/_g;s/\=/\\=/g') sed -i 's/^ token: \"Bearer .*$/ token: \"Bearer '"${ESCAPED_SCIM_TOKEN}"'"/' $BRIDGE_CONF1 sed -i 's/^ token: \"Bearer .*$/ token: \"Bearer '"${ESCAPED_SCIM_TOKEN}"'"/' $BRIDGE_CONF2 else # no wire-server running?- echo "${WIRE_SERVER_PATH}/deploy/dockerephemeral/run.sh"- echo "${WIRE_SERVER_PATH}/services/start-services-only.sh"+ echo "start wire service by going to the wire-server directory and running:"+ echo "./deploy/dockerephemeral/run.sh"+ echo "make cr" false fi } function assert_num_members() { sleep 2 # mitigate race conditions (increase the time if this function fails)- if [ "$(curl -s -H'content-type: application/json' -H'Z-User: '"${WIRE_USERID}" http://localhost:8085/teams/${WIRE_TEAMID}/members | jq '.members|length')" != "$1" ]; then+ if [ "$(curl -s -H'content-type: application/json' -H'Z-User: '"${WIRE_USERID}" http://localhost:8085/teams/"${WIRE_TEAMID}"/members | jq '.members|length')" != "$1" ]; then echo "$2" false fi@@ -116,16 +119,16 @@ clear scaffolding_spar-echo WIRE_USERID: $WIRE_USERID-echo WIRE_TEAMID: $WIRE_TEAMID-echo SCIM_TOKEN: $SCIM_TOKEN+echo WIRE_USERID: "$WIRE_USERID"+echo WIRE_TEAMID: "$WIRE_TEAMID"+echo SCIM_TOKEN: "$SCIM_TOKEN" scaffolding1 sudo slapcat-cabal run ldap-scim-bridge $BRIDGE_CONF1+cabal run ldap-scim-bridge "$BRIDGE_CONF1" assert_num_members 2 "user could not be created!" scaffolding2 sudo slapcat-cabal run ldap-scim-bridge $BRIDGE_CONF2+cabal run ldap-scim-bridge "$BRIDGE_CONF2" assert_num_members 1 "user could not be deleted!"
ldap-scim-bridge.cabal view
@@ -1,121 +1,138 @@-cabal-version: 2.4-name: ldap-scim-bridge-version: 0.8-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-category: System-build-type: Simple-extra-doc-files: README.md- CHANGELOG.md-extra-source-files: examples/wire-server/run.sh- examples/wire-server/conf1.yaml- examples/wire-server/conf2.yaml- examples/wire-server/runlog-tested-with: GHC == 8.8.3+cabal-version: 2.4+name: ldap-scim-bridge+version: 0.9+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+category: System+build-type: Simple+extra-doc-files:+ CHANGELOG.md+ README.md +extra-source-files:+ examples/wire-server/conf1.yaml+ examples/wire-server/conf2.yaml+ examples/wire-server/run.sh+ examples/wire-server/runlog++tested-with: GHC ==8.8.3+ source-repository head- type: git- location: https://github.com/wireapp/ldap-scim-bridge.git+ type: git+ location: https://github.com/wireapp/ldap-scim-bridge.git common common-options- build-depends: base >=4.13 && <4.15- , relude- , hscim >=0.3.6 && <0.4- , ldap-client >=0.4.1 && <0.5- , network >=3.1.1.1 && <3.2- , text >=1.2.4.1 && <1.3- , yaml >=0.11.5.0 && <0.12- , aeson >=1.4.7.1 && <1.5- , aeson-pretty >=0.8.8 && <0.9- , containers >=0.6.2.1 && <0.7- , bytestring >=0.10.12 && <0.11- , email-validate >=2.3.2.13 && <2.4- , string-conversions >=0.4.0.1 && <0.5- , servant-client >=0.18.3 && <0.19- , unordered-containers >= 0.2.14.0 && <0.3- , servant-client-core >=0.18.3 && <0.19- , servant >=0.18.3 && <0.19- , http-types >=0.12.3 && <0.13- , string-conversions >=0.4.0.1 && <0.5- , http-client >=0.7.8 && <0.8- , http-client-tls >=0.3.5 && <0.4- , tinylog >=0.15 && <0.16+ 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 - mixins: base hiding (Prelude)- , relude (Relude as Prelude)+ mixins:+ base hiding (Prelude),+ relude (Relude as Prelude) - ghc-options: -Wall- -Wcompat- -Widentities- -Wincomplete-uni-patterns- -Wincomplete-record-updates- if impl(ghc >= 8.0)- ghc-options: -Wredundant-constraints- if impl(ghc >= 8.2)- ghc-options: -fhide-source-paths- if impl(ghc >= 8.4)- ghc-options: -Wmissing-export-lists- -Wpartial-fields- if impl(ghc >= 8.8)- ghc-options: -Wmissing-deriving-strategies+ ghc-options:+ -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+ -Wmissing-deriving-strategies - default-language: Haskell2010- default-extensions: AllowAmbiguousTypes- BangPatterns- ConstraintKinds- DataKinds- DefaultSignatures- DeriveFunctor- DeriveGeneric- DeriveLift- DeriveTraversable- DerivingStrategies- EmptyCase- FlexibleContexts- FlexibleInstances- FunctionalDependencies- GADTs- InstanceSigs- KindSignatures- LambdaCase- MultiParamTypeClasses- MultiWayIf- NamedFieldPuns- OverloadedStrings- PackageImports- PatternSynonyms- PolyKinds- QuasiQuotes- RankNTypes- RecordWildCards- ScopedTypeVariables- StandaloneDeriving- TemplateHaskell- TupleSections- TypeApplications- TypeFamilies- TypeFamilyDependencies- TypeOperators- UndecidableInstances- ViewPatterns+ default-language: Haskell2010+ default-extensions:+ AllowAmbiguousTypes+ BangPatterns+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveFunctor+ DeriveGeneric+ DeriveLift+ DeriveTraversable+ DerivingStrategies+ DerivingVia+ EmptyCase+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ InstanceSigs+ KindSignatures+ LambdaCase+ MultiParamTypeClasses+ MultiWayIf+ NamedFieldPuns+ NoImplicitPrelude+ OverloadedStrings+ PackageImports+ PatternSynonyms+ PolyKinds+ QuasiQuotes+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ TemplateHaskell+ TupleSections+ TypeApplications+ TypeFamilies+ TypeFamilyDependencies+ TypeOperators+ UndecidableInstances+ ViewPatterns library- import: common-options- hs-source-dirs: src- exposed-modules: LdapScimBridge+ import: common-options+ hs-source-dirs: src+ exposed-modules: LdapScimBridge executable ldap-scim-bridge- import: common-options- hs-source-dirs: app- main-is: Main.hs- build-depends: ldap-scim-bridge- ghc-options: -threaded- -rtsopts- -with-rtsopts=-N+ import: common-options+ hs-source-dirs: app+ main-is: Main.hs+ build-depends: ldap-scim-bridge+ ghc-options: -threaded -rtsopts -with-rtsopts=-N++test-suite ldap-scim-bridge-test+ main-is: Spec.hs+ 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+ , hspec+ , ldap-client >=0.4.2 && <0.5+ , ldap-scim-bridge+ , QuickCheck+ , string-conversions+ , text >=2.0.2 && <2.1+ , yaml >=0.11.11 && <0.12++ hs-source-dirs: test+ default-language: Haskell2010
src/LdapScimBridge.hs view
@@ -6,9 +6,10 @@ import Control.Exception (ErrorCall (ErrorCall), catch, throwIO) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Encode.Pretty as Aeson+import qualified Data.Aeson.Key as K+import qualified Data.Aeson.KeyMap as KM import qualified Data.ByteString.Char8 as ByteString import qualified Data.Foldable as Foldable-import qualified Data.HashMap.Lazy as HM import qualified Data.List import qualified Data.Map as Map import Data.String.Conversions (cs)@@ -37,6 +38,7 @@ import qualified Web.Scim.Schema.Schema as Scim import qualified Web.Scim.Schema.User as Scim import qualified Web.Scim.Schema.User.Email as Scim+import Prelude data LdapConf = LdapConf { -- | eg. @Ldap.Tls (host conf) Ldap.defaultTlsSettings@@@ -86,9 +88,7 @@ fdeleteFromDirectory :: Maybe LdapSearch <- obj Aeson..:? "deleteFromDirectory" let vhost :: Host- vhost = case ftls of- True -> Ldap.Tls fhost Ldap.defaultTlsSettings- False -> Ldap.Plain fhost+ vhost = if ftls then Ldap.Tls fhost Ldap.defaultTlsSettings else Ldap.Plain fhost vport :: PortNumber vport = fromIntegral fport@@ -122,11 +122,11 @@ fobjectClass :: Text <- obj Aeson..: "objectClass" extra :: [LdapFilterAttr] <- do- let go :: (Text, Yaml.Value) -> Yaml.Parser LdapFilterAttr+ let go :: (KM.Key, Yaml.Value) -> Yaml.Parser LdapFilterAttr go (key, val) = do str <- Aeson.withText "val" pure val- pure $ LdapFilterAttr key str- go `mapM` HM.toList (HM.filterWithKey (\k _ -> k `notElem` ["base", "objectClass"]) obj)+ pure $ LdapFilterAttr (K.toText key) str+ go `mapM` KM.toList (KM.filterWithKey (\k _ -> k `notElem` ["base", "objectClass"]) obj) pure $ LdapSearch (Dn fbase) fobjectClass extra data ScimConf = ScimConf@@ -215,6 +215,7 @@ fuserName <- obj Aeson..: "userName" fexternalId <- obj Aeson..: "externalId" mfemail <- obj Aeson..:? "email"+ mfrole <- obj Aeson..:? "roles" let listToMap :: [(Text, a)] -> Map Text [a] listToMap = foldl' go mempty@@ -225,7 +226,8 @@ [ (\fdisplayName -> (fdisplayName, mapDisplayName fdisplayName)) <$> mfdisplayName, Just (fuserName, mapUserName fuserName), Just (fexternalId, mapExternalId fexternalId),- (\femail -> (femail, mapEmail femail)) <$> mfemail+ (\femail -> (femail, mapEmail femail)) <$> mfemail,+ (\frole -> (frole, mapRole frole)) <$> mfrole ] where -- The name that shows for this user in wire.@@ -266,13 +268,20 @@ "<=1 (with more than one email, which one should be primary?)" (Prelude.length bad) + mapRole :: Text -> FieldMapping+ mapRole ldapFieldName = FieldMapping "roles" $+ \case+ [] -> Right id+ [val] -> Right $ \usr -> usr {Scim.roles = [val]}+ bad -> Left $ WrongNumberOfAttrValues ldapFieldName "1" (Prelude.length bad)+ type LdapResult a = IO (Either LdapError a) ldapObjectClassFilter :: Text -> Filter -- TODO: inline? ldapObjectClassFilter = (Attr "objectClass" :=) . cs ldapFilterAttrToFilter :: LdapFilterAttr -> Filter -- TODO: inline? replace LdapFilterAttr with `Attr` and `:=`?-ldapFilterAttrToFilter (LdapFilterAttr key val) = Attr key := (cs val)+ldapFilterAttrToFilter (LdapFilterAttr key val) = Attr key := cs val listLdapUsers :: LdapConf -> LdapSearch -> LdapResult [SearchEntry] listLdapUsers conf searchConf = Ldap.with (ldapHost conf) (ldapPort conf) $ \l -> do@@ -366,7 +375,7 @@ -- delete lgr Info "[delete: started]" let ldapDeleteesAttr = filter (isDeletee (ldapSource conf)) ldaps- ldapDeleteesDirectory :: [SearchEntry] <- case (ldapDeleteFromDirectory (ldapSource conf)) of+ ldapDeleteesDirectory :: [SearchEntry] <- case ldapDeleteFromDirectory (ldapSource conf) of Just (searchConf :: LdapSearch) -> either (throwIO . ErrorCall . show) pure =<< listLdapUsers (ldapSource conf) searchConf Nothing ->
+ test/Spec.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE OverloadedStrings #-}++import Data.ByteString (ByteString)+import Data.String.Conversions (cs)+import Data.Text+import qualified Data.Yaml as Yaml+import Ldap.Client as Ldap+import LdapScimBridge hiding (main)+import Test.Hspec+import Text.Email.Parser (unsafeEmailAddress)+import Web.Scim.Schema.Meta as Scim+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+ describe "LdapScimBridge" $ do+ it "map displayName userName externalId and email" $ do+ let displayName = "John Doe"+ let userName = "jdoe"+ let externalId = "jdoe@nodomain"+ let email = "jdoe@nodomain"+ let searchEntry =+ searchEntryEmpty+ & addAttr "displayName" displayName+ & addAttr "uidNumber" userName+ & addAttr "email" email++ let expectedScimUser = mkScimUser displayName userName externalId email Nothing++ conf <- Yaml.decodeThrow confYaml+ let Right (actualSearchEntry, actualScimUser) = ldapToScim conf searchEntry+ actualSearchEntry `shouldBe` searchEntry+ actualScimUser `shouldBe` expectedScimUser++ it "map role" $ do+ let displayName = "John Doe"+ let userName = "jdoe"+ let externalId = "jdoe@nodomain"+ let email = "jdoe@nodomain"+ let role = "partner"+ let searchEntry =+ searchEntryEmpty+ & addAttr "displayName" displayName+ & addAttr "uidNumber" userName+ & addAttr "email" email+ & addAttr "employeeType" role++ let expectedScimUser = mkScimUser displayName userName externalId email (Just role)++ conf <- Yaml.decodeThrow confYaml+ let Right (actualSearchEntry, actualScimUser) = ldapToScim conf searchEntry+ actualSearchEntry `shouldBe` searchEntry+ actualScimUser `shouldBe` expectedScimUser++searchEntryEmpty :: SearchEntry+searchEntryEmpty = SearchEntry (Dn "") []++addAttr :: Text -> Text -> SearchEntry -> SearchEntry+addAttr key value (SearchEntry dn attrs) = SearchEntry dn ((Attr key, [cs value]) : attrs)++mkScimUser :: Text -> Text -> Text -> Text -> Maybe Text -> Scim.User ScimTag+mkScimUser displayName userName externalId email mRole =+ Scim.User+ { schemas = [User20],+ userName = userName,+ externalId = Just externalId,+ name = Nothing,+ displayName = Just displayName,+ nickName = Nothing,+ profileUrl = Nothing,+ title = Nothing,+ userType = Nothing,+ preferredLanguage = Nothing,+ locale = Nothing,+ active = Nothing,+ password = Nothing,+ emails = [Email {typ = Nothing, Scim.value = EmailAddress2 {unEmailAddress = unsafeEmailAddress (cs local) (cs domain)}, primary = Nothing}],+ phoneNumbers = [],+ ims = [],+ photos = [],+ addresses = [],+ entitlements = [],+ roles = maybeToList mRole,+ x509Certificates = [],+ extra = NoUserExtra+ }+ where+ [local, domain] = splitOn "@" email++confYaml :: ByteString+confYaml =+ "logLevel: \"Debug\" # one of Trace,Debug,Info,Warn,Error,Fatal; `Fatal` is least noisy, `Trace` most.\n\+ \ldapSource:\n\+ \ tls: false\n\+ \ host: \"localhost\"\n\+ \ port: 389\n\+ \ dn: \"cn=admin,dc=nodomain\"\n\+ \ password: \"geheim\"\n\+ \ search:\n\+ \ base: \"ou=People,dc=nodomain\"\n\+ \ objectClass: \"account\"\n\+ \ codec: \"utf8\"\n\+ \ deleteOnAttribute: # optional, related to `delete-from-directory`.\n\+ \ key: \"deleted\"\n\+ \ value: \"true\"\n\+ \ deleteFromDirectory: # optional; ok to use together with `delete-on-attribute` if you use both.\n\+ \ base: \"ou=DeletedPeople,dc=nodomain\"\n\+ \ objectClass: \"account\"\n\+ \scimTarget:\n\+ \ tls: false\n\+ \ host: \"localhost\"\n\+ \ port: 8088\n\+ \ path: \"/scim/v2\"\n\+ \ token: \"Bearer RRhtCL/VF9IYcmb3E9zaDo3rP6w3mZ3Ww3da7d2RDR8=\"\n\+ \mapping:\n\+ \ displayName: \"displayName\"\n\+ \ userName: \"uidNumber\"\n\+ \ externalId: \"email\"\n\+ \ email: \"email\"\n\+ \ roles: \"employeeType\"\n"