diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -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.
diff --git a/examples/wire-server/conf1.yaml b/examples/wire-server/conf1.yaml
--- a/examples/wire-server/conf1.yaml
+++ b/examples/wire-server/conf1.yaml
@@ -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"
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
@@ -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 "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
+ 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!"
diff --git a/ldap-scim-bridge.cabal b/ldap-scim-bridge.cabal
--- a/ldap-scim-bridge.cabal
+++ b/ldap-scim-bridge.cabal
@@ -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
-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
+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
diff --git a/src/LdapScimBridge.hs b/src/LdapScimBridge.hs
--- a/src/LdapScimBridge.hs
+++ b/src/LdapScimBridge.hs
@@ -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 ->
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -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"