yesod-auth-basic (empty) → 0.1.0.0

raw patch · 7 files changed

+318/−0 lines, 7 filesdep +basedep +base64-bytestringdep +bytestringsetup-changed

Dependencies added: base, base64-bytestring, bytestring, exceptions, hlint, hspec, text, wai, word8, yesod, yesod-auth-basic, yesod-test

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• Yesod/Auth/Http/Basic.hs +164/−0
• test/HLint.hs +19/−0
• test/Spec.hs +1/−0
• test/YesodAuthHttpBasicSpec.hs +41/−0
• yesod-auth-basic.cabal +61/−0

@@ -0,0 +1,30 @@+Copyright (c) 2015, Christopher Reichert++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.++    * Neither the name of Christopher Reichert nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,164 @@+-- | A Yesod middleware for <<http://tools.ietf.org/html/rfc1945#section-11.1 HTTP Basic Authentication>>+--+-- This middleware performs a single authentication lookup+-- per request and uses the Yesod request-local caching+-- 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.+--+-- @+-- instance YesodAuth App where+--     type AuthId App = Text+--     getAuthId = return . Just . credsIdent+--     maybeAuthId = defaultMaybeBasicAuthId checkCreds+--       where+--         checkCreds = \k s -> return $ (k == "user")+--                                    && (s == "secret")+-- @+--+--+-- WWW-Authenticate challenges are currently not implemented.+-- The current workaround is to override the error handler:+--+-- @+-- instance Yesod App where+--   errorHandler NotAuthenticated = selectRep $+--       provideRep $ do+--         addHeader "WWW-Authenticate" $ T.concat+--               [ "RedirectJSON realm=\"Realm\", param=\"myurl.com\"" ]+--         -- send error response here+--         ...+--   errorHandler e = defaultErrorHandler e+--   ...+-- @+--+--+-- Proper response status on failed authentication is not implemented.+-- The current workaround is to override the 'Yesod' typeclass+-- @isAuthorized@ function to handle required auth routes. e.g.+--+-- @+-- instance Yesod App where+--   isAuthorized SecureR _   =+--     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 will not be exported until+       -- features are implemented which actually uses+       -- them+       --+       -- , 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           Network.Wai+import           Yesod                  hiding (Header)+++-- | Authentication Settings+data AuthSettings = AuthSettings+    {+      authRealm :: Text+    }++-- | 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 }+    deriving Typeable+++-- | A function to verify user credentials+type CheckCreds = ByteString+                  -> ByteString+                  -> IO Bool+++-- | Retrieve the 'AuthId' using Authorization header.+--+-- If valid credentials are found and authorized the+-- auth id is cached.+--+-- 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)+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)+cachedAuth = fmap unCached . cached . fmap CachedBasicAuthId+++-- | 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.+--+-- Subsequent calls to 'maybeAuthId' do not require the 'CheckCreds'+-- function to be run again.+maybeBasicAuthId+  :: MonadIO m+     => CheckCreds+     -> AuthSettings+     -> Request+     -> m (Maybe Text)+maybeBasicAuthId checkCreds AuthSettings{..} req =+    case authorization of+      Just (strategy, userpass)+        | BS.map toLower strategy == "basic" ->+              authorizeCredentials $ BS.dropWhile isSpace userpass+        | otherwise -> return Nothing+      _ -> return Nothing+  where+    authorization = BS.break isSpace+                    <$> lookup "Authorization" (requestHeaders req)+    authorizeCredentials encoded =+      let (username, password') = BS.breakByte _colon $ decodeLenient encoded+      in case BS.uncons password' of+          Nothing -> return Nothing+          Just (_,password) -> do+            authorized <- liftIO $ checkCreds username password+            return $ if authorized+                       then Just $ T.decodeUtf8 username+                       else Nothing

@@ -0,0 +1,19 @@++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"+                ]

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,41 @@++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}++module YesodAuthHttpBasicSpec where++import           Data.Monoid ((<>))+import           Test.Hspec+import           Yesod       hiding (get)+import           Yesod.Test+++-- TODO create real tests++spec :: SpecWith ()+spec = describe "Yesod HTTP Basic Authentication" $+  yesodSpec app $+    ydescribe "Yesod HTTP Basic Authentication" $+      ydescribe "tests1" $ do+        yit "Has Basic Auth" $ do+           -- addRequestHeader (hUserAgent, "Chrome/41.0.2228.0")+           get $ LiteAppRoute []+           statusIs 200+        yit "Denies Failed Basic Auth" $ do+          get $ LiteAppRoute []+          statusIs 200+          -- statusIs 403+++instance RenderMessage LiteApp FormMessage where+  renderMessage _ _ = defaultFormMessage+++app :: LiteApp+app = liteApp $+  dispatchTo $ do+    mfoo <- lookupGetParam "foo"+    case mfoo of+     Nothing -> return "Hello world!"+     Just foo -> return $ "foo=" <> foo

@@ -0,0 +1,61 @@++name:                yesod-auth-basic+version:             0.1.0.0+license:             BSD3+license-file:        LICENSE+author:              Christopher Reichert+maintainer:          creichert07@gmail.com+copyright:           (c) 2015, Christopher Reichert+category:            Web+build-type:          Simple+cabal-version:       >=1.10+synopsis:            Yesod Middleware for HTTP Basic Authentication+description:+ An efficient Yesod middleware middleware for HTTP Basic+ Authentication.+ .+ Utilizes Yesod request-local caching mechanisms to store valid auth+ credentials found in the Authorization header.+++source-repository head+  type:     git+  location: git://github.com/creichert/yesod-auth-basic.git+++library+  exposed-modules:     Yesod.Auth.Http.Basic+  ghc-options:         -Wall+  default-language:    Haskell2010+  build-depends:       base              == 4.*+                     , base64-bytestring+                     , bytestring+                     , exceptions+                     , text+                     , yesod+                     , wai+                     , word8+++test-suite spec+  type:                exitcode-stdio-1.0+  main-is:             Spec.hs+  hs-source-dirs:      test/+  other-modules:       YesodAuthHttpBasicSpec+  ghc-options:         -Wall -Werror -threaded+  default-language:    Haskell2010+  build-depends:       base                 == 4.*+                     , yesod+                     , yesod-auth-basic+                     , yesod-test+                     , hspec                >= 1.3+                     , text+++test-suite hlint+    main-is:          test/HLint.hs+    ghc-options:      -Wall -Werror -threaded+    type:             exitcode-stdio-1.0+    default-language: Haskell2010+    build-depends:    base+                    , hlint == 1.8.*