fix build

src/Application.hs

@@ -252,7 +252,7 @@ makeFoundation appSettings''@AppSettings{..} = do
 
     runAppLoggingT tempFoundation $ do
       $logInfoS "InstanceID" $ UUID.toText appInstanceID
-      $logDebugS "Configuration" $ tshow appSettings''
+      $logDebugS "Configuration" $ tshowShort appSettings''
       $logDebugS "RTSFlags" . tshow =<< liftIO getRTSFlags
 
       smtpPool <- for appSmtpConf $ \c -> do
@@ -366,7 +366,7 @@ makeFoundation appSettings''@AppSettings{..} = do
                           }
           return . Just $ mkAvsQuery avsServer avsAuth avsEnv
 
-      $logDebugS "Runtime configuration" $ tshow appSettings'
+      $logDebugS "Runtime configuration" $ tshowShort appSettings'
 
       let foundation = mkFoundation appSettings' sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey appPersonalisedSheetFilesSeedKey appVolatileClusterSettingsCache appAvsQuery
 

src/Model/Types/Avs.hs

@@ -77,6 +77,7 @@ instance FromJSON AvsPersonId where
 instance ToJSON AvsPersonId where 
   toJSON (AvsPersonId pid) = toJSON pid 
 
+
 newtype AvsCardNo = AvsCardNo { avsCardNo :: Text }  -- always 8 digits
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
   deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField)
@@ -88,7 +89,6 @@ instance ToJSON AvsCardNo where
   toJSON (AvsCardNo cno) = toJSON cno
 
 
-
 data AvsLicence = AvsNoLicence | AvsLicenceVorfeld | AvsLicenceRollfeld
   deriving (Bounded, Enum, Eq, Ord, Read, Show, Generic, Typeable)
 

src/Settings.hs

@@ -243,6 +243,17 @@ data AppSettings = AppSettings
     , appCommunicationAttachmentsMaxSize :: Maybe Natural
     } deriving Show
 
+-- | Some settings strech for multiple lines 
+tshowShort :: AppSettings -> Text 
+tshowShort a = Text.take 256 $ tshow a' -- TODO: show only one line!
+  where a' = a { 
+                appFileChunkingParams = afcp { fastCDCGearHashTable = error "emptyarray" }
+               }
+        afcp  = appFileChunkingParams a 
+        -- fcght = fastCDCGearHashTable afcp 
+
+
+
 data JobMode = JobsLocal { jobsAcceptOffload :: Bool }
              | JobsOffload
              | JobsDrop

src/Utils/Avs.hs

@@ -30,27 +30,33 @@ avsApi = Proxy
 data AvsQuery where
   AvsQuery :: { avsQueryPerson :: MonadIO m => AvsQueryPerson -> m (Either ClientError AvsResponsePerson)
               , avsQueryStatus :: MonadIO m => AvsQueryStatus -> m (Either ClientError AvsResponseStatus)
+              ...
               }
       -> AvsQuery
 -}
 
 data AvsQuery = AvsQuery
   { avsQueryPerson         :: forall m. MonadIO m => AvsQueryPerson      -> m (Either ClientError AvsResponsePerson)
-  , avsQueryStatus         :: forall m. MonadIO m => AvsQueryStatus      -> m (Either ClientError AvsResponseStatus)
+  , avsQueryStatus         :: forall m. MonadIO m => AvsQueryStatus      -> m (Either ClientError AvsResponseStatus)  
-  , avsQueryGetAllLicences :: forall m. MonadIO m =>                        m (Either ClientError AvsResponseGetLicences)
-  , avsQueryGetLicences    :: forall m. MonadIO m => AvsQueryGetLicences -> m (Either ClientError AvsResponseGetLicences)
   , avsQuerySetLicences    :: forall m. MonadIO m => AvsQuerySetLicences -> m (Either ClientError AvsResponseSetLicences)
+  , avsQueryGetLicences    :: forall m. MonadIO m => AvsQueryGetLicences -> m (Either ClientError AvsResponseGetLicences)
+  , avsQueryGetAllLicences :: forall m. MonadIO m =>                        m (Either ClientError AvsResponseGetLicences)
   }
 
 makeLenses_ ''AvsQuery
 
+-- | To query all active licences, a special argument must be prepared
+avsQueryAllLicences :: AvsQueryGetLicences
+avsQueryAllLicences = AvsQueryGetLicences $ Set.singleton $ AvsObjPersonId $ AvsPersonId 0
+
+
 mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery
 mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
-    { avsQueryPerson      = \q -> liftIO $ catch404toEmpty <$> runClientM (rawQueryPerson                 q)  cliEnv
+    { avsQueryPerson      = \q -> liftIO $ catch404toEmpty <$> runClientM (rawQueryPerson      q)  cliEnv
-    , avsQueryStatus      = \q -> liftIO $                     runClientM (rawQueryStatus                 q)  cliEnv
+    , avsQueryStatus      = \q -> liftIO $                     runClientM (rawQueryStatus      q)  cliEnv        
-    , avsQueryGetAllLicences =    liftIO $                     runClientM (rawQueryGetLicences allPersonIds)  cliEnv
+    , avsQuerySetLicences = \q -> liftIO $                     runClientM (rawQuerySetLicences q)  cliEnv
-    , avsQueryGetLicences = \q -> liftIO $                     runClientM (rawQueryGetLicences            q)  cliEnv
+    , avsQueryGetLicences = \q -> liftIO $                     runClientM (rawQueryGetLicences q)  cliEnv
-    , avsQuerySetLicences = \q -> liftIO $                     runClientM (rawQuerySetLicences            q)  cliEnv
+    , avsQueryGetAllLicences =    liftIO $                     runClientM (rawQueryGetLicences avsQueryAllLicences) cliEnv
     }
   where
     (rawQueryPerson :<|> rawQueryStatus :<|> rawQueryGetLicences :<|> rawQuerySetLicences) = client avsApi basicAuth
@@ -59,5 +65,4 @@ mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
       | baseUrl == base = Right $ AvsResponsePerson mempty -- WORKAROUND: AVS server erroneously returns 404 if no matching person could be found in its database!
     catch404toEmpty other = other
 
-    allPersonIds :: AvsQueryGetLicences
+    
-    allPersonIds = AvsQueryGetLicences $ Set.singleton $ AvsObjPersonId 0

templates/ldap.hamlet

@@ -7,9 +7,12 @@
       Antwort: #
     <dl .deflist>
       $forall (lk, lv) <- answers
-        <dt>
+        $with numv <- length lv
-          #{show lk}
+          <dt>
-        <dd>
+            #{show lk}
-          UTF8:  #{presentUtf8 lv}
+            $if 1 < numv
-          &#8212;
+              \ (#{show numv})
-          Latin: #{presentLatin1 lv}
+          <dd>
+            UTF8:  #{presentUtf8 lv}
+            &#8212;
+            Latin: #{presentLatin1 lv}