Switched to Enumerable
This commit is contained in:
parent
5addbf8465
commit
e2f217f981
@ -25,6 +25,7 @@ module Web.Restful.Application
|
|||||||
import Web.Encodings
|
import Web.Encodings
|
||||||
import qualified Data.ByteString.Lazy as B
|
import qualified Data.ByteString.Lazy as B
|
||||||
import Data.Object
|
import Data.Object
|
||||||
|
import Data.Enumerable
|
||||||
|
|
||||||
import qualified Hack
|
import qualified Hack
|
||||||
import Hack.Middleware.CleanPath
|
import Hack.Middleware.CleanPath
|
||||||
@ -95,7 +96,7 @@ toHackApp a = do
|
|||||||
findResourceNames :: ResourceName a model
|
findResourceNames :: ResourceName a model
|
||||||
=> Resource
|
=> Resource
|
||||||
-> [(a, [(String, String)])]
|
-> [(a, [(String, String)])]
|
||||||
findResourceNames r = takeJusts $ map (checkPatternHelper r) allValues
|
findResourceNames r = takeJusts $ map (checkPatternHelper r) enumerate
|
||||||
|
|
||||||
checkPatternHelper :: ResourceName a model
|
checkPatternHelper :: ResourceName a model
|
||||||
=> Resource
|
=> Resource
|
||||||
|
|||||||
@ -21,6 +21,7 @@ import qualified Hack
|
|||||||
import Web.Encodings
|
import Web.Encodings
|
||||||
import qualified Web.Authenticate.Rpxnow as Rpxnow
|
import qualified Web.Authenticate.Rpxnow as Rpxnow
|
||||||
import qualified Web.Authenticate.OpenId as OpenId
|
import qualified Web.Authenticate.OpenId as OpenId
|
||||||
|
import Data.Enumerable
|
||||||
|
|
||||||
import Web.Restful
|
import Web.Restful
|
||||||
import Web.Restful.Constants
|
import Web.Restful.Constants
|
||||||
@ -39,17 +40,8 @@ data AuthResource =
|
|||||||
| LoginRpxnow
|
| LoginRpxnow
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
type RpxnowApiKey = String -- FIXME newtype
|
instance Enumerable AuthResource where
|
||||||
instance ResourceName AuthResource (Maybe RpxnowApiKey) where
|
enumerate =
|
||||||
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 =
|
|
||||||
Check
|
Check
|
||||||
: Logout
|
: Logout
|
||||||
: Openid
|
: Openid
|
||||||
@ -58,6 +50,16 @@ instance ResourceName AuthResource (Maybe RpxnowApiKey) where
|
|||||||
: LoginRpxnow
|
: 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 Check = "/auth/check/"
|
||||||
resourcePattern Logout = "/auth/logout/"
|
resourcePattern Logout = "/auth/logout/"
|
||||||
resourcePattern Openid = "/auth/openid/"
|
resourcePattern Openid = "/auth/openid/"
|
||||||
@ -130,8 +132,8 @@ authOpenidComplete = do
|
|||||||
data RpxnowRequest = RpxnowRequest String (Maybe String)
|
data RpxnowRequest = RpxnowRequest String (Maybe String)
|
||||||
instance Request RpxnowRequest where
|
instance Request RpxnowRequest where
|
||||||
parseRequest = do
|
parseRequest = do
|
||||||
token <- getParam "token"
|
token <- postParam "token"
|
||||||
dest <- getParam "dest"
|
dest <- postParam "dest"
|
||||||
return $! RpxnowRequest token $ chopHash `fmap` dest
|
return $! RpxnowRequest token $ chopHash `fmap` dest
|
||||||
|
|
||||||
chopHash :: String -> String
|
chopHash :: String -> String
|
||||||
|
|||||||
@ -30,6 +30,7 @@ import Data.List.Split (splitOn)
|
|||||||
import Web.Restful.Definitions
|
import Web.Restful.Definitions
|
||||||
import Web.Restful.Handler
|
import Web.Restful.Handler
|
||||||
import Data.List (intercalate)
|
import Data.List (intercalate)
|
||||||
|
import Data.Enumerable
|
||||||
|
|
||||||
import Test.Framework (testGroup, Test)
|
import Test.Framework (testGroup, Test)
|
||||||
import Test.Framework.Providers.HUnit
|
import Test.Framework.Providers.HUnit
|
||||||
@ -64,7 +65,7 @@ fromString' ('$':rest) = Dynamic rest
|
|||||||
fromString' ('*':rest) = Slurp rest
|
fromString' ('*':rest) = Slurp rest
|
||||||
fromString' x = Static x
|
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.
|
-- | Get the URL pattern for each different resource name.
|
||||||
-- Something like /foo/$bar/baz/ will match the regular expression
|
-- Something like /foo/$bar/baz/ will match the regular expression
|
||||||
-- /foo/(\\w*)/baz/, matching the middle part with the urlParam bar.
|
-- /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.
|
-- into the bar urlParam.
|
||||||
resourcePattern :: a -> String
|
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.
|
-- | Find the handler for each resource name/verb pattern.
|
||||||
getHandler :: b -> a -> Verb -> Handler
|
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 :: (Monad m, ResourceName rn model) => rn -> m ()
|
||||||
checkResourceName rn = do
|
checkResourceName rn = do
|
||||||
let avs@(y:_) = allValues
|
let avs@(y:_) = enumerate
|
||||||
_ignore = asTypeOf rn y
|
_ignore = asTypeOf rn y
|
||||||
let patterns = map (fromString . resourcePattern) avs
|
let patterns = map (fromString . resourcePattern) avs
|
||||||
case validatePatterns patterns of
|
case validatePatterns patterns of
|
||||||
|
|||||||
@ -1,5 +1,5 @@
|
|||||||
name: restful
|
name: restful
|
||||||
version: 0.1.2
|
version: 0.1.3
|
||||||
license: BSD3
|
license: BSD3
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Michael Snoyman <michael@snoyman.com>
|
author: Michael Snoyman <michael@snoyman.com>
|
||||||
@ -35,7 +35,8 @@ library
|
|||||||
test-framework-quickcheck,
|
test-framework-quickcheck,
|
||||||
test-framework-hunit,
|
test-framework-hunit,
|
||||||
HUnit,
|
HUnit,
|
||||||
QuickCheck == 1.*
|
QuickCheck == 1.*,
|
||||||
|
enumerable >= 0.0.3
|
||||||
exposed-modules: Web.Restful,
|
exposed-modules: Web.Restful,
|
||||||
Web.Restful.Constants,
|
Web.Restful.Constants,
|
||||||
Web.Restful.Request,
|
Web.Restful.Request,
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user