mend

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

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 ->
--}
+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
+
+-}
+

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) ""

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

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 --
 ---------------