src/Gargantext/Rights_hs

   1 -- Right Management
   2 -----------------------------------------------------------------
   3 -- data Management = RolesRights | NodesRights | OperationsRights
   4 -----------------------------------------------------------------
   5 -----------------------------------------------------------------
   6 -- Role Rights Management
   7 --    rights to create roles (group)
   8 -- Node Rights Management
   9 --    rights to read/write Node
  10 -- Operation Rights Management
  11 --    rights for which operations
  12 -----------------------------------------------------------------
  13 -- Roles Rights Management
  14 -----------------------------------------------------------------
  15 -- 2 main roles
  16 -- admin : can create group and assign Node Rights to it
  17 -- user  : can not create group and assign Node rights inside his group (if he has the rights)
  18
  19 -- Use cases:
  20 -- if all user are in public and have read/write permissions: everything is free inside the public group
  21 -- else:
  22 --      in X institution x admin can create an gx group or a gy group for each department and assign user to it
  23 --      users y can share with user y withing the group if he has the rights for it
  24 --      an admin can give admin group to a user
  25
  26 -- Roles Rights Management are stored in "User Node"
  27 -- right to read on group called "x"  == can share permissions inside group x
  28 -- right to write on group called "x" == can modify group x itself
  29
  30 -- Question: how to manage the hierarchy of roles/groups ?
  31 -- Example: use can create a group inside a group but not outside of it
  32
  33 -----------------------------------------------------------------
  34 -- Node Rights Management
  35 -----------------------------------------------------------------
  36 -- Les actions sur un Node (if /= Graph) depends on the rights of his parent
  37
  38 -- | rightsOf:
  39 -- technically : get the column Node (in table nodes) with rights (ACL)
  40 rightsOf :: Node -> Rights
  41 rightsOf n = undefined
  42
  43 rightsOfNode :: User -> Node -> Rights
  44 rightsOfNode u n = case n of
  45                 UserNode     -> rightsOf n
  46                 ProjectNode  -> rightsOf n
  47                 CorpusNode   -> rightsOf n
  48                 GraphNode    -> rightsOf n
  49                 _            -> rightsOf (parentOf n)
  50
  51 rightsOfNodeNgram :: User -> NodeNgram -> Rights
  52 rightsOfNodeNgram u n = rightsOf n'
  53     where
  54         n' = nodeOf n
  55
  56 rightsOfNodeNgramNgram :: User -> NodeNgramNgram -> Rights
  57 rightsOfNodeNgramNgram u n = rightsOf n'
  58     where
  59         n' = nodeOf n
  60
  61 rightsOfNodeNodeNgram
  62 rightsOfNodeNode
  63
  64
  65 -----------------------------------------------------------------
  66 -- Operation Rights Management
  67 -----------------------------------------------------------------
  68 data Operation = Read | Write
  69 -- Starting with simple case:
  70 -- type ModifyRights = Write
  71 -- type Exec = Write
  72
  73 data Rights = { _rightsRead  :: Bool
  74               , _rightsWrite :: Bool
  75               }
  76     deriving (Show, Read, Eq)
  77
  78 data LogRightsMessage = RightsSuccess | RightsError
  79     deriving (Show, Read, Eq)
  80
  81 type Read  = Bool
  82 type Write = Bool
  83
  84
  85 -----------------------------------------------------------------
  86 -- | TODO
  87 -- find the tables where there is the relation Node / User / Rights
  88 getRightsOfNodeWithUser :: Node -> User -> IO Rights
  89 getRightsOfNodeWithUser n u = undefined
  90
  91 userCan :: Operation -> User -> Node -> IO Bool
  92 userCan op u n = do
  93     rights <- getRightsOfNodeWithUser u n
  94     r = case op of
  95           Read  -> _rightsRead  rights
  96           Write -> _rightsWrite rights
  97     pure (r == True)
  98
  99 -- | User can (or can not) give/change rights of the Node
 100 userCanModifyRights :: User -> Node -> IO Bool
 101 userCanModifyRights u n = True `==` <$> userCan Write u n
 102
 103 -- | User can see who has access to the Node
 104 userCanReadRights :: User -> Node -> IO Bool
 105 userCanReadRights u n = True `==` <$> userCan Read u n
 106
 107
 108 chmod :: Rights -> User -> Node -> IO LogRightsMessage
 109 chmod r u n = undefined
 110
 111 chmod' :: Read -> Write -> User -> Node -> IO LogRightsMessage
 112 chmod' r w u n = chmod rights u n
 113     where
 114         rights = Rights r w
 115
 116
 117 readAccessOnly :: User -> Node -> IO LogRightsMessage
 118 readAccessOnly u n = chmod r u n
 119     where
 120         r = Rights True False
 121
 122
 123 stopAccess :: User -> Node -> IO LogRightsMessage
 124 stopAccess =
 125
 126 chmodAll :: Rights -> User -> [Node] -> IO [LogRightsMessage]
 127 chmd b r u ns = map (chmod b r u n) ns
 128
 129 chmodChildren :: Rights -> User -> [Node] -> IO [LogRightsMessage]
 130 chmodChildren b r u n = map (chmod br u n) ns'
 131     where
 132         ns' = childrenOf n
 133
 134