Removed invalidParams

This commit is contained in:
Michael Snoyman 2010-02-17 09:37:52 +02:00
parent f07701e25d
commit 2babde3d78
4 changed files with 9 additions and 26 deletions

View File

@ -86,8 +86,6 @@ instance Exception e => Failure e (Handler yesod) where
instance RequestReader (Handler yesod) where instance RequestReader (Handler yesod) where
getRawRequest = Handler $ \(HandlerData rr _) getRawRequest = Handler $ \(HandlerData rr _)
-> return ([], HCContent rr) -> return ([], HCContent rr)
invalidParams = invalidArgs . map helper where
helper ((_pt, pn, _pvs), e) = (pn, show e)
getYesod :: Handler yesod yesod getYesod :: Handler yesod yesod
getYesod = Handler $ \(HandlerData _ yesod) -> return ([], HCContent yesod) getYesod = Handler $ \(HandlerData _ yesod) -> return ([], HCContent yesod)
@ -153,7 +151,7 @@ notFound = errorResponse NotFound
permissionDenied :: Handler yesod a permissionDenied :: Handler yesod a
permissionDenied = errorResponse PermissionDenied permissionDenied = errorResponse PermissionDenied
invalidArgs :: [(ParamName, ParamValue)] -> Handler yesod a invalidArgs :: [(ParamName, String)] -> Handler yesod a
invalidArgs = errorResponse . InvalidArgs invalidArgs = errorResponse . InvalidArgs
------- Headers ------- Headers

View File

@ -34,7 +34,7 @@ import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import qualified Network.Wai import qualified Network.Wai
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
import Control.Exception (Exception, SomeException (..)) import Control.Exception (Exception)
class YesodApproot a => YesodAuth a where class YesodApproot a => YesodAuth a where
-- | The following breaks DRY, but I cannot think of a better solution -- | The following breaks DRY, but I cannot think of a better solution
@ -91,26 +91,10 @@ instance ConvertSuccess OIDFormReq Html where
convertSuccess (OIDFormReq (Just s) _) = convertSuccess (OIDFormReq (Just s) _) =
Tag "p" [("class", "message")] $ cs s Tag "p" [("class", "message")] $ cs s
someParam :: (Monad m, RequestReader m)
=> ParamType
-> (RawRequest -> ParamName -> [ParamValue])
-> ParamName
-> m ParamValue
someParam pt paramList pn = do
rr <- getRawRequest
case paramList rr pn of
[x] -> return x
x -> invalidParams [((pt, pn, x), SomeException ExpectedSingleParam)]
data ExpectedSingleParam = ExpectedSingleParam data ExpectedSingleParam = ExpectedSingleParam
deriving (Show, Typeable) deriving (Show, Typeable)
instance Exception ExpectedSingleParam instance Exception ExpectedSingleParam
getParam :: (Monad m, RequestReader m)
=> ParamName
-> m ParamValue
getParam = someParam GetParam getParams
authOpenidForm :: Yesod y => Handler y ChooseRep authOpenidForm :: Yesod y => Handler y ChooseRep
authOpenidForm = do authOpenidForm = do
rr <- getRawRequest rr <- getRawRequest
@ -134,7 +118,10 @@ authOpenidForm = do
authOpenidForward :: YesodAuth y => Handler y () authOpenidForward :: YesodAuth y => Handler y ()
authOpenidForward = do authOpenidForward = do
oid <- getParam "openid" rr <- getRawRequest
oid <- case getParams rr "openid" of
[x] -> return x
_ -> invalidArgs [("openid", show ExpectedSingleParam)]
authroot <- getFullAuthRoot authroot <- getFullAuthRoot
let complete = authroot ++ "/openid/complete/" let complete = authroot ++ "/openid/complete/"
res <- runAttemptT $ OpenId.getForwardUrl oid complete res <- runAttemptT $ OpenId.getForwardUrl oid complete

View File

@ -32,7 +32,6 @@ module Yesod.Request
, ParamType (..) , ParamType (..)
, ParamName , ParamName
, ParamValue , ParamValue
, ParamException
#if TEST #if TEST
, testSuite , testSuite
#endif #endif
@ -47,7 +46,6 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import Data.Convertible.Text import Data.Convertible.Text
import Control.Arrow ((***)) import Control.Arrow ((***))
import Control.Exception (SomeException (..))
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import "transformers" Control.Monad.Trans import "transformers" Control.Monad.Trans
import Control.Concurrent.MVar import Control.Concurrent.MVar
@ -61,11 +59,11 @@ import Test.Framework (testGroup, Test)
data ParamType = GetParam | PostParam data ParamType = GetParam | PostParam
type ParamName = String type ParamName = String
type ParamValue = String type ParamValue = String
type ParamException = [((ParamType, ParamName, [ParamValue]), SomeException)]
class RequestReader m where class RequestReader m where
getRawRequest :: m RawRequest getRawRequest :: m RawRequest
invalidParams :: ParamException -> m a instance RequestReader ((->) RawRequest) where
getRawRequest = id
languages :: (Functor m, RequestReader m) => m [Language] languages :: (Functor m, RequestReader m) => m [Language]
languages = rawLangs `fmap` getRawRequest languages = rawLangs `fmap` getRawRequest

View File

@ -192,7 +192,7 @@ data SpecialResponse =
data ErrorResponse = data ErrorResponse =
NotFound NotFound
| InternalError String | InternalError String
| InvalidArgs [(String, String)] | InvalidArgs [(String, String)] -- FIXME use SomeException?
| PermissionDenied | PermissionDenied
deriving (Show, Eq) deriving (Show, Eq)