1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, DeriveDataTypeable, DataKinds #-}
    2 {-# OPTIONS_GHC -fno-warn-orphans #-}
    3 module Databrary.Model.Permission.Types
    4   ( Permission(..)
    5   , Access(..), accessPermission'
    6   , accessSite, accessMember, accessPermission
    7   , PublicPolicy(..)
    8   , SharedPolicy(..)
    9   , VolumeRolePolicy(..)
   10   , extractPermissionIgnorePolicy
   11   ) where
   12 
   13 import Language.Haskell.TH.Lift (deriveLift, deriveLiftMany)
   14 import qualified Data.Typeable.Internal
   15 import qualified GHC.Arr
   16 import qualified Database.PostgreSQL.Typed.Types
   17 import qualified Database.PostgreSQL.Typed.Dynamic
   18 import qualified Database.PostgreSQL.Typed.Enum
   19 import qualified Data.Aeson.Types
   20 import qualified Data.ByteString
   21 import qualified Data.ByteString.Char8
   22 
   23 import Databrary.Has (Has(..))
   24 import Databrary.Model.Enum
   25 import qualified Databrary.Model.Kind
   26 import qualified Databrary.HTTP.Form.Deform
   27 
   28 -- makeDBEnum "permission" "Permission"
   29 -- TODO: db coherence
   30 data Permission
   31   = PermissionNONE |
   32     PermissionPUBLIC |
   33     PermissionSHARED |
   34     PermissionREAD |
   35     PermissionEDIT |
   36     PermissionADMIN
   37   deriving (Eq,
   38             Ord,
   39             Enum,
   40             GHC.Arr.Ix,
   41             Bounded,
   42             Data.Typeable.Internal.Typeable)
   43 instance Show Permission where
   44   show PermissionNONE = "NONE"
   45   show PermissionPUBLIC = "PUBLIC"
   46   show PermissionSHARED = "SHARED"
   47   show PermissionREAD = "READ"
   48   show PermissionEDIT = "EDIT"
   49   show PermissionADMIN = "ADMIN"
   50 instance Database.PostgreSQL.Typed.Types.PGType "permission"
   51 instance Database.PostgreSQL.Typed.Types.PGParameter "permission" Permission where
   52   pgEncode _ PermissionNONE
   53     = Data.ByteString.pack [78, 79, 78, 69]
   54   pgEncode _ PermissionPUBLIC
   55     = Data.ByteString.pack [80, 85, 66, 76, 73, 67]
   56   pgEncode _ PermissionSHARED
   57     = Data.ByteString.pack [83, 72, 65, 82, 69, 68]
   58   pgEncode _ PermissionREAD
   59     = Data.ByteString.pack [82, 69, 65, 68]
   60   pgEncode _ PermissionEDIT
   61     = Data.ByteString.pack [69, 68, 73, 84]
   62   pgEncode _ PermissionADMIN
   63     = Data.ByteString.pack [65, 68, 77, 73, 78]
   64 instance Database.PostgreSQL.Typed.Types.PGColumn "permission" Permission where
   65   pgDecode _ x_a42l2
   66     = case Data.ByteString.unpack x_a42l2 of
   67         [78, 79, 78, 69] -> PermissionNONE
   68         [80, 85, 66, 76, 73, 67] -> PermissionPUBLIC
   69         [83, 72, 65, 82, 69, 68] -> PermissionSHARED
   70         [82, 69, 65, 68] -> PermissionREAD
   71         [69, 68, 73, 84] -> PermissionEDIT
   72         [65, 68, 77, 73, 78] -> PermissionADMIN
   73         _ -> error
   74                ("pgDecode permission: "
   75                 ++ (Data.ByteString.Char8.unpack x_a42l2))
   76 instance Database.PostgreSQL.Typed.Dynamic.PGRep "permission" Permission
   77 instance Database.PostgreSQL.Typed.Enum.PGEnum Permission
   78 instance Databrary.Model.Kind.Kinded Permission where
   79   kindOf _ = "permission"
   80 instance DBEnum Permission
   81 instance Data.Aeson.Types.ToJSON Permission where
   82   toJSON
   83     = (Data.Aeson.Types.toJSON . fromEnum)
   84 instance Data.Aeson.Types.FromJSON Permission where  -- not used
   85   parseJSON = parseJSONEnum
   86 instance Databrary.HTTP.Form.Deform.Deform f_a42l3 Permission where
   87   deform = enumForm
   88 
   89 instance Monoid Permission where
   90   mempty = PermissionNONE
   91   mappend = max
   92 
   93 -- | TODO: Figure out what this thing represents
   94 data Access = Access
   95   { accessSite' :: !Permission -- ^ ??
   96   , accessMember' :: !Permission -- ^ ??
   97   } deriving (Eq) -- , Show)
   98 
   99 accessPermission' :: Access -> Permission
  100 accessPermission' (Access s m) = min s m
  101 
  102 accessSite, accessMember, accessPermission :: Has Access a => a -> Permission
  103 accessSite = accessSite' . view
  104 accessMember = accessMember' . view
  105 accessPermission = accessPermission' . view
  106 
  107 instance Bounded Access where
  108   minBound = Access minBound minBound
  109   maxBound = Access maxBound maxBound
  110 
  111 instance Monoid Access where
  112   mempty = Access mempty mempty
  113   mappend (Access s1 m1) (Access s2 m2) = Access (mappend s1 s2) (mappend m1 m2)
  114 
  115 deriveLiftMany [''Permission, ''Access]
  116 
  117 -- | A PublicPolicy represents a set of rules that customize the public viewer role
  118 -- for a given volume. Restricted is the only current policy. It signifies
  119 -- hiding all data, except high level summary information and highlights.
  120 -- The word policy is a reference to the term used in attribute-based access control.
  121 data PublicPolicy = PublicRestrictedPolicy | PublicNoPolicy -- deriving (Show, Eq)
  122 
  123 -- | A SharedPolicy is the same as PublicPolicy currently, but applied to the shared
  124 -- viewer role.
  125 data SharedPolicy = SharedRestrictedPolicy | SharedNoPolicy -- deriving (Show, Eq)
  126 
  127 -- | A user's effective access to a given volume.
  128 data VolumeRolePolicy =
  129     RoleNone
  130   | RolePublicViewer PublicPolicy
  131   | RoleSharedViewer SharedPolicy
  132   | RoleReader
  133   | RoleEditor
  134   | RoleAdmin
  135   -- deriving (Show, Eq)
  136 
  137 deriveLift ''PublicPolicy
  138 deriveLift ''SharedPolicy
  139 deriveLift ''VolumeRolePolicy
  140 
  141 -- | Transition function used until all call sites take into Policy
  142 -- value into consideration.
  143 extractPermissionIgnorePolicy :: VolumeRolePolicy -> Permission
  144 extractPermissionIgnorePolicy rp =
  145   case rp of
  146       RoleNone -> PermissionNONE
  147       RolePublicViewer _ -> PermissionPUBLIC
  148       RoleSharedViewer _ -> PermissionSHARED
  149       RoleReader -> PermissionREAD
  150       RoleEditor -> PermissionEDIT
  151       RoleAdmin -> PermissionADMIN