61 lines
1.9 KiB
Haskell
61 lines
1.9 KiB
Haskell
{-# 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
|
|
|