-- SPDX-FileCopyrightText: 2022 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Auth.Dummy
  ( apDummy
  , dummyLogin
  , DummyMessage(..)
  ) where

import Import.NoFoundation
import Database.Persist.Sql (SqlBackendCanRead)

import Utils.Metrics
import Utils.Form

import qualified Data.CaseInsensitive as CI


data DummyMessage = MsgDummyIdent
                  | MsgDummyIdentPlaceholder
                  | MsgDummyNoFormData
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)


dummyForm :: ( RenderMessage (HandlerSite m) FormMessage
             , RenderMessage (HandlerSite m) (ValueRequired (HandlerSite m))
             , RenderMessage (HandlerSite m) DummyMessage
             , YesodPersist (HandlerSite m)
             , SqlBackendCanRead (YesodPersistBackend (HandlerSite m))
             , MonadHandler m
             ) => WForm m (FormResult (CI Text))
dummyForm = do
  mr <- getMessageRender
  wreq (ciField & addDatalist userList) (fslpI MsgDummyIdent (mr MsgDummyIdentPlaceholder) & addAttr "autocomplete" "username" & 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)

apDummy :: Text
apDummy = "dummy"

dummyLogin :: forall site.
              ( YesodAuth site
              , YesodPersist site
              , SqlBackendCanRead (YesodPersistBackend site)
              , RenderAFormSite site
              , RenderMessage site DummyMessage
              , RenderMessage site (ValueRequired site)
              , Button site ButtonSubmit
              ) => AuthPlugin site
dummyLogin = AuthPlugin{..}
  where
    apName :: Text
    apName = apDummy

    apDispatch :: forall m. MonadAuthHandler site m => Text -> [Text] -> m TypedContent
    apDispatch method [] | encodeUtf8 method == methodPost = liftSubHandler $ do
      ((loginRes, _), _) <- runFormPost $ renderWForm FormLogin dummyForm
      tp <- getRouteToParent
      case loginRes of
        FormFailure errs -> do
          forM_ errs $ addMessage Error . toHtml
          redirect $ tp LoginR
        FormMissing -> do
          addMessageI Warning MsgDummyNoFormData
          redirect $ tp LoginR
        FormSuccess ident -> do
          observeLoginOutcome apName LoginSuccessful
          setCredsRedirect $ Creds apName (CI.original ident) []
    apDispatch _ [] = badMethod
    apDispatch _ _ = notFound

    apLogin :: (Route Auth -> Route site) -> WidgetFor site ()
    apLogin toMaster = do
      (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderWForm FormLogin dummyForm
      let loginForm = wrapForm login FormSettings
            { formMethod = POST
            , formAction = Just . SomeRoute . toMaster $ PluginR apName []
            , formEncoding = loginEnctype
            , formAttrs = [("uw-no-navigate-away-prompt","")]
            , formSubmit = FormSubmit
            , formAnchor = Just "login--dummy" :: Maybe Text
            }
      $(widgetFile "widgets/dummy-login-form/dummy-login-form")