webapp: Added help buttons and links next to fields that require explanations.

Assistant/WebApp/Configurators/AWS.hs

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

Assistant/WebApp/Configurators/Edit.hs

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

Assistant/WebApp/Configurators/Ssh.hs

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