-- SPDX-FileCopyrightText: 2025 Steffen Jost -- -- 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 client is NOT associated with the supervisionship-company missingCompanyClient :: E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool) missingCompanyClient us = (us E.^. UserSupervisorUser) `usrDoesNotBelong` (us E.^. UserSupervisorCompany) -- | once per day, check if there are supervisionships where supervisor or client are not associated witht the supervisionship-company areThereInsaneCompanySupervisions :: HandlerFor UniWorX (Bool, UTCTime) areThereInsaneCompanySupervisions = $(memcachedByHere) (Just . Right $ 22 * diffHour) [st|isane-company-supervision|] $ do now <- liftIO getCurrentTime res <- runDBRead $ E.selectExists $ do us <- E.from $ E.table @UserSupervisor E.where_ $ E.isJust (us E.^. UserSupervisorCompany) E.&&. (missingCompanySupervisor us E.||. missingCompanyClient us) $logInfoS "sanity" [st|Are there insane company supervisions: #{tshow res}|] return (res,now)