From 6172e021cf896111b5a580105aa12ad8c0800d83 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Thu, 14 Mar 2024 09:57:23 +0100 Subject: [PATCH] WPB-2970 Update dependencies, cleanup, add unit test (#25) --- .envrc | 1 + .github/workflows/ci.yml | 74 ++++++++--- .gitignore | 3 + Dockerfile | 3 +- cabal.project | 8 ++ examples/wire-server/run.sh | 47 +++---- ldap-scim-bridge.cabal | 237 +++++++++++++++++++----------------- shell.nix | 28 +++++ src/LdapScimBridge.hs | 18 +-- test/Spec.hs | 91 ++++++++++++++ treefmt.toml | 26 ++++ 11 files changed, 374 insertions(+), 162 deletions(-) create mode 100644 .envrc create mode 100644 cabal.project create mode 100644 shell.nix create mode 100644 test/Spec.hs create mode 100644 treefmt.toml diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..1d953f4 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +use nix diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 2f28d55..fea6451 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -8,41 +8,75 @@ on: tags: - 'v*' +# INFO: The following configuration block ensures that only one build runs per branch, +# which may be desirable for projects with a costly build process. +# Remove this block from the CI workflow to let each CI job run to completion. +concurrency: + group: build-${{ github.ref }} + cancel-in-progress: true + jobs: build: - name: ghc ${{ matrix.ghc }} - runs-on: ubuntu-18.04 + name: GHC ${{ matrix.ghc-version }} on ${{ matrix.os }} + runs-on: ${{ matrix.os }} strategy: + fail-fast: false matrix: - cabal: ["2.4"] - ghc: - - "8.8.3" - if: "!startsWith(github.ref, 'refs/tags/v')" + os: [ubuntu-latest] + ghc-version: ['9.4'] + cabal: ['3.10.2.1'] steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v4 if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' - - uses: actions/setup-haskell@v1 - name: Setup Haskell + - name: Set up GHC ${{ matrix.ghc-version }} + uses: haskell-actions/setup@v2 + id: setup with: - ghc-version: ${{ matrix.ghc }} + ghc-version: ${{ matrix.ghc-version }} + # Defaults, added for clarity: cabal-version: ${{ matrix.cabal }} + cabal-update: true + + - name: Configure the build + run: | + cabal configure --enable-tests --enable-benchmarks --disable-documentation + cabal build all --dry-run + # The last step generates dist-newstyle/cache/plan.json for the cache key. + + - name: Restore cached dependencies + uses: actions/cache/restore@v3 + id: cache + env: + key: ${{ runner.os }}-ghc-${{ steps.setup.outputs.ghc-version }}-cabal-${{ steps.setup.outputs.cabal-version }} + with: + path: ${{ steps.setup.outputs.cabal-store }} + key: ${{ env.key }}-plan-${{ hashFiles('**/plan.json') }} + restore-keys: ${{ env.key }}- + + - name: Install dependencies + # If we had an exact cache hit, the dependencies will be up to date. + if: steps.cache.outputs.cache-hit != 'true' + run: cabal build all --only-dependencies - - uses: actions/cache@v1 - name: Cache ~/.cabal/store + # Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail. + - name: Save cached dependencies + uses: actions/cache/save@v3 + # If we had an exact cache hit, trying to save the cache would error because of key clash. + if: steps.cache.outputs.cache-hit != 'true' with: - path: ~/.cabal/store - key: ${{ runner.os }}-${{ matrix.ghc }}-cabal + path: ${{ steps.setup.outputs.cabal-store }} + key: ${{ steps.cache.outputs.cache-primary-key }} - name: Build - run: | - cabal v2-update - cabal v2-build --enable-tests --enable-benchmarks + run: cabal build all - - name: Test - run: | - echo 'No tests' + - name: Run tests + run: cabal test all + + - name: Check cabal file + run: cabal check publish: # needs : build diff --git a/.gitignore b/.gitignore index 80bd4ac..ce4d4d1 100644 --- a/.gitignore +++ b/.gitignore @@ -52,3 +52,6 @@ TAGS # other .DS_Store + +# nix +.direnv diff --git a/Dockerfile b/Dockerfile index 68851f4..790667d 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,9 +1,10 @@ -FROM haskell:8.10.7-buster +FROM haskell:9.4.8-buster WORKDIR /opt/ldap-scim-bridge # Add just the .cabal file to capture dependencies COPY ./ldap-scim-bridge.cabal /opt/ldap-scim-bridge/ldap-scim-bridge.cabal +COPY ./cabal.project /opt/ldap-scim-bridge/cabal.project RUN cabal v2-update diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..086d82a --- /dev/null +++ b/cabal.project @@ -0,0 +1,8 @@ +-- currently the latest tinylog version is not compatible with bytestring > 0.11 +-- we're using our own patch for tinylog until https://gitlab.com/twittner/tinylog/-/merge_requests/8 or similar has been merged into the upstream repo +source-repository-package + type: git + location: https://gitlab.com/leif.battermann/tinylog.git + tag: c570eaec033766b49ed394feb9638bfc0bd247e2 + +packages: ldap-scim-bridge.cabal diff --git a/examples/wire-server/run.sh b/examples/wire-server/run.sh index 6be915a..5b3383e 100755 --- a/examples/wire-server/run.sh +++ b/examples/wire-server/run.sh @@ -28,11 +28,13 @@ export WIRE_TEAMID 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 scaffolding2() { 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 @@ function scaffolding_spar() { 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 @@ function assert_num_members() { 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 index f59ae31..040d12c 100644 --- 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.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: + 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/shell.nix b/shell.nix new file mode 100644 index 0000000..05d8c75 --- /dev/null +++ b/shell.nix @@ -0,0 +1,28 @@ +let + nixpkgs = fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/7eeacecff44e05a9fd61b9e03836b66ecde8a525.tar.gz"; + sha256 = "sha256:0f6nv0pgk58d1962r8vswi7ks59fryh0yrdk99d30b3qj11a2045"; + }; + pkgs = import nixpkgs { config = { }; overlays = [ ]; }; +in + + +pkgs.mkShellNoCC rec { + nativeBuildInputs = with pkgs; [ + cabal-install + ghcid + ghc + zlib + (haskell.lib.justStaticExecutables pkgs.haskell.packages.ghc94.ormolu_0_5_2_0) + (haskell.lib.justStaticExecutables haskellPackages.cabal-fmt) + nixpkgs-fmt + treefmt + shellcheck + jq + gcc + ]; + + # Ensure that libz.so and other libraries are available to TH + # splices, cabal repl, etc. + LD_LIBRARY_PATH = pkgs.lib.makeLibraryPath nativeBuildInputs; +} diff --git a/src/LdapScimBridge.hs b/src/LdapScimBridge.hs index 013cbce..be8bc6c 100644 --- a/src/LdapScimBridge.hs +++ b/src/LdapScimBridge.hs @@ -6,9 +6,10 @@ module LdapScimBridge where 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.Meta as Scim 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 @@ instance Aeson.FromJSON LdapConf where 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 @@ instance Aeson.FromJSON LdapSearch where 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 @@ -272,7 +272,7 @@ 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 +366,7 @@ updateScimPeer lgr conf = do -- 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 index 0000000..91a7645 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,91 @@ +{-# 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 + +main :: IO () +main = hspec $ do + describe "LdapScimBridge" $ do + it "map displayName userName externalId and email" $ do + testMapping "George" "george" "george@nodomain" "george@nodomain" + +testMapping :: Text -> Text -> Text -> Text -> IO () +testMapping displayName userName externalId email = do + let [local, domain] = splitOn "@" email + conf <- Yaml.decodeThrow confYaml + let searchEntry = + SearchEntry + (Dn "123") + [ (Attr "displayName", [cs displayName]), + (Attr "uidNumber", [cs userName]), + (Attr "email", [cs email]) + ] + let expectedScimUser = + 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 = [], + x509Certificates = [], + extra = NoUserExtra + } + let Right (actualSearchEntry, actualScimUser) = ldapToScim conf searchEntry + actualSearchEntry `shouldBe` searchEntry + actualScimUser `shouldBe` expectedScimUser + +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\"" diff --git a/treefmt.toml b/treefmt.toml new file mode 100644 index 0000000..1f9e46d --- /dev/null +++ b/treefmt.toml @@ -0,0 +1,26 @@ +# One CLI to format the code tree - https://github.com/numtide/treefmt + +[formatter.nix] +command = "nixpkgs-fmt" +includes = ["*.nix"] + +[formatter.cabal-fmt] +command = "cabal-fmt" +options = [ "--inplace" ] +includes = [ "*.cabal" ] +excludes = [ + "dist-newstyle/" +] + +[formatter.haskell] +command = "ormolu" +options = [ + "--mode", "inplace", + "--check-idempotence", +] +includes = ["*.hs"] +excludes = [] + +[formatter.shellcheck] +command = "shellcheck" +includes = ["*.sh"]