chore(avs): add safety catch for revoke unknown avs licences

messages/uniworx/categories/avs/de-de-formal.msg

@@ -14,8 +14,9 @@ AvsQueryStatusInvalid t@Text: Nur numerische IDs eingeben, durch Komma getrennt!
 AvsLicence: Fahrberechtigung
 AvsPersonNoNotId: AVS Personennummer dient zur menschlichen Kommunikation mit der Ausweisstelle und darf nicht verwechselt werden mit der maschinell verwendeten AVS Personen Id
 AvsTitleLicenceSynch: Abgleich Fahrberechtigungen zwischen AVS und FRADrive
-BtnRevokeAvsLicences: Fahrberechtigungen im AVS sofort entziehen
+BtnAvsRevokeUnknown: Fahrberechtigungen im AVS sofort entziehen
-BtnImportUnknownAvsIds: Daten unbekannter Personen importieren
+BtnAvsImportUnknown: AVS Daten unbekannter Personen importieren
+AvsRevokeFor n@Int: Sind Sie absolut sicher, dass Sie #{n} #{pluralDE n "unbekanntem Fahrer" "unbekannten Fahrern"} jegliche Fahrlizenz im AVS sofort entziehen wollen?
 AvsImportIDs n@Int m@Int: AVS Persondendaten importiert: #{show n}/#{show m}
 AvsImportAmbiguous n@Int: Import für #{show n} uneindeutige AVS IDs fehlgeschlagen
 AvsImportUnknowns n@Int: Import für #{show n} unbekannte AVS IDs fehlgeschlagen

messages/uniworx/categories/avs/en-eu.msg

@@ -14,8 +14,9 @@ AvsQueryStatusInvalid t: Numeric IDs only, comma seperated! #{show t}
 AvsLicence: Driving Licence
 AvsPersonNoNotId: AVS person number is used in human communication only and must not be mistaken for the AVS personen id used in machine communications
 AvsTitleLicenceSynch: Synchronisation driving licences between AVS and FRADrive
-BtnRevokeAvsLicences: Revoke AVS driving licences immediately
+BtnAvsRevokeUnknown: Revoke AVS driving licences for unknown persons immediately
-BtnImportUnknownAvsIds: Import unknown person data
+BtnAvsImportUnknown: Import AVS data for unknown persons
+AvsRevokeFor n@Int: Are you sure to immediately revoke all apron driving licences for #{n} unknown #{pluralENs n "driver"}?
 AvsImportIDs n m: AVS person data imported: #{show n}/#{show m}
 AvsImportAmbiguous n@Int: Import failed for #{show n} ambiguous AVS Ids
 AvsImportUnknowns n@Int: Import failed for #{show n} unknown AVS Ids

src/Handler/Admin/Avs.hs

@@ -39,7 +39,7 @@ single :: (k,a) -> Map k a
 single = uncurry Map.singleton
 
 
--- Button needed only here
+-- Button only needed in AVS TEST; further buttons see below
 data ButtonAvsTest = BtnCheckLicences | BtnSynchLicences
   deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
 instance Universe ButtonAvsTest
@@ -277,18 +277,24 @@ type SynchTableExpr = (                   E.SqlExpr (E.Value AvsPersonId)
 type SynchDBRow = (E.Value AvsPersonId, E.Value AvsLicence, Entity Qualification, Entity QualificationUser, Entity User)
 -}
 
-
+-- Buttons only needed for AVS Synching
-data ButtonAvsSynch = BtnImportUnknownAvsIds | BtnRevokeAvsLicences
+data ButtonAvsImportUnknown = BtnAvsImportUnknown
   deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
-instance Universe ButtonAvsSynch
+instance Universe ButtonAvsImportUnknown
-instance Finite   ButtonAvsSynch
+instance Finite   ButtonAvsImportUnknown
+nullaryPathPiece ''ButtonAvsImportUnknown camelToPathPiece
+embedRenderMessage ''UniWorX ''ButtonAvsImportUnknown id
+instance Button UniWorX ButtonAvsImportUnknown where
+  btnClasses  BtnAvsImportUnknown = [BCIsButton, BCPrimary]  
 
-nullaryPathPiece ''ButtonAvsSynch camelToPathPiece
+data ButtonAvsRevokeUnknown = BtnAvsRevokeUnknown
-embedRenderMessage ''UniWorX ''ButtonAvsSynch id
+  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
-
+instance Universe ButtonAvsRevokeUnknown
-instance Button UniWorX ButtonAvsSynch where
+instance Finite   ButtonAvsRevokeUnknown
-  btnClasses  BtnImportUnknownAvsIds = [BCIsButton, BCPrimary]
+nullaryPathPiece ''ButtonAvsRevokeUnknown camelToPathPiece
-  btnClasses  BtnRevokeAvsLicences   = [BCIsButton, BCDanger]
+embedRenderMessage ''UniWorX ''ButtonAvsRevokeUnknown id
+instance Button UniWorX ButtonAvsRevokeUnknown where
+  btnClasses  BtnAvsRevokeUnknown  = [BCIsButton, BCDanger]
 
 
 data LicenceTableAction =  LicenceTableChangeAvs
