refactor(lms): lms decoding delimiter is fully optional now

config/settings.yml

@@ -125,10 +125,10 @@ ldap:
 
 ldap-re-test-failover: 60
 
-lms:
-  upload-headedness:    "_env:LMSUPLOADHEADEDNESS:true"
-  upload-delimiter:     "_env:LMSUPLOADDELIMITER:,"
-  download-headedness:  "_env:LMSDOWNLOADHEADEDNESS:true"
+lms-direct:
+  upload-header:        "_env:LMSUPLOADHEADER:true"
+  upload-delimiter:     "_env:LMSUPLOADDELIMITER:"
+  download-header:      "_env:LMSDOWNLOADHEADER:true"
   download-delimiter:   "_env:LMSDOWNLOADDELIMITER:,"
   download-cr-lf:       "_env:LMSDOWNLOADCRLF:true"
 

src/Handler/LMS/Result.hs

@@ -262,15 +262,11 @@ postLmsResultDirectR sid qsh = do
   (_params, files) <- runRequestBody
   (status, msg) <- case files of
     [(fhead,file)] -> do
-      LmsConf{..} <- getsYesod $ view _appLmsConf
-      let fmtOpts = def { csvDelimiter     = lmsUploadDelimiter
-                        , csvIncludeHeader = lmsUploadHeadedness
-                        }
-          csvOpts = def { csvFormat = fmtOpts }
+      lmsDecoder <- getLmsCsvDecoder
       runDBJobs $ do
         qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
         enr <- try $ runConduit $ fileSource file
-                .| decodeCsvWith csvOpts
+                .| lmsDecoder
                 .| foldMC (saveResultCsv qid) 0
         case enr of
           Left (e :: SomeException) -> do -- catch all to avoid ok220 in case of any error

src/Handler/LMS/Userlist.hs

@@ -258,15 +258,11 @@ postLmsUserlistDirectR sid qsh = do
   (_params, files) <- runRequestBody
   (status, msg) <- case files of
     [(fhead,file)] -> do
-      LmsConf{..} <- getsYesod $ view _appLmsConf
-      let fmtOpts = def { csvDelimiter     = lmsUploadDelimiter
-                        , csvIncludeHeader = lmsUploadHeadedness
-                        }
-          csvOpts = def { csvFormat = fmtOpts }
+      lmsDecoder <- getLmsCsvDecoder
       runDBJobs $ do
         qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
         enr <- try $ runConduit $ fileSource file
-                .| decodeCsvWith csvOpts
+                .| lmsDecoder
                 .| foldMC (saveUserlistCsv qid) 0
         case enr of
           Left (e :: SomeException) -> do
@@ -286,4 +282,3 @@ postLmsUserlistDirectR sid qsh = do
       $logWarnS "LMS" msg
       return (badRequest400, msg)
   sendResponseStatus status msg
-  

src/Handler/LMS/Users.hs

@@ -170,9 +170,9 @@ getLmsUsersDirectR sid qsh = do
       --csvRenderedHeader = lmsUserTableCsvHeader
       --cvsRendered = CsvRendered {..}
       csvRendered = toCsvRendered lmsUserTableCsvHeader $ lmsUser2csv . entityVal <$> lms_users
