1 {-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
    2 module Databrary.Model.Authorize.SQL
    3   ( authorizationRow
    4   , authorizeRow
    5   , selectAuthorizeParent
    6   , selectAuthorizeChild
    7   , updateAuthorize
    8   , insertAuthorize
    9   , deleteAuthorize
   10   , selectAuthorizeActivity
   11   , makeAuthorize
   12   ) where
   13 
   14 import qualified Language.Haskell.TH as TH
   15 
   16 import Databrary.Model.Time
   17 import Databrary.Model.SQL.Select
   18 import Databrary.Model.Party.SQL (selectParty)
   19 import Databrary.Model.Audit.SQL
   20 import Databrary.Model.Party.Types
   21 import Databrary.Model.Permission.Types
   22 import Databrary.Model.Permission.SQL
   23 import Databrary.Model.Authorize.Types
   24 
   25 authorizationRow :: Selector -- ^ @'Party' -> 'Party' -> 'Authorization'@
   26 authorizationRow = selectMap (TH.ConE 'Authorization `TH.AppE`) $ accessRow "authorize_view"
   27 
   28 makeAuthorize :: Access -> Maybe Timestamp -> Party -> Party -> Authorize
   29 makeAuthorize a e c p = Authorize
   30   { authorization = Authorization
   31     { authorizeAccess = a
   32     , authorizeChild = c
   33     , authorizeParent = p
   34     }
   35   , authorizeExpires = e
   36   }
   37 
   38 authorizeRow :: Selector -- ^ @'Party' -> 'Party' -> 'Authorize'@
   39 authorizeRow = addSelects 'makeAuthorize
   40   (accessRow "authorize") [SelectColumn "authorize" "expires"]
   41 
   42 selectAuthorizeParent :: TH.Name -- ^ child 'Party'
   43   -> TH.Name -- ^ 'Identity'
   44   -> Selector -- ^ 'Authorize'
   45 selectAuthorizeParent child ident = selectJoin '($)
   46   [ selectMap (`TH.AppE` TH.VarE child) authorizeRow
   47   , joinOn ("authorize.parent = party.id AND authorize.child = ${partyId $ partyRow " ++ nameRef child ++ "}")
   48     $ selectParty ident
   49   ]
   50 
   51 selectAuthorizeChild :: TH.Name -- ^ parent 'Party'
   52   -> TH.Name -- ^ 'Identity'
   53   -> Selector -- ^ 'Authorize'
   54 selectAuthorizeChild parent ident = selectMap (`TH.AppE` TH.VarE parent) $ selectJoin '($)
   55   [ authorizeRow
   56   , joinOn ("authorize.child = party.id AND authorize.parent = ${partyId $ partyRow " ++ nameRef parent ++ "}")
   57     $ selectParty ident
   58   ]
   59 
   60 authorizeSets :: String -- ^ @'Authorize'@
   61   -> [(String, String)]
   62 authorizeSets a = accessSets a ++
   63   [ ("expires", "${authorizeExpires " ++ a ++ "}")
   64   ]
   65 
   66 authorizeKeys :: String -- ^ @'Authorize'@
   67   -> [(String, String)]
   68 authorizeKeys a =
   69   [ ("child", "${partyId $ partyRow $ authorizeChild $ authorization " ++ a ++ "}")
   70   , ("parent", "${partyId $ partyRow $ authorizeParent $ authorization " ++ a ++ "}")
   71   ]
   72 
   73 updateAuthorize :: TH.Name -- ^ @'AuditIdentity'@
   74   -> TH.Name -- ^ @'Authorize'@
   75   -> TH.ExpQ
   76 updateAuthorize ident a = auditUpdate ident "authorize"
   77   (authorizeSets as)
   78   (whereEq $ authorizeKeys as)
   79   Nothing
   80   where as = nameRef a
   81 
   82 insertAuthorize :: TH.Name -- ^ @'AuditIdentity'@
   83   -> TH.Name -- ^ @'Authorize'@
   84   -> TH.ExpQ
   85 insertAuthorize ident a = auditInsert ident "authorize"
   86   (authorizeKeys as ++ authorizeSets as)
   87   Nothing
   88   where as = nameRef a
   89 
   90 deleteAuthorize :: TH.Name -- ^ @'AuditIdentity'@
   91   -> TH.Name -- ^ @'Authorize'@
   92   -> TH.ExpQ
   93 deleteAuthorize ident a = auditDelete ident "authorize"
   94   (whereEq $ authorizeKeys as)
   95   Nothing
   96   where as = nameRef a
   97 
   98 selectAuthorizeActivity :: TH.Name -- ^@'Identity'@
   99   -> Selector -- ^ @('Timestamp', 'Party')@
  100 selectAuthorizeActivity ident = selectJoin '(,)
  101   [ selectAuditActivity "authorize"
  102   , joinOn "audit.child = party.id"
  103     $ selectParty ident
  104   ]