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 site FormMessage
            , RenderMessage site PWHashMessage
            , Button site ButtonSubmit
            ) => AForm (HandlerT site IO) HashLogin
hashForm = HashLogin
  <$> areq ciField (fslpI MsgPWHashIdent "Identifikation") Nothing
  <*> areq passwordField (fslpI MsgPWHashPassword "Passwort") Nothing


hashLogin :: ( YesodAuth site
             , YesodPersist site
             , SqlBackendCanRead (YesodPersistBackend site)
             , RenderMessage site FormMessage
             , RenderMessage site PWHashMessage
             , Button site ButtonSubmit
             ) => PWHashAlgorithm -> AuthPlugin site
hashLogin pwHashAlgo = AuthPlugin{..}
  where
    apName = "PWHash"
    apDispatch "POST" [] = do
      ((loginRes, _), _) <- lift . runFormPost $ renderAForm FormStandard hashForm
      case loginRes of
        FormFailure errs -> do
          forM_ errs $ addMessage Error . toHtml
          redirect LoginR
        FormMissing -> redirect LoginR
        FormSuccess HashLogin{..} -> do
          user <- lift . 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.
                  lift . setCredsRedirect $ Creds apName userIdent []
            other -> do
              $logDebugS "PWHash" $ tshow other
              loginErrorMessageI LoginR Msg.InvalidLogin
    -- apDispatch "GET" [] = do
    --   authData <- lookupBasicAuth
    --   pwdata <- liftIO $ Yaml.decodeFileEither fp

    --   addHeader "WWW-Authenticate" [st|Basic realm="uni2work maintenance auth" charset="UTF-8"|]

    --   case pwdata of
    --     Left err -> $logDebugS "Auth" $ tshow err
    --     Right pws -> $logDebugS "Auth" $ tshow (length pws) <> " pw entries"

    --   case (authData, pwdata) of
    --     (Nothing, _) -> do
    --       notAuthenticated
    --     (Just (usr, (Text.encodeUtf8 -> pw)), Right pwdata')
    --       | [ PWEntry{ pwUser = pwUser@(User{..}), pwHash = (Text.encodeUtf8 -> pwHash) } ]
    --           <- [ pwe | pwe@PWEntry{..} <- pwdata'
    --                    , let User{..} = pwUser
    --                    , userIdent  == usr
    --                    , userPlugin == apName
    --              ]
    --       , verifyPassword pw pwHash
    --         -> lift $ do
    --           runDB . void $ insertUnique pwUser
    --           setCredsRedirect $ Creds apName userIdent []
    --     _ -> permissionDenied "Invalid auth"
    apDispatch _ _ = notFound
    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 = []
            , formSubmit = FormSubmit
            , formAnchor = Just "login--hash" :: Maybe Text
            }
      $(widgetFile "widgets/hash-login-form/hash-login-form")