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 ]