diff --git a/TODO b/TODO index e69de29b..b74fc905 100644 --- a/TODO +++ b/TODO @@ -0,0 +1 @@ +Catch exceptions and return as 500 errors diff --git a/Web/Restful/Application.hs b/Web/Restful/Application.hs index 6903b3f2..eb287784 100644 --- a/Web/Restful/Application.hs +++ b/Web/Restful/Application.hs @@ -25,6 +25,7 @@ module Web.Restful.Application import Web.Encodings import qualified Data.ByteString.Lazy as B import Data.Object +import Data.Enumerable import qualified Hack import Hack.Middleware.CleanPath @@ -95,7 +96,7 @@ toHackApp a = do findResourceNames :: ResourceName a model => Resource -> [(a, [(String, String)])] -findResourceNames r = takeJusts $ map (checkPatternHelper r) allValues +findResourceNames r = takeJusts $ map (checkPatternHelper r) enumerate checkPatternHelper :: ResourceName a model => Resource diff --git a/Web/Restful/Helpers/Auth.hs b/Web/Restful/Helpers/Auth.hs index fec60a3d..82b3114a 100644 --- a/Web/Restful/Helpers/Auth.hs +++ b/Web/Restful/Helpers/Auth.hs @@ -21,6 +21,7 @@ import qualified Hack import Web.Encodings import qualified Web.Authenticate.Rpxnow as Rpxnow import qualified Web.Authenticate.OpenId as OpenId +import Data.Enumerable import Web.Restful import Web.Restful.Constants @@ -39,17 +40,8 @@ data AuthResource = | LoginRpxnow deriving Show -type RpxnowApiKey = String -- FIXME newtype -instance ResourceName AuthResource (Maybe RpxnowApiKey) where - getHandler _ Check Get = authCheck - getHandler _ Logout Get = authLogout - getHandler _ Openid Get = authOpenidForm - getHandler _ OpenidForward Get = authOpenidForward - getHandler _ OpenidComplete Get = authOpenidComplete - getHandler (Just key) LoginRpxnow Get = rpxnowLogin key - getHandler _ _ _ = notFound - - allValues = +instance Enumerable AuthResource where + enumerate = Check : Logout : Openid @@ -58,6 +50,16 @@ instance ResourceName AuthResource (Maybe RpxnowApiKey) where : LoginRpxnow : [] +type RpxnowApiKey = String -- FIXME newtype +instance ResourceName AuthResource (Maybe RpxnowApiKey) where + getHandler _ Check Get = authCheck + getHandler _ Logout Get = authLogout + getHandler _ Openid Get = authOpenidForm + getHandler _ OpenidForward Get = authOpenidForward + getHandler _ OpenidComplete Get = authOpenidComplete + getHandler (Just key) LoginRpxnow Post = rpxnowLogin key + getHandler _ _ _ = notFound + resourcePattern Check = "/auth/check/" resourcePattern Logout = "/auth/logout/" resourcePattern Openid = "/auth/openid/" @@ -130,8 +132,8 @@ authOpenidComplete = do data RpxnowRequest = RpxnowRequest String (Maybe String) instance Request RpxnowRequest where parseRequest = do - token <- getParam "token" - dest <- getParam "dest" + token <- postParam "token" + dest <- postParam "dest" return $! RpxnowRequest token $ chopHash `fmap` dest chopHash :: String -> String diff --git a/Web/Restful/Resource.hs b/Web/Restful/Resource.hs index 2415f776..5c47dc34 100644 --- a/Web/Restful/Resource.hs +++ b/Web/Restful/Resource.hs @@ -30,6 +30,7 @@ import Data.List.Split (splitOn) import Web.Restful.Definitions import Web.Restful.Handler import Data.List (intercalate) +import Data.Enumerable import Test.Framework (testGroup, Test) import Test.Framework.Providers.HUnit @@ -64,7 +65,7 @@ fromString' ('$':rest) = Dynamic rest fromString' ('*':rest) = Slurp rest fromString' x = Static x -class Show a => ResourceName a b | a -> b where +class (Show a, Enumerable a) => ResourceName a b | a -> b where -- | Get the URL pattern for each different resource name. -- Something like /foo/$bar/baz/ will match the regular expression -- /foo/(\\w*)/baz/, matching the middle part with the urlParam bar. @@ -73,11 +74,6 @@ class Show a => ResourceName a b | a -> b where -- into the bar urlParam. resourcePattern :: a -> String - -- | Get all possible values for resource names. - -- Remember, if you use variables ($foo) in your resourcePatterns you - -- can get an unlimited number of resources for each resource name. - allValues :: [a] - -- | Find the handler for each resource name/verb pattern. getHandler :: b -> a -> Verb -> Handler @@ -123,7 +119,7 @@ overlaps (Static a:x) (Static b:y) = a == b && overlaps x y checkResourceName :: (Monad m, ResourceName rn model) => rn -> m () checkResourceName rn = do - let avs@(y:_) = allValues + let avs@(y:_) = enumerate _ignore = asTypeOf rn y let patterns = map (fromString . resourcePattern) avs case validatePatterns patterns of diff --git a/restful.cabal b/restful.cabal index 029211bb..68a5a6e6 100644 --- a/restful.cabal +++ b/restful.cabal @@ -1,5 +1,5 @@ name: restful -version: 0.1.2 +version: 0.1.3 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -35,7 +35,8 @@ library test-framework-quickcheck, test-framework-hunit, HUnit, - QuickCheck == 1.* + QuickCheck == 1.*, + enumerable >= 0.0.3 exposed-modules: Web.Restful, Web.Restful.Constants, Web.Restful.Request,