webapp: Added help buttons and links next to fields that require explanations.
This commit is contained in:
parent
98231b3248
commit
4f4209b833
14 changed files with 254 additions and 63 deletions
|
@ -61,9 +61,9 @@ extractCreds i = AWSCreds (accessKeyID i) (secretAccessKey i)
|
|||
|
||||
s3InputAForm :: AForm WebApp WebApp AWSInput
|
||||
s3InputAForm = AWSInput
|
||||
<$> areq textField "Access Key ID" Nothing
|
||||
<*> areq passwordField "Secret Access Key" Nothing
|
||||
<*> areq (selectFieldList $ M.toList $ AWS.regionMap AWS.S3) "Datacenter" (Just $ AWS.defaultRegion AWS.S3)
|
||||
<$> accessKeyIDField
|
||||
<*> secretAccessKeyField
|
||||
<*> datacenterField AWS.S3
|
||||
<*> areq (selectFieldList storageclasses) "Storage class" (Just StandardRedundancy)
|
||||
<*> areq textField "Repository name" (Just "S3")
|
||||
where
|
||||
|
@ -73,27 +73,35 @@ s3InputAForm = AWSInput
|
|||
, ("Reduced redundancy (costs less)", ReducedRedundancy)
|
||||
]
|
||||
|
||||
textField' :: RenderMessage master FormMessage => Field sub master Text
|
||||
textField' = Field
|
||||
{ fieldParse = fieldParse textField
|
||||
, fieldView = \theId name attrs val _isReq ->
|
||||
[whamlet|
|
||||
<input id="#{theId}" name="#{name}" *{attrs} type="text" value="#{either id id val}">
|
||||
|]
|
||||
}
|
||||
|
||||
glacierInputAForm :: AForm WebApp WebApp AWSInput
|
||||
glacierInputAForm = AWSInput
|
||||
<$> areq textField "Access Key ID" Nothing
|
||||
<*> areq passwordField "Secret Access Key" Nothing
|
||||
<*> areq (selectFieldList $ M.toList $ AWS.regionMap AWS.Glacier) "Datacenter" (Just $ AWS.defaultRegion AWS.Glacier)
|
||||
<$> accessKeyIDField
|
||||
<*> secretAccessKeyField
|
||||
<*> datacenterField AWS.Glacier
|
||||
<*> pure StandardRedundancy
|
||||
<*> areq textField "Repository name" (Just "glacier")
|
||||
|
||||
awsCredsAForm :: AForm WebApp WebApp AWSCreds
|
||||
awsCredsAForm = AWSCreds
|
||||
<$> areq textField "Access Key ID" Nothing
|
||||
<*> areq passwordField "Secret Access Key" Nothing
|
||||
<$> accessKeyIDField
|
||||
<*> secretAccessKeyField
|
||||
|
||||
accessKeyIDField :: AForm WebApp WebApp Text
|
||||
accessKeyIDField = areq (textField `withNote` help) "Access Key ID" Nothing
|
||||
where
|
||||
help = [whamlet|
|
||||
<a href="https://portal.aws.amazon.com/gp/aws/securityCredentials#id_block">
|
||||
Get Amazon access keys
|
||||
|]
|
||||
|
||||
secretAccessKeyField :: AForm WebApp WebApp Text
|
||||
secretAccessKeyField = areq passwordField "Secret Access Key" Nothing
|
||||
|
||||
datacenterField :: AWS.Service -> AForm WebApp WebApp Text
|
||||
datacenterField service = areq (selectFieldList list) "Datacenter" defregion
|
||||
where
|
||||
list = M.toList $ AWS.regionMap service
|
||||
defregion = Just $ AWS.defaultRegion service
|
||||
|
||||
getAddS3R :: Handler RepHtml
|
||||
#ifdef WITH_S3
|
||||
|
|
|
@ -89,9 +89,10 @@ editRepositoryAForm :: RepoConfig -> AForm WebApp WebApp RepoConfig
|
|||
editRepositoryAForm def = RepoConfig
|
||||
<$> areq textField "Name" (Just $ repoName def)
|
||||
<*> aopt textField "Description" (Just $ repoDescription def)
|
||||
<*> areq (selectFieldList $ customgroups++standardgroups) "Repository group" (Just $ repoGroup def)
|
||||
<*> areq (selectFieldList groups `withNote` help) "Repository group" (Just $ repoGroup def)
|
||||
<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def)
|
||||
where
|
||||
groups = customgroups ++ standardgroups
|
||||
standardgroups :: [(Text, RepoGroup)]
|
||||
standardgroups = map (\g -> (T.pack $ descStandardGroup g , RepoGroupStandard g))
|
||||
[minBound :: StandardGroup .. maxBound :: StandardGroup]
|
||||
|
@ -99,6 +100,7 @@ editRepositoryAForm def = RepoConfig
|
|||
customgroups = case repoGroup def of
|
||||
RepoGroupCustom s -> [(T.pack s, RepoGroupCustom s)]
|
||||
_ -> []
|
||||
help = [whamlet|<a href="@{RepoGroupR}">What's this?</a>|]
|
||||
|
||||
getEditRepositoryR :: UUID -> Handler RepHtml
|
||||
getEditRepositoryR = editForm False
|
||||
|
|
|
@ -47,13 +47,13 @@ mkSshData s = SshData
|
|||
, rsyncOnly = False
|
||||
}
|
||||
|
||||
sshInputAForm :: SshInput -> AForm WebApp WebApp SshInput
|
||||
sshInputAForm def = SshInput
|
||||
sshInputAForm :: (Field WebApp WebApp Text) -> SshInput -> AForm WebApp WebApp SshInput
|
||||
sshInputAForm hostnamefield def = SshInput
|
||||
<$> aopt check_hostname "Host name" (Just $ hostname def)
|
||||
<*> aopt check_username "User name" (Just $ username def)
|
||||
<*> aopt textField "Directory" (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ directory def)
|
||||
where
|
||||
check_hostname = checkM (liftIO . checkdns) textField
|
||||
check_hostname = checkM (liftIO . checkdns) hostnamefield
|
||||
checkdns t = do
|
||||
let h = T.unpack t
|
||||
r <- catchMaybeIO $ getAddrInfo canonname (Just h) Nothing
|
||||
|
@ -89,7 +89,7 @@ getAddSshR :: Handler RepHtml
|
|||
getAddSshR = sshConfigurator $ do
|
||||
u <- liftIO $ T.pack <$> myUserName
|
||||
((result, form), enctype) <- lift $
|
||||
runFormGet $ renderBootstrap $ sshInputAForm $
|
||||
runFormGet $ renderBootstrap $ sshInputAForm textField $
|
||||
SshInput Nothing (Just u) Nothing
|
||||
case result of
|
||||
FormSuccess sshinput -> do
|
||||
|
@ -115,7 +115,7 @@ getEnableRsyncR u = do
|
|||
case (parseSshRsyncUrl =<< M.lookup "rsyncurl" m, M.lookup "name" m) of
|
||||
(Just sshinput, Just reponame) -> sshConfigurator $ do
|
||||
((result, form), enctype) <- lift $
|
||||
runFormGet $ renderBootstrap $ sshInputAForm sshinput
|
||||
runFormGet $ renderBootstrap $ sshInputAForm textField sshinput
|
||||
case result of
|
||||
FormSuccess sshinput'
|
||||
| isRsyncNet (hostname sshinput') ->
|
||||
|
@ -276,7 +276,7 @@ makeSshRepo forcersync setup sshdata = do
|
|||
getAddRsyncNetR :: Handler RepHtml
|
||||
getAddRsyncNetR = do
|
||||
((result, form), enctype) <- runFormGet $
|
||||
renderBootstrap $ sshInputAForm $
|
||||
renderBootstrap $ sshInputAForm hostnamefield $
|
||||
SshInput Nothing Nothing Nothing
|
||||
let showform status = page "Add a Rsync.net repository" (Just Config) $
|
||||
$(widgetFile "configurators/addrsync.net")
|
||||
|
@ -290,6 +290,19 @@ getAddRsyncNetR = do
|
|||
showform $ UnusableServer
|
||||
"That is not a rsync.net host name."
|
||||
_ -> showform UntestedServer
|
||||
where
|
||||
hostnamefield = textField `withNote` help
|
||||
help = [whamlet|
|
||||
<a .btn data-toggle="collapse" data-target="#help">
|
||||
Help
|
||||
<div #help .collapse>
|
||||
<div>
|
||||
When you sign up for a Rsync.net account, you should receive an #
|
||||
email from them with the host name and user name to put here.
|
||||
<div>
|
||||
The host name will be something like "usw-s001.rsync.net", and the #
|
||||
user name something like "7491"
|
||||
|]
|
||||
|
||||
makeRsyncNet :: SshInput -> String -> (Remote -> Handler ()) -> Handler RepHtml
|
||||
makeRsyncNet sshinput reponame setup = do
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue