chore(letter): complete envelope max counting, hard coded limit yet

src/Utils.hs

@@ -965,10 +965,10 @@ forMaybeM :: ( Monad m
              ) => f a -> (Element (f a) -> MaybeT m (Element (f b))) -> m (f b)
 forMaybeM = flip mapMaybeM
 
-{-
---   Takes computations returnings @Maybes@; tries each one in order.
---   The first one to return a @Just@ wins. Returns @Nothing@ if all computations
---   return @Nothing@.
+
+-- | Takes computations returnings @Maybe@; tries each one in order.
+--   The first one to return a @Just@ wins. 
+--   Returns @Nothing@ if all computations return @Nothing@.
 --   Copied from GHC.Data.Maybe, which could not be imported somehow.
 firstJustsM :: (Monad m, Foldable f) => f (m (Maybe a)) -> m (Maybe a)
 firstJustsM = foldlM go Nothing 
@@ -976,7 +976,6 @@ firstJustsM = foldlM go Nothing
     go :: Monad m => Maybe a -> m (Maybe a) -> m (Maybe a)
     go Nothing          action = action
     go result@(Just _) _action = return result
--}
 
 -- | Run the maybe computation repeatedly until the first Just is returned
 --   or the number of maximum retries is exhausted.

src/Utils/Print/Letters.hs

@@ -3,6 +3,7 @@
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
 {-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Utils.Print.Letters where
 
@@ -23,6 +24,10 @@ import qualified Text.Pandoc.Builder as P
 
 import Text.Hamlet
 
+-- import           Database.Esqueleto.Experimental ((:&)(..))
+import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
+import qualified Database.Esqueleto.Utils as E
+
 -- import System.Exit
 -- import System.Process.Typed -- for calling pdftk for pdf encryption
 
@@ -186,19 +191,19 @@ mkApcIdent uuid envelope lk tnow apcAck = Text.filter apcAcceptedChars $ Text.in
       ]
   where
     ensureLength :: Int -> Text -> Text
-    ensureLength n = Text.take n . Text.justifyLeft n 'x'
+    ensureLength n = Text.take n . Text.justifyLeft n 'x' . Text.filter apcAcceptedChars
 
 mkEnvelope :: (Int, Char) -> Text 
 mkEnvelope (i,c) = Text.cons (pfx $ i `mod` 63) $ Text.singleton sfx
   where 
     pfx n
-      | n <=  0   = Text.cons '-' $ Text.singleton c
-      | n <= 10   = Text.cons (chr $ ord '0' + n `mod` 10) 
-      | n <= 36   = Text.cons (chr $ ord 'a' + n - 11)
-      | n <= 62   = Text.cons (chr $ ord 'A' + n - 37)
-      | otherwise = Text.cons '-' $ Text.singleton c
+      | n <=  0   = '-'
+      | n <= 10   = chr $ ord '0' + n `mod` 10
+      | n <= 36   = chr $ ord 'a' + n - 11
+      | n <= 62   = chr $ ord 'A' + n - 37
+      | otherwise = '-'
     sfx 
-      | n <= 62   = c
+      | i <= 62   = Char.toLower c
       | otherwise = Char.toUpper c
 
 formatApcIdentTime :: (HasLocalTime t, MonadHandler m) => t -> m Text
@@ -221,7 +226,8 @@ apcAcceptedChars '-' = True
 apcAcceptedChars '_' = True
 apcAcceptedChars  c  = isAlphaNum c
 
-
+apcEnvelopeSize :: Int64
+apcEnvelopeSize = 6
 
 ------------------
 -- Letter Class --
@@ -254,14 +260,23 @@ class MDLetter l where
   getMailBody       :: l -> Maybe (DateTimeFormatter -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) -- Just returns cover-lettter for attaching PDF to, Nothing indicates that the letter should be sent as direct Html Email
   getMailBody = const Nothing
 
-letterApcIdent :: (MDLetter l, MonadHandler m) => l -> CryptoUUIDUser -> UTCTime -> m Text
+letterApcIdent :: (MDLetter l) => l -> CryptoUUIDUser -> UTCTime -> Handler Text
 letterApcIdent l uuid now = do
-  -- now  <- liftIO getCurrentTime
-  tnow <- formatApcIdentTime now
-  let startEnvelope = (0, getLetterEnvelope l)
-      mkApcEnv env = mkApcIdent uuid env (getLetterKind l) tnow (pjiApcAcknowledge $ getPJId l)
-  -- TODO: turn this into a loop increasing the number for each 6 unacknowledged letters to the first part of the ident only      
-  return $ mkApcEnv startEnvelope
+    -- now  <- liftIO getCurrentTime
+    tnow <- formatApcIdentTime now
+    let mkApcIdnt i = mkApcIdent uuid (i,getLetterEnvelope l) (getLetterKind l) tnow (pjiApcAcknowledge $ getPJId l)
+        attemptId i = do
+          let apcId  = mkApcIdnt i
+              recenv = fst $ Text.breakOn apcIdentSeparator apcId
+          envCount <- runDB . E.select $ do
+            pj <- E.from $ E.table @PrintJob
+            E.where_ $ E.isNothing (pj E.^. PrintJobAcknowledged)
+                E.&&. (E.val recenv `E.isPrefixOf_` pj E.^. PrintJobApcIdent)
+            return E.countRows
+          case envCount of 
+            (E.Value nrLetters):_ -> return $ toMaybe (nrLetters < apcEnvelopeSize) apcId
+            []                    -> return $ Just apcId
+    fromMaybe (mkApcIdnt 0) <$> firstJustsM [attemptId i | i <- [0..128]]
 
 letterFileName :: (MDLetter l) => l -> FilePath
 letterFileName = Text.unpack . (<> ".pdf") . text2asciiAlphaNum . pjiFileName . getPJId