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).
This commit is contained in:
Joey Hess 2013-10-14 12:19:11 -04:00
parent ce2f461ec7
commit 267f8b0bb5
11 changed files with 20 additions and 18 deletions

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

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

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

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

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

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

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

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 $

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

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

View file

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