1 {-# LANGUAGE TemplateHaskell #-} 2 module Databrary.Model.Identity.Types 3 ( Identity(..) 4 , MonadHasIdentity 5 , extractFromIdentifiedSessOrDefault 6 , identityVerf 7 , identityAdmin 8 , identitySuperuser 9 ) where 10 11 import qualified Data.ByteString as BS 12 13 import Databrary.Has (Has(..), MonadHas) 14 import Databrary.Model.Id.Types 15 import Databrary.Model.Permission.Types 16 import Databrary.Model.Party.Types 17 import Databrary.Model.Token.Types 18 19 -- | Who is making the request that we are handling? 20 data Identity 21 = NotLoggedIn 22 -- ^ User may have an identity, but they have not established it yet 23 | IdentityNotNeeded 24 -- ^ We don't care what the user's identity is. 25 -- Used mainly for BackgroundContext, but also used when 26 -- running unprotected routes 27 | Identified Session 28 -- ^ An actual human user on a web browser. One of the other two return values 29 -- for 'determineIdentity'. 30 | ReIdentified SiteAuth 31 -- ^ Speculation: used in video conversion when sending results from the 32 -- compute cluster back to the system. Used as a 'su' to run actions as the 33 -- account who created the upload asset, instead of the anonymous account submitting the result? 34 35 -- | Get the SiteAuth for the Identity, which corresponds to what privileges the Identity has 36 -- within the site as well which Party/Account the Identity is 37 instance Has SiteAuth Identity where 38 view (Identified Session{ sessionAccountToken = AccountToken{ tokenAccount = t } }) = t 39 view (ReIdentified a) = a 40 view IdentityNotNeeded = nobodySiteAuth 41 view NotLoggedIn = nobodySiteAuth 42 43 instance Has Party Identity where 44 view = view . (view :: Identity -> SiteAuth) 45 instance Has Account Identity where 46 view = view . (view :: Identity -> SiteAuth) 47 instance Has (Id Party) Identity where 48 view = view . (view :: Identity -> SiteAuth) 49 instance Has Access Identity where 50 view = view . (view :: Identity -> SiteAuth) 51 52 -- | Used by an action that will reference the actor's identity in order to authorize the action being performed. 53 -- In some cases, this identity simply hasn't been established or was not resolved because the 54 -- context indicated that an identity wasn't needed. 55 type MonadHasIdentity c m = (MonadHas Identity c m, Has SiteAuth c, Has Party c, Has (Id Party) c, Has Access c) 56 57 -- | Extract a value from part of a session for Identified, otherwise use the default value 58 extractFromIdentifiedSessOrDefault :: a -> (Session -> a) -> Identity -> a 59 extractFromIdentifiedSessOrDefault z f = \case 60 Identified sess -> f sess 61 NotLoggedIn -> z 62 IdentityNotNeeded -> z 63 ReIdentified _ -> z 64 65 -- | Extract the secure token for state changing action, only available for logged in session identity 66 identityVerf :: Identity -> Maybe BS.ByteString 67 identityVerf = extractFromIdentifiedSessOrDefault Nothing (Just . sessionVerf) 68 69 identitySuperuserFor :: (Access -> Permission) -> Identity -> Bool 70 identitySuperuserFor f (Identified t) = sessionSuperuser t && f (view t) == PermissionADMIN 71 identitySuperuserFor _ (ReIdentified _) = True 72 identitySuperuserFor _ _ = False 73 74 identityAdmin :: Identity -> Bool 75 identityAdmin = identitySuperuserFor accessMember 76 77 identitySuperuser :: Identity -> Bool 78 identitySuperuser = identitySuperuserFor accessPermission