module Auth.Dummy ( dummyLogin , DummyMessage(..) ) where import Import.NoFoundation import Database.Persist.Sql (SqlBackendCanRead) import Utils.Form import Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive as CI data DummyMessage = MsgDummyIdent | MsgDummyNoFormData deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) dummyForm :: ( RenderMessage site FormMessage , RenderMessage site DummyMessage , YesodPersist site , SqlBackendCanRead (YesodPersistBackend site) , Button site ButtonSubmit ) => AForm (HandlerT site IO) (CI Text) dummyForm = areq (selectField userList) (fslI MsgDummyIdent) Nothing where userList = fmap mkOptionList . runDB $ map toOption <$> selectList [] [Asc UserIdent] toOption (Entity _ User{..}) = Option (CI.original userIdent) userIdent (CI.original userIdent) dummyLogin :: ( YesodAuth site , YesodPersist site , SqlBackendCanRead (YesodPersistBackend site) , RenderMessage site FormMessage , RenderMessage site DummyMessage , Button site ButtonSubmit ) => AuthPlugin site dummyLogin = AuthPlugin{..} where apName = "dummy" -- apDispatch :: Text -> [Text] -> HandlerT Auth (HandlerT site IO) TypedContent apDispatch "POST" [] = do ((loginRes, _), _) <- lift . runFormPost $ renderAForm FormStandard dummyForm case loginRes of FormFailure errs -> do lift . forM_ errs $ addMessage Error . toHtml redirect LoginR FormMissing -> do lift $ addMessageI Warning MsgDummyNoFormData redirect LoginR FormSuccess ident -> lift . setCredsRedirect $ Creds "dummy" (CI.original ident) [] apDispatch _ _ = notFound apLogin toMaster = do (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard dummyForm let loginForm = wrapForm login FormSettings { formMethod = POST , formAction = Just . SomeRoute . toMaster $ PluginR "dummy" [] , formEncoding = loginEnctype , formAttrs = [] , formSubmit = FormSubmit , formAnchor = Just "login--dummy" :: Maybe Text } $(widgetFile "widgets/dummy-login-form/dummy-login-form")