chore(auth): implement fetchUserData, generalized version of azureUser and ldapUser

2024-03-07 05:38:39 +01:00 · 2024-03-07 05:38:39 +01:00 · aca5a79de2
commit aca5a79de2
parent 4feb05a02e
3 changed files with 182 additions and 111 deletions
--- a/src/Auth/LDAP.hs
+++ b/src/Auth/LDAP.hs
@ -116,6 +116,7 @@ ldapUserEmail = Ldap.Attr "mail" :|
  ]


+-- TODO: deprecate in favour of FetchUserDataException
 data LdapUserException = LdapUserLdapError LdapPoolError
                       | LdapUserNoResult
                       | LdapUserAmbiguous
@ -182,6 +183,7 @@ ldapUserWith withLdap' (conf@LdapConf{..}, pool) Creds{..} = either (throwM . Ld
 --   where upsertIdent = fromMaybe (CI.original userIdent) userLdapPrimaryKey 


+-- TODO: deprecate in favour of fetchUserData
 ldapUser :: ( MonadMask m
            , MonadUnliftIO m
          --, MonadLogger m
--- a/src/Auth/OAuth2.hs
+++ b/src/Auth/OAuth2.hs
@ -7,7 +7,7 @@
 module Auth.OAuth2
  ( apAzure
  , azurePrimaryKey, azureUserPrincipalName, azureUserDisplayName, azureUserGivenName, azureUserSurname, azureUserMail, azureUserTelephone, azureUserMobile, azureUserPreferredLanguage
-  , azureUser, azureUser'
+  -- , azureUser, azureUser'
  , AzureUserException(..), _AzureUserError, _AzureUserNoResult, _AzureUserAmbiguous
  , apAzureMock
  , azureMockServer
@ -15,7 +15,7 @@ module Auth.OAuth2
  , refreshOAuth2Token
  ) where

-import qualified Data.CaseInsensitive as CI
+-- import qualified Data.CaseInsensitive as CI
 import Data.Maybe (fromJust)
 import Data.Text

@ -33,6 +33,7 @@ apAzure :: Text
 apAzure = "AzureADv2"


+-- TODO: deprecate in favour of FetchUserDataException
 data AzureUserException = AzureUserError
                        | AzureUserNoResult
                        | AzureUserAmbiguous
@ -56,28 +57,49 @@ azureUserPreferredLanguage = "preferredLanguage"


 -- | User lookup in Microsoft Graph with given credentials
-azureUser :: ( MonadMask m
-             , MonadHandler m
-             )
-             => AzureConf
-             -> Creds site
-             -> m [(Text, [ByteString])] -- (Either AzureUserException [(Text, [ByteString])])
-azureUser _conf Creds{..} = fmap throwLeft . runExceptT $ do
-  results <- queryOAuth2User @[(Text, [ByteString])] credsIdent
-  case results of
-    Left _ -> throwE AzureUserNoResult
-    Right [res] -> return res
-    Right _multiple -> throwE AzureUserAmbiguous
+-- TODO: deprecate in favour of fetchUserData
+-- azureUser :: ( MonadMask m
+--              , MonadHandler m
+--              -- , HandlerSite m ~ site
+--              -- , BackendCompatible SqlBackend (YesodPersistBackend site)
+--              -- , BaseBackend (YesodPersistBackend site) ~ SqlBackend
+--              -- , YesodPersist site
+--              -- , PersistUniqueWrite (YesodPersistBackend site)
+--              )
+--              => AzureConf
+--              -> Creds site
+--              -> m [(Text, [ByteString])] -- (Either AzureUserException [(Text, [ByteString])])
+-- azureUser AzureConf{..} Creds{..} = fmap throwLeft . runExceptT $ do
+--   now <- liftIO getCurrentTime
+--   results <- queryOAuth2User @[(Text, [ByteString])] credsIdent
+--   case results of
+--     Right [res] -> do
+--       -- void . liftHandler . runDB $ upsert ExternalUser
+--       --   { externalUserUser     =  error "no userid" -- TODO: use azureUserPrimaryKey once UserIdent is referenced instead of UserId
+--       --   , externalUserSource   =  AuthSourceIdAzure azureConfClientId
+--       --   , externalUserData     =  toJSON res
+--       --   , externalUserLastSync =  now
+--       --   }
+--       --   [ ExternalUserData     =. toJSON res
+--       --   , ExternalUserLastSync =. now
+--       --   ]
+--       return res
+--     Right _multiple -> throwE AzureUserAmbiguous
+--     Left _ -> throwE AzureUserNoResult

 -- | User lookup in Microsoft Graph with given user
-azureUser' :: ( MonadMask m
-              , MonadHandler m
-             )
-             => AzureConf
-             -> User
-             -> m (Maybe [(Text, [ByteString])]) -- (Either AzureUserException [(Text, [ByteString])])
-azureUser' conf User{userIdent}
-  = runMaybeT . catchIfMaybeT (is _AzureUserNoResult) $ azureUser conf (Creds apAzure (CI.original userIdent) [])
+-- azureUser' :: ( MonadMask m
+--               , MonadHandler m
+--               , HandlerSite m ~ site
+--               , BaseBackend (YesodPersistBackend site) ~ SqlBackend
+--               , YesodPersist site
+--               , PersistUniqueWrite (YesodPersistBackend site)
+--               )
+--              => AzureConf
+--              -> User
+--              -> ReaderT (YesodPersistBackend site) m (Maybe [(Text, [ByteString])]) -- (Either AzureUserException [(Text, [ByteString])])
+-- azureUser' conf User{userIdent}
+--   = runMaybeT . catchIfMaybeT (is _AzureUserNoResult) $ azureUser conf (Creds apAzure (CI.original userIdent) [])


 ----------------------------------------
