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

module Auth.PWFile
  ( maintenanceLogin
  ) where

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

import qualified Data.Yaml as Yaml

import qualified Data.Text.Encoding as Text

import Yesod.Auth.Util.PasswordStore (verifyPassword)

  
maintenanceLogin :: ( YesodAuth site
                    , YesodPersist site
                    , IsSqlBackend (YesodPersistBackend site)
                    , PersistUniqueWrite (YesodPersistBackend site)
                    ) => FilePath -> AuthPlugin site
maintenanceLogin fp = AuthPlugin{..}
  where
    apName = "PWFile"
    apLogin = mempty
    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