From 996bc2ac27bf8fccadcd5d30876dbd3263963cc1 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 19 Jul 2019 14:45:44 +0200 Subject: [PATCH] feat(csv): implement csv import --- frontend/src/utils/inputs/file-input.js | 1 + frontend/src/utils/inputs/file-input.scss | 3 + frontend/src/utils/inputs/inputs.scss | 5 + messages/uniworx/de.msg | 23 +- src/Handler/Exam.hs | 54 ++++- src/Handler/Utils/Table/Pagination.hs | 222 +++++++++++++++--- src/Utils/Form.hs | 34 ++- src/Utils/Parameters.hs | 9 +- .../csv-import-confirmation-wrapper.hamlet | 4 + templates/csv-import-confirmation.hamlet | 21 ++ templates/csv-import-confirmation.julius | 81 +++++++ templates/csv-import-confirmation.lucius | 52 ++++ templates/default-layout.lucius | 16 -- templates/table/csv-transcode.hamlet | 12 +- templates/table/csv-transcode.lucius | 21 ++ templates/table/layout-filter-default.hamlet | 3 +- templates/table/layout.hamlet | 1 - templates/widgets/aform/aform.hamlet | 7 +- 18 files changed, 497 insertions(+), 72 deletions(-) create mode 100644 frontend/src/utils/inputs/file-input.scss create mode 100644 templates/csv-import-confirmation-wrapper.hamlet create mode 100644 templates/csv-import-confirmation.hamlet create mode 100644 templates/csv-import-confirmation.julius create mode 100644 templates/csv-import-confirmation.lucius create mode 100644 templates/table/csv-transcode.lucius diff --git a/frontend/src/utils/inputs/file-input.js b/frontend/src/utils/inputs/file-input.js index 676d6ff2c..568e1baf4 100644 --- a/frontend/src/utils/inputs/file-input.js +++ b/frontend/src/utils/inputs/file-input.js @@ -1,4 +1,5 @@ import { Utility } from '../../core/utility'; +import './file-input.scss'; const FILE_INPUT_CLASS = 'file-input'; const FILE_INPUT_INITIALIZED_CLASS = 'file-input--initialized'; diff --git a/frontend/src/utils/inputs/file-input.scss b/frontend/src/utils/inputs/file-input.scss new file mode 100644 index 000000000..7bf23248d --- /dev/null +++ b/frontend/src/utils/inputs/file-input.scss @@ -0,0 +1,3 @@ +.file-input__list:empty { + display: none; +} diff --git a/frontend/src/utils/inputs/inputs.scss b/frontend/src/utils/inputs/inputs.scss index 7bd86c059..643902d08 100644 --- a/frontend/src/utils/inputs/inputs.scss +++ b/frontend/src/utils/inputs/inputs.scss @@ -25,6 +25,11 @@ color: var(--color-fontsec); } +.form-section-legend { + color: var(--color-fontsec); + margin: 7px 0; +} + .form-group-label { font-weight: 600; padding-top: 6px; diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 92bcd7821..5fef09aba 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -933,6 +933,8 @@ CommTutorialHeading: Tutorium-Mitteilung RecipientCustom: Weitere Empfänger RecipientToggleAll: Alle/Keine +DBCsvImportActionToggleAll: Alle/Keine + RGCourseParticipants: Kursteilnehmer RGCourseLecturers: Kursverwalter RGCourseCorrectors: Korrektoren @@ -1200,6 +1202,14 @@ CsvAddNew: Neue Einträge einfügen CsvDeleteMissing: Fehlende Einträge entfernen BtnCsvExport: CSV-Datei exportieren BtnCsvImport: CSV-Datei importieren +BtnCsvImportConfirm: CSV-Import abschließen + +CsvImportNotConfigured: CSV-Import nicht vorgesehen +CsvImportConfirmationHeading: CSV-Import abschließen +CsvImportConfirmationTip: Durch den CSV-Import würden die unten aufgeführten Änderungen vorgenommen. Bitte überprüfen Sie diese zunächst sorgfältig. +CsvImportUnnecessary: Durch den CSV-Import würden keine Änderungen vorgenommen werden +CsvImportSuccessful n@Int: CSV-Import erfolgreich, es #{pluralDE n "wurde eine Aktion" (mappend (mappend "wurden " (toMessage n)) " Aktionen")} durchgeführt +CsvImportAborted: CSV-Import abgebrochen Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%) @@ -1217,4 +1227,15 @@ CsvColumnExamUserExercisePointsMax: Maximale Anzahl von Punkten, die der Teilneh CsvColumnExamUserExercisePasses: Anzahl von Übungsblättern, die der Teilnehmer bestanden hat CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die der Teilnehmer bis zu seinem Klausurtermin bestehen hätte können -Action: Aktion \ No newline at end of file +Action: Aktion + +DBCsvDuplicateKey: Zwei Zeilen der CSV-Dateien referenzieren den selben internen Datensatz und können daher nicht verarbeitet werden. +DBCsvDuplicateKeyTip: Entfernen Sie ein der unten aufgeführten Zeilen aus Ihren CSV-Dateien und versuchen Sie es erneut. + +ExamUserCsvRegister: Teilnehmer zur Klausur anmelden +ExamUserCsvAssignOccurrence: Teilnehmern einen anderen Termin/Raum zuweisen +ExamUserCsvDeregister: Teilnehmer von der Klausur abmelden + +TableHeadingFilter: Filter +TableHeadingCsvImport: CSV-Import +TableHeadingCsvExport: CSV-Export \ No newline at end of file diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs index f649c0e75..574f13531 100644 --- a/src/Handler/Exam.hs +++ b/src/Handler/Exam.hs @@ -22,6 +22,9 @@ import Data.Map ((!), (!?)) import qualified Data.Map as Map import qualified Data.Set as Set +import qualified Data.Text as Text +import qualified Data.Text.Lens as Text + import Data.Aeson hiding (Result(..)) import Text.Hamlet (ihamlet) import Text.Blaze.Html.Renderer.String (renderHtml) @@ -883,6 +886,31 @@ embedRenderMessage ''UniWorX ''ExamUserAction id data ExamUserActionData = ExamUserDeregisterData | ExamUserAssignOccurrenceData (Maybe ExamOccurrenceId) +data ExamUserCsvActionClass + = ExamUserCsvRegister + | ExamUserCsvAssignOccurrence + | ExamUserCsvDeregister + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) +embedRenderMessage ''UniWorX ''ExamUserCsvActionClass id + +data ExamUserCsvAction + = ExamUserCsvRegisterData + { examUserCsvUser :: UserId + } + | ExamUserCsvAssignOccurrenceData + { examUserCsvRegistration :: ExamRegistrationId + , examUserCsvOccurrence :: ExamOccurrenceId + } + | ExamUserCsvDeregisterData + { examUserCsvRegistration :: ExamRegistrationId + } + deriving (Eq, Ord, Read, Show, Generic, Typeable) +deriveJSON defaultOptions + { constructorTagModifier = over Text.packed $ Text.intercalate "-" . map Text.toLower . drop 3 . dropEnd 1 . splitCamel + , fieldLabelModifier = camelToPathPiece' 3 + , sumEncoding = TaggedObject "action" "data" + } ''ExamUserCsvAction + getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html getEUsersR = postEUsersR postEUsersR tid ssh csh examn = do @@ -994,7 +1022,31 @@ postEUsersR tid ssh csh examn = do <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPasses . _Wrapped . integral) <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPoints . _Wrapped) <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _numSheetsPasses . _Wrapped . integral) - dbtCsvDecode = Nothing + dbtCsvDecode = Just DBTCsvDecode + { dbtCsvRowKey = \ExamUserTableCsv{} -> mzero -- FIXME: guess user from csv row and do lookup via UniqueExamRegistration + , dbtCsvComputeActions = awaitForever $ \case + DBCsvDiffMissing{dbCsvOldKey} -> yield . ExamUserCsvDeregisterData $ E.unValue dbCsvOldKey + _other -> return () -- FIXME: compute edit on existing rows & add rows + , dbtCsvClassifyAction = \case + ExamUserCsvRegisterData{} -> ExamUserCsvRegister + ExamUserCsvDeregisterData{} -> ExamUserCsvDeregister + ExamUserCsvAssignOccurrenceData{} -> ExamUserCsvAssignOccurrence + , dbtCsvCoarsenActionClass = \case + ExamUserCsvRegister -> DBCsvActionNew + ExamUserCsvDeregister -> DBCsvActionMissing + _other -> DBCsvActionExisting + , dbtCsvExecuteActions = do + C.mapM_ $ \case + ExamUserCsvDeregisterData{..} -> delete examUserCsvRegistration + _other -> return () -- FIXME + return $ CExamR tid ssh csh examn EUsersR + , dbtCsvRenderKey = \existing -> \case + ExamUserCsvDeregisterData{..} + -> let Entity _ User{..} = view resultUser $ existing ! E.Value examUserCsvRegistration + in nameWidget userDisplayName userSurname + _other -> mempty -- FIXME + , dbtCsvRenderActionClass = \c -> [whamlet|_{c}|] + } examUsersDBTableValidator = def diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 4f6676899..7997741b1 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -7,7 +7,9 @@ module Handler.Utils.Table.Pagination , DBRow(..), _dbrOutput, _dbrIndex, _dbrCount , DBStyle(..), defaultDBSFilterLayout, DBEmptyStyle(..) , module Handler.Utils.Table.Pagination.CsvColumnExplanations - , DBTCsvEncode, DBTCsvDecode + , DBCsvActionMode(..) + , DBCsvDiff(..), _DBCsvDiffNew, _DBCsvDiffExisting, _DBCsvDiffMissing, _dbCsvOldKey, _dbCsvOld, _dbCsvNewKey, _dbCsvNew + , DBTCsvEncode, DBTCsvDecode(..) , DBTable(..), noCsvEncode, IsDBTable(..), DBCell(..) , singletonFilter , DBParams(..) @@ -50,23 +52,29 @@ import qualified Database.Esqueleto.Internal.Language as E (From) import qualified Network.Wai as Wai -import Control.Monad.RWS hiding ((<>), mapM_) -import Control.Monad.Writer hiding ((<>), mapM_) +import Control.Monad.RWS (RWST(..), execRWS) +import Control.Monad.Writer (WriterT(..)) import Control.Monad.Reader (ReaderT(..), mapReaderT) +import Control.Monad.State (StateT(..), evalStateT) import Control.Monad.Trans.Maybe +import Control.Monad.State.Class (modify) +import qualified Control.Monad.State.Class as State import Data.Foldable (Foldable(foldMap)) -import Data.Map (Map) +import Data.Map (Map, (!)) import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.CaseInsensitive as CI +import Data.Csv (NamedRecord) +import qualified Data.Csv as Csv (encodeByName) + import Colonnade hiding (bool, fromMaybe, singleton) import qualified Colonnade (singleton) -import Colonnade.Encode +import Colonnade.Encode hiding (row) import Text.Hamlet (hamletFile) @@ -97,6 +105,8 @@ import Data.Semigroup as Sem (Semigroup(..)) import qualified Data.Conduit.List as C +import qualified Control.Monad.Catch as Catch + #if MIN_VERSION_base(4,11,0) type Monoid' = Monoid @@ -271,8 +281,19 @@ piIsUnset PaginationInput{..} = and , isNothing piPage ] + +data DBCsvActionMode = DBCsvActionNew | DBCsvActionExisting | DBCsvActionMissing + deriving (Read, Show, Eq, Ord, Enum, Bounded, Generic, Typeable) +instance Universe DBCsvActionMode +instance Finite DBCsvActionMode -data ButtonCsvMode = BtnCsvExport | BtnCsvImport +nullaryPathPiece ''DBCsvActionMode $ camelToPathPiece' 3 +deriveJSON defaultOptions + { constructorTagModifier = camelToPathPiece' 3 + } ''DBCsvActionMode + + +data ButtonCsvMode = BtnCsvExport | BtnCsvImport | BtnCsvImportConfirm deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) instance Universe ButtonCsvMode instance Finite ButtonCsvMode @@ -288,21 +309,45 @@ instance Button UniWorX ButtonCsvMode where #{iconCSV} \ _{BtnCsvExport} |] - btnLabel BtnCsvImport - = [whamlet| - $newline never - _{BtnCsvImport} - |] - -data DBCsvMode = DBCsvNormal - | DBCsvExport - | DBCsvImport - { _dbCsvFiles :: [FileInfo] - , _dbCsvModifyExisting, _dbCsvAddNew, _dbCsvDeleteMissing :: Bool - } + btnLabel x = [whamlet|_{x}|] -type DBTableKey k' = (ToJSON k', FromJSON k', Ord k', Binary k') +data DBCsvMode + = DBCsvNormal + | DBCsvExport + | DBCsvImport + { dbCsvFiles :: [FileInfo] + } + +data DBCsvDiff r' csv k' + = DBCsvDiffNew + { dbCsvNewKey :: Maybe k' + , dbCsvNew :: csv + } + | DBCsvDiffExisting + { dbCsvOldKey :: k' + , dbCsvOld :: r' + , dbCsvNew :: csv + } + | DBCsvDiffMissing + { dbCsvOldKey :: k' + , dbCsvOld :: r' + } + +makeLenses_ ''DBCsvDiff +makePrisms ''DBCsvDiff + +data DBCsvException k' + = DBCsvDuplicateKey + { dbCsvDuplicateKey :: k' + , dbCsvDuplicateKeyRowA, dbCsvDuplicateKeyRowB :: NamedRecord + } + deriving (Show, Typeable) + +instance (Typeable k', Show k') => Exception (DBCsvException k') + + +type DBTableKey k' = (Show k', ToJSON k', FromJSON k', Ord k', Binary k', Typeable k') data DBRow r = forall k'. DBTableKey k' => DBRow { dbrKey :: k' , dbrOutput :: r @@ -440,9 +485,23 @@ instance PathPiece x => PathPiece (WithIdent x) where (ident, (Text.stripSuffix sep -> Just rest)) <- return $ Text.breakOn sep txt WithIdent <$> pure ident <*> fromPathPiece rest - type DBTCsvEncode r' csv = DictMaybe (ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv) (Conduit r' (YesodDB UniWorX) csv) -type DBTCsvDecode csv = DictMaybe (FromNamedRecord csv) (Sink csv (YesodDB UniWorX) ()) +data DBTCsvDecode r' k' csv = forall route csvAction csvActionClass. + ( FromNamedRecord csv, ToNamedRecord csv, DefaultOrdered csv + , DBTableKey k' + , RedirectUrl UniWorX route + , Typeable csv + , Ord csvAction, FromJSON csvAction, ToJSON csvAction + , Ord csvActionClass + ) => DBTCsvDecode + { dbtCsvRowKey :: csv -> MaybeT (YesodDB UniWorX) k' + , dbtCsvComputeActions :: Conduit (DBCsvDiff r' csv k') (YesodDB UniWorX) csvAction + , dbtCsvClassifyAction :: csvAction -> csvActionClass + , dbtCsvCoarsenActionClass :: csvActionClass -> DBCsvActionMode + , dbtCsvExecuteActions :: Sink csvAction (YesodDB UniWorX) route + , dbtCsvRenderKey :: Map k' r' -> csvAction -> Widget + , dbtCsvRenderActionClass :: csvActionClass -> Widget + } data DBTable m x = forall a r r' h i t k k' csv. ( ToSortable h, Functor h @@ -460,7 +519,7 @@ data DBTable m x = forall a r r' h i t k k' csv. , dbtStyle :: DBStyle , dbtParams :: DBParams m x , dbtCsvEncode :: DBTCsvEncode r' csv - , dbtCsvDecode :: DBTCsvDecode csv + , dbtCsvDecode :: Maybe (DBTCsvDecode r' k' csv) , dbtIdent :: i } @@ -756,9 +815,6 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db ((csvExportRes, csvExportWdgt), csvExportEnctype) <- lift . runFormGet . identifyForm FIDDBTableCsvExport . set (mapped . mapped . _1 . mapped) DBCsvExport $ buttonForm' [BtnCsvExport] ((csvImportRes, csvImportWdgt), csvImportEnctype) <- lift . runFormPost . identifyForm FIDDBTableCsvImport . renderAForm FormDBTableCsvImport $ DBCsvImport <$> areq fileFieldMultiple (fslI MsgCsvFile) Nothing - <*> apopt checkBoxField (fslI MsgCsvModifyExisting) (Just True) - <*> apopt checkBoxField (fslI MsgCsvAddNew) (Just True) - <*> apopt checkBoxField (fslI MsgCsvDeleteMissing) (Just False) let csvMode = asum @@ -826,13 +882,97 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db formResult csvMode $ \case DBCsvExport - | Just (Dict, dbtCsvEncode') <- dbtCsvEncode - -> do - setContentDisposition' . Just $ unpack dbtIdent <.> unpack extensionCsv - sendResponse <=< liftHandlerT . respondCsvDB $ C.sourceList rows .| dbtCsvEncode' - DBCsvImport{} - | Just (Dict, _dbtCsvDecode) <- dbtCsvDecode - -> error "dbCsvImport" + | Just (Dict, dbtCsvEncode') <- dbtCsvEncode -> do + setContentDisposition' . Just $ unpack dbtIdent <.> unpack extensionCsv + sendResponse <=< liftHandlerT . respondCsvDB $ C.sourceList rows .| dbtCsvEncode' + DBCsvImport{..} + | Just (DBTCsvDecode{ dbtCsvClassifyAction = dbtCsvClassifyAction :: csvAction -> csvActionClass + , .. + } :: DBTCsvDecode r' k' csv) <- dbtCsvDecode -> do + let existing = Map.fromList $ zip currentKeys rows + sourceDiff :: Source (StateT (Map k' csv) (YesodDB UniWorX)) (DBCsvDiff r' csv k') + sourceDiff = do + let + toDiff :: csv -> StateT (Map k' csv) (YesodDB UniWorX) (DBCsvDiff r' csv k') + toDiff row = do + rowKey <- lift . runMaybeT $ dbtCsvRowKey row + seenKeys <- State.get + (<* modify (maybe id (flip Map.insert row) rowKey)) $ if + | Just rowKey' <- rowKey + , Just oldRow <- Map.lookup rowKey' seenKeys + -> throwM $ DBCsvDuplicateKey rowKey' (toNamedRecord oldRow) (toNamedRecord row) + | Just rowKey' <- rowKey + , Just oldRow <- Map.lookup rowKey' existing + -> return $ DBCsvDiffExisting rowKey' oldRow row + | otherwise + -> return $ DBCsvDiffNew rowKey row + mapM_ fileSourceCsv dbCsvFiles .| C.mapM toDiff + + seen <- State.get + forM_ (Map.toList existing) $ \(rowKey, oldRow) -> if + | Map.member rowKey seen -> return () + | otherwise -> yield $ DBCsvDiffMissing rowKey oldRow + + accActionMap :: Map csvActionClass (Set csvAction) -> csvAction -> Map csvActionClass (Set csvAction) + accActionMap acc csvAct = Map.insertWith Set.union (dbtCsvClassifyAction csvAct) (Set.singleton csvAct) acc + + importCsv = do + actionMap <- flip evalStateT Map.empty . runConduit $ sourceDiff .| transPipe lift dbtCsvComputeActions .| C.fold accActionMap Map.empty + + when (Map.null actionMap) $ do + addMessageI Info MsgCsvImportUnnecessary + redirect $ tblLink id + + liftHandlerT . (>>= sendResponse) $ + siteLayoutMsg MsgCsvImportConfirmationHeading $ do + setTitleI MsgCsvImportConfirmationHeading + + let + precomputeIdents :: forall f m'. (Eq (Element f), MonoFoldable f, MonadHandler m') => f -> m' (Element f -> Text) + precomputeIdents = foldM (\f act -> (\id' x -> bool (f x) id' $ act == x) <$> newIdent) (\_ -> error "No id precomputed") + actionClassIdent <- precomputeIdents $ Map.keys actionMap + actionIdent <- precomputeIdents . Set.unions $ Map.elems actionMap + + let defaultChecked actClass = case dbtCsvCoarsenActionClass actClass of + DBCsvActionMissing -> False + _other -> True + csvActionCheckBox :: [(Text, Text)] -> csvAction -> Widget + csvActionCheckBox vAttrs act = do + let + sJsonField :: Field (HandlerT UniWorX IO) csvAction + sJsonField = secretJsonField' $ \theId name attrs val _isReq -> + [whamlet| + $newline never + + |] + fieldView sJsonField (actionIdent act) (toPathPiece PostDBCsvImportAction) vAttrs (Right act) False + (csvImportConfirmForm', csvImportConfirmEnctype) <- liftHandlerT . generateFormPost . identifyForm FIDDBTableCsvImportConfirm $ \csrf -> return (error "No meaningful FormResult", $(widgetFile "csv-import-confirmation")) + let csvImportConfirmForm = wrapForm' BtnCsvImportConfirm csvImportConfirmForm' FormSettings + { formMethod = POST + , formAction = Just $ tblLink id + , formEncoding = csvImportConfirmEnctype + , formAttrs = [] + , formSubmit = FormSubmit + , formAnchor = Nothing :: Maybe Text + } + + $(widgetFile "csv-import-confirmation-wrapper") + catches importCsv + [ Catch.Handler $ \case + (DBCsvDuplicateKey{..} :: DBCsvException k') + -> liftHandlerT $ sendResponseStatus badRequest400 =<< do + let offendingCsv = decodeUtf8 $ Csv.encodeByName (headerOrder (error "not to be forced" :: csv)) [ dbCsvDuplicateKeyRowA, dbCsvDuplicateKeyRowB ] + + mr <- getMessageRender + + siteLayoutMsg (ErrorResponseTitle $ InvalidArgs [mr MsgDBCsvDuplicateKey]) $ + [whamlet| +

_{MsgDBCsvDuplicateKey} +

_{MsgDBCsvDuplicateKeyTip} + 

+                           #{offendingCsv}
+                       |]
+          ]
     _other      -> return ()
 
   let
@@ -889,7 +1029,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
 
     csvWdgt = $(widgetFile "table/csv-transcode")
 
-    uiLayout table = dbsFilterLayout filterWdgt filterEnc (SomeRoute $ rawAction :#: wIdent "table-wrapper") $(widgetFile "table/layout")
+    uiLayout table = csvWdgt <> dbsFilterLayout filterWdgt filterEnc (SomeRoute $ rawAction :#: wIdent "table-wrapper") $(widgetFile "table/layout")
 
     dbInvalidateResult' = foldr (<=<) return . catMaybes $
       [ do
@@ -898,6 +1038,22 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
           return . dbInvalidateResult dbtParams . DBTIRowsMissing $ length previousKeys - length currentKeys
       ]
 
+  ((csvImportConfirmRes, ()), _enctype) <- case dbtCsvDecode of
+    Just (DBTCsvDecode{dbtCsvExecuteActions} :: DBTCsvDecode r' k' csv) -> do
+      lift . runFormPost . identifyForm FIDDBTableCsvImportConfirm $ \_csrf -> do
+        acts <- globalPostParamFields PostDBCsvImportAction secretJsonField
+        return . (, ()) $ if
+          | null acts -> FormSuccess $ do
+              addMessageI Info MsgCsvImportAborted
+              redirect $ tblLink id
+          | otherwise -> FormSuccess $ do
+              finalDest <- runConduit $ C.sourceList acts .| dbtCsvExecuteActions
+              addMessageI Success . MsgCsvImportSuccessful $ length acts
+              E.transactionSave
+              redirect finalDest
+    _other -> return ((FormMissing, ()), mempty)
+  formResult csvImportConfirmRes id
+
   dbInvalidateResult' <=< bool (dbHandler (Proxy @m) (Proxy @x) $ (\table -> $(widgetFile "table/layout-wrapper")) . uiLayout) (sendResponse <=< tblLayout . uiLayout <=< dbWidget (Proxy @m) (Proxy @x)) psShortcircuit <=< runDBTable dbtable paginationInput currentKeys . fmap swap $ runWriterT table'
   where
     tblLayout :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Widget -> m' Html
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index ecbf65f1a..73e6473e4 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -199,6 +199,7 @@ data FormIdentifier
   | FIDDBTable
   | FIDDBTableCsvExport
   | FIDDBTableCsvImport
+  | FIDDBTableCsvImportConfirm
   | FIDDelete
   | FIDCourseRegister
   | FIDuserRights
@@ -567,7 +568,26 @@ data SecretJSONFieldException = SecretJSONFieldDecryptFailure
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
 instance Exception SecretJSONFieldException
 
-secretJsonField :: ( ToJSON a, FromJSON a
+secretJsonField' :: ( ToJSON a, FromJSON a
+                    , MonadHandler m
+                    , MonadSecretBox (ExceptT EncodedSecretBoxException m)
+                    , MonadSecretBox (WidgetT (HandlerSite m) IO)
+                    , RenderMessage (HandlerSite m) FormMessage
+                    , RenderMessage (HandlerSite m) SecretJSONFieldException
+                    )
+                 => FieldViewFunc m Text -> Field m a
+secretJsonField' fieldView' = Field{..}
+  where
+    fieldParse [v] [] = bimap (\_ -> SomeMessage SecretJSONFieldDecryptFailure) Just <$> runExceptT (encodedSecretBoxOpen v)
+    fieldParse [] [] = return $ Right Nothing
+    fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
+    fieldView theId name attrs val isReq = do
+      val' <- traverse (encodedSecretBox SecretBoxShort) val
+      fieldView' theId name attrs val' isReq
+    fieldEnctype = UrlEncoded
+
+secretJsonField :: forall m a.
+                   ( ToJSON a, FromJSON a
                    , MonadHandler m
                    , MonadSecretBox (ExceptT EncodedSecretBoxException m)
                    , MonadSecretBox (WidgetT (HandlerSite m) IO)
@@ -575,17 +595,7 @@ secretJsonField :: ( ToJSON a, FromJSON a
                    , RenderMessage (HandlerSite m) SecretJSONFieldException
                    )
                 => Field m a
-secretJsonField = Field{..}
-  where
-    fieldParse [v] [] = bimap (\_ -> SomeMessage SecretJSONFieldDecryptFailure) Just <$> runExceptT (encodedSecretBoxOpen v)
-    fieldParse [] [] = return $ Right Nothing
-    fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
-    fieldView theId name attrs val _isReq = do
-      val' <- traverse (encodedSecretBox SecretBoxShort) val
-      [whamlet|
-        
-      |]
-    fieldEnctype = UrlEncoded
+secretJsonField = secretJsonField' $ fieldView (hiddenField :: Field m Text)
 
 htmlFieldSmall :: forall m. (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m Html
 htmlFieldSmall = checkMMap sanitize (pack . renderHtml) textField
diff --git a/src/Utils/Parameters.hs b/src/Utils/Parameters.hs
index 57d1a0cff..6a66df6e1 100644
--- a/src/Utils/Parameters.hs
+++ b/src/Utils/Parameters.hs
@@ -6,7 +6,7 @@ module Utils.Parameters
   , GlobalPostParam(..)
   , lookupGlobalPostParam, hasGlobalPostParam, lookupGlobalPostParams
   , lookupGlobalPostParamForm, hasGlobalPostParamForm
-  , globalPostParamField
+  , globalPostParamField, globalPostParamFields
   ) where
 
 import ClassyPrelude.Yesod
@@ -55,6 +55,7 @@ data GlobalPostParam = PostFormIdentifier
                      | PostDeleteTarget
                      | PostMassInputShape
                      | PostBearer
+                     | PostDBCsvImportAction
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
 
 instance Universe GlobalPostParam
@@ -84,3 +85,9 @@ globalPostParamField ident Field{fieldParse} = runMaybeT $ do
   ts <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askParams
   fs <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askFiles
   MaybeT $ either (const Nothing) id <$> lift (fieldParse ts fs)
+
+globalPostParamFields :: Monad m => GlobalPostParam -> Field m a -> MForm m [a]
+globalPostParamFields ident Field{fieldParse} = fmap (fromMaybe []) . runMaybeT $ do
+  ts <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askParams
+  fs <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askFiles
+  forM ((Left <$> fs) ++ (Right <$> ts)) $ \inp -> MaybeT $ either (const Nothing) id <$> lift (either (\f -> fieldParse [] [f]) (\t -> fieldParse [t] []) inp)
diff --git a/templates/csv-import-confirmation-wrapper.hamlet b/templates/csv-import-confirmation-wrapper.hamlet
new file mode 100644
index 000000000..b5459079b
--- /dev/null
+++ b/templates/csv-import-confirmation-wrapper.hamlet
@@ -0,0 +1,4 @@
+

+  
_{MsgCsvImportConfirmationTip}
+

+  ^{csvImportConfirmForm}
diff --git a/templates/csv-import-confirmation.hamlet b/templates/csv-import-confirmation.hamlet
new file mode 100644
index 000000000..473a2c101
--- /dev/null
+++ b/templates/csv-import-confirmation.hamlet
@@ -0,0 +1,21 @@
+$newline never
+#{csrf}
+

+  $forall actionClass <- sortOn dbtCsvCoarsenActionClass (Map.keys actionMap)
+    

+      
+