{-# LANGUAGE NoImplicitPrelude
           , RecordWildCards
           , TemplateHaskell
           , FlexibleContexts
           , TypeFamilies
           , OverloadedStrings
  #-}

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


dummyForm :: ( RenderMessage site FormMessage
             , RenderMessage site DummyMessage
             , YesodPersist site
             , SqlBackendCanRead (YesodPersistBackend site)
             , Button site SubmitButton
             , Show (ButtonCssClass site)
             ) => AForm (HandlerT site IO) (CI Text)
dummyForm = areq (selectField userList) (fslI MsgDummyIdent) Nothing
         <* submitButton
  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 SubmitButton
              , Show (ButtonCssClass site)
              ) => 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 -> redirect LoginR
        FormSuccess ident ->
          lift . setCredsRedirect $ Creds "dummy" (CI.original ident) []
    apDispatch _ _ = notFound
    apLogin toMaster = do
      (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard dummyForm
      $(widgetFile "widgets/dummy-login-form")