yesod-form 1.7.9.2 → 1.7.11
raw patch · 4 files changed
Files
- ChangeLog.md +29/−0
- Yesod/Form/Functions.hs +180/−2
- test/main.hs +1/−1
- yesod-form.cabal +2/−2
ChangeLog.md view
@@ -1,5 +1,34 @@ # ChangeLog for yesod-form +## 1.7.11++* Add `lookupRawFieldInput`, giving field views access to all raw+ parameter values the named field was run against — whether from a+ direct submission or a `runFormPRG` replay. The `Either Text a`+ argument a view receives only carries the first submitted value, so+ fields rendering several inputs under one name (e.g. a composite+ amount-plus-currency field) previously could not restore the user's+ input after a failed submission.++## 1.7.10.1++* Move the `runFormPRG` integration tests to yesod-test's test suite,+ removing yesod-form's test-suite dependency on yesod-test. That+ dependency created a package-level cycle+ (yesod-test → yesod-form → yesod-test) which broke the Stackage+ build plan. [#1928](https://github.com/yesodweb/yesod/issues/1928)++## 1.7.10++* Add `runFormPRG`, a `runFormPost` variant for the+ Post/Redirect/Get pattern: failed submissions are stashed in the session+ and replayed (input and validation errors) by the next GET.+ [#1927](https://github.com/yesodweb/yesod/pull/1927)++## 1.7.9.3++* Support `yesod-core` 1.7+ ## 1.7.9.2 * Improve deprecation messages for `radioField` and `checkboxesField` [#1902](https://github.com/yesodweb/yesod/pull/1902)
Yesod/Form/Functions.hs view
@@ -32,6 +32,8 @@ , runFormPost , runFormPostNoToken , runFormGet+ -- ** Post\/Redirect\/Get+ , runFormPRG -- * Generate a blank form , generateFormPost , generateFormGet'@@ -58,6 +60,7 @@ , convertField , addClass , removeClass+ , lookupRawFieldInput ) where import Yesod.Form.Types@@ -67,16 +70,20 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST, local, mapRWST) import Control.Monad.Trans.Writer (runWriterT, writer)-import Control.Monad (liftM, join)+import Control.Monad (liftM, join, when)+import Data.IORef (IORef, newIORef, modifyIORef', readIORef)+import qualified Data.Aeson as A import Data.Byteable (constEqBytes)+import qualified Data.ByteString.Lazy as BL import Text.Blaze (Markup, toMarkup) #define Html Markup #define toHtml toMarkup import Yesod.Core-import Network.Wai (requestMethod)+import Network.Wai (Request, requestMethod, rawPathInfo) import Data.Maybe (listToMaybe, fromMaybe) import qualified Data.Map as Map import qualified Data.Text.Encoding as TE+import qualified Data.Text.Encoding.Error as TEE import Control.Arrow (first) -- | Get a unique identifier.@@ -222,6 +229,34 @@ -> MForm m (FormResult (Maybe a), FieldView site) mopt field fs mdef = mhelper field fs (join mdef) (const $ const $ FormSuccess Nothing) (FormSuccess . Just) False +-- | Per-request store of the raw parameter values each field was run+-- against, keyed by field name; see 'lookupRawFieldInput'.+newtype RawFieldInput = RawFieldInput (IORef (Map.Map Text [Text]))++rawFieldInputRef :: MonadHandler m => m (IORef (Map.Map Text [Text]))+rawFieldInputRef = do+ RawFieldInput ref <- cachedBy "yesod-form-raw-field-input" $+ fmap RawFieldInput $ liftIO $ newIORef Map.empty+ return ref++-- | The raw parameter values the named field was run against in this+-- request, whether from a direct submission or a Post\/Redirect\/Get+-- replay ('runFormPRG'). Empty if no form containing the field has run+-- with a submission in this request (e.g. 'generateFormPost', or an+-- 'identifyForm'-wrapped form that was not the one submitted).+--+-- This lets the view of a field rendering several inputs under one name+-- restore all of the user's raw input after a failed submission: the+-- @Either Text a@ argument a view receives can only carry the first+-- submitted value. Only fields run through 'mreq'\/'mopt' (and the+-- applicative\/widget helpers built on them) record their values here.+--+-- @since 1.7.11+lookupRawFieldInput :: MonadHandler m => Text -> m [Text]+lookupRawFieldInput name = do+ ref <- rawFieldInputRef+ Map.findWithDefault [] name `liftM` liftIO (readIORef ref)+ mhelper :: (site ~ HandlerSite m, MonadHandler m) => Field m a -> FieldSettings site@@ -245,6 +280,9 @@ mfs <- askFiles let mvals = fromMaybe [] $ Map.lookup name p files = fromMaybe [] $ mfs >>= Map.lookup name+ lift $ do+ ref <- rawFieldInputRef+ liftIO $ modifyIORef' ref $ Map.insert name mvals emx <- lift $ fieldParse mvals files return $ case emx of Left (SomeMessage e) -> (FormFailure [renderMessage site langs e], maybe (Left "") Left (listToMaybe mvals))@@ -356,6 +394,146 @@ => (Html -> MForm m (FormResult a, xml)) -> m (xml, Enctype) generateFormPost form = first snd `liftM` postHelper form Nothing++-- | Run a form for the Post\/Redirect\/Get pattern, so that invalid input+-- and its validation errors survive a redirect.+--+-- Use this in /both/ the GET and POST handlers of a route, exactly as you+-- would 'runFormPost':+--+-- * On a POST request this behaves exactly like 'runFormPost' (including+-- CSRF protection). Additionally, on 'FormFailure' the submitted+-- parameters are stashed in the user session so that your handler can+-- simply 'redirect' back to the GET route instead of re-rendering. On+-- 'FormSuccess' any previously stashed parameters for this route are+-- cleared. On 'FormMissing' (another 'identifyForm'-wrapped form on the+-- page was the one submitted) the stash is left untouched.+--+-- * On a GET request, if stashed parameters exist for the current path,+-- they are removed from the session and the form is run against them:+-- the fields re-render with the user's input and validation errors, just+-- as a non-redirecting handler would have rendered them. A fresh CSRF+-- token is rendered into the form (the stashed token is discarded, and+-- no token check is performed on a replay). If nothing is stashed, this+-- behaves like 'generateFormPost' (the result is 'FormMissing').+--+-- > getRegisterR :: Handler Html+-- > getRegisterR = do+-- > ((_res, widget), enctype) <- runFormPRG personForm+-- > defaultLayout+-- > [whamlet|+-- > <form method=post action=@{RegisterR} enctype=#{enctype}>+-- > ^{widget}+-- > |]+-- >+-- > postRegisterR :: Handler Html+-- > postRegisterR = do+-- > ((res, _widget), _enctype) <- runFormPRG personForm+-- > case res of+-- > FormSuccess person -> do+-- > -- insert into the database, etc.+-- > setMessage "Registered!"+-- > redirect RegisterR+-- > _ -> redirect RegisterR+--+-- Notes and caveats:+--+-- * The stash is keyed by request path, so the GET and POST handlers must+-- share a route (the common Yesod pattern). Form pages on different+-- routes do not interfere with each other; two tabs on the /same/ path+-- share one stash (the last failed submission wins).+--+-- * Multiple forms on one page work when wrapped with 'identifyForm': on+-- replay, only the form that was actually submitted re-renders with+-- values and errors; the others return 'FormMissing' and render blank.+-- (The stash is popped once per request and shared between calls via+-- the per-request cache, so every form in the handler sees it.)+--+-- * Uploaded files are not stashed; file fields re-render empty after the+-- redirect.+--+-- * The stashed parameters live in the user session. With the default+-- client-session backend the whole session must fit in a cookie+-- (roughly 4KB), so this is unsuitable for very large forms. If the+-- stash fails to decode, it is discarded and a blank form is generated.+--+-- * If the application has no session backend, stashing is a no-op and+-- this degrades to 'runFormPost'\/'generateFormPost' semantics (input+-- will not survive the redirect).+--+-- * If your POST handler re-renders on failure instead of redirecting, do+-- not use this function: the stash would be consumed by an unrelated+-- later GET of the same path.+--+-- * On a replay the form may even produce 'FormSuccess' (e.g. a 'checkM'+-- validation whose outcome depends on external state); the result is+-- returned as-is. GET handlers normally use only the widget.+--+-- * A HEAD request reads the stash without consuming it, so that+-- middleware such as @autoHead@ does not eat the replay meant for the+-- subsequent GET.+--+-- @since 1.7.10+runFormPRG+ :: (RenderMessage (HandlerSite m) FormMessage, MonadResource m, MonadHandler m)+ => (Html -> MForm m (FormResult a, xml))+ -> m ((FormResult a, xml), Enctype)+runFormPRG form = do+ req <- getRequest+ let method = requestMethod $ reqWaiRequest req+ key = prgSessionKey $ reqWaiRequest req+ if method == "GET" || method == "HEAD"+ then do+ -- The per-request cache lets several calls in one handler+ -- (multiple forms on a page) all see the stash, even though it+ -- is deleted from the session on first read.+ PRGStash menv <- cachedBy (TE.encodeUtf8 key) $ do+ mbs <- lookupSessionBS key+ when (method /= "HEAD") $ deleteSession key+ return $ PRGStash $ mbs >>= A.decodeStrict+ case menv of+ Nothing -> postHelper form Nothing+ Just env -> replayHelper form env+ else do+ env <- postEnv+ res@((formRes, _), _) <- postHelper form env+ case (formRes, env) of+ (FormSuccess{}, _) -> deleteSession key+ (FormFailure{}, Just (params, _)) -> setSessionBS key $+ BL.toStrict $ A.encode $+ Map.delete defaultCsrfParamName params+ -- FormMissing means another identified form on this page+ -- was the one submitted; leave its stash alone.+ _ -> return ()+ return res++-- | Per-request cache wrapper for the Post\/Redirect\/Get stash; see+-- 'runFormPRG'.+newtype PRGStash = PRGStash (Maybe Env)++-- | Like 'postHelper', but runs the form against a supplied 'Env' (with an+-- empty 'FileEnv') instead of the current request body. A fresh CSRF token+-- fragment is rendered into the form, and no token check is performed: the+-- replayed submission was already checked by 'postHelper' when it was+-- stashed, and this run is a re-render, not a submission.+replayHelper :: MonadHandler m+ => (Html -> MForm m a)+ -> Env+ -> m (a, Enctype)+replayHelper form env = do+ req <- getRequest+ let token =+ case reqToken req of+ Nothing -> mempty+ Just n -> [shamlet|<input type=hidden name=#{defaultCsrfParamName} value=#{n}>|]+ m <- getYesod+ langs <- languages+ runFormGeneric (form token) m langs (Just (env, Map.empty))++-- | Session key for the Post\/Redirect\/Get stash, namespaced by request+-- path so that form pages on different routes do not interfere.+prgSessionKey :: Request -> Text+prgSessionKey req = "_PRG:" <> TE.decodeUtf8With TEE.lenientDecode (rawPathInfo req) postEnv :: MonadHandler m => m (Maybe (Env, FileEnv)) postEnv = do
test/main.hs view
@@ -7,7 +7,7 @@ import Yesod.Form.Types main :: IO ()-main = hspec $+main = hspec $ do describe "parseTime" $ mapM_ (\(s, e) -> it s $ parseTime (pack s) `shouldBe` e) [ ("01:00:00", Right $ TimeOfDay 1 0 0) , ("1:00", Right $ TimeOfDay 1 0 0)
yesod-form.cabal view
@@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: yesod-form-version: 1.7.9.2+version: 1.7.11 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -39,7 +39,7 @@ , transformers >= 0.2.2 , wai >= 1.3 , xss-sanitize >= 0.3.0.1- , yesod-core >= 1.6 && < 1.7+ , yesod-core >= 1.6 && < 1.8 , yesod-persistent >= 1.6 && < 1.7 if flag(network-uri)