diff --git a/Data/Object/Instances.hs b/Data/Object/Instances.hs
index 13402e71..3c9ae8ae 100644
--- a/Data/Object/Instances.hs
+++ b/Data/Object/Instances.hs
@@ -89,7 +89,7 @@ instance SafeFromObject Html where
map helper2 m ++
[ toLazyByteString "" ]
helper2 :: (B.ByteString, RawObject) -> B.ByteString
- helper2 (k, v) = B.concat $
+ helper2 (k, v) = B.concat
[ toLazyByteString "
"
, toLazyByteString k
, toLazyByteString ""
diff --git a/TODO b/TODO
index 45fb01e7..db5eacf3 100644
--- a/TODO
+++ b/TODO
@@ -1 +1,2 @@
HTML sitemap generation
+Remove model
diff --git a/Web/Restful/Application.hs b/Web/Restful/Application.hs
index 561632e8..dc9f5296 100644
--- a/Web/Restful/Application.hs
+++ b/Web/Restful/Application.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -44,10 +43,7 @@ import Web.Restful.Constants
import Web.Restful.Resource
-- | A data type that can be turned into a Hack application.
-class ResourceName a b => RestfulApp a b | a -> b where
- -- | Load up the model, ie the data which use passed to each handler.
- getModel :: a -> IO b
-
+class ResourceName a => RestfulApp a where
-- | The encryption key to be used for encrypting client sessions.
encryptKey :: a -> IO Word256
encryptKey _ = getKey defaultKeyFile
@@ -87,25 +83,23 @@ class ResourceName a b => RestfulApp a b | a -> b where
-- | Given a sample resource name (purely for typing reasons), generating
-- a Hack application.
-toHackApp :: RestfulApp resourceName modelType
+toHackApp :: RestfulApp resourceName
=> resourceName
-> IO Hack.Application
toHackApp a = do
when (checkOverlaps a) $ checkResourceName a -- FIXME maybe this should be done compile-time?
- model <- getModel a
key <- encryptKey a
- let handlers = getHandler model
- app' = toHackApplication a handlers
+ let app' = toHackApplication a getHandler
clientsession' = clientsession [authCookieName] key -- FIXME gotta be a better way...
app = foldr ($) app' $ hackMiddleware a ++ [clientsession']
return app
-findResourceNames :: ResourceName a model
+findResourceNames :: ResourceName a
=> Resource
-> [(a, [(String, String)])]
findResourceNames r = takeJusts $ map (checkPatternHelper r) enumerate
-checkPatternHelper :: ResourceName a model
+checkPatternHelper :: ResourceName a
=> Resource
-> a
-> Maybe (a, [(String, String)])
@@ -119,7 +113,7 @@ takeJusts [] = []
takeJusts (Nothing:rest) = takeJusts rest
takeJusts (Just x:rest) = x : takeJusts rest
-toHackApplication :: RestfulApp resourceName model
+toHackApplication :: RestfulApp resourceName
=> resourceName
-> (resourceName -> Verb -> Handler)
-> Hack.Application
diff --git a/Web/Restful/Helpers/Auth.hs b/Web/Restful/Helpers/Auth.hs
index 272fc656..9b3457ec 100644
--- a/Web/Restful/Helpers/Auth.hs
+++ b/Web/Restful/Helpers/Auth.hs
@@ -15,6 +15,9 @@
---------------------------------------------------------
module Web.Restful.Helpers.Auth
( AuthResource
+ , authHandler
+ , authResourcePattern
+ , RpxnowApiKey (..)
) where
import qualified Hack
@@ -50,24 +53,26 @@ instance Enumerable AuthResource 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
- -- two different versions of RPX protocol apparently...
- getHandler (Just key) LoginRpxnow Get = rpxnowLogin key
- getHandler (Just key) LoginRpxnow Post = rpxnowLogin key
- getHandler _ _ _ = notFound
+newtype RpxnowApiKey = RpxnowApiKey String
- resourcePattern Check = "/auth/check/"
- resourcePattern Logout = "/auth/logout/"
- resourcePattern Openid = "/auth/openid/"
- resourcePattern OpenidForward = "/auth/openid/forward/"
- resourcePattern OpenidComplete = "/auth/openid/complete/"
- resourcePattern LoginRpxnow = "/auth/login/rpxnow/"
+authHandler :: Maybe RpxnowApiKey -> AuthResource -> Verb -> Handler
+authHandler _ Check Get = authCheck
+authHandler _ Logout Get = authLogout
+authHandler _ Openid Get = authOpenidForm
+authHandler _ OpenidForward Get = authOpenidForward
+authHandler _ OpenidComplete Get = authOpenidComplete
+-- two different versions of RPX protocol apparently...
+authHandler (Just (RpxnowApiKey key)) LoginRpxnow Get = rpxnowLogin key
+authHandler (Just (RpxnowApiKey key)) LoginRpxnow Post = rpxnowLogin key
+authHandler _ _ _ = notFound
+
+authResourcePattern :: AuthResource -> String -- FIXME supply prefix as well
+authResourcePattern Check = "/auth/check/"
+authResourcePattern Logout = "/auth/logout/"
+authResourcePattern Openid = "/auth/openid/"
+authResourcePattern OpenidForward = "/auth/openid/forward/"
+authResourcePattern OpenidComplete = "/auth/openid/complete/"
+authResourcePattern LoginRpxnow = "/auth/login/rpxnow/"
data OIDFormReq = OIDFormReq (Maybe String) (Maybe String)
diff --git a/Web/Restful/Resource.hs b/Web/Restful/Resource.hs
index a0fa555d..3bffbffb 100644
--- a/Web/Restful/Resource.hs
+++ b/Web/Restful/Resource.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -70,7 +69,7 @@ fromString' ('*':rest) = Slurp rest
fromString' ('#':rest) = DynInt rest
fromString' x = Static x
-class (Show a, Enumerable a) => ResourceName a b | a -> b where
+class (Show a, Enumerable a) => ResourceName a 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.
@@ -80,7 +79,7 @@ class (Show a, Enumerable a) => ResourceName a b | a -> b where
resourcePattern :: a -> String
-- | Find the handler for each resource name/verb pattern.
- getHandler :: b -> a -> Verb -> Handler
+ getHandler :: a -> Verb -> Handler
type SMap = [(String, String)]
@@ -135,7 +134,7 @@ overlaps (Static s:x) (DynInt _:y)
| otherwise = False
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) => rn -> m ()
checkResourceName rn = do
let avs@(y:_) = enumerate
_ignore = asTypeOf rn y
diff --git a/restful.cabal b/restful.cabal
index e2e2bc47..e598a704 100644
--- a/restful.cabal
+++ b/restful.cabal
@@ -1,5 +1,5 @@
name: restful
-version: 0.1.6
+version: 0.1.7
license: BSD3
license-file: LICENSE
author: Michael Snoyman