chore(avs): avs licence synchronize via anti join (WIP, we see light)
This commit is contained in:
Steffen Jost
parent
15f7a7576a
commit
3794f7482b
@ -14,7 +14,7 @@
|
||||
|
||||
|
||||
UserAvs
|
||||
personId AvsPersonId -- unique identifier for user throughout avs
|
||||
personId AvsPersonId -- unique identifier for user throughout avs; newtype for Int
|
||||
user UserId
|
||||
UniqueUserAvsUser user
|
||||
UniqueUserAvsId personId
|
||||
|
||||
@ -97,10 +97,12 @@ false = E.val False
|
||||
-- infinity = unsafeSqlValue "'infinity'"
|
||||
|
||||
justVal :: PersistField typ => typ -> E.SqlExpr (E.Value (Maybe typ))
|
||||
justVal = E.val . Just
|
||||
-- justVal = E.val . Just
|
||||
justVal = E.just . E.val
|
||||
|
||||
justValList :: PersistField typ => [typ] -> E.SqlExpr (E.ValueList (Maybe typ))
|
||||
justValList = E.valList . map Just
|
||||
-- justValList = E.valList . map Just
|
||||
justValList = E.justList . E.valList
|
||||
|
||||
infixl 4 =?.
|
||||
(=?.) :: PersistField typ => E.SqlExpr (E.Value typ) -> E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool)
|
||||
|
||||
@ -5,6 +5,9 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- TODO: remove this line, once the module is completed
|
||||
{-# OPTIONS_GHC -Wno-error=unused-local-binds #-} -- TODO: remove this line, once the module is completed
|
||||
{-# OPTIONS_GHC -Wno-warn=unused-local-binds #-} -- TODO: remove this line, once the module is completed
|
||||
|
||||
|
||||
module Handler.Utils.Avs
|
||||
( upsertAvsUser, upsertAvsUserById, upsertAvsUserByCard
|
||||
@ -33,7 +36,8 @@ import Handler.Users.Add
|
||||
|
||||
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.Utils as E
|
||||
import qualified Database.Esqueleto.PostgreSQL as E
|
||||
|
||||
|
||||
--------------------
|
||||
@ -43,7 +47,7 @@ import qualified Database.Esqueleto.Utils as E
|
||||
data AvsException
|
||||
= AvsInterfaceUnavailable -- Interface to AVS was not configured at startup or does not respond
|
||||
| AvsUserUnassociated UserId -- Manipulating AVS Data for a user that is not linked to AVS yet
|
||||
| AvsUserUnknownByAvs AvsPersonId -- AvsPersionId not (or no longer) found in AVS DB
|
||||
| AvsUserUnknownByAvs AvsPersonId -- AvsPersonId not (or no longer) found in AVS DB
|
||||
| AvsUserAmbiguous -- Multiple matching existing users found in our DB
|
||||
| AvsPersonSearchEmpty -- AvsPersonSearch returned empty result
|
||||
| AvsPersonSearchAmbiguous -- AvsPersonSearch returned more than one result
|
||||
@ -118,56 +122,69 @@ setLicencesAvs pls = do
|
||||
-- Only react to changes as compared to last seen status in avs.model
|
||||
-- TODO: turn into a job, once the interface is actually available
|
||||
checkLicences :: Handler ()
|
||||
checkLicences = do
|
||||
{-
|
||||
checkLicences = do
|
||||
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
|
||||
AvsResponseGetLicences licences <- throwLeftM avsQueryGetAllLicences
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
--let (vorfeld, nonvorfeld) = Set.partition (`avsPersonLicenceIs` AvsLicenceVorfeld) licences
|
||||
-- rollfeld = Set.filter (`avsPersonLicenceIs` AvsLicenceRollfeld) nonvorfeld
|
||||
let (noOrVorfeld, rollfeld) = Set.spanAntitone (`avsPersonLicenceIsLEQ` AvsLicenceVorfeld) licences
|
||||
(_nolicence , vorfeld) = Set.spanAntitone (`avsPersonLicenceIsLEQ` AvsNoLicence) noOrVorfeld
|
||||
idsRollfeld = avsLicencePersonId <$> Set.toList rollfeld
|
||||
idsVorfeld = avsLicencePersonId <$> Set.toList vorfeld
|
||||
|
||||
-- let licenceMap Map.map avsLicencePersonID $ avsMap.fromSet avsLicenceRampLicence licences
|
||||
-- idsRollfeld = concat $ Map.lookup AvsLicenceRollfeld licenceMap
|
||||
-- idsVorfeld = concat $ Map.lookup AvsLicenceVorfeld
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
-- Note: FRADrive users with 'R' also own 'F' qualification, but AvsGetResponseGetLicences yields only either
|
||||
let nowaday = utctDay now
|
||||
noOne = AvsPersonId 0
|
||||
vorORrollfeld' = Set.dropWhileAntitone (`avsPersonLicenceIsLEQ` AvsNoLicence) licences
|
||||
rollfeld' = Set.dropWhileAntitone (`avsPersonLicenceIsLEQ` AvsLicenceVorfeld) vorORrollfeld'
|
||||
vorORrollfeld :: NonEmpty AvsPersonId = set2NonEmpty noOne (Set.map avsLicencePersonID vorORrollfeld')
|
||||
rollfeld = set2NonEmpty noOne (Set.map avsLicencePersonID rollfeld' )
|
||||
|
||||
|
||||
runDB $ do
|
||||
E.select $ do
|
||||
(qauli E.:& qualUser E.:& usrAvs) <-
|
||||
E.from $ E.table @Qualification
|
||||
`E.innerJoin` E.table @QualificationUser
|
||||
`E.on` (\(quali E.:& qualUser) -> qual E.^. QualificationId E.==. qualUser E.^. QualificationUserQualification)
|
||||
`E.innerJoin` E.table @UserAvs
|
||||
`E.on` (\(_ E.:& qualUser E.:& usrAvs) -> qualUser E.^. QualificationUserUser E.==. usrAvs E.^. UserAvsUser)
|
||||
E.where_ $ E.isJust (quali E.^. QualificationAvsLicence)
|
||||
E.&&. (usrAvs E.^. QualificationAvsLicence `E.notIn` E.valList idsRollfeld)
|
||||
-- we get a weird type error so we try a simple demo here:
|
||||
(_res :: [(E.Value AvsPersonId, E.Value AvsPersonId )]) <- runDB $ E.select $ do
|
||||
(usrAvs E.:& (excl,_)) <-
|
||||
E.from $ E.table @UserAvs `E.innerJoin` E.values ((E.val (AvsPersonId 10), E.val ("ten" :: Text))
|
||||
:| [ (E.val (AvsPersonId 20), E.val "twenty")
|
||||
, (E.val (AvsPersonId 30), E.val "thirty") ]
|
||||
)
|
||||
`E.on` (\(usrAvs E.:& (excl,_)) -> excl E.==. usrAvs E.^. UserAvsPersonId)
|
||||
return (usrAvs E.^. UserAvsPersonId, excl)
|
||||
-- > Looks like we need te Type NonEmpty (SqlExpr (Value typ)) i.e. we need to wrap everything with E.val?!
|
||||
|
||||
SELECT *
|
||||
FROM sometable
|
||||
FULL OUTER JOIN
|
||||
(VALUES {{1,2,3},{4,5,6}}) AS t(x,y,z)
|
||||
ON sometable.x = t.x
|
||||
WHERE either IS NULL -- Use ERaw
|
||||
|
||||
{-
|
||||
|
||||
-- WAS WILL ICH HIER WIRKLICH:
|
||||
-- Liefere alle avsIds, welche die falsche Qualifikation zugewiesen bekommen haben?
|
||||
-- Wie erhalte ich alle IDs, welche es KEINE Qualifikation haben? FROM valList scheint es nicht zu geben!
|
||||
|
||||
return
|
||||
( userAvs E.^. UserAvsPersonId
|
||||
, quali E.^. QualificationAvsLicence
|
||||
)
|
||||
|
||||
--TODO this must be chunked into separate jobs/tasks
|
||||
--forM licences $ \AvsPersonLicence{..} -> do
|
||||
-- antijoinAvsLicences :: AvsLicence -> NonEmpty AvsPersonId -> DB [(E.Value (Maybe AvsPersonId), E.Value (Maybe AvsPersonId))]
|
||||
antijoinAvsLicences lic avsLics = --fmap (fmap $(E.unValueN 2)) $
|
||||
E.select $ do
|
||||
((_qauli E.:& _qualUser E.:& usrAvs) E.:& excl) <-
|
||||
E.from $ ( E.table @Qualification
|
||||
`E.innerJoin` E.table @QualificationUser
|
||||
`E.on` ( \(quali E.:& qualUser) ->
|
||||
(quali E.^. QualificationId E.==. qualUser E.^. QualificationUserQualification)
|
||||
-- NOTE: filters on the innerJoin must be part of ON-condition in order for anti-join to work!
|
||||
E.&&. (quali E.^. QualificationAvsLicence E.==. E.justVal lic) -- correct type of licence
|
||||
E.&&. (E.val nowaday `E.between` (qualUser E.^. QualificationUserFirstHeld
|
||||
,qualUser E.^. QualificationUserValidUntil)) -- currently valid
|
||||
E.&&. E.isNothing (qualUser E.^. QualificationUserBlockedDue) -- no blocked
|
||||
)
|
||||
`E.innerJoin` E.table @UserAvs
|
||||
`E.on` (\(_ E.:& qualUser E.:& usrAvs) -> qualUser E.^. QualificationUserUser E.==. usrAvs E.^. UserAvsUser)
|
||||
) `E.fullOuterJoin` E.values avsLics -- left-hand side produces all currently valid matching qualifications
|
||||
`E.on` (\((_ E.:& _ E.:& usrAvs) E.:& excl) -> usrAvs E.?. UserAvsPersonId E.==. excl)
|
||||
E.where_ $ E.isNothing excl E.||. E.isNothing (usrAvs E.?. UserAvsPersonId) -- anti join
|
||||
return (usrAvs E.?. UserAvsPersonId, excl)
|
||||
-}
|
||||
-- (_rollDelta, _vorfDelta) <- runDB $ (,)
|
||||
-- <$> antijoinAvsLicences AvsLicenceRollfeld rollfeld
|
||||
-- <*> antijoinAvsLicences AvsLicenceVorfeld vorORrollfeld
|
||||
|
||||
-- let roll2zero = Set.fromList rollRevoke
|
||||
-- roll2roll = Set.fromList rollGrant
|
||||
-- vorf2vorf = Set.fromList vorfGrant
|
||||
-- vorf2zero = Set.fromList vorfRevoke
|
||||
-- cases to consider:
|
||||
-- aID is either in lhs or rhs of vorfDelta, rollDelta or both.
|
||||
-- The case
|
||||
|
||||
|
||||
error "CONTINUE HERE" -- TODO STUB
|
||||
|
||||
|
||||
|
||||
@ -11,8 +11,10 @@ module Utils.Set
|
||||
, setPartitionEithers
|
||||
, setFromFunc
|
||||
, mapIntersectNotOne
|
||||
, set2NonEmpty
|
||||
) where
|
||||
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map.Strict()
|
||||
import qualified Data.Map as Map
|
||||
@ -65,4 +67,10 @@ setPartitionEithers :: (Ord a, Ord b) => Set (Either a b) -> (Set a, Set b)
|
||||
setPartitionEithers = (,) <$> setMapMaybe (preview _Left) <*> setMapMaybe (preview _Right)
|
||||
|
||||
setFromFunc :: (Finite k, Ord k) => (k -> Bool) -> Set k
|
||||
setFromFunc = Set.fromList . flip filter universeF
|
||||
setFromFunc = Set.fromList . flip filter universeF
|
||||
|
||||
|
||||
-- | convert a Set to NonEmpty, inserting a default value if necessary
|
||||
set2NonEmpty :: a -> Set a -> NonEmpty.NonEmpty a
|
||||
set2NonEmpty _ (Set.toList -> h:t) = h NonEmpty.:| t
|
||||
set2NonEmpty d _ = d NonEmpty.:| []
|
||||
|
||||
Loading…
Reference in New Issue
Block a user