switch to runFormPostNoToken to work around strange yesod bug

I am not happy about disabling yesod's XSRF tokens, but the webapp has two
guards of its own that should suffice: Listening only to localhost
(normally) and requiring its own auth token on every single request
(always).

Assistant/WebApp/Configurators/AWS.hs

@@ -121,7 +121,7 @@ postAddS3R :: Handler Html
 postAddS3R = awsConfigurator $ do
 	defcreds <- liftAnnex previouslyUsedAWSCreds
 	((result, form), enctype) <- liftH $
-		runFormPost $ renderBootstrap $ s3InputAForm defcreds
+		runFormPostNoToken $ renderBootstrap $ s3InputAForm defcreds
 	case result of
 		FormSuccess input -> liftH $ do
 			let name = T.unpack $ repoName input
@@ -144,7 +144,7 @@ postAddGlacierR :: Handler Html
 postAddGlacierR = glacierConfigurator $ do
 	defcreds <- liftAnnex previouslyUsedAWSCreds
 	((result, form), enctype) <- liftH $
-		runFormPost $ renderBootstrap $ glacierInputAForm defcreds
+		runFormPostNoToken $ renderBootstrap $ glacierInputAForm defcreds
 	case result of
 		FormSuccess input -> liftH $ do
 			let name = T.unpack $ repoName input
@@ -187,7 +187,7 @@ enableAWSRemote :: RemoteType -> UUID -> Widget
 enableAWSRemote remotetype uuid = do
 	defcreds <- liftAnnex previouslyUsedAWSCreds
 	((result, form), enctype) <- liftH $
-		runFormPost $ renderBootstrap $ awsCredsAForm defcreds
+		runFormPostNoToken $ renderBootstrap $ awsCredsAForm defcreds
 	case result of
 		FormSuccess creds -> liftH $ do
 			m <- liftAnnex readRemoteLog

Assistant/WebApp/Configurators/Delete.hs

@@ -81,7 +81,7 @@ deleteCurrentRepository = dangerPage $ do
 	havegitremotes <- haveremotes syncGitRemotes
 	havedataremotes <- haveremotes syncDataRemotes
 	((result, form), enctype) <- liftH $
-		runFormPost $ renderBootstrap $ sanityVerifierAForm $
+		runFormPostNoToken $ renderBootstrap $ sanityVerifierAForm $
 			SanityVerifier magicphrase
 	case result of
 		FormSuccess _ -> liftH $ do

Assistant/WebApp/Configurators/Edit.hs

@@ -181,7 +181,7 @@ editForm new uuid = page "Edit repository" (Just Configuration) $ do
 	curr <- liftAnnex $ getRepoConfig uuid mremote
 	liftAnnex $ checkAssociatedDirectory curr mremote
 	((result, form), enctype) <- liftH $
-		runFormPost $ renderBootstrap $ editRepositoryAForm (isNothing mremote) curr
+		runFormPostNoToken $ renderBootstrap $ editRepositoryAForm (isNothing mremote) curr
 	case result of
 		FormSuccess input -> liftH $ do
 			setRepoConfig uuid mremote curr input

Assistant/WebApp/Configurators/IA.hs

@@ -126,7 +126,7 @@ postAddIAR :: Handler Html
 postAddIAR = iaConfigurator $ do
 	defcreds <- liftAnnex previouslyUsedIACreds
 	((result, form), enctype) <- liftH $
-		runFormPost $ renderBootstrap $ iaInputAForm defcreds
+		runFormPostNoToken $ renderBootstrap $ iaInputAForm defcreds
 	case result of
 		FormSuccess input -> liftH $ do
 			let name = escapeBucket $ T.unpack $ itemName input
@@ -165,7 +165,7 @@ enableIARemote :: UUID -> Widget
 enableIARemote uuid = do
 	defcreds <- liftAnnex previouslyUsedIACreds
 	((result, form), enctype) <- liftH $
-		runFormPost $ renderBootstrap $ iaCredsAForm defcreds
+		runFormPostNoToken $ renderBootstrap $ iaCredsAForm defcreds
 	case result of
 		FormSuccess creds -> liftH $ do
 			m <- liftAnnex readRemoteLog

Assistant/WebApp/Configurators/Local.hs

@@ -155,7 +155,7 @@ postFirstRepositoryR = page "Getting started" (Just Configuration) $ do
 	let androidspecial = False
 	path <- liftIO . defaultRepositoryPath =<< liftH inFirstRun
 #endif
-	((res, form), enctype) <- liftH $ runFormPost $ newRepositoryForm path
+	((res, form), enctype) <- liftH $ runFormPostNoToken $ newRepositoryForm path
 	case res of
 		FormSuccess (RepositoryPath p) -> liftH $
 			startFullAssistant (T.unpack p) ClientGroup Nothing
@@ -178,7 +178,7 @@ getNewRepositoryR = postNewRepositoryR
 postNewRepositoryR :: Handler Html
 postNewRepositoryR = page "Add another repository" (Just Configuration) $ do
 	home <- liftIO myHomeDir
-	((res, form), enctype) <- liftH $ runFormPost $ newRepositoryForm home
+	((res, form), enctype) <- liftH $ runFormPostNoToken $ newRepositoryForm home
 	case res of
 		FormSuccess (RepositoryPath p) -> do
 			let path = T.unpack p
@@ -233,7 +233,7 @@ postAddDriveR = page "Add a removable drive" (Just Configuration) $ do
 	removabledrives <- liftIO driveList
 	writabledrives <- liftIO $
 		filterM (canWrite . T.unpack . mountPoint) removabledrives
-	((res, form), enctype) <- liftH $ runFormPost $
+	((res, form), enctype) <- liftH $ runFormPostNoToken $
 		selectDriveForm (sort writabledrives)
 	case res of
 		FormSuccess drive -> liftH $ redirect $ ConfirmAddDriveR drive

Assistant/WebApp/Configurators/Pairing.hs

@@ -265,7 +265,7 @@ data InputSecret = InputSecret { secretText :: Maybe Text }
 promptSecret :: Maybe PairMsg -> (Text -> Secret -> Widget) -> Handler Html
 promptSecret msg cont = pairPage $ do
 	((result, form), enctype) <- liftH $
-		runFormPost $ renderBootstrap $
+		runFormPostNoToken $ renderBootstrap $
 			InputSecret <$> aopt textField "Secret phrase" Nothing
 	case result of
 		FormSuccess v -> do

Assistant/WebApp/Configurators/Preferences.hs

@@ -90,7 +90,7 @@ postPreferencesR :: Handler Html
 postPreferencesR = page "Preferences" (Just Configuration) $ do
 	((result, form), enctype) <- liftH $ do
 		current <- liftAnnex getPrefs
-		runFormPost $ renderBootstrap $ prefsAForm current
+		runFormPostNoToken $ renderBootstrap $ prefsAForm current
 	case result of
 		FormSuccess new -> liftH $ do
 			liftAnnex $ storePrefs new

Assistant/WebApp/Configurators/Ssh.hs

@@ -116,7 +116,7 @@ postAddSshR :: Handler Html
 postAddSshR = sshConfigurator $ do
 	username <- liftIO $ T.pack <$> myUserName
 	((result, form), enctype) <- liftH $
-		runFormPost $ renderBootstrap $ sshInputAForm textField $
+		runFormPostNoToken $ renderBootstrap $ sshInputAForm textField $
 			SshInput Nothing (Just username) Nothing 22
 	case result of
 		FormSuccess sshinput -> do
@@ -168,7 +168,7 @@ enableSpecialSshRemote getsshinput rsyncnetsetup genericsetup u = do
 	case (mkSshInput . unmangle <$> getsshinput m, M.lookup "name" m) of
 		(Just sshinput, Just reponame) -> sshConfigurator $ do
 			((result, form), enctype) <- liftH $
-				runFormPost $ renderBootstrap $ sshInputAForm textField sshinput
+				runFormPostNoToken $ renderBootstrap $ sshInputAForm textField sshinput
 			case result of
 				FormSuccess sshinput'
 					| isRsyncNet (inputHostname sshinput') ->
@@ -413,7 +413,7 @@ getAddRsyncNetR :: Handler Html
 getAddRsyncNetR = postAddRsyncNetR
 postAddRsyncNetR :: Handler Html
 postAddRsyncNetR = do
-	((result, form), enctype) <- runFormPost $
+	((result, form), enctype) <- runFormPostNoToken $
 		renderBootstrap $ sshInputAForm hostnamefield $
 			SshInput Nothing Nothing Nothing 22
 	let showform status = inpage $

Assistant/WebApp/Configurators/WebDAV.hs

@@ -67,7 +67,7 @@ postAddBoxComR :: Handler Html
 postAddBoxComR = boxConfigurator $ do
 	defcreds <- liftAnnex $ previouslyUsedWebDAVCreds "box.com"
 	((result, form), enctype) <- liftH $
-		runFormPost $ renderBootstrap $ boxComAForm defcreds
+		runFormPostNoToken $ renderBootstrap $ boxComAForm defcreds
 	case result of
 		FormSuccess input -> liftH $ 
 			makeWebDavRemote initSpecialRemote "box.com" (toCredPair input) $ M.fromList
@@ -110,7 +110,7 @@ postEnableWebDAVR uuid = do
 			maybe (pure Nothing) previouslyUsedWebDAVCreds $
 				urlHost url
 		((result, form), enctype) <- liftH $
-			runFormPost $ renderBootstrap $ webDAVCredsAForm defcreds
+			runFormPostNoToken $ renderBootstrap $ webDAVCredsAForm defcreds
 		case result of
 			FormSuccess input -> liftH $
 				makeWebDavRemote enableSpecialRemote name (toCredPair input) M.empty

Assistant/WebApp/Configurators/XMPP.hs

@@ -112,7 +112,7 @@ xmppform :: Route WebApp -> Handler Html
 xmppform next = xmppPage $ do
 	((result, form), enctype) <- liftH $ do
 		oldcreds <- liftAnnex getXMPPCreds
-		runFormPost $ renderBootstrap $ xmppAForm $
+		runFormPostNoToken $ renderBootstrap $ xmppAForm $
 			creds2Form <$> oldcreds
 	let showform problem = $(widgetFile "configurators/xmpp")
 	case result of

doc/bugs/Assistant_stalls_when_adding__47__creating_repo_on_ArchLinux.mdwn

@@ -71,3 +71,5 @@ git-annex: Nothing listed in /home/omehani/.config/git-annex/autostart
 
 # End of transcript or log.
 """]]
+
+> workaround is in place [[done]] --[[Joey]]