Steffen Jost
d84269154f
also - change some AdminProblemR DB actions to DBRead instead - add insane supervision warning to AdminProblem page
47 lines
2.2 KiB
Haskell
47 lines
2.2 KiB
Haskell
-- SPDX-FileCopyrightText: 2025 Steffen Jost <s.jost@fraport.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Utils.Company where
|
|
|
|
import Import.NoFoundation
|
|
import Foundation.Type
|
|
import Foundation.DB
|
|
|
|
-- import Database.Esqueleto.Experimental ((:&)(..))
|
|
import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
|
|
import qualified Database.Esqueleto.Utils as E
|
|
-- import qualified Database.Esqueleto.PostgreSQL as E
|
|
|
|
import Handler.Utils.Memcached
|
|
|
|
|
|
-- DB Queries related to firms and supervision that are used in several places
|
|
|
|
|
|
-- | check if a user is NOT associated with a company; false if company is null
|
|
usrDoesNotBelong :: E.SqlExpr (E.Value UserId) -> E.SqlExpr (E.Value (Maybe CompanyId)) -> E.SqlExpr (E.Value Bool)
|
|
usrDoesNotBelong uid fsh = E.isJust fsh E.&&. E.notExists (do
|
|
uc <- E.from $ E.table @UserCompany
|
|
E.where_ $ uc E.^. UserCompanyUser E.==. uid
|
|
E.&&. uc E.^. UserCompanyCompany E.=?. fsh
|
|
)
|
|
|
|
-- | given a supervisionship, true if supervisor is NOT associated with the supervisionship-company
|
|
missingCompanySupervisor :: E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)
|
|
missingCompanySupervisor us = (us E.^. UserSupervisorSupervisor) `usrDoesNotBelong` (us E.^. UserSupervisorCompany)
|
|
|
|
-- | given a supervisionship, true if subordinate is NOT associated with the supervisionship-company
|
|
missingCompanySubordinate :: E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)
|
|
missingCompanySubordinate us = (us E.^. UserSupervisorUser) `usrDoesNotBelong` (us E.^. UserSupervisorCompany)
|
|
|
|
-- | once per day, check if there are supervisionships where supervisor or subordinate are not associated witht the supervisionship-company
|
|
areThereInsaneCompanySupervisions :: HandlerFor UniWorX Bool
|
|
areThereInsaneCompanySupervisions = $(memcachedByHere) (Just . Right $ 22 * diffHour) [st|isane-company-supervision|] $ do
|
|
res <- runDBRead $ E.selectExists $ do
|
|
us <- E.from $ E.table @UserSupervisor
|
|
E.where_ $ E.isJust (us E.^. UserSupervisorCompany)
|
|
E.&&. (missingCompanySupervisor us E.||. missingCompanySubordinate us)
|
|
$logInfoS "sanity" [st|Are there insane company supervisions: #{tshow res}|]
|
|
return res
|