@ -183,7 +205,7 @@ refreshOAuth2Token (_, rToken) url secure
        clientID <- liftIO $ fromJust <$> lookupEnv "CLIENT_ID"
        clientSecret <- liftIO $ fromJust <$> lookupEnv "CLIENT_SECRET"
        return $ body ++ [("client_id", fromString clientID), ("client_secret", fromString clientSecret), ("scope", "openid profile")]
-      else return $ ("scope", "ID Profile") : body
+      else return $ scopeParam " " ["ID","Profile"] : body
    $logErrorS "\27[31mAdmin Handler\27[0m" $ tshow (requestBody $ urlEncodedBody body' req{ secure = secure })
    eResult <- lift $ getResponseBody <$> httpJSONEither @m @OAuth2Token (urlEncodedBody body' req{ secure = secure })
    case eResult of
--- a/src/Foundation/Yesod/Auth.hs
+++ b/src/Foundation/Yesod/Auth.hs
@ -4,7 +4,7 @@

 module Foundation.Yesod.Auth
  ( authenticate
-  , ldapLookupAndUpsert -- TODO generalize
+  -- , ldapLookupAndUpsert -- TODO: remove in favour of fetchUserData
  , upsertUser
  , decodeUserTest
  , UserConversionException(..)
@ -35,6 +35,7 @@ import qualified Control.Monad.Catch as C (Handler(..))
 import qualified Data.ByteString as ByteString
 import qualified Data.CaseInsensitive as CI
 import qualified Data.Map as Map
+import qualified Data.List.NonEmpty as NonEmpty (toList)
 import qualified Data.Set as Set
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
@ -55,7 +56,7 @@ authenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend
  $logErrorS "OAuth session Debug" $ "\27[34m" <> tshow sess <> "\27[0m" -- TODO: debug only

  now <- liftIO getCurrentTime
-  userAuthConf <- getsYesod $ view _appUserAuthConf
+  userAuthConf <- getsYesod $ view _appUserAuthConf -- TODO: debug only
  $logErrorS "authenticate AuthConf Debug" $ "\27[31m" <> tshow userAuthConf <> "\27[0m" -- TODO: debug only

  let
@ -77,27 +78,15 @@ authenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend
      = return res

    excHandlers =
-      -- TODO: merge ldap and azure exception types
-      [ C.Handler $ \(ldapExc :: LdapUserException) -> case ldapExc of
-          LdapUserNoResult -> do
-            $logWarnS "Auth" $ "LDAP user lookup failed after successful login for " <> credsIdent
+      [ C.Handler $ \(fExc :: FetchUserDataException) -> case fExc of
+          FetchUserDataNoResult -> do
+            $logWarnS "FetchUserException" $ "User lookup failed after successful login for " <> credsIdent
            excRecovery . UserError $ IdentifierNotFound credsIdent
-          LdapUserAmbiguous -> do
-            $logWarnS "Auth" $ "Multiple LDAP auth results for " <> credsIdent
+          FetchUserDataAmbiguous -> do
+            $logWarnS "FetchUserException" $ "Multiple User results for " <> credsIdent
            excRecovery . UserError $ IdentifierNotFound credsIdent
          err -> do
-            $logErrorS "Auth" $ tshow err
-            mr <- getMessageRender
-            excRecovery . ServerError $ mr MsgInternalLoginError
-      , C.Handler $ \case
-          AzureUserNoResult -> do
-            $logWarnS "OAuth" $ "User lookup failed after successful login for " <> credsIdent
-            excRecovery . UserError $ IdentifierNotFound credsIdent
-          AzureUserAmbiguous -> do
-            $logWarnS "OAuth" $ "Multiple OAuth results for " <> credsIdent
-            excRecovery . UserError $ IdentifierNotFound credsIdent
-          err -> do
-            $logErrorS "OAuth" $ tshow err
+            $logErrorS "FetchUserException" $ tshow err
            mr <- getMessageRender
            excRecovery . ServerError $ mr MsgInternalLoginError
      , C.Handler $ \(cExc :: UserConversionException) -> do
@ -123,22 +112,27 @@ authenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend

  flip catches excHandlers $ if
    | not isDummy, not isOther
-    , UserAuthConfSingleSource (AuthSourceConfAzureAdV2 upsertUserAzureConf) <- userAuthConf
+    -- , UserAuthConfSingleSource (AuthSourceConfAzureAdV2 upsertUserAzureConf) <- userAuthConf
    , Just upsertMode' <- upsertMode -> do
-        upsertUserAzureData <- azureUser upsertUserAzureConf Creds{..}
-        $logDebugS "AuthAzure" $ "Successful Azure lookup: " <> tshow upsertUserAzureData
-        Authenticated . entityKey <$> upsertUser upsertMode' UpsertUserDataAzure{..}
-    | not isDummy, not isOther
-    , UserAuthConfSingleSource (AuthSourceConfLdap upsertUserLdapConf) <- userAuthConf
-    , Just upsertMode' <- upsertMode -> do
-        ldapPool <- fmap (fromMaybe $ error "No LDAP Pool") . getsYesod $ view _appLdapPool
-        upsertUserLdapData <- ldapUser ldapPool Creds{..}
-        $logDebugS "AuthLDAP" $ "Successful LDAP lookup: " <> tshow upsertUserLdapData
-        Authenticated . entityKey <$> upsertUser upsertMode' UpsertUserDataLdap{..}
+        userData <- fetchUserData upsertMode' Creds{..}
+        $logDebugS "Auth" $ "Successful user data lookup: " <> tshow userData
+        Authenticated . entityKey <$> upsertUser upsertMode' userData
+        -- Authenticated . entityKey <$> upsertUser upsertMode' UpsertUserDataAzure{..}
+        -- upsertUserAzureData <- azureUser upsertUserAzureConf Creds{..}
+        -- $logDebugS "AuthAzure" $ "Successful Azure lookup: " <> tshow upsertUserAzureData
+        -- Authenticated . entityKey <$> upsertUser upsertMode' UpsertUserDataAzure{..}
+    -- | not isDummy, not isOther
+    -- , UserAuthConfSingleSource (AuthSourceConfLdap upsertUserLdapConf) <- userAuthConf
+    -- , Just upsertMode' <- upsertMode -> do
+    --     ldapPool <- fmap (fromMaybe $ error "No LDAP Pool") . getsYesod $ view _appLdapPool
+    --     upsertUserLdapData <- ldapUser ldapPool Creds{..}
+    --     $logDebugS "AuthLDAP" $ "Successful LDAP lookup: " <> tshow upsertUserLdapData
+    --     Authenticated . entityKey <$> upsertUser upsertMode' UpsertUserDataLdap{..}
    | otherwise
      -> acceptExisting


+-- TODO: rename to DecodeUserException (associate with function!)
 data UserConversionException
  = UserInvalidIdent
  | UserInvalidEmail
@ -175,33 +169,75 @@ _upsertUserMode mMode cs@Creds{..}
    defaultOther = apHash


-- TODO: generalize
-ldapLookupAndUpsert :: forall m.
-                       ( MonadHandler m
-                       , HandlerSite m ~ UniWorX
-                       , MonadMask m
-                       , MonadUnliftIO m
-                       )
-                    => Text
-                    -> SqlPersistT m (Entity User)
-ldapLookupAndUpsert ident = 
-  getsYesod (view _appLdapPool) >>= \case 
-    Nothing -> throwM $ LdapUserLdapError $ LdapHostNotResolved "No LDAP configuration in Foundation."
-    Just ldapPool@(upsertUserLdapConf, _) ->
-      ldapUser'' ldapPool ident >>= \case
-        Nothing -> throwM LdapUserNoResult
-        Just upsertUserLdapData -> upsertUser UpsertUserGuessUser UpsertUserDataLdap{..}
+data FetchUserDataException
+  = FetchUserDataNoResult
+  | FetchUserDataAmbiguous
+  | FetchUserDataException
+  deriving (Eq, Ord, Read, Show, Generic)
+  deriving anyclass (Exception)
+
+-- TODO: deprecate in favour of fetchUserData
+-- ldapLookupAndUpsert :: forall m.
+--                        ( MonadHandler m
+--                        , HandlerSite m ~ UniWorX
+--                        , MonadMask m
+--                        , MonadUnliftIO m
+--                        )
+--                     => Text
+--                     -> SqlPersistT m (Entity User)
+-- ldapLookupAndUpsert ident = 
+--   getsYesod (view _appLdapPool) >>= \case 
+--     Nothing -> throwM $ LdapUserLdapError $ LdapHostNotResolved "No LDAP configuration in Foundation."
+--     Just ldapPool ->
+--       ldapUser'' ldapPool ident >>= \case
+--         Nothing -> throwM LdapUserNoResult
+--         Just ldapData -> upsertUser UpsertUserGuessUser ldapData
+
+
+-- | Fetch user data with given credentials from external source(s)
+fetchUserData :: forall m site.
+                 ( MonadHandler m
+                 , HandlerSite m ~ UniWorX
+                 , MonadCatch m
+                 )
+              => UpsertUserMode
+              -> Creds site
+              -> SqlPersistT m (NonEmpty UpsertUserData)
+fetchUserData upsertMode creds@Creds{..} = do
+  userAuthConf <- getsYesod $ view _appUserAuthConf
+  now <- liftIO getCurrentTime
+
+  results :: NonEmpty UpsertUserData <- case userAuthConf of
+    UserAuthConfSingleSource{..} -> fmap throwLeft . runExceptT $ case userAuthConfSingleSource of
+      AuthSourceConfAzureAdV2 AzureConf{ azureConfClientId = upsertUserAzureTenantId } -> do
+        queryOAuth2User @[(Text, [ByteString])] credsIdent >>= \case
+          Right upsertUserAzureData -> return UpsertUserDataAzure{..}
+          Left _ -> throwE FetchUserDataNoResult
+      AuthSourceConfLdap LdapConf{..} -> do
+        ldapPool <- fmap (fromMaybe $ error "LDAP source configured, but no LDAP pool initialized") . getsYesod $ view _appLdapPool
+        UpsertUserDataLdap ldapConfSourceId <$> ldapUser ldapPool creds
+
+  -- insert ExternalUser entries for each fetched dataset
+  forM_ results $ \res ->
+    let externalUserUser =  error "no userid" -- TODO: use azureUserPrimaryKey/ldapPrimaryKey once UserIdent is referenced instead of UserId
+        externalUserLastSync = now
+        (externalUserData, externalUserSource) = case res of
+          UpsertUserDataAzure{..} -> (toJSON upsertUserAzureData, AuthSourceIdAzure upsertUserAzureTenantId)
+          UpsertUserDataLdap{..} -> (toJSON upsertUserLdapData, AuthSourceIdLdap upsertUserLdapHost)
+     in void . liftHandler . runDB $ upsert ExternalUser{..} [ExternalUserData =. externalUserData, ExternalUserLastSync =. externalUserLastSync]
+
+  return results


 -- | Upsert User and related auth in DB according to given external source data (does not query source itself)
 upsertUser :: forall m.
-                  ( MonadHandler m
-                  , HandlerSite m ~ UniWorX
-                  , MonadCatch m
-                  )
-               => UpsertUserMode
-               -> UpsertUserData
-               -> SqlPersistT m (Entity User)
+              ( MonadHandler m
+              , HandlerSite m ~ UniWorX
+              , MonadCatch m
+              )
+           => UpsertUserMode
+           -> NonEmpty UpsertUserData
+           -> SqlPersistT m (Entity User)
 upsertUser _upsertMode upsertData = do
  now <- liftIO getCurrentTime
  userDefaultConf <- getsYesod $ view _appUserDefaults
@ -234,7 +270,7 @@ upsertUser _upsertMode upsertData = do

  let
    userSystemFunctions = determineSystemFunctions . Set.fromList $ map CI.mk userSystemFunctions'
-    userSystemFunctions' = case upsertData of
+    userSystemFunctions' = concat $ upsertData <&> \case
      UpsertUserDataAzure{..} -> do
        (_k, v) <- upsertUserAzureData
        v' <- v
@ -259,7 +295,7 @@ decodeUser :: ( MonadThrow m
              )
           => UTCTime -- ^ Now
           -> UserDefaultConf
-           -> UpsertUserData -- ^ Raw source data
+           -> NonEmpty UpsertUserData -- ^ Raw source data
           -> m (User,_) -- ^ Data for new User entry and updating existing User entries
 decodeUser now UserDefaultConf{..} upsertData = do
    userIdent <- if
@ -275,35 +311,47 @@ decodeUser now UserDefaultConf{..} upsertData = do
        -> throwM UserInvalidIdent

    let
-      (userSurname, userFirstName, userDisplayName, userEmail, userTelephone, userMobile, userCompanyPersonalNumber, userCompanyDepartment, userLanguages)
+      (azureSurname, azureFirstName, azureDisplayName, azureEmail, azureTelephone, azureMobile, azureLanguages)
        | Just azureData <- mbAzureData
-          = ( azureData `decodeAzure'` azureUserSurname
-            , azureData `decodeAzure'` azureUserGivenName
-            , azureData `decodeAzure'` azureUserDisplayName
-            , CI.mk $
-              azureData `decodeAzure'` azureUserMail
-            , azureData `decodeAzure`  azureUserTelephone
-            , azureData `decodeAzure`  azureUserMobile
-            , Nothing -- userCompanyPersonalNumber not contained in Azure response
-            , Nothing -- userCompanyDepartment not contained in Azure response
-            , Nothing -- azureData `decodeAzure`  azureUserPreferredLanguage -- TODO: parse Languages from azureUserPreferredLanguage
-            )
-        | Just ldapData <- mbLdapData
-          = ( ldapData `decodeLdap'` ldapUserSurname
-            , ldapData `decodeLdap'` ldapUserFirstName
-            , ldapData `decodeLdap'` ldapUserDisplayName
-            , CI.mk $
-              ldapData `decodeLdap'` (Ldap.Attr "mail") -- TODO: use ldapUserEmail?
-            , ldapData `decodeLdap`  ldapUserTelephone
-            , ldapData `decodeLdap`  ldapUserMobile
-            , ldapData `decodeLdap`  ldapUserFraportPersonalnummer
-            , ldapData `decodeLdap`  ldapUserFraportAbteilung
-            , Nothing -- userLanguage not contained in LDAP response
+          = ( azureData `decodeAzure` azureUserSurname
+            , azureData `decodeAzure` azureUserGivenName
+            , azureData `decodeAzure` azureUserDisplayName
+            , azureData `decodeAzure` azureUserMail
+            , azureData `decodeAzure` azureUserTelephone
+            , azureData `decodeAzure` azureUserMobile
+            , Nothing -- azureData `decodeAzure` azureUserPreferredLanguage -- TODO: parse Languages from azureUserPreferredLanguage
            )
        | otherwise
-          = error "decodeUser: Both azureData and ldapData are empty, cannot decode basic fields from no data!"
+          = ( Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing )

+      (ldapSurname, ldapFirstName, ldapDisplayName, ldapEmail, ldapTelephone, ldapMobile, ldapCompanyPersonalNumber, ldapCompanyDepartment)
+        | Just ldapData <- mbLdapData
+          = ( ldapData `decodeLdap` ldapUserSurname
+            , ldapData `decodeLdap` ldapUserFirstName
+            , ldapData `decodeLdap` ldapUserDisplayName
+            , ldapData `decodeLdap` (Ldap.Attr "mail") -- TODO: use ldapUserEmail?
+            , ldapData `decodeLdap` ldapUserTelephone
+            , ldapData `decodeLdap` ldapUserMobile
+            , ldapData `decodeLdap` ldapUserFraportPersonalnummer
+            , ldapData `decodeLdap` ldapUserFraportAbteilung
+            )
+        | otherwise
+          = ( Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing )
+
+    -- TODO: throw on collisions?
+
+    -- TODO: use user-auth precedence from app config when implementing multi-source support
    let
+      userSurname = fromMaybe mempty $ azureSurname <|> ldapSurname
+      userFirstName = fromMaybe mempty $ azureFirstName <|> ldapFirstName
+      userDisplayName = fromMaybe mempty $ azureDisplayName <|> ldapDisplayName
+      userEmail = maybe mempty CI.mk $ azureEmail <|> ldapEmail
+      userTelephone = azureTelephone <|> ldapTelephone
+      userMobile = azureMobile <|> ldapMobile
+      userLanguages = azureLanguages
+      userCompanyPersonalNumber = ldapCompanyPersonalNumber
+      userCompanyDepartment = ldapCompanyDepartment
+
      newUser = User
        { userMaxFavourites         =  userDefaultMaxFavourites
        , userMaxFavouriteTerms     =  userDefaultMaxFavouriteTerms
@ -349,10 +397,9 @@ decodeUser now UserDefaultConf{..} upsertData = do

  where
    mbAzureData :: Maybe (Map Text [ByteString])
-    mbAzureData = Map.fromListWith (++) . fmap (second . filter $ not . ByteString.null) <$> preview _upsertUserAzureData upsertData
+    mbAzureData = fmap (Map.fromListWith (++) . map (\(t,bs) -> (t, filter (not . ByteString.null) bs))) . concat $ preview _upsertUserAzureData <$> NonEmpty.toList upsertData
    mbLdapData :: Maybe (Map Ldap.Attr [Ldap.AttrValue]) -- Recall: Ldap.AttrValue == ByteString
-    mbLdapData = Map.fromListWith (++) . fmap (second . filter $ not . ByteString.null) <$> preview _upsertUserLdapData upsertData
-    -- ldapData = fmap (Map.fromListWith (++)) $ upsertData ^? _upsertUserLdapData . over _2 (filter $ not . ByteString.null)
+    mbLdapData = fmap (Map.fromListWith (++) . map (\(t,bs) -> (t, filter (not . ByteString.null) bs))) . concat $ preview _upsertUserLdapData <$> NonEmpty.toList upsertData

    -- just returns Nothing on error, pure
    decodeAzure :: Map Text [ByteString] -> Text -> Maybe Text
@ -360,10 +407,10 @@ decodeUser now UserDefaultConf{..} upsertData = do
    decodeLdap :: Map Ldap.Attr [Ldap.AttrValue] -> Ldap.Attr -> Maybe Text
    decodeLdap ldapData attr = listToMaybe . rights $ Text.decodeUtf8' <$> ldapData !!! attr

-    decodeAzure' :: Map Text [ByteString] -> Text -> Text
-    decodeAzure' azureData = fromMaybe "" . decodeAzure azureData
-    decodeLdap' :: Map Ldap.Attr [Ldap.AttrValue] -> Ldap.Attr -> Text
-    decodeLdap' ldapData = fromMaybe "" . decodeLdap ldapData
+    -- decodeAzure' :: Map Text [ByteString] -> Text -> Text
+    -- decodeAzure' azureData = fromMaybe "" . decodeAzure azureData
+    -- decodeLdap' :: Map Ldap.Attr [Ldap.AttrValue] -> Ldap.Attr -> Text
+    -- decodeLdap' ldapData = fromMaybe "" . decodeLdap ldapData
    -- accept the first successful decoding or empty; only throw an error if all decodings fail
    -- decodeLdap' :: (Exception e) => Ldap.Attr -> e -> m (Maybe Text)
    -- decodeLdap' attr err
@ -393,7 +440,7 @@ decodeUserTest :: ( MonadHandler m
                  , HandlerSite m ~ UniWorX
                  , MonadCatch m
                  )
-               => UpsertUserData
+               => NonEmpty UpsertUserData
               -> m (Either UserConversionException (User, [Update User]))
 decodeUserTest decodeData = do
  now <- liftIO getCurrentTime