yesod-auth-ldap (empty) → 0.0.1
raw patch · 5 files changed
+202/−0 lines, 5 filesdep +LDAPdep +authenticate-ldapdep +basesetup-changed
Dependencies added: LDAP, authenticate-ldap, base, bytestring, hamlet, text, transformers, yesod-auth, yesod-core, yesod-form
Files
- LICENSE +25/−0
- Setup.lhs +9/−0
- Yesod/Auth/LDAP.hs +119/−0
- include/qq.h +9/−0
- yesod-auth-ldap.cabal +40/−0
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2010, Michael Snoyman. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,9 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple+> import System.Cmd (system)++> main :: IO ()+> main = defaultMain+
+ Yesod/Auth/LDAP.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}++-- Plugin LDAP authentication for Yesod, based heavily on Yesod.Auth.Kerberos.+-- Verify that your LDAP installation can bind and return LDAP objects before+-- trying to use this module.+++-- sample manual LDAP code here++-- ++module Yesod.Auth.LDAP+ ( genericAuthLDAP ) where++#include "qq.h"++import Yesod.Auth+import Yesod.Auth.Message+import Web.Authenticate.LDAP+import LDAP+import Data.Text (Text,pack,unpack)+import Text.Hamlet+import Yesod.Handler+import Yesod.Widget+import Control.Monad.IO.Class (liftIO)+import Yesod.Form+import Control.Applicative ((<$>), (<*>))++data LDAPConfig = LDAPConfig {+ -- | When a user gives username x, f(x) will be passed to Kerberos+ usernameModifier :: Text -> Text+ -- | When a user gives username x, f(x) will be passed to Yesod+ , identifierModifier :: Text -> [LDAPEntry] -> Text+ , ldapHost :: String+ , ldapPort' :: LDAPInt+ , initDN :: String -- DN for initial binding, must have authority to search+ , initPass :: String -- Password for initDN+ , baseDN :: Maybe String -- Base DN for user search, if any+ , ldapScope :: LDAPScope+ } +++genericAuthLDAP :: YesodAuth m => LDAPConfig -> AuthPlugin m+genericAuthLDAP config = AuthPlugin "LDAP" dispatch $ \tm -> addHamlet+ [QQ(hamlet)|+ <div id="header">+ <h1>Login++ <div id="login">+ <form method="post" action="@{tm login}">+ <table>+ <tr>+ <th>Username:+ <td>+ <input id="x" name="username" autofocus="" required>+ <tr>+ <th>Password:+ <td>+ <input type="password" name="password" required>+ <tr>+ <td> + <td>+ <input type="submit" value="Login">++ <script>+ if (!("autofocus" in document.createElement("input"))) {+ document.getElementById("x").focus();+ }+|]+ where+ dispatch "POST" ["login"] = postLoginR config >>= sendResponse+ dispatch _ _ = notFound++login :: AuthRoute+login = PluginR "LDAP" ["login"]+++postLoginR :: (YesodAuth y) => LDAPConfig -> GHandler Auth y ()+postLoginR config = do+ (mu,mp) <- runInputPost $ (,)+ <$> iopt textField "username"+ <*> iopt textField "password"++ let errorMessage (message :: Text) = do+ setMessage [QQ(shamlet)|Error: #{message}|]+ toMaster <- getRouteToMaster+ redirect $ toMaster LoginR++ case (mu,mp) of+ (Nothing, _ ) -> do+ mr <- getMessageRender+ errorMessage $ mr PleaseProvideUsername+ (_ , Nothing) -> do+ mr <- getMessageRender+ errorMessage $ mr PleaseProvidePassword+ (Just u , Just p ) -> do+ result <- liftIO $ loginLDAP (usernameModifier config u) + (unpack p)+ (ldapHost config)+ (ldapPort' config)+ (initDN config)+ (initPass config)+ (baseDN config)+ (ldapScope config)+ + + case result of+ Ok ldapEntries -> do+ let creds = Creds+ { credsIdent = identifierModifier config u ldapEntries + , credsPlugin = "LDAP"+ , credsExtra = []+ }+ setCreds True creds+ ldapError -> errorMessage (pack $ show ldapError)+
+ include/qq.h view
@@ -0,0 +1,9 @@+-- CPP macro which choses which quasyquotes syntax to use depending+-- on GHC version.+--+-- QQ stands for quasyquote.+#if GHC7+# define QQ(x) x+#else+# define QQ(x) $x+#endif
+ yesod-auth-ldap.cabal view
@@ -0,0 +1,40 @@+name: yesod-auth-ldap+version: 0.0.1 +license: BSD3+license-file: LICENSE+author: Michael Litchard +maintainer: Michael Litchard +synopsis: LDAP Authentication for Yesod.+category: Web, Yesod+stability: experimental +cabal-version: >= 1.6.0+build-type: Simple+homepage: http://www.yesodweb.com/+extra-source-files: include/qq.h+description: LDAP Authentication for Yesod.++flag ghc7++library+ if flag(ghc7)+ build-depends: base >= 4.3 && < 5+ cpp-options: -DGHC7+ else+ build-depends: base >= 4 && < 4.3+ build-depends: LDAP == 0.6.6 + , bytestring >= 0.9.1.4 && < 0.10+ , yesod-core >= 0.10 && < 0.11+ , yesod-auth >= 0.8 && < 0.9+ , text >= 0.7 && < 0.12+ , hamlet >= 0.10 && < 0.11+ , yesod-form >= 0.4 && < 0.5+ , transformers >= 0.2.2 && < 0.3+ , authenticate-ldap == 0.0.1++ exposed-modules: Yesod.Auth.LDAP+ ghc-options: -Wall+ include-dirs: include++source-repository head+ type: git+ location: git://github.com:mlitchard/yesod-auth-ldap.git