module Yesod.Auth.SmbClient (authSmbClient) where
import Control.Applicative ((<$>), (<*>))
import Data.Text (Text)
import System.Authenticate.SmbClient (loginSmbClient)
import Text.Hamlet (hamlet)
import Yesod.Auth (
AuthPlugin(..),
Creds(..),
Route(..),
loginErrorMessage,
setCreds,
YesodAuth(..))
import Yesod.Core (
lift,
liftIO,
notFound,
toWidget)
import Yesod.Form (
iopt,
runInputPost,
textField)
pid = "smbclient"
authSmbClient :: YesodAuth m =>
Text
-> Text
-> AuthPlugin m
authSmbClient server domain =
AuthPlugin pid dispatch login
where
dispatch "POST" [] = do
input <- lift $ runInputPost $ (,)
<$> iopt textField "ident"
<*> iopt textField "password"
case input of
(Just ident, Just password) -> do
auth <- validate ident password
either failed success auth
_ ->
failed undefined
dispatch _ _ = notFound
validate ident password =
liftIO $ loginSmbClient server domain ident password
success ident =
lift $ setCreds True $ Creds pid ident []
failed _ =
loginErrorMessage LoginR "Login failed."
url = PluginR pid []
login toMaster =
toWidget [hamlet|
$newline never
<div #smbclientlogin>
<form method=post action=@{toMaster url} .formhorizontal>
<div .controlgroup>
<label .controllabel>
Username
<div .controls>
<input type=text name=ident required>
<div .controlgroup>
<label .controllabel>
Password
<div .controls>
<input type=password name=password required>
<div .formactions>
<input type=submit .btn .btnprimary value="Login">|]