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