From 8c7e9f4a1357f230ce7fd7a4b4f54dbab7e191ef Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Tue, 10 Nov 2015 21:35:42 +0100
Subject: [PATCH] ID and SSH pub key can be set by the user

---
 Foundation.hs          |  2 ++
 Handler/YourAccount.hs | 63 ++++++++++++++++++++++++++++++++++++------
 config/models          |  2 ++
 gonito.cabal           |  1 +
 messages/en.msg        |  2 ++
 5 files changed, 62 insertions(+), 8 deletions(-)

diff --git a/Foundation.hs b/Foundation.hs
index ec58c62..ecc1c42 100644
--- a/Foundation.hs
+++ b/Foundation.hs
@@ -173,6 +173,8 @@ instance YesodAuth App where
                     , userPassword = Nothing
                     , userName = Nothing
                     , userIsAdmin = False
+                    , userLocalId = Nothing
+                    , userSshPubKey = Nothing
                     }
 
     -- You can add other plugins like BrowserID, email or OAuth here
diff --git a/Handler/YourAccount.hs b/Handler/YourAccount.hs
index 45e19f3..d7150d7 100644
--- a/Handler/YourAccount.hs
+++ b/Handler/YourAccount.hs
@@ -7,11 +7,13 @@ import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
 import Handler.Shared
 import Handler.Extract
 
+import Text.Regex.TDFA
+
 getYourAccountR :: Handler Html
 getYourAccountR = do
     userId <- requireAuthId
     user <- runDB $ get404 userId
-    (formWidget, formEnctype) <- generateFormPost (yourAccountForm $ userName user)
+    (formWidget, formEnctype) <- generateFormPost (yourAccountForm (userName user) (userLocalId user) (userSshPubKey user))
     let submission = Nothing :: Maybe (Import.FileInfo, Text)
         handlerName = "getYourAccountR" :: Text
     defaultLayout $ do
@@ -21,22 +23,67 @@ getYourAccountR = do
 
 postYourAccountR :: Handler Html
 postYourAccountR = do
-    ((result, formWidget), formEnctype) <- runFormPost (yourAccountForm Nothing)
+    ((result, formWidget), formEnctype) <- runFormPost (yourAccountForm Nothing Nothing Nothing)
     let handlerName = "postYourAccountR" :: Text
         accountData = case result of
             FormSuccess res -> Just res
             _ -> Nothing
-        Just (name, aboutMe) = accountData
+        Just (name, localId, sshPubKey) = accountData
     userId <- requireAuthId
-    runDB $ update userId [UserName =. name]
+    updateUserAccount userId name localId sshPubKey
     user <- runDB $ get404 userId
     defaultLayout $ do
         aDomId <- newIdent
         setTitle "Your account"
         $(widgetFile "your-account")
 
-
-yourAccountForm :: Maybe Text -> Form (Maybe Text, Maybe Text)
-yourAccountForm maybeName = renderBootstrap3 BootstrapBasicForm $ (,)
+yourAccountForm :: Maybe Text -> Maybe Text -> Maybe Text -> Form (Maybe Text, Maybe Text, Maybe Text)
+yourAccountForm maybeName maybeLocalId maybeSshPubKey = renderBootstrap3 BootstrapBasicForm $ (,,)
     <$> aopt textField (fieldSettingsLabel MsgAccountName) (Just maybeName)
-    <*> aopt textField (fieldSettingsLabel MsgAboutMe) Nothing
+    <*> aopt textField (fieldSettingsLabel MsgId) (Just maybeLocalId)
+    <*> aopt textField (fieldSettingsLabel MsgSshPubKey) (Just maybeSshPubKey)
+
+localIdRegexp = makeRegexOpts defaultCompOpt{newSyntax=True} defaultExecOpt ("\\`[a-z][-a-z0-9]{0,31}\\'" ::String)
+
+unwantedLocalIds :: [Text]
+unwantedLocalIds = ["git",
+                    "gitolite",
+                    "admin",
+                    "root",
+                    "filipg"]
+
+isLocalIdAcceptable :: Text -> Bool
+isLocalIdAcceptable localId =
+  match localIdRegexp (unpack localId) && not (localId `elem` unwantedLocalIds)
+
+updateUserAccount :: Key User -> Maybe Text -> Maybe Text -> Maybe Text -> Handler ()
+updateUserAccount userId name maybeLocalId maybeSshPubKey = do
+  updateJustName userId name
+  updateLocalIdAndPubKey userId maybeLocalId maybeSshPubKey
+
+updateLocalIdAndPubKey :: Key User -> Maybe Text -> Maybe Text -> Handler ()
+updateLocalIdAndPubKey userId (Just localId) maybeSshPubKey = do
+  if isLocalIdAcceptable localId
+    then
+     do
+      otherTheSame <- runDB $ selectFirst [UserLocalId ==. (Just localId), UserId !=. userId] []
+      case otherTheSame of
+        Just _ -> do
+          setMessage $ toHtml ("ID already used" :: Text)
+        Nothing -> do
+          user <- runDB $ get404 userId
+          case userLocalId user of
+             Just prevLocalId -> do
+               unless (prevLocalId == localId) $ setMessage $ toHtml ("only the administrator can change your ID" :: Text)
+             Nothing -> do
+               runDB $ update userId [UserLocalId =. (Just localId), UserSshPubKey =. maybeSshPubKey]
+    else
+      setMessage $ toHtml ("unexpected ID (use only lower-case letters, digits and hyphens, start with a letter)" :: Text)
+
+updateLocalIdAndPubKey _ Nothing (Just _) = do
+  setMessage $ toHtml ("SSH public key cannot be added without an ID" :: Text)
+
+updateLocalIdAndPubKey _ Nothing Nothing = return ()
+
+updateJustName :: Key User -> Maybe Text -> Handler ()
+updateJustName userId name = runDB $ update userId [UserName =. name]
diff --git a/config/models b/config/models
index f851dde..5536ed4 100644
--- a/config/models
+++ b/config/models
@@ -4,6 +4,8 @@ User
     UniqueUser ident
     name Text Maybe
     isAdmin Bool default=True
+    localId Text Maybe
+    sshPubKey Text Maybe
     deriving Typeable
 Email
     email Text
diff --git a/gonito.cabal b/gonito.cabal
index 1685afe..1a261ce 100644
--- a/gonito.cabal
+++ b/gonito.cabal
@@ -112,6 +112,7 @@ library
                  , geval
                  , filepath
                  , yesod-table
+                 , regex-tdfa
 
 executable         gonito
     if flag(library-only)
diff --git a/messages/en.msg b/messages/en.msg
index 2c9351b..c29d31b 100644
--- a/messages/en.msg
+++ b/messages/en.msg
@@ -16,3 +16,5 @@ SubmissionDescription: Submission description
 YourAccount: your account
 AboutMe: about me
 AccountName: name
+Id: ID
+SshPubKey: your SSH public key