Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Fix Permissions for lens permission accessors; two lines between top-…

…level defs
  • Loading branch information...
commit f2d08b44d8a610ca8d8095f759d0c5af094caa8d 1 parent f29e16d
Dmitry Dzhus authored
8 src/Snap/Snaplet/Redson.hs
View
@@ -59,6 +59,7 @@ import Snap.Snaplet.Redson.Permissions
import Snap.Snaplet.Redson.Search
import Snap.Snaplet.Redson.Util
+
------------------------------------------------------------------------------
-- | Redson snaplet state type.
--
@@ -158,12 +159,14 @@ modelMessage event = \model id ->
in
DataMessage $ Text $ A.encode $ M.fromList response
+
-- | Model instance creation message.
creationMessage :: ModelName
-> CRUD.InstanceId
-> Network.WebSockets.Message p
creationMessage = modelMessage "create"
+
-- | Model instance deletion message.
deletionMessage :: ModelName
-> CRUD.InstanceId
@@ -335,6 +338,7 @@ modelEvents = ifTop $ do
acceptRequest r
PS.subscribe ps)
+
------------------------------------------------------------------------------
-- | Serve JSON metamodel with respect to current user and field
-- permissions.
@@ -349,6 +353,7 @@ metamodel = ifTop $ do
modifyResponse $ setContentType "application/json"
writeLBS (A.encode $ stripModel au m)
+
------------------------------------------------------------------------------
-- | Serve JSON array of readable models to user. Every array element
-- is an object with fields "name" and "title". In transparent mode,
@@ -385,6 +390,8 @@ defaultSearchLimit = 100
-----------------------------------------------------------------------------
-- | Serve model instances which have index values containing supplied
-- search parameters.
+--
+-- Currently not available in transparent mode.
search :: Handler b (Redson b) ()
search =
let
@@ -462,7 +469,6 @@ search =
return ()
-
-----------------------------------------------------------------------------
-- | CRUD routes for models.
routes :: [(B.ByteString, Handler b (Redson b) ())]
10 src/Snap/Snaplet/Redson/Permissions.hs
View
@@ -21,14 +21,17 @@ import qualified Data.Map as M
import Snap.Core (Method(..))
import Snap.Snaplet.Auth
+
import Snap.Snaplet.Redson.Snapless.Metamodel
+
-- | User who has all permissions (used in security-disabled mode).
data SuperUser = SuperUser
-- | Either superuser or logged in user.
type User = Either SuperUser AuthUser
+
-- | Map between CRUD methods and form permission lenses.
methodMap :: [(Method, Lens Model Permissions)]
methodMap = [ (POST, canCreateM)
@@ -37,6 +40,7 @@ methodMap = [ (POST, canCreateM)
, (DELETE, canDeleteM)
]
+
-- | Check if provided roles meet the permission requirements.
--
-- Always succeed in case Everyone is required, always fail in case
@@ -78,7 +82,7 @@ getFieldPermissions (Right user) model =
(userRoles user))
(fields model)
in
- (union (getFields canRead) (getFields canWrite), getFields canWrite)
+ (union (getFields _canRead) (getFields _canWrite), getFields _canWrite)
-- | Get list of CRUD/HTTP methods accessible by user for model.
@@ -147,7 +151,7 @@ stripModel user model =
(\f -> elem (name f) readables)
(fields model)
-- Fields with boolean canWrite's
- strippedFields = map (\f -> f{canWrite = stripMapper $
+ strippedFields = map (\f -> f{_canWrite = stripMapper $
elem (name f) writables})
readableFields
formPerms = getModelPermissions user model
@@ -156,4 +160,4 @@ stripModel user model =
p ^= (stripMapper $ elem m formPerms))
methodMap
in
- foldl' (\m f -> f m) model{ fields = strippedFields } boolFormPerms
+ foldl' (\m f -> f m) model{fields = strippedFields} boolFormPerms
1  src/Snap/Snaplet/Redson/Util.hs
View
@@ -34,6 +34,7 @@ handleError err = do
r <- getResponse
finishWith r
+
notFound :: Error
notFound = Error 404
Please sign in to comment.
Something went wrong with that request. Please try again.