1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, TypeFamilies, RecordWildCards #-}
    2 module Databrary.Model.Volume.Types
    3   ( VolumeRow(..)
    4   , Volume(..)
    5   , VolumeOwner
    6   , blankVolume
    7   , toPolicyDefaulting
    8   , volumeAccessPolicyWithDefault
    9   , coreVolumeId
   10   ) where
   11 
   12 import qualified Data.ByteString as BS
   13 import Data.Maybe (fromMaybe)
   14 import qualified Data.Text as T
   15 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
   16 import Language.Haskell.TH.Lift (deriveLiftMany)
   17 
   18 import Databrary.Has (Has(..))
   19 import Databrary.Model.Time
   20 import Databrary.Model.Kind
   21 import Databrary.Model.Permission.Types
   22 import Databrary.Model.Id.Types
   23 import Databrary.Model.Party.Types
   24 
   25 type instance IdType Volume = Int32
   26 
   27 data VolumeRow = VolumeRow
   28   { volumeId :: Id Volume
   29   , volumeName :: T.Text
   30   , volumeBody :: Maybe T.Text
   31   , volumeAlias :: Maybe T.Text
   32   , volumeDOI :: Maybe BS.ByteString
   33   }
   34   -- deriving (Show, Eq)
   35 
   36 type VolumeOwner = (Id Party, T.Text)
   37 
   38 data Volume = Volume
   39   { volumeRow :: !VolumeRow
   40   , volumeCreation :: Timestamp
   41   , volumeOwners :: [VolumeOwner]
   42   , volumeRolePolicy :: VolumeRolePolicy
   43   }
   44   -- deriving (Show, Eq)
   45 
   46 instance Kinded Volume where
   47   kindOf _ = "volume"
   48 
   49 instance Has (Id Volume) VolumeRow where
   50   view = volumeId
   51 instance Has (Id Volume) Volume where
   52   view = (view . volumeRow)
   53 instance Has Permission Volume where
   54   view = extractPermissionIgnorePolicy . volumeRolePolicy
   55 deriveLiftMany [''VolumeRow, ''Volume]
   56 
   57 -- | Convert shareFull value read from db into a policy
   58 -- value, applying a default if needed.
   59 toPolicyDefaulting :: Maybe Bool -> a -> a -> a
   60 toPolicyDefaulting mShareFull noPolicy restrictedPolicy =
   61     let
   62         -- in the rare circumstance that a volume access
   63         -- entry in db improperly contains null for public/shared group,
   64         -- arbitrarily use True to follow old convention before sharefull
   65         -- was introduced.
   66         shareFull = fromMaybe True mShareFull
   67     in
   68         if shareFull then noPolicy else restrictedPolicy
   69 
   70 volumeAccessPolicyWithDefault :: Permission -> Maybe Bool -> VolumeRolePolicy
   71 volumeAccessPolicyWithDefault perm1 mShareFull =
   72   case perm1 of
   73     PermissionNONE ->
   74       RoleNone
   75     PermissionPUBLIC ->
   76       RolePublicViewer (toPolicyDefaulting mShareFull PublicNoPolicy PublicRestrictedPolicy)
   77     PermissionSHARED ->
   78       RoleSharedViewer (toPolicyDefaulting mShareFull SharedNoPolicy SharedRestrictedPolicy)
   79     PermissionREAD ->
   80       RoleReader
   81     PermissionEDIT ->
   82       RoleEditor
   83     PermissionADMIN ->
   84       RoleAdmin
   85 
   86 blankVolume :: Volume
   87 blankVolume = Volume
   88   { volumeRow = VolumeRow
   89     { volumeId = error "blankVolume"
   90     , volumeName = ""
   91     , volumeAlias = Nothing
   92     , volumeBody = Nothing
   93     , volumeDOI = Nothing
   94     }
   95   , volumeCreation = posixSecondsToUTCTime 1357900000
   96   , volumeOwners = []
   97   , volumeRolePolicy = RoleNone
   98   }
   99 
  100 coreVolumeId :: Id Volume
  101 coreVolumeId = Id 0