Be possible to set alternative repo scheme

This commit is contained in:
Filip Gralinski 2020-02-21 23:16:06 +01:00
parent e935cb6182
commit 7560d3ca17
6 changed files with 19 additions and 12 deletions

View File

@ -123,6 +123,7 @@ initAdmin (Just adminUser) (Just adminPass) = do
, userVerificationKey = Nothing
, userKeyExpirationDate = Nothing
, userTriggerToken = Nothing
, userAltRepoScheme = Nothing
}
return ()

View File

@ -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

View File

@ -73,6 +73,7 @@ createOrUse Nothing userIdentifier = do
Nothing
Nothing
(Just triggerToken)
Nothing
return userId
createResetLinkForm :: Form (Text, Maybe CourseId)

View File

@ -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]

View File

@ -10,6 +10,7 @@ User
verificationKey Text Maybe
keyExpirationDate UTCTime Maybe
triggerToken Text Maybe
altRepoScheme Text Maybe
deriving Typeable
PublicKey
user UserId

View File

@ -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