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)))