-      fmtOpts = def { csvDelimiter      = lmsDownloadDelimiter
+      fmtOpts = def { csvIncludeHeader  = lmsDownloadHeader
+                    , csvDelimiter      = lmsDownloadDelimiter
                     , csvUseCrLf        = lmsDownloadCrLf
-                    , csvIncludeHeader  = lmsDownloadHeadedness
                     }
       csvOpts = def { csvFormat = fmtOpts }
   csvSheetName <- csvFilenameLmsUser qsh

src/Handler/Utils/LMS.hs

@@ -1,7 +1,8 @@
 {-# OPTIONS -Wno-redundant-constraints #-} -- needed for Getter
 
 module Handler.Utils.LMS
-  ( csvLmsIdent
+  ( getLmsCsvDecoder
+  , csvLmsIdent
   , csvLmsTimestamp
   , csvLmsBlocked
   , csvLmsSuccess
@@ -21,11 +22,27 @@ module Handler.Utils.LMS
 
 import Import
 import Handler.Utils
+import Handler.Utils.Csv
+import Data.Csv (HasHeader(..), FromRecord)
+
 import qualified Database.Esqueleto.Legacy as E
 
 import Control.Monad.Random.Class (uniform)
 import Control.Monad.Trans.Random (evalRandTIO)
 
+
+getLmsCsvDecoder :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m, FromNamedRecord csv, FromRecord csv) => Handler (ConduitT ByteString csv m ())
+getLmsCsvDecoder = do
+  LmsConf{..} <- getsYesod $ view _appLmsConf
+  if  | Just upDelim <- lmsUploadDelimiter -> do
+        let fmtOpts = def { csvDelimiter     = upDelim
+                          , csvIncludeHeader = lmsUploadHeader
+                          }
+            csvOpts = def { csvFormat = fmtOpts }
+        return $ decodeCsvWith csvOpts
+      | lmsUploadHeader -> return   decodeCsv
+      | otherwise       -> return $ decodeCsvPositional NoHeader
+
 -- generic Column names
 csvLmsIdent   :: IsString a => a
 csvLmsIdent = fromString "user" -- "Benutzerkennung"
@@ -121,4 +138,3 @@ randomLMSpw :: MonadIO m => m Text
 randomLMSpw = randomText extra lengthPassword
   where
     extra = "_-+*.:;=!?#"
-  

src/Settings.hs

@@ -304,10 +304,10 @@ data LdapConf = LdapConf
   } deriving (Show)
 
 data LmsConf = LmsConf
-  { lmsUploadDelimiter    :: Char
-  , lmsUploadHeadedness   :: Bool
+  { lmsUploadHeader       :: Bool
+  , lmsUploadDelimiter    :: Maybe Char
+  , lmsDownloadHeader     :: Bool
   , lmsDownloadDelimiter  :: Char
-  , lmsDownloadHeadedness :: Bool
   , lmsDownloadCrLf       :: Bool
   } deriving (Show)
 
@@ -492,11 +492,11 @@ deriveFromJSON
 
 instance FromJSON LmsConf where
   parseJSON = withObject "LmsConf" $ \o -> do
-    lmsUploadDelimiter    <- o .: "upload-delimiter"
-    lmsUploadHeadedness   <- o .: "upload-headedness"
-    lmsDownloadDelimiter  <- o .: "download-delimiter"
-    lmsDownloadHeadedness <- o .: "download-headedness"
-    lmsDownloadCrLf       <- o .: "download-cr-lf"
+    lmsUploadHeader       <- o .:  "upload-header"
+    lmsUploadDelimiter    <- o .:? "upload-delimiter"
+    lmsDownloadHeader     <- o .:  "download-header"
+    lmsDownloadDelimiter  <- o .:  "download-delimiter"    
+    lmsDownloadCrLf       <- o .:  "download-cr-lf"
     return LmsConf{..}
 
 makeLenses_ ''LmsConf
@@ -597,7 +597,7 @@ instance FromJSON AppSettings where
               Ldap.Tls host _ -> not $ null host
               Ldap.Plain host -> not $ null host
         appLdapConf               <- P.fromList . mapMaybe (assertM nonEmptyHost) <$> o .:? "ldap" .!= []
-        appLmsConf                <- o .: "lms"
+        appLmsConf                <- o .: "lms-direct"
         appAvsConf                <- assertM (not . null . avsPass)  <$> o .:? "avs"
         appLprConf                <- o .: "lpr"
         appSmtpConf               <- assertM (not . null . smtpHost) <$> o .:? "smtp"