diff --git a/Yesod/Auth/Http/Basic.hs b/Yesod/Auth/Http/Basic.hs --- a/Yesod/Auth/Http/Basic.hs +++ b/Yesod/Auth/Http/Basic.hs @@ -1,15 +1,21 @@ --- | A Yesod middleware for <> +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | A Yesod middleware for +-- <> -- -- -- Performs a single authentication lookup per request and uses the --- <> mechanisms to store valid auth -- credentials found in the Authorization header. -- -- -- The recommended way to use this module is to override the --- @maybeAuthId@ to @defaultMaybeBasicAuthId@ and supply a --- lookup function. +-- @maybeAuthId@ to @defaultMaybeBasicAuthId@ and supply a lookup +-- function. -- -- @ -- instance YesodAuth App where @@ -22,8 +28,8 @@ -- @ -- -- --- WWW-Authenticate challenges are currently not implemented. --- The current workaround is to override the error handler: +-- WWW-Authenticate challenges are currently not implemented. The +-- current workaround is to override the error handler: -- -- @ -- instance Yesod App where @@ -48,52 +54,42 @@ -- maybeAuthId >>= return . maybe AuthenticationRequired (const Authorized) -- isAuthorized _ _ = Authorized -- @ --- -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - module Yesod.Auth.Http.Basic ( -- * Drop in replace for maybeAuthId. defaultMaybeBasicAuthId - -- * The AuthSettings currently do nothing - -- useful but are supplied to the defaultMaybeAUthId - -- anyways + -- * The AuthSettings currently do nothing + -- useful but are supplied to the defaultMaybeAUthId + -- anyways. , AuthSettings , authRealm , defaultAuthSettings ) where -import Control.Applicative -import Control.Monad.Catch (MonadThrow) -import Data.ByteString (ByteString) import qualified Data.ByteString as BS -import Data.ByteString.Base64 (decodeLenient) -import Data.Text (Text) import qualified Data.Text.Encoding as T -import Data.Typeable -import Data.Word8 (isSpace, toLower, _colon) -import Prelude -import Network.Wai -import Yesod hiding (Header) +import Data.ByteString (ByteString) +import Data.ByteString.Base64 (decodeLenient) +import Data.Text (Text) +import Data.Typeable +import Data.Word8 (isSpace, toLower, _colon) +import Network.Wai +import Prelude +import Yesod hiding (Header) + -- | Authentication Settings -data AuthSettings = AuthSettings - { +data AuthSettings = AuthSettings { authRealm :: Text - } + } deriving (Eq, Show) --- | ready-to-go 'AuthSettings' which can be used +-- | Ready-to-go 'AuthSettings' which can be used defaultAuthSettings :: AuthSettings defaultAuthSettings = AuthSettings { authRealm = "Realm" } - -- | Cachable basic authentication credentials newtype CachedBasicAuthId a = CachedBasicAuthId { unCached :: Maybe a } @@ -105,45 +101,43 @@ -> ByteString -> IO Bool - -- | Retrieve the 'AuthId' using Authorization header. -- --- If valid credentials are found and authorized the --- auth id is cached. +-- If valid credentials are found and authorized the auth id is +-- cached. -- --- TODO use more general type than Text to represent --- the auth id +-- TODO use more general type than Text to represent the auth id defaultMaybeBasicAuthId - :: (MonadIO m, MonadThrow m, MonadBaseControl IO m) - => CheckCreds - -> AuthSettings - -> HandlerT site m (Maybe Text) + :: MonadHandler m + => CheckCreds + -> AuthSettings + -> m (Maybe Text) defaultMaybeBasicAuthId auth cfg = cachedAuth $ waiRequest >>= maybeBasicAuthId auth cfg -- | Cached Authentication credentials cachedAuth - :: (MonadIO m, MonadThrow m, MonadBaseControl IO m) - => HandlerT site m (Maybe Text) - -> HandlerT site m (Maybe Text) + :: (MonadHandler m) + => m (Maybe Text) + -> m (Maybe Text) cachedAuth = fmap unCached . cached . fmap CachedBasicAuthId --- | Use the HTTP Basic _Authorization_ header to retrieve --- the AuthId of request +-- | Use the HTTP Basic _Authorization_ header to retrieve the AuthId +-- of request -- --- This function uses yesod 'cachedAuth' to cache the result of --- the first succesful header lookup. +-- This function uses yesod 'cachedAuth' to cache the result of the +-- first succesful header lookup. -- -- Subsequent calls to 'maybeAuthId' do not require the 'CheckCreds' -- function to be run again. maybeBasicAuthId - :: MonadIO m - => CheckCreds - -> AuthSettings - -> Request - -> m (Maybe Text) + :: (MonadHandler m) + => CheckCreds + -> AuthSettings + -> Request + -> m (Maybe Text) maybeBasicAuthId checkCreds AuthSettings{..} req = case authorization of Just (strategy, userpass) diff --git a/test/HLint.hs b/test/HLint.hs deleted file mode 100644 --- a/test/HLint.hs +++ /dev/null @@ -1,19 +0,0 @@ - -module Main (main) where - -import Language.Haskell.HLint (hlint) -import System.Exit (exitFailure, exitSuccess) - - -main :: IO () -main = do - hints <- hlint arguments - print hints - if null hints - then exitSuccess - else exitFailure - where - arguments = [ - "Yesod" - , "test" - ] diff --git a/yesod-auth-basic.cabal b/yesod-auth-basic.cabal --- a/yesod-auth-basic.cabal +++ b/yesod-auth-basic.cabal @@ -1,6 +1,6 @@ name: yesod-auth-basic -version: 0.1.0.2 +version: 0.1.0.3 license: BSD3 license-file: LICENSE author: Christopher Reichert @@ -35,6 +35,7 @@ , yesod , wai , word8 + , monad-control if impl(ghc < 7.6) build-depends: @@ -54,13 +55,3 @@ , yesod-test , hspec >= 1.3 , text - - -test-suite hlint - main-is: test/HLint.hs - ghc-options: -Wall -threaded - type: exitcode-stdio-1.0 - default-language: Haskell2010 - build-depends: base - , hlint -