module Auth.PWHash
  ( hashLogin
  , PWHashMessage(..)
  ) where

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

import Utils.Form

import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI

import Yesod.Auth.Util.PasswordStore (verifyPasswordWith)

import qualified Yesod.Auth.Message as Msg


data HashLogin = HashLogin
  { hashIdent :: CI Text
  , hashPassword :: Text
  } deriving (Generic, Typeable)

data PWHashMessage = MsgPWHashIdent
                   | MsgPWHashPassword
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)


hashForm :: ( RenderMessage (HandlerSite m) FormMessage
            , RenderMessage (HandlerSite m) PWHashMessage
            , MonadHandler m
            ) => AForm m HashLogin
hashForm = HashLogin
  <$> areq ciField (fslpI MsgPWHashIdent "Identifikation") Nothing
  <*> areq passwordField (fslpI MsgPWHashPassword "Passwort") Nothing


hashLogin :: forall site.
             ( YesodAuth site
             , YesodPersist site
             , SqlBackendCanRead (YesodPersistBackend site)
             , PersistRecordBackend User (YesodPersistBackend site)
             , RenderMessage site PWHashMessage
             , RenderMessage site AFormMessage
             , Button site ButtonSubmit
             ) => PWHashAlgorithm -> AuthPlugin site
hashLogin pwHashAlgo = AuthPlugin{..}
  where
    apName :: Text
    apName = "PWHash"

    apDispatch :: forall m. MonadAuthHandler site m => Text -> [Text] -> m TypedContent
    apDispatch "POST" [] = liftSubHandler $ do
      ((loginRes, _), _) <- runFormPost $ renderAForm FormStandard hashForm
      tp <- getRouteToParent
      case loginRes of
        FormFailure errs -> do
          forM_ errs $ addMessage Error . toHtml
          redirect $ tp LoginR
        FormMissing -> redirect $ tp LoginR
        FormSuccess HashLogin{..} -> do
          user <- liftHandler . runDB . getBy $ UniqueAuthentication hashIdent
          case user of
            Just (Entity _ User{ userAuthentication = AuthPWHash{..}, userIdent = CI.original -> userIdent })
              | verifyPasswordWith pwHashAlgo (2^) (encodeUtf8 hashPassword) (encodeUtf8 authPWHash) -> -- (2^) is magic.
                  setCredsRedirect $ Creds apName userIdent []
            other -> do
              $logDebugS "PWHash" $ tshow other
              loginErrorMessageI LoginR Msg.InvalidLogin
    apDispatch _ _ = notFound

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