@@ -310,7 +316,7 @@ data LicenceTableActionData =  LicenceTableChangeAvsData
 
 postProblemAvsSynchR,  getProblemAvsSynchR :: Handler Html
 postProblemAvsSynchR = getProblemAvsSynchR
-getProblemAvsSynchR = do  
+getProblemAvsSynchR = do    
   let catchAllAvs' r = flip catch (\err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) >> redirect r)
       catchAllAvs    = catchAllAvs' ProblemAvsSynchR -- == current route; use only in conditions that are not repeated upon reload
   AvsLicenceDifferences{..} <- catchAllAvs' AdminR retrieveDifferingLicences
@@ -325,32 +331,47 @@ getProblemAvsSynchR = do
       pure toZero
   let unknownLicenceOwners    = E.unValue <$> unknownLicenceOwners'
       numUnknownLicenceOwners = length unknownLicenceOwners
-  (btnUnknownWgt, btnUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDAbsUnknownLicences
-  case btnUnknownRes of
-    Nothing -> return ()
-    (Just BtnImportUnknownAvsIds)  -> catchAllAvs $ do 
-      res <- forM (take 500 unknownLicenceOwners) $ try . upsertAvsUserById -- TODO: turn this into a background job
-      let procRes (Right _)                           = (Sum 1, mempty :: Set.Set AvsPersonId, mempty :: Set.Set AvsPersonId, mempty)
-          --TODO: continue here!
-          --procRes (Left (AvsUserAmbiguous api))     = (Sum 0, Set.singleton api, mempty, mempty)
-          --procRes (Left (AvsUserUnknownByAvs api))  = (Sum 0, mempty, Set.singleton api, mempty)
-          procRes (Left (err :: SomeException))       = (Sum 0, mempty, mempty, Set.singleton $ tshow err)
-          (Sum oks, ambis, unkns, errs) = foldMap procRes res
-          ms = if oks == numUnknownLicenceOwners then Success else Warning      
-      unless (null ambis) $ addMessageModal Error (i18n $ MsgAvsImportAmbiguous $ length ambis) (Right (text2widget $ tshow ambis))
-      unless (null unkns) $ addMessageModal Error (i18n $ MsgAvsImportUnknowns  $ length unkns) (Right (text2widget $ tshow unkns))
-      unless (null errs)  $ addMessageModal Error (i18n MsgAvsCommunicationError)               (Right (text2widget $ tshow errs ))
-      addMessageI ms $ MsgAvsImportIDs oks numUnknownLicenceOwners
-      redirect ProblemAvsSynchR
 
-    (Just BtnRevokeAvsLicences) -> catchAllAvs $ do
+  (btnImportUnknownWgt, btnImportUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDBtnAvsImportUnknown
-      let revokes = Set.map (AvsPersonLicence AvsNoLicence) $ Set.fromList unknownLicenceOwners
+  ifMaybeM btnImportUnknownRes () $ \BtnAvsImportUnknown -> catchAllAvs $ do 
-          no_revokes = Set.size revokes
+    res <- forM (take 500 unknownLicenceOwners) $ try . upsertAvsUserById -- TODO: turn this into a background job
-      oks <- setLicencesAvs revokes
+    let procRes (Right _)                           = (Sum 1, mempty :: Set.Set AvsPersonId, mempty :: Set.Set AvsPersonId, mempty)
-      if oks < no_revokes 
+        --TODO: continue here!
-        then addMessageI Error MsgRevokeUnknownLicencesFail
+        --procRes (Left (AvsUserAmbiguous api))     = (Sum 0, Set.singleton api, mempty, mempty)
-        else addMessageI Info  MsgRevokeUnknownLicencesOk        
+        --procRes (Left (AvsUserUnknownByAvs api))  = (Sum 0, mempty, Set.singleton api, mempty)
-      redirect ProblemAvsSynchR
+        procRes (Left (err :: SomeException))       = (Sum 0, mempty, mempty, Set.singleton $ tshow err)
+        (Sum oks, ambis, unkns, errs) = foldMap procRes res
+        ms = if oks == numUnknownLicenceOwners then Success else Warning      
+    unless (null ambis) $ addMessageModal Error (i18n $ MsgAvsImportAmbiguous $ length ambis) (Right (text2widget $ tshow ambis))
+    unless (null unkns) $ addMessageModal Error (i18n $ MsgAvsImportUnknowns  $ length unkns) (Right (text2widget $ tshow unkns))
+    unless (null errs)  $ addMessageModal Error (i18n MsgAvsCommunicationError)               (Right (text2widget $ tshow errs ))
+    addMessageI ms $ MsgAvsImportIDs oks numUnknownLicenceOwners
+    redirect ProblemAvsSynchR
+
+  (btnRevokeUnknownWgt, btnRevokeUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDBtnAvsRevokeUnknown
+  let revokeUnknownExecWgt   = btnRevokeUnknownWgt
+      revokeUnknownSafetyWgt = [whamlet| 
+          <div .form-group >
+            <div .form-group__input>
+              <div .buttongroup>
+                ^{modalBtn}
+        |]      
+      modalBtn = btnModal MsgBtnAvsRevokeUnknown (btnClasses BtnAvsRevokeUnknown) (Right youSureWgt)
+      youSureWgt = [whamlet|
+          <h1>
+            _{MsgAvsRevokeFor (length unknownLicenceOwners)}
+          <p>
+            ^{revokeUnknownExecWgt}
+        |]
+      
+  ifMaybeM btnRevokeUnknownRes () $ \BtnAvsRevokeUnknown -> catchAllAvs $ do
+    let revokes = Set.map (AvsPersonLicence AvsNoLicence) $ Set.fromList unknownLicenceOwners
+        no_revokes = Set.size revokes
+    oks <- setLicencesAvs revokes
+    if oks < no_revokes 
+      then addMessageI Error MsgRevokeUnknownLicencesFail
+      else addMessageI Info  MsgRevokeUnknownLicencesOk        
+    redirect ProblemAvsSynchR
 
   -- licence differences
   ((tres0,tb0),(tres1up,tb1up),(tres1down,tb1down),(tres2,tb2)) <- runDB $ (,,,) 

src/Utils/Form.hs

@@ -297,15 +297,15 @@ data FormIdentifier
   | FIDLanguage
   | FIDExamAutoOccurrenceCalculate | FIDExamAutoOccurrenceConfirm | FIDExamAutoOccurrenceNudge UUID | FIDExamAutoOccurrenceIgnoreRoom UUID
   | FIDTestDownload
+  | FIDLmsLetter
   | FIDAvsQueryPerson
   | FIDAvsQueryStatus
   | FIDAvsCreateUser
   | FIDAvsQueryLicenceDiffs
   | FIDAvsQueryLicence
   | FIDAvsSetLicence
-  | FIDAvsRemoveLicences
+  | FIDBtnAvsImportUnknown
-  | FIDLmsLetter
+  | FIDBtnAvsRevokeUnknown
-  | FIDAbsUnknownLicences
   deriving (Eq, Ord, Read, Show)
 
 instance PathPiece FormIdentifier where

src/Utils/Frontend/Modal.hs

@@ -49,15 +49,15 @@ modal modalTrigger' modalContent = customModal Modal{..}
     modalTrigger mRoute triggerId = $(widgetFile "widgets/modal/trigger")
 
 -- | Variant of `modal` that looks like a button
-btnModal :: (PathPiece (ButtonClass site))
+btnModal :: (RenderMessage site a, PathPiece (ButtonClass site))
-      => Text                                         -- ^ Button Text       
+      => a                                            -- ^ Button Text       
       -> [ButtonClass site]                           -- ^ Button class 
       -> Either (SomeRoute site) (WidgetFor site ())  -- ^ Modal contant: either dynamic link or static widget
       -> WidgetFor site ()                            -- ^ result widget
 btnModal btl bcs = modal fakeBtn 
   where 
     fakeBtn = [whamlet|<button :not (onull bcs):class=#{unwords $ map toPathPiece bcs}>
-                #{btl}
+                _{btl}
               |]
 
 -- | Variant of `modal` for use in messages (uses a different id generator to avoid collisions)

templates/i18n/admin-test/de-de-formal.hamlet

@@ -73,7 +73,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
       Modal as button 
       <ul>
         <li>^{modal btnModalText (Right "Noch ein Test-Inhalt für ein Button Modal")}
-        <li>^{btnModal "Another Button" [BCIsButton, BCDanger] (Right "anderer Text")}
+        <li>^{btnModal (text2message "Anderer Modal Knopf") [BCIsButton, BCDanger] (Right "anderer Text")}
     <li>
       Some icons: ^{isVisible False} ^{hasComment True}
 

templates/i18n/admin-test/en-eu.hamlet

@@ -67,8 +67,13 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
       Modals:
       <ul>
         <li>^{modal "Click me for ajax test" (Left $ SomeRoute UsersR)}
-        <li>^{modal "Click me for content test" (Right "Test Inhalt für Modal")}
+        <li>^{modal "Click me for content test" (Right "Test message for this modal message")}
         <li>^{modal "Email-Test" (Right emailWidget')}
+    <li>
+      Modal as button 
+      <ul>
+        <li>^{modal btnModalText (Right "Just another test message for a button bodal")}
+        <li>^{btnModal (text2message "Yet another button") [BCIsButton, BCDanger] (Right "Yet another text")}
     <li>
       Some icons: ^{isVisible False} ^{hasComment True}
 

templates/i18n/avs-synchronisation/de-de-formal.hamlet

@@ -22,7 +22,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
 
       Es gibt zwei Möglichkeiten zum Auflösen dieses Problems: #
     <p>
-      ^{btnUnknownWgt}    
+      ^{btnImportUnknownWgt}^{revokeUnknownSafetyWgt}
 
   $else 
     <p>

templates/i18n/avs-synchronisation/en-eu.hamlet

@@ -15,7 +15,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
 
       There are two solutions to this problem: #
     <p>
-      ^{btnUnknownWgt}
+      ^{btnImportUnknownWgt}
+      ^{revokeUnknownSafetyWgt}
 
   $else
     <p>