[WPB-14436] cleanup plumbing

.github/workflows/ci.yml

@@ -24,8 +24,8 @@ jobs:
       fail-fast: false
       matrix:
         os: [ubuntu-latest]
-        ghc-version: ['9.4']
-        cabal: ['3.10.2.1']
+        ghc-version: ['9.6.6']
+        cabal: ['3.10.3.0']
 
     steps:
     - uses: actions/checkout@v4

.gitignore

@@ -1,3 +1,4 @@
+/.ghci
 ### Haskell
 dist
 dist-*

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)

Dockerfile

@@ -1,4 +1,4 @@
-FROM haskell:9.4.8-buster
+FROM haskell:9.6.6-slim-bullseye
 
 WORKDIR /opt/ldap-scim-bridge
 

admin/publish.sh

@@ -0,0 +1,19 @@
+#!/bin/bash
+
+echo "WARNING!! this script has never run!!  test carefully!!"
+exit 1
+
+# hackage
+# from https://hackage.haskell.org/upload
+dir=$(mktemp -d dist-docs.XXXXXX)
+trap 'rm -r "$dir"' EXIT
+cabal v2-haddock --builddir="$dir" --haddock-for-hackage --enable-doc
+cabal upload -d --publish $dir/*-docs.tar.gz
+
+# docker
+export VERSION=0.10
+docker build -t ldap-scim-bridge:${VERSION} .
+docker tag ldap-scim-bridge:${VERSION} quay.io/wire/ldap-scim-bridge:${VERSION}
+docker login quay.io
+docker push quay.io/wire/ldap-scim-bridge:${VERSION}
+

examples/wire-server/run.sh

@@ -29,7 +29,7 @@ export SCIM_TOKEN
 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 @@ function scaffolding_spar() {
     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 @@ function scaffolding_spar() {
     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

@@ -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 <[email protected]>
-copyright:          (c) 2021 wire.com
+author:             wire.com
+maintainer:         [email protected]
+copyright:          (c) 2024 wire.com
 category:           System
 build-type:         Simple
 extra-doc-files:
@@ -22,35 +22,35 @@ extra-source-files:
   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
   location: https://github.com/wireapp/ldap-scim-bridge.git
 
 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),
@@ -123,16 +123,16 @@ test-suite ldap-scim-bridge-test
   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

shell.nix

@@ -1,7 +1,7 @@
 let
   nixpkgs = fetchTarball {
-    url = "https://github.com/NixOS/nixpkgs/archive/7eeacecff44e05a9fd61b9e03836b66ecde8a525.tar.gz";
-    sha256 = "sha256:0f6nv0pgk58d1962r8vswi7ks59fryh0yrdk99d30b3qj11a2045";
+    url = "https://github.com/NixOS/nixpkgs/archive/4f31540079322e6013930b5b2563fd10f96917f0.tar.gz";
+    sha256 = "sha256:12748r3h44hy3a41slm5hcihn1nhrxjlgp75qz6iwzazkxnclx00";
   };
   pkgs = import nixpkgs { config = { }; overlays = [ ]; };
 in
@@ -13,7 +13,7 @@ pkgs.mkShellNoCC rec {
     ghcid
     ghc
     zlib
-    (haskell.lib.justStaticExecutables pkgs.haskell.packages.ghc94.ormolu_0_5_2_0)
+    (haskell.lib.justStaticExecutables haskellPackages.ormolu)
     (haskell.lib.justStaticExecutables haskellPackages.cabal-fmt)
     nixpkgs-fmt
     treefmt

src/LdapScimBridge.hs

@@ -13,6 +13,7 @@ import qualified Data.List
 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
@@ -172,14 +173,27 @@ instance Aeson.FromJSON (PhantomParent Level) where
 instance Aeson.FromJSON BridgeConf
 
 data MappingError
-  = MissingAttr Text
-  | MissingMandatoryValue 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)
+
+instance Show MappingError where
+  show = renderMappingError
+
+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 <> ")")
 
 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
@@ -241,20 +255,20 @@ instance Aeson.FromJSON Mapping where
       mapDisplayName ldapFieldName scimFieldName = FieldMapping scimFieldName $
         \case
           [val] -> Right $ \usr -> usr {Scim.displayName = Just val}
-          bad -> Left $ WrongNumberOfAttrValues (ldapFieldName <> " -> " <> scimFieldName) "1" (Prelude.length bad)
+          bad -> Left $ WrongNumberOfAttrValues ldapFieldName scimFieldName "1" (Prelude.length bad)
 
       -- 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 <> " -> " <> scimFieldName) "1" (Prelude.length bad)
+          bad -> Left $ WrongNumberOfAttrValues ldapFieldName scimFieldName "1" (Prelude.length bad)
 
       mapExternalId :: Text -> Text -> FieldMapping
       mapExternalId ldapFieldName scimFieldName = FieldMapping scimFieldName $
         \case
           [val] -> Right $ \usr -> usr {Scim.externalId = Just val}
-          bad -> Left $ WrongNumberOfAttrValues (ldapFieldName <> " -> " <> scimFieldName) "1" (Prelude.length bad)
+          bad -> Left $ WrongNumberOfAttrValues ldapFieldName scimFieldName "1" (Prelude.length bad)
 
       mapEmail :: Text -> Text -> FieldMapping
       mapEmail ldapFieldName scimFieldName = FieldMapping scimFieldName $
@@ -264,13 +278,14 @@ instance Aeson.FromJSON Mapping where
             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)
+                ldapFieldName
+                scimFieldName
                 "<=1 (with more than one email, which one should be primary?)"
                 (Prelude.length bad)
 
@@ -279,7 +294,7 @@ instance Aeson.FromJSON Mapping where
         \case
           [] -> Right id
           [val] -> Right $ \usr -> usr {Scim.roles = [val]}
-          bad -> Left $ WrongNumberOfAttrValues (ldapFieldName <> " -> " <> scimFieldName) "1" (Prelude.length bad)
+          bad -> Left $ WrongNumberOfAttrValues ldapFieldName scimFieldName "1" (Prelude.length bad)
 
 type LdapResult a = IO (Either LdapError a)
 
@@ -330,9 +345,21 @@ 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")]
+    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

test/Spec.hs

@@ -67,13 +67,30 @@ main = hspec $ do
               & addAttr "email" email
 
       conf <- Yaml.decodeThrow confYaml
-      ldapToScim Strict conf searchEntry `shouldBe` Left [(searchEntry, MissingMandatoryValue "userName")]
+      ldapToScim Strict conf searchEntry `shouldBe` Left [(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
+      ldapToScim Strict conf searchEntry `shouldBe` Left [(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]
+
+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 =
@@ -91,7 +108,7 @@ mkExpectedScimUser displayName userName externalId email mRole =
       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 = [],