diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index c72124c58..b1ffb2dae 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -354,7 +354,7 @@ getPrintDownloadR cupj = do getPrintAcknowR, postPrintAcknowR :: Day -> Handler Html getPrintAcknowR = postPrintAcknowR postPrintAcknowR ackDay = do - -- TODO: besser mit cryptoids arbeiten und an den Post Request hängen?! + -- TODO: besser mit cryptoids als hiddenfield in Form hineinhängen arbeiten und an den Post Request hängen?! ((ackRes, ackWgt), ackEnctype) <- runFormPost (identifyForm FIDPrintAcknowledge buttonForm :: Form ButtonConfirm) let ackForm = wrapForm ackWgt def { formAction = Just $ SomeRoute $ PrintAcknowR ackDay diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index e6c2edf10..7fb5f498b 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -3,6 +3,7 @@ module Handler.Utils.Avs --, checkLicences getLicence, getLicenceDB , setLicence, setLicenceAvs, setLicencesAvs + , checkLicences ) where import Import @@ -68,14 +69,18 @@ setLicenceAvs apid lic = do let req = Set.singleton $ AvsPersonLicence apid lic setLicencesAvs req -setLicencesAvs :: Set AvsPersonLicence -> DB () +-- setLicencesAvs :: Set AvsPersonLicence -> DB () +setLicencesAvs :: (MonadHandler m, MonadThrow m, HandlerSite m ~ UniWorX) => + Set AvsPersonLicence -> m () setLicencesAvs pls = do AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery AvsResponseSetLicences responses <- throwLeftM $ avsQuerySetLicences $ AvsQuerySetLicences pls - forM_ responses $ \AvsLicenceResponse{} -> - error "CONTINUE HERE" -- TODO STUB + forM_ responses $ \AvsLicenceResponse{..} -> + unless (sloppyBool avsResponseSuccess) $ + -- TODO: create an Admin Problems overview page + $logErrorS "AVS" $ "Set licence failed for " <> tshow avsResponsePersonID <> " due to " <> cropText avsResponseMessage + -{- -- | Retrieve all currently valid driving licences and check against our database -- Only react to changes as compared to last seen status in avs.model -- TODO: turn into a job, once the interface is actually available @@ -86,12 +91,35 @@ checkLicences = do --TODO this must be chunked into separate jobs/tasks --forM licences $ \AvsPersonLicence{..} -> do error "CONTINUE HERE" -- TODO STUB --} + {- upsertAvsUser :: AvsStatusPerson -> or +-} + +{- upsertAvsUser :: AvsPersonId -> --} \ No newline at end of file +upsertAvsUser api = do + mbuid <- getBy $ UniqueUserAvsId api + case mbuid + Nothing -> do -- unknown user + + (Just uid) -> do -- known user +-} + +{- +-- lookupAvsUser :: AvsPersonId -> +lookupAvsUser api = do + AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery + -- avsQueryPerson does not support querying an AvsPersonId, hence we need a preliminary avsQueryStatus to get all AvsCardNo + AvsResponseStatus statuses <- throwLeftM $ avsQueryStatus $ AvsQueryStatus $ Set.singleton api + _avsperson <- forM statuses $ \AvsStatusPerson{avsStatusPersonCardStatus} -> + forM avsStatusPersonCardStatus $ \AvsDataPersonCard{avsDataCardNo} -> + AvsResponsePerson ps <- throwLeftM $ avsQueryPerson $ AvsQueryPerson def{avsPersonQueryCardNo = avsDataCardNo} + return $ mergeByPersonId ps + +-} + diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 72c2fab42..b08a57909 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -135,7 +135,7 @@ nullaryPathPiece ''ButtonConfirm $ camelToPathPiece' 1 embedRenderMessage ''UniWorX ''ButtonConfirm id instance Button UniWorX ButtonConfirm where - btnClasses BtnConfirm = [BCIsButton, BCDanger] + btnClasses BtnConfirm = [BCIsButton, BCPrimary] --confirmButton :: (Button (HandlerSite m) ButtonConfirm, MonadHandler m) => AForm m () --confirmButton = combinedButtonFieldF_ (Proxy @ButtonConfirm) "" diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index ef7ebfd3b..3e446ae76 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/src/Jobs/Handler/SendNotification/Qualification.hs @@ -20,11 +20,6 @@ import qualified Data.Text as Text import qualified Data.CaseInsensitive as CI import Text.Hamlet --- import qualified Database.Esqueleto.Experimental as E --- import qualified Database.Esqueleto.Utils as E - - --- TODO: refactor! Do not call error in Jobs, as this results in locked jobs. Abort graceful! dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> Handler () dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = userMailT jRecipient $ do diff --git a/src/Utils.hs b/src/Utils.hs index 5276e8544..aade01871 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -949,9 +949,6 @@ actRight :: Applicative f => Either a b -> (b -> f (Either a c)) -> f (Either a actRight (Left x) _ = pure $ Left x actRight (Right y) f = f y ---leftExceptT :: Monad m => m (Either e a) -> ExceptT e m a ---leftExceptT -- TODO - --------------- -- Exception -- ---------------