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 , userVerificationKey = Nothing
, userKeyExpirationDate = Nothing , userKeyExpirationDate = Nothing
, userTriggerToken = Nothing , userTriggerToken = Nothing
, userAltRepoScheme = Nothing
} }
return () return ()

View File

@ -77,10 +77,6 @@ isTrusted :: User -> Bool
isTrusted user = isTrusted user =
case userIdent user of case userIdent user of
"ptlen@ceti.pl" -> True "ptlen@ceti.pl" -> True
"hexin1989@gmail.com" -> True
"romang@amu.edu.pl" -> True
"junczys@amu.edu.pl" -> True
"rafalj@amu.edu.pl" -> True
_ -> True _ -> True
data LayoutCustomization = LayoutCustomization { data LayoutCustomization = LayoutCustomization {
@ -266,6 +262,7 @@ instance YesodAuth App where
, userVerificationKey = Nothing , userVerificationKey = Nothing
, userKeyExpirationDate = Nothing , userKeyExpirationDate = Nothing
, userTriggerToken = Nothing , userTriggerToken = Nothing
, userAltRepoScheme = Nothing
} }
-- You can add other plugins like BrowserID, email or OAuth here -- You can add other plugins like BrowserID, email or OAuth here

View File

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

View File

@ -19,14 +19,14 @@ getYourAccountR = do
keyS <- runDB $ selectFirst [PublicKeyUser ==. userId] [] keyS <- runDB $ selectFirst [PublicKeyUser ==. userId] []
let key = publicKeyPubkey <$> entityVal <$> keyS 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 defaultLayout $ do
setTitle "Your account" setTitle "Your account"
$(widgetFile "your-account") $(widgetFile "your-account")
postYourAccountR :: Handler Html postYourAccountR :: Handler Html
postYourAccountR = do postYourAccountR = do
((result, formWidget), formEnctype) <- runFormPost (yourAccountForm Nothing Nothing Nothing False) ((result, formWidget), formEnctype) <- runFormPost (yourAccountForm Nothing Nothing Nothing Nothing False)
userId <- requireAuthId userId <- requireAuthId
user <- runDB $ get404 userId user <- runDB $ get404 userId
@ -36,10 +36,10 @@ postYourAccountR = do
FormSuccess res -> Just res FormSuccess res -> Just res
_ -> Nothing _ -> Nothing
case accountData of case accountData of
Just (name, localId, mPassword, sshPubKey, avatarFile, anonimised) -> do Just (name, localId, mPassword, sshPubKey, mAltRepoScheme, avatarFile, anonimised) -> do
if checkPassword mPassword if checkPassword mPassword
then then
updateUserAccount userId name localId mPassword sshPubKey avatarFile anonimised updateUserAccount userId name localId mPassword sshPubKey mAltRepoScheme avatarFile anonimised
else else
tooWeakPasswordMessage tooWeakPasswordMessage
Nothing -> do Nothing -> do
@ -57,21 +57,23 @@ autocompleteOff :: (RenderMessage master msg2, RenderMessage master msg1) => msg
autocompleteOff name tooltip = setts { fsAttrs = (fsAttrs setts) ++ [("autocomplete", "nope")]} autocompleteOff name tooltip = setts { fsAttrs = (fsAttrs setts) ++ [("autocomplete", "nope")]}
where setts = (bfs name) { fsTooltip = Just $ SomeMessage tooltip } 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 :: 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 anonimised = renderBootstrap3 BootstrapBasicForm $ (,,,,,) yourAccountForm maybeName maybeLocalId maybeSshPubKey maybeAltRepoScheme anonimised = renderBootstrap3 BootstrapBasicForm $ (,,,,,,)
<$> aopt textField (fieldWithTooltip MsgAccountName MsgAccountNameTooltip) (Just maybeName) <$> aopt textField (fieldWithTooltip MsgAccountName MsgAccountNameTooltip) (Just maybeName)
<*> aopt textField (autocompleteOff MsgId MsgIdTooltip) (Just maybeLocalId) <*> aopt textField (autocompleteOff MsgId MsgIdTooltip) (Just maybeLocalId)
<*> aopt passwordConfirmField (bfs MsgPassword) Nothing <*> aopt passwordConfirmField (bfs MsgPassword) Nothing
<*> aopt textField (fieldWithTooltip MsgSshPubKey MsgSshPubKeyTooltip) (Just maybeSshPubKey) <*> aopt textField (fieldWithTooltip MsgSshPubKey MsgSshPubKeyTooltip) (Just maybeSshPubKey)
<*> aopt textField (fieldWithTooltip MsgAltRepoScheme MsgAltRepoSchemeTooltip) (Just maybeAltRepoScheme)
<*> fileAFormOpt (bfs MsgAvatar) <*> fileAFormOpt (bfs MsgAvatar)
<*> areq checkBoxField (bfs MsgWantToBeAnonimised) (Just anonimised) <*> areq checkBoxField (bfs MsgWantToBeAnonimised) (Just anonimised)
updateUserAccount :: Key User -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe FileInfo -> Bool -> Handler () updateUserAccount :: Key User -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe FileInfo -> Bool -> Handler ()
updateUserAccount userId name maybeLocalId maybePassword maybeSshPubKey maybeAvatarFile anonimised = do updateUserAccount userId name maybeLocalId maybePassword maybeSshPubKey maybeAltRepoScheme maybeAvatarFile anonimised = do
updateJustName userId name updateJustName userId name
updateAvatar userId maybeAvatarFile updateAvatar userId maybeAvatarFile
updateLocalIdAndPubKey userId maybeLocalId maybeSshPubKey updateLocalIdAndPubKey userId maybeLocalId maybeSshPubKey
updateAnonimity userId anonimised updateAnonimity userId anonimised
updateAltRepoScheme userId maybeAltRepoScheme
case maybePassword of case maybePassword of
Nothing -> return () Nothing -> return ()
Just "" -> return () Just "" -> return ()
@ -117,6 +119,9 @@ updateLocalIdAndPubKey _ Nothing (Just _) = do
updateLocalIdAndPubKey _ Nothing Nothing = return () 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 :: Key User -> Maybe Text -> Handler ()
updateJustName userId name = runDB $ update userId [UserName =. name] updateJustName userId name = runDB $ update userId [UserName =. name]

View File

@ -10,6 +10,7 @@ User
verificationKey Text Maybe verificationKey Text Maybe
keyExpirationDate UTCTime Maybe keyExpirationDate UTCTime Maybe
triggerToken Text Maybe triggerToken Text Maybe
altRepoScheme Text Maybe
deriving Typeable deriving Typeable
PublicKey PublicKey
user UserId 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 ChallengeDeadlineTooltip: no submissions will be accepted after the deadline; this can be used for organizing competitions set in time
WritingPapers: writing papers with Gonito WritingPapers: writing papers with Gonito
UserIdentifier: user login/identifier 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