Removed invalidParams
This commit is contained in:
parent
f07701e25d
commit
2babde3d78
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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)
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user