diff --git a/src/Auth/Dummy.hs b/src/Auth/Dummy.hs index 9f88b5ed6..90f3e3cee 100644 --- a/src/Auth/Dummy.hs +++ b/src/Auth/Dummy.hs @@ -27,7 +27,7 @@ dummyForm :: ( RenderMessage (HandlerSite m) FormMessage ) => AForm m (CI Text) dummyForm = wFormToAForm $ do mr <- getMessageRender - aFormToWForm $ areq (ciField & addDatalist userList) (fslpI MsgDummyIdent (mr MsgDummyIdentPlaceholder) & noAutocomplete) Nothing + aFormToWForm $ areq (ciField & addDatalist userList) (fslpI MsgDummyIdent (mr MsgDummyIdentPlaceholder) & noAutocomplete & addName PostLoginDummy) Nothing where userList = fmap mkOptionList . runDB $ withReaderT projectBackend (map toOption <$> selectList [] [Asc UserIdent] :: ReaderT SqlBackend _ [Option UserIdent]) toOption (Entity _ User{..}) = Option userDisplayName userIdent (CI.original userIdent) diff --git a/src/Utils/Parameters.hs b/src/Utils/Parameters.hs index 6a66df6e1..96fe65fd9 100644 --- a/src/Utils/Parameters.hs +++ b/src/Utils/Parameters.hs @@ -56,6 +56,7 @@ data GlobalPostParam = PostFormIdentifier | PostMassInputShape | PostBearer | PostDBCsvImportAction + | PostLoginDummy deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) instance Universe GlobalPostParam diff --git a/test/TestImport.hs b/test/TestImport.hs index 3b1280e33..8e71a84f6 100644 --- a/test/TestImport.hs +++ b/test/TestImport.hs @@ -61,6 +61,9 @@ import Data.Typeable import Handler.Utils (runAppLoggingT) +import Web.PathPieces (toPathPiece) +import Utils.Parameters (GlobalPostParam(PostLoginDummy)) + runDB :: SqlPersistM a -> YesodExample UniWorX a runDB query = do @@ -108,7 +111,7 @@ authenticateAs (Entity _ User{..}) = do request $ do setMethod "POST" addToken_ "#login--dummy" - byLabelExact "Identifikation" $ CI.original userIdent + addPostParam (toPathPiece PostLoginDummy) $ CI.original userIdent setUrl $ AuthR $ PluginR "dummy" [] -- | Create a user. The dummy email entry helps to confirm that foreign-key