Extract user's name from a JWT token

Handler/JWT.hs

@@ -10,16 +10,28 @@ import qualified Jose.Jwa as JWA
 
 import Data.Aeson
 
-data JwtAuthInfo = JwtAuthInfo Text
+data JwtAuthInfo = JwtAuthInfo {
+     jwtAuthInfoUsername :: Text,
+     jwtAuthInfoFamilyName :: Maybe Text,
+     jwtAuthInfoGivenName :: Maybe Text
+  }
+
   deriving (Show, Eq)
 
 instance FromJSON JwtAuthInfo where
  parseJSON (Object v) =
     JwtAuthInfo <$> v .: "preferred_username"
+                <*> v .: "family_name"
+                <*> v .: "given_name"
  parseJSON _ = mzero
 
 jwtAuthInfoIdent :: JwtAuthInfo -> Text
-jwtAuthInfoIdent (JwtAuthInfo ident) = ident
+jwtAuthInfoIdent jwtAuthInfo = jwtAuthInfoUsername jwtAuthInfo
+
+jwtAuthInfoCustomField :: Text -> JwtAuthInfo -> Maybe Text
+jwtAuthInfoCustomField "given_name" jwt = jwtAuthInfoGivenName jwt
+jwtAuthInfoCustomField "family_name" jwt = jwtAuthInfoFamilyName jwt
+jwtAuthInfoCustomField _ _ = Nothing
 
 authorizationTokenAuth :: Handler (Maybe JwtAuthInfo)
 authorizationTokenAuth = do

Handler/ShowChallenge.hs

@@ -27,6 +27,7 @@ import Handler.Dashboard
 import Handler.Common
 import Handler.Evaluate
 import Handler.JWT
+import Handler.Team
 
 import Database.Persist.Sql (fromSqlKey)
 
@@ -1112,10 +1113,32 @@ getAddUserR = do
       case x of
         Just _ -> return $ Bool False
         Nothing -> do
-          _ <- runDB $ insert User
+          -- family or given name can be used for a team name
+          -- (as an ugly work-around...), hence we look at TEAM_FIELD and when
+          -- it is set to "given_name" or "family_name" it is not
+          -- considered a part of the user's
+          -- name
+
+          app <- getYesod
+          let teamField = appTeamField $ appSettings app
+
+          let uname = intercalate " " $ catMaybes (
+                [if teamField /= (Just "given_name")
+                 then jwtAuthInfoGivenName infos
+                 else Nothing,
+                 if teamField /= (Just "family_name")
+                 then jwtAuthInfoFamilyName infos
+                 else Nothing])
+
+
+          let mUName = if (null uname)
+                      then Nothing
+                      else (Just uname)
+
+          userId <- runDB $ insert User
             { userIdent = ident
             , userPassword = Nothing
-            , userName = Nothing
+            , userName = mUName
             , userIsAdmin = False
             , userLocalId = Nothing
             , userIsAnonymous = False
@@ -1125,6 +1148,23 @@ getAddUserR = do
             , userTriggerToken = Nothing
             , userAltRepoScheme = Nothing
             }
+
+          case teamField of
+            Just teamFieldName -> do
+              case jwtAuthInfoCustomField teamFieldName infos of
+                Just team -> do
+                  t <- runDB $ getBy $ UniqueTeam team
+                  (teamId, isCaptain) <- case t of
+                    Just (Entity existingTeamId _) -> return (existingTeamId, False)
+                    Nothing -> do
+                      newTeamId <- runDB $ insert $ Team {teamIdent = team,
+                                                         teamAvatar = Nothing}
+                      return (newTeamId, True)
+                  runDB $ addMemberToTeam userId teamId isCaptain
+                  return ()
+                Nothing -> return ()
+            Nothing -> return ()
+
           return $ Bool True
     Nothing -> return $ Bool False
 

Settings.hs

@@ -19,7 +19,6 @@ import Yesod.Default.Util          (WidgetFileSettings, widgetFileNoReload,
                                     widgetFileReload)
 
 import qualified Jose.Jwk as JWK
-import Data.Aeson
 
 data RepoScheme = SelfHosted | Branches
                   deriving (Eq, Show)
@@ -108,6 +107,9 @@ data AppSettings = AppSettings
     , appIsPublic :: Bool
     , appJSONWebKey :: Maybe JWK.Jwk
     , appViewingProgressStyle   :: ViewingProgressStyle
+    -- ^ Take the team name from a given metadata field
+    -- Currently makes sense only when JWT token is used
+    , appTeamField :: Maybe Text
     }
 
 instance FromJSON AppSettings where
@@ -157,6 +159,8 @@ instance FromJSON AppSettings where
 
         appViewingProgressStyle   <- toViewingProgressStyle <$> o .: "viewing-progress-style"
 
+        appTeamField             <- o .:? "team-field"
+
         return AppSettings {..}
 
 -- | Settings for 'widgetFile', such as which template languages to support and

config/settings.yml

@@ -71,4 +71,9 @@ location: "_env:LOCATION:"
 # Note: at the moment, only RS256 is handled.
 json-web-key: "_env:JSON_WEB_KEY"
 
+# Take the team name of a user from a given metadata field. Currently
+# handled only when JWK is used, family_name and given_name are handled.
+# If one of these is set, it is not considered a part of the username.
+team-field: "_env:TEAM_FIELD"
+
 #analytics: UA-YOURCODE