chore(avs): add licence choice to resolve avs synch

src/Handler/Admin/Avs.hs

@@ -16,6 +16,7 @@ import Import
 import qualified Control.Monad.State.Class as State
 -- import Data.Aeson (encode)
 import qualified Data.Text as Text
+import qualified Data.CaseInsensitive as CI
 import qualified Data.Set  as Set
 import qualified Data.Map as Map
 
@@ -294,23 +295,25 @@ nullaryPathPiece ''LicenceTableAction $ camelToPathPiece' 2
 embedRenderMessage ''UniWorX ''LicenceTableAction id
 
 data LicenceTableActionData =  LicenceTableChangeAvsData
-                            |  LicenceTableRevokeFDriveData
-                            |  LicenceTableGrantFDriveData { licenceTableChangeFDriveEnd :: Day }
+                            |  LicenceTableRevokeFDriveData --TODO: add { licenceTableChangeFDriveQId :: QualificationId to avoid lookup later
+                            |  LicenceTableGrantFDriveData { licenceTableChangeFDriveQId :: QualificationId
+                                                           , licenceTableChangeFDriveEnd :: Day
+                                                           }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 
 postProblemAvsSynchR,  getProblemAvsSynchR :: Handler Html
 postProblemAvsSynchR = getProblemAvsSynchR
 getProblemAvsSynchR = do  
+  _now <- liftIO getCurrentTime
+  let _nowaday = utctDay now
 
-  -- TODO: just for Testing
-  -- now <- liftIO getCurrentTime
+  -- TODO: just for Testing  
   -- let TimeOfDay hours minutes _seconds = timeToTimeOfDay (utctDayTime now)
   --     setTo0 = Set.fromList [AvsPersonId hours, AvsPersonId minutes, AvsPersonId 12345678]
   --     setTo1 = Set.fromList [AvsPersonId minutes]
   --     setTo2 = Set.fromList [AvsPersonId hours, AvsPersonId 12345678]
-  -- addMessageI Success $ MsgAvsSetLicences AvsLicenceVorfeld 99 1000 
-
+  
   (setTo0, setTo1, setTo2) <- try retrieveDifferingLicences >>= \case
     Right res -> return res
     Left  err -> do addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException)))
@@ -345,7 +348,7 @@ getProblemAvsSynchR = do
                     | otherwise          -> addMessageI Info  MsgRevokeUnknownLicencesOk        
         Left  err   -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException)))
       >> redirect ProblemAvsSynchR
-    
+      
   ((tres0,tb0),(tres1,tb1),(tres2,tb2)) <- runDB $ (,,) 
           <$> mkLicenceTable "driveSynchNoLicence"  AvsNoLicence       setTo0 (Just LicenceTableChangeAvs)
           <*> mkLicenceTable "driveSynchVorfeld"    AvsLicenceVorfeld  setTo1 (Just LicenceTableChangeAvs)
@@ -358,7 +361,10 @@ getProblemAvsSynchR = do
                            in addMessageI mkind $ MsgAvsSetLicences aLic no_ok no_req          
           (Left err)    -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException)))        
         redirect ProblemAvsSynchR -- reload to update all tables 
-      procRes _alic r@(_, _apids) = addMessage Info $ toHtml $ tshow r
+      -- procRes alic (LicenceTableRevokeFDriveData, apids) = do         -- TODO: continue here !!!
+            -- qId <- runDB $ getBy UniqueQualificationAvsLicence alic
+      -- procRes alic (LicenceTableGrantFDriveData{..}, apids ) = do     -- TODO: continue here !!!
+      procRes _alic r@(_, _apids) = addMessage Error $ toHtml $ "NOT YET IMPLEMENTED !!! " <> tshow r
   formResult tres2 $ procRes AvsLicenceRollfeld
   formResult tres1 $ procRes AvsLicenceVorfeld
   formResult tres0 $ procRes AvsNoLicence
@@ -411,6 +417,7 @@ instance HasUser LicenceTableData where
 mkLicenceTable :: Text -> AvsLicence -> Set AvsPersonId -> Maybe LicenceTableAction -> DB (FormResult (LicenceTableActionData, Set AvsPersonId), Widget)
 mkLicenceTable dbtIdent aLic apids defAct = do 
   currentRoute <- fromMaybe (error "mkLicenceTable called from 404-handler") <$> liftHandler getCurrentRoute
+  avsQualifications <- selectList [QualificationAvsLicence !=. Nothing] []
   now <- liftIO getCurrentTime
   let nowaday = utctDay now            
       fltrLic qual = if 
@@ -457,12 +464,22 @@ mkLicenceTable dbtIdent aLic apids defAct = do
         [ fltrUserNameEmailHdrUI MsgLmsUser mPrev
         , prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
         ]
+      qualOpt :: Entity Qualification -> Handler (Option QualificationId)
+      qualOpt (Entity qualId qual) = do
+        cQualId :: CryptoUUIDQualification <- encrypt qualId
+        return $ Option
+          { optionDisplay       = CI.original $ qualificationName qual
+          , optionInternalValue = qualId
+          , optionExternalValue = tshow cQualId
+          }        
       acts :: Map LicenceTableAction (AForm Handler LicenceTableActionData)
       acts = mconcat
           [ singletonMap LicenceTableChangeAvs    $ pure LicenceTableChangeAvsData
-          , if aLic == AvsNoLicence
-              then singletonMap LicenceTableGrantFDrive  $ LicenceTableGrantFDriveData <$> apopt dayField (fslI MsgLmsQualificationValidUntil) Nothing
-              else singletonMap LicenceTableRevokeFDrive $ pure LicenceTableRevokeFDriveData
+          , if aLic /= AvsNoLicence
+              then singletonMap LicenceTableRevokeFDrive $ pure LicenceTableRevokeFDriveData
+              else singletonMap LicenceTableGrantFDrive  $ LicenceTableGrantFDriveData 
+                    <$> apopt (selectField . fmap mkOptionList $ mapM qualOpt avsQualifications) (fslI MsgQualificationName) Nothing
+                    <*> apopt dayField (fslI MsgLmsQualificationValidUntil) Nothing
           ]      
       dbtParams = DBParamsForm
           { dbParamsFormMethod = POST