1 {-# LANGUAGE OverloadedStrings #-} 2 module Databrary.Model.Identity 3 ( module Databrary.Model.Identity.Types 4 , determineIdentity 5 , maybeIdentity 6 , identityJSON 7 ) where 8 9 import Data.Monoid ((<>)) 10 11 import Databrary.Ops 12 import Databrary.Has 13 import qualified Databrary.JSON as JSON 14 import Databrary.Model.Id 15 import Databrary.Model.Token 16 import Databrary.HTTP.Request 17 import Databrary.Service.Types 18 import Databrary.Service.DB 19 import Databrary.HTTP.Cookie 20 import Databrary.Model.Party 21 import Databrary.Model.Permission 22 import Databrary.Model.Identity.Types 23 24 -- | Extract session token from cookie, and use it to find an active session. 25 -- 26 -- This is web framework code, and should NOT be used within application logic. 27 -- 28 -- TODO: Make this more plain, taking the Secret and Request (or just the 29 -- cookies) as regular arguments. 30 determineIdentity :: (MonadHas Secret c m, MonadHasRequest c m, MonadDB c m) => m Identity 31 determineIdentity = 32 maybe NotLoggedIn Identified <$> (flatMapM lookupSession =<< getSignedCookie "session") 33 34 -- | Takes default action and a monadic function. If the Identity within the 35 -- monadic context is 'Identified', apply the function to the 'Session' held 36 -- within. Otherwise, run the default action. 37 maybeIdentity 38 :: (MonadHasIdentity c m) 39 => m a -- ^ Default action 40 -> (Session -> m a) -- ^ Monadic function 41 -> m a -- ^ Result 42 maybeIdentity z f = extractFromIdentifiedSessOrDefault z f =<< peek 43 44 identityJSON :: JSON.ToObject o => Identity -> JSON.Record (Id Party) o 45 identityJSON i = partyJSON (view i) `JSON.foldObjectIntoRec` 46 ( "authorization" JSON..= accessSite i 47 <> "csverf" `JSON.kvObjectOrEmpty` identityVerf i 48 <> "superuser" `JSON.kvObjectOrEmpty` (True `useWhen` (identityAdmin i)))