chore(admin): switch to generic Aeson Value for oauth response parsing

src/Handler/Admin/ExternalUser.hs

@@ -15,10 +15,9 @@ import Auth.LDAP
 
 import Handler.Utils
 
-import qualified Data.Text as Text
-import qualified Data.Text.Encoding as Text
-
-import qualified Ldap.Client as Ldap
+import Data.Aeson.Encode.Pretty (encodePretty)
+import qualified Data.Text.Lazy as Lazy
+import qualified Data.Text.Lazy.Encoding as Lazy
 
 
 getAdminExternalUserR,  postAdminExternalUserR :: Handler Html
@@ -28,25 +27,27 @@ postAdminExternalUserR = do
     flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing
 
   let
-    presentUtf8   v = Text.intercalate ", " (either tshow id . Text.decodeUtf8' <$> v)
-    presentLatin1 v = Text.intercalate ", " (                 Text.decodeLatin1 <$> v)
+    -- presentUtf8   v = Text.intercalate ", " (either tshow id . Text.decodeUtf8' <$> v)
+    -- presentLatin1 v = Text.intercalate ", " (                 Text.decodeLatin1 <$> v)
 
-    procFormPerson :: Text -> Handler (Maybe [(AuthSourceIdent, [(Text,(Int,Text,Text))])])
+    procFormPerson :: Text -> Handler (Maybe [(AuthSourceIdent,Lazy.Text)]) -- (Maybe [(AuthSourceIdent, [(Text,(Int,Text,Text))])])
     procFormPerson needle = getsYesod (view _appUserAuthConf) >>= \case
       UserAuthConfSingleSource{..} -> case userAuthConfSingleSource of
         AuthSourceConfAzureAdV2 AzureConf{..} -> do
           -- only singleton results supported right now, i.e. lookups by email, userPrincipalName (aka fraport ident), or id
-          queryOAuth2User @[(Text,[ByteString])] needle >>= \case
+          queryOAuth2User @Value needle >>= \case
             Left _ -> addMessage Error (text2Html "Encountered UserDataException while Azure user query!") >> return Nothing
-            Right azureData -> return . Just . singleton . (AuthSourceIdAzure azureConfTenantId,) $ azureData <&> \(k,vs) -> (k, (length vs, presentUtf8 vs, presentLatin1 vs))
-        AuthSourceConfLdap LdapConf{ ldapConfSourceId = authSourceIdLdapHost } -> do
+            Right azureResponse -> return . Just . singleton . (AuthSourceIdAzure azureConfTenantId,) . Lazy.decodeUtf8 $ encodePretty azureResponse
+            -- Right azureData -> return . Just . singleton . (AuthSourceIdAzure azureConfTenantId,) $ azureData <&> \(k,vs) -> (k, (length vs, presentUtf8 vs, presentLatin1 vs))
+        AuthSourceConfLdap LdapConf{..} -> do
           getsYesod (view _appLdapPool) >>= \case
             Nothing -> addMessage Error (text2Html "LDAP Pool configuration missing!") >> return Nothing
             Just pool -> do
               ldapData <- ldapSearch pool needle
               -- decodedErr <- decodeUserTest $ NonEmpty.singleton UpsertUserDataLdap{ upsertUserLdapHost = ldapConfSourceId, upsertUserLdapData = concat ldapData }
               -- whenIsLeft decodedErr $ addMessageI Error
-              return . Just $ ldapData <&> \(Ldap.SearchEntry _dn attrs) -> (AuthSourceIdLdap{..}, (\(k,v) -> (tshow k, (length v, presentUtf8 v, presentLatin1 v))) <$> attrs)
+              return . Just . singleton . (AuthSourceIdLdap ldapConfSourceId,) . Lazy.decodeUtf8 $ encodePretty ldapData
+              -- return . Just $ ldapData <&> \(Ldap.SearchEntry _dn attrs) -> (AuthSourceIdLdap{..}, (\(k,v) -> (tshow k, (length v, presentUtf8 v, presentLatin1 v))) <$> attrs)
 
   mbData <- formResultMaybe presult procFormPerson
 

src/Ldap/Client/Instances.hs

@@ -19,6 +19,8 @@ import Utils.PathPiece (derivePathPiece)
 
 import Ldap.Client
 
+import Network.HTTP.Types.Method.Instances () -- for FromJSON instance for ByteString
+
 
 deriving instance Ord Attr
 deriving instance Ord Dn
@@ -54,4 +56,6 @@ derivePersistField "Password"
 derivePersistField "Scope"
 
 deriveJSON defaultOptions ''Attr
+deriveJSON defaultOptions ''Dn
 deriveJSON defaultOptions ''Scope
+deriveJSON defaultOptions ''SearchEntry

templates/admin/external-user.hamlet

@@ -22,16 +22,18 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
               LDAP host: #
               #{ldapHost}
         <dd .deflist__dd>
-          <dl .deflist>
-            $forall (k,(numv,vUtf8,vLatin1)) <- responses
-              <dt .deflist__dt>
-                #{k}
-                $if 1 < numv
-                  \ (#{show numv})
-              <dd .deflist__dd>
-                UTF8:  #{vUtf8}
-                &#8212;
-                Latin: #{vLatin1}
+          <pre>
+            #{responses}
+$#          <dl .deflist>
+$#            $forall (k,(numv,vUtf8,vLatin1)) <- responses
+$#              <dt .deflist__dt>
+$#                #{k}
+$#                $if 1 < numv
+$#                  \ (#{show numv})
+$#              <dd .deflist__dd>
+$#                UTF8:  #{vUtf8}
+$#                &#8212;
+$#                Latin: #{vLatin1}
 
 <section>
   <p>