chore(avs): make avs timeouts setting configurable

config/settings.yml

@@ -157,10 +157,12 @@ lms-direct:
   deletion-days:        "_env:LMSDELETIONDAYS:7"
 
 avs:
-  host:    "_env:AVSHOST:skytest.fra.fraport.de"
-  port:    "_env:AVSPORT:443"
-  user:    "_env:AVSUSER:fradrive"
-  pass:    "_env:AVSPASS:"
+  host:         "_env:AVSHOST:skytest.fra.fraport.de"
+  port:         "_env:AVSPORT:443"
+  user:         "_env:AVSUSER:fradrive"
+  pass:         "_env:AVSPASS:"
+  timeout:      "_env:AVSTIMEOUT:42"
+  cache-expiry: "_env:AVSCACHEEXPIRY:420"
 
 lpr:
   host:    "_env:LPRHOST:fravm017173.fra.fraport.de"

src/Handler/Admin/Avs.hs

@@ -140,7 +140,15 @@ postAdminAvsR = do
   mbAvsConf <- getsYesod $ view _appAvsConf
   let avsWgt = [whamlet|
           $maybe avsConf <- mbAvsConf
-            AVS Konfiguration ist #{decodeUtf8 (avsUser avsConf)}@#{avsHost avsConf}:#{avsPort avsConf}
+            <h2>
+              AVS Konfiguration
+            <ul>
+              <li>
+                Host:  #{decodeUtf8 (avsUser avsConf)}@#{avsHost avsConf}:#{avsPort avsConf}
+              <li>
+                Timeout sekundäre AVS Abfragen: #{avsTimeout avsConf}s
+              <li>
+                Cache Gültigkeit sekundäre AVS Abfragen: #{tshow (avsCacheExpiry avsConf)}
           $nothing
             AVS nicht konfiguriert!
         |]

src/Handler/Qualification.hs

@@ -420,9 +420,10 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
       --     )      
       , single ("avs-card"  , FilterColumnHandler $ \case
           [] -> return (const E.true) :: Handler (QualificationTableExpr -> E.SqlExpr (E.Value Bool))
-          cs -> 
+          cs -> do
             let crds = mapMaybe parseAvsCardNo $ foldMap anySeparatedText cs
-            in  timeoutHandler (0 * 30 * 1000000) (queryAvsCardNos crds) >>= \case 
+            toutsecs <- getsYesod $ preview $ _appAvsConf . _Just . _avsTimeout
+            maybeTimeoutHandler toutsecs (queryAvsCardNos crds) >>= \case 
               Nothing               -> addMessageI Error MsgAvsCommunicationTimeout 
                                     >> return (const E.false)
               (Just (null -> True)) -> return (const E.false)
@@ -462,7 +463,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
       [ fltrUserNameEmailHdrUI MsgLmsUser mPrev
       , prismAForm (singletonFilter "user-company")                             mPrev $ aopt textField (fslI MsgTableCompany)
       , prismAForm (singletonFilter "personal-number" )                         mPrev $ aopt textField (fslI MsgCompanyPersonalNumber)
-      , prismAForm (singletonFilter "avs-card" )                                mPrev $ aopt textField (fslI MsgAvsCardNo & setTooltip SomeMessages [SomeMessage MsgTableFilterComma, SomeMessage MsgAvsQueryNeeded])
+      , prismAForm (singletonFilter "avs-card" )                                mPrev $ aopt textField (fslI MsgAvsCardNo & setTooltip (SomeMessages [SomeMessage MsgTableFilterComma, SomeMessage MsgAvsQueryNeeded]))
       , prismAForm (singletonFilter "avs-number" )                              mPrev $ aopt textField (fslI MsgAvsPersonNo)            
       , prismAForm (singletonFilter "validity"         . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
       , if isNothing mbRenewal then mempty

src/Handler/Utils/Avs.hs

@@ -587,9 +587,11 @@ queryAvsCardNo crd = do
                                        }
 
 avsPersonQueryCached :: AvsQueryPerson -> Handler AvsResponsePerson
-avsPersonQueryCached apq = memcachedBy (Just . Right $ 5 * diffMinute) apq $ do     -- TODO using settings for time
-  AvsQuery{avsQueryPerson} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
-  throwLeftM $ avsQueryPerson apq
+avsPersonQueryCached apq = do 
+  cexpire <- getsYesod $ preview $ _appAvsConf . _Just . _avsCacheExpiry . to Right
+  memcachedBy cexpire apq $ do
+    AvsQuery{avsQueryPerson} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
+    throwLeftM $ avsQueryPerson apq
 
 
 -- A datatype for a specific heterogeneous list

src/Handler/Utils/Concurrent.hs

@@ -13,6 +13,12 @@ import UnliftIO.Concurrent as Handler.Utils.Concurrent hiding (yield)
 
 
 
+maybeTimeoutHandler :: Maybe Int -> HandlerFor site a -> HandlerFor site (Maybe a)
+maybeTimeoutHandler Nothing     = fmap Just
+maybeTimeoutHandler (Just secs) = timeoutHandler $ bool maxBound micro (micro > 0)
+  where 
+    micro = 1000000 * secs
+
 -- | Run a handler action until it finishes or if it exceeds a given number of microseconds via `registerDelay`
 timeoutHandler :: Int -> HandlerFor site a -> HandlerFor site (Maybe a)
 timeoutHandler maxWait act = do

src/Settings.hs

@@ -330,6 +330,8 @@ data AvsConf = AvsConf
   , avsPort :: Int
   , avsUser :: ByteString
   , avsPass :: ByteString
+  , avsTimeout      :: Int      -- Seconds; wait time for some online user queries
+  , avsCacheExpiry  :: DiffTime -- Seconds, only for non-licence related queries
   } deriving (Show)
 
 data LprConf = LprConf
@@ -529,12 +531,16 @@ makeLenses_ ''LmsConf
 
 instance FromJSON AvsConf where
   parseJSON = withObject "AvsConf" $ \o -> do
-    avsHost <- o .: "host"
-    avsPort <- o .: "port"
-    avsUser <- o .: "user"
-    avsPass <- o .:? "pass" .!= ""
+    avsHost         <- o .: "host"
+    avsPort         <- o .: "port"
+    avsUser         <- o .: "user"
+    avsPass         <- o .:? "pass" .!= ""
+    avsTimeout      <- o .: "timeout"
+    avsCacheExpiry  <- o .: "cache-expiry"
     return AvsConf{..}
 
+makeLenses_ ''AvsConf    
+
 instance FromJSON LprConf where
   parseJSON = withObject "LprConf" $ \o -> do
     lprHost  <- o .: "host"