From 7560d3ca1705a1d350d9c7632f8d217dc9e321b0 Mon Sep 17 00:00:00 2001 From: Filip Gralinski Date: Fri, 21 Feb 2020 23:16:06 +0100 Subject: [PATCH] Be possible to set alternative repo scheme --- Application.hs | 1 + Foundation.hs | 5 +---- Handler/AccountReset.hs | 1 + Handler/YourAccount.hs | 21 +++++++++++++-------- config/models | 1 + messages/en.msg | 2 ++ 6 files changed, 19 insertions(+), 12 deletions(-) diff --git a/Application.hs b/Application.hs index f91e734..ab3b050 100644 --- a/Application.hs +++ b/Application.hs @@ -123,6 +123,7 @@ initAdmin (Just adminUser) (Just adminPass) = do , userVerificationKey = Nothing , userKeyExpirationDate = Nothing , userTriggerToken = Nothing + , userAltRepoScheme = Nothing } return () diff --git a/Foundation.hs b/Foundation.hs index 4e45806..8bdcac2 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -77,10 +77,6 @@ isTrusted :: User -> Bool isTrusted user = case userIdent user of "ptlen@ceti.pl" -> True - "hexin1989@gmail.com" -> True - "romang@amu.edu.pl" -> True - "junczys@amu.edu.pl" -> True - "rafalj@amu.edu.pl" -> True _ -> True data LayoutCustomization = LayoutCustomization { @@ -266,6 +262,7 @@ instance YesodAuth App where , userVerificationKey = Nothing , userKeyExpirationDate = Nothing , userTriggerToken = Nothing + , userAltRepoScheme = Nothing } -- You can add other plugins like BrowserID, email or OAuth here diff --git a/Handler/AccountReset.hs b/Handler/AccountReset.hs index b02ebcd..c28be98 100644 --- a/Handler/AccountReset.hs +++ b/Handler/AccountReset.hs @@ -73,6 +73,7 @@ createOrUse Nothing userIdentifier = do Nothing Nothing (Just triggerToken) + Nothing return userId createResetLinkForm :: Form (Text, Maybe CourseId) diff --git a/Handler/YourAccount.hs b/Handler/YourAccount.hs index a05c620..8f86c09 100644 --- a/Handler/YourAccount.hs +++ b/Handler/YourAccount.hs @@ -19,14 +19,14 @@ getYourAccountR = do keyS <- runDB $ selectFirst [PublicKeyUser ==. userId] [] let key = publicKeyPubkey <$> entityVal <$> keyS - (formWidget, formEnctype) <- generateFormPost (yourAccountForm (userName user) (userLocalId user) key (userIsAnonymous user)) + (formWidget, formEnctype) <- generateFormPost (yourAccountForm (userName user) (userLocalId user) key (userAltRepoScheme user) (userIsAnonymous user)) defaultLayout $ do setTitle "Your account" $(widgetFile "your-account") postYourAccountR :: Handler Html postYourAccountR = do - ((result, formWidget), formEnctype) <- runFormPost (yourAccountForm Nothing Nothing Nothing False) + ((result, formWidget), formEnctype) <- runFormPost (yourAccountForm Nothing Nothing Nothing Nothing False) userId <- requireAuthId user <- runDB $ get404 userId @@ -36,10 +36,10 @@ postYourAccountR = do FormSuccess res -> Just res _ -> Nothing case accountData of - Just (name, localId, mPassword, sshPubKey, avatarFile, anonimised) -> do + Just (name, localId, mPassword, sshPubKey, mAltRepoScheme, avatarFile, anonimised) -> do if checkPassword mPassword then - updateUserAccount userId name localId mPassword sshPubKey avatarFile anonimised + updateUserAccount userId name localId mPassword sshPubKey mAltRepoScheme avatarFile anonimised else tooWeakPasswordMessage Nothing -> do @@ -57,21 +57,23 @@ autocompleteOff :: (RenderMessage master msg2, RenderMessage master msg1) => msg autocompleteOff name tooltip = setts { fsAttrs = (fsAttrs setts) ++ [("autocomplete", "nope")]} where setts = (bfs name) { fsTooltip = Just $ SomeMessage tooltip } -yourAccountForm :: Maybe Text -> Maybe Text -> Maybe Text -> Bool -> Form (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe FileInfo, Bool) -yourAccountForm maybeName maybeLocalId maybeSshPubKey anonimised = renderBootstrap3 BootstrapBasicForm $ (,,,,,) +yourAccountForm :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Bool -> Form (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe FileInfo, Bool) +yourAccountForm maybeName maybeLocalId maybeSshPubKey maybeAltRepoScheme anonimised = renderBootstrap3 BootstrapBasicForm $ (,,,,,,) <$> aopt textField (fieldWithTooltip MsgAccountName MsgAccountNameTooltip) (Just maybeName) <*> aopt textField (autocompleteOff MsgId MsgIdTooltip) (Just maybeLocalId) <*> aopt passwordConfirmField (bfs MsgPassword) Nothing <*> aopt textField (fieldWithTooltip MsgSshPubKey MsgSshPubKeyTooltip) (Just maybeSshPubKey) + <*> aopt textField (fieldWithTooltip MsgAltRepoScheme MsgAltRepoSchemeTooltip) (Just maybeAltRepoScheme) <*> fileAFormOpt (bfs MsgAvatar) <*> areq checkBoxField (bfs MsgWantToBeAnonimised) (Just anonimised) -updateUserAccount :: Key User -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe FileInfo -> Bool -> Handler () -updateUserAccount userId name maybeLocalId maybePassword maybeSshPubKey maybeAvatarFile anonimised = do +updateUserAccount :: Key User -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe FileInfo -> Bool -> Handler () +updateUserAccount userId name maybeLocalId maybePassword maybeSshPubKey maybeAltRepoScheme maybeAvatarFile anonimised = do updateJustName userId name updateAvatar userId maybeAvatarFile updateLocalIdAndPubKey userId maybeLocalId maybeSshPubKey updateAnonimity userId anonimised + updateAltRepoScheme userId maybeAltRepoScheme case maybePassword of Nothing -> return () Just "" -> return () @@ -117,6 +119,9 @@ updateLocalIdAndPubKey _ Nothing (Just _) = do updateLocalIdAndPubKey _ Nothing Nothing = return () +updateAltRepoScheme :: Key User -> Maybe Text -> Handler () +updateAltRepoScheme userId mAltRepoScheme = runDB $ update userId [UserAltRepoScheme =. mAltRepoScheme] + updateJustName :: Key User -> Maybe Text -> Handler () updateJustName userId name = runDB $ update userId [UserName =. name] diff --git a/config/models b/config/models index 6aa0fcb..3e111e0 100644 --- a/config/models +++ b/config/models @@ -10,6 +10,7 @@ User verificationKey Text Maybe keyExpirationDate UTCTime Maybe triggerToken Text Maybe + altRepoScheme Text Maybe deriving Typeable PublicKey user UserId diff --git a/messages/en.msg b/messages/en.msg index c929ff2..7f701fd 100644 --- a/messages/en.msg +++ b/messages/en.msg @@ -88,3 +88,5 @@ ChallengeDeadlineTime: challenge deadline time ChallengeDeadlineTooltip: no submissions will be accepted after the deadline; this can be used for organizing competitions set in time WritingPapers: writing papers with Gonito UserIdentifier: user login/identifier +AltRepoScheme: alternative git repo scheme (URL without the challenge name pointing to some external server) +AltRepoSchemeTooltip: set this if you want to use an alternative git server for all your submissions