mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

switch to runFormPostNoToken to work around strange yesod bug

Browse source
This commit is contained in:
Joey Hess 2013-10-14 12:18:04 -04:00
parent 25462f125d
commit 4bb8720d85
11 changed files with 19 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
Assistant/WebApp/Configurators/AWS.hs
View file

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

2
Assistant/WebApp/Configurators/Delete.hs
View file

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

2
Assistant/WebApp/Configurators/Edit.hs
View file

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

2
Assistant/WebApp/Configurators/Fsck.hs
View file

@ -59,7 +59,7 @@ runFsckForm new activity = case activity of
go (Schedule r t) d ru = do
u <- liftAnnex getUUID
repolist <- liftAssistant (getrepolist ru)
runFormPost $ \msg -> do
runFormPostNoToken $ \msg -> do
(reposRes, reposView) <- mreq (selectFieldList repolist) "" (Just ru)
(durationRes, durationView) <- mreq intField "" (Just $ durationSeconds d `quot` 60 )
(timeRes, timeView) <- mreq (selectFieldList times) "" (Just t)

4
Assistant/WebApp/Configurators/IA.hs
View file

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

6
Assistant/WebApp/Configurators/Local.hs
View file

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

2
Assistant/WebApp/Configurators/Pairing.hs
View file

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

2
Assistant/WebApp/Configurators/Preferences.hs
View file

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

6
Assistant/WebApp/Configurators/Ssh.hs
View file

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

4
Assistant/WebApp/Configurators/WebDAV.hs
View file

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

2
Assistant/WebApp/Configurators/XMPP.hs
View file

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