yesod-auth-basic 0.1.0.3 → 0.2.0.0

raw patch · 5 files changed

+284/−111 lines, 5 filesdep −exceptionsdep −iproutedep −monad-controldep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: exceptions, iproute, monad-control

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +30/−0
• README.md +66/−0
• Yesod/Auth/Http/Basic.hs +64/−73
• test/YesodAuthHttpBasicSpec.hs +110/−21
• yesod-auth-basic.cabal +14/−17

@@ -0,0 +1,30 @@+# Changelog++## 0.2.0.0++### Breaking changes++- Require GHC 8.10 / base 4.14 or newer.+- Decode credentials with strict RFC 4648 Base64 validation. Quoted tokens,+  embedded whitespace, invalid characters, missing required padding, excess+  padding, and trailing junk are rejected rather than silently repaired.+- Require ASCII spaces after the case-insensitive `Basic` scheme. Tabs and+  nonbreaking spaces are no longer accepted as separators.++Clients should use their HTTP library's Basic Auth option, or send an unquoted+Base64 token. Decoded usernames and passwords are still passed to the checker+unchanged; credentials are not trimmed.++### Fixes and maintenance++- Return `Nothing` for invalid UTF-8 usernames instead of throwing, even if the+  credential checker accepts those bytes. Passwords remain opaque bytes.+- Use a `newtype` for `AuthSettings`; its realm field remains reserved.+- Replace placeholder tests with authentication, UTF-8, and request-cache tests.+- Replace Travis with cached, pedantic GitHub Actions builds for LTS 18.28,+  LTS 22.38, and LTS 24.65.+- Simplify README/Haddock usage and Basic challenge examples, remove unused+  dependencies, and show the callback type directly in the public signature.++Route authorization and HTTP challenges remain application-managed. Successful+and failed authentication results remain cached only within each request.

@@ -0,0 +1,66 @@+# Yesod HTTP Basic Authentication++[![Hackage](https://img.shields.io/hackage/v/yesod-auth-basic.svg)](https://hackage.haskell.org/package/yesod-auth-basic)++HTTP Basic Auth for Yesod applications. Use HTTPS.++## Usage++Import `Yesod.Auth.Http.Basic`, then add this override to your existing+`YesodAuth` instance, where `AuthId App = Text`:++```haskell+maybeAuthId = defaultMaybeBasicAuthId checkCredentials defaultAuthSettings+```++Supply your application's credential checker. For example:++```haskell+checkCredentials :: ByteString -> ByteString -> IO Bool+checkCredentials username password =+    pure (username == "user" && password == "secret") -- Example only.+```++The checker receives decoded bytes unchanged. Usernames must be valid UTF-8+because the authenticated ID is `Text`; password encoding is up to the checker.+Successful and failed results are cached **only within the current request**.++## Protect routes and send a challenge++The helper does not enforce access or send HTTP challenges. Configure these in+your application's `Yesod` instance (using your own route names):++```haskell+instance Yesod App where+    authRoute _ = Nothing -- Return 401 instead of redirecting to a login page.++    isAuthorized ProtectedR _ = do+        user <- maybeAuthId+        pure $ maybe AuthenticationRequired (const Authorized) user+    isAuthorized _ _ = pure Authorized++    errorHandler NotAuthenticated = do+        addHeader "WWW-Authenticate" "Basic realm=\"API\", charset=\"UTF-8\""+        defaultErrorHandler NotAuthenticated+    errorHandler err = defaultErrorHandler err+```++Missing or invalid credentials on `ProtectedR` produce a 401 response.+`authRealm` is currently reserved; set the challenge's realm in your handler.++## Requests++Let your HTTP client construct the header:++```sh+curl --user 'user:secret' https://example.com/protected+```++```text+Authorization: Basic <base64(username:password)>+```++`Basic` is case-insensitive and followed by ASCII spaces. Use standard Base64+with required padding, without quotes or embedded whitespace. Malformed headers+are rejected, not repaired. Decoded credentials are not trimmed; colons after+the first delimiter remain part of the password.

@@ -1,68 +1,53 @@ {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-} --- | A Yesod middleware for--- <<http://tools.ietf.org/html/rfc1945#section-11.1 HTTP Basic--- Authentication>>--------- Performs a single authentication lookup per request and uses the--- <<https://github.com/yesodweb/yesod/blob/master/yesod-core/Yesod/Core/TypeCache.hs#L21--- Yesod request-local caching>> mechanisms to store valid auth--- credentials found in the Authorization header.---+-- | HTTP Basic authentication for Yesod. Use HTTPS. ----- The recommended way to use this module is to override the--- @maybeAuthId@ to @defaultMaybeBasicAuthId@ and supply a lookup--- function.+-- Import this module and set @maybeAuthId@ in your existing @YesodAuth@+-- instance, where @AuthId App = Text@: -- -- @--- instance YesodAuth App where---     type AuthId App = Text---     getAuthId = return . Just . credsIdent---     maybeAuthId = defaultMaybeBasicAuthId checkCreds defaultAuthSettings---       where---         checkCreds = \k s -> return $ (k == "user")---                                    && (s == "secret")+-- maybeAuthId = defaultMaybeBasicAuthId checkCredentials defaultAuthSettings -- @ -------- WWW-Authenticate challenges are currently not implemented. The--- current workaround is to override the error handler:+-- Supply an application-specific credential checker: -- -- @--- 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---   ...+-- checkCredentials :: ByteString -> ByteString -> IO Bool+-- checkCredentials username password =+--     pure (username == "user" && password == "secret") -- Example only. -- @ --+-- The checker receives decoded bytes unchanged. Usernames must be UTF-8;+-- password encoding is up to the checker. Both successful and failed results+-- are cached for the current request, never across HTTP requests. ----- 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.+-- Route authorization and HTTP challenges belong to your application: -- -- @ -- instance Yesod App where---   isAuthorized SecureR _   =---     maybeAuthId >>= return . maybe AuthenticationRequired (const Authorized)---   isAuthorized _ _         = Authorized+--     authRoute _ = Nothing -- Return 401 instead of redirecting to a login page.+--+--     isAuthorized ProtectedR _ = do+--         user <- maybeAuthId+--         pure $ maybe AuthenticationRequired (const Authorized) user+--     isAuthorized _ _ = pure Authorized+--+--     errorHandler NotAuthenticated = do+--         addHeader "WWW-Authenticate" "Basic realm=\"API\", charset=\"UTF-8\""+--         defaultErrorHandler NotAuthenticated+--     errorHandler err = defaultErrorHandler err -- @+--+-- This produces a 401 response for missing or invalid credentials on+-- @ProtectedR@. See <https://www.rfc-editor.org/rfc/rfc7617 RFC 7617>.  module Yesod.Auth.Http.Basic        (-         -- * Drop in replace for maybeAuthId.+          -- * Authentication          defaultMaybeBasicAuthId -         -- * The AuthSettings currently do nothing-         -- useful but are supplied to the defaultMaybeAUthId-         -- anyways.+         -- * Settings        , AuthSettings        , authRealm        , defaultAuthSettings@@ -72,51 +57,55 @@ import qualified Data.Text.Encoding     as T  import Data.ByteString        (ByteString)-import Data.ByteString.Base64 (decodeLenient)+import Data.ByteString.Base64 (decode) import Data.Text              (Text) import Data.Typeable-import Data.Word8             (isSpace, toLower, _colon)+import Data.Word8             (toLower, _colon, _space) import Network.Wai import Prelude import Yesod                  hiding (Header)  --- | Authentication Settings-data AuthSettings = AuthSettings {+-- | Reserved authentication settings. HTTP challenges are application-managed.+newtype AuthSettings = AuthSettings {       authRealm :: Text+      -- ^ Reserved realm value; does not generate a @WWW-Authenticate@ header.     } deriving (Eq, Show) --- | Ready-to-go 'AuthSettings' which can be used+-- | Default reserved settings, with @authRealm = "Realm"@. defaultAuthSettings :: AuthSettings defaultAuthSettings = AuthSettings { authRealm = "Realm" } --- | Cachable basic authentication credentials+-- | A request-local authentication result, including failed authentication. newtype CachedBasicAuthId a   = CachedBasicAuthId { unCached :: Maybe a }     deriving Typeable  --- | A function to verify user credentials+-- | Application-supplied checker for decoded username and password bytes. type CheckCreds = ByteString                   -> ByteString                   -> IO Bool --- | Retrieve the 'AuthId' using Authorization header.+-- | Look up HTTP Basic credentials and return the verified UTF-8 username. ----- If valid credentials are found and authorized the auth id is--- cached.+-- Use as @maybeAuthId@ in a @YesodAuth@ instance with @AuthId@ equal to 'Text'.+-- Missing or malformed headers, invalid UTF-8 usernames, and rejected+-- credentials return 'Nothing'. The checker receives the decoded bytes+-- without trimming; passwords may contain colons. ----- TODO use more general type than Text to represent the auth id+-- Both successful and failed results are cached within the current request.+-- This function does not enforce route access or generate a challenge. defaultMaybeBasicAuthId   :: MonadHandler m-  => CheckCreds+  => (ByteString -> ByteString -> IO Bool)   -> AuthSettings   -> m (Maybe Text) defaultMaybeBasicAuthId auth cfg =     cachedAuth $ waiRequest >>= maybeBasicAuthId auth cfg  --- | Cached Authentication credentials+-- | Cache the authentication result for the current request. cachedAuth   :: (MonadHandler m)   => m (Maybe Text)@@ -124,36 +113,38 @@ cachedAuth = fmap unCached . cached . fmap CachedBasicAuthId  --- | Use the HTTP Basic _Authorization_ header to retrieve the AuthId--- of request+-- | Decode and check HTTP Basic credentials for one request. ----- This function uses yesod 'cachedAuth' to cache the result of the--- first succesful header lookup.+-- The scheme is case-insensitive and followed by one or more ASCII spaces.+-- Credentials must be strictly Base64-encoded (RFC 4648); malformed input is+-- rejected before invoking the credential checker, not silently repaired. ----- Subsequent calls to 'maybeAuthId' do not require the 'CheckCreds'--- function to be run again.+-- Request-local caching is provided by 'defaultMaybeBasicAuthId'. maybeBasicAuthId   :: (MonadHandler m)   => CheckCreds   -> AuthSettings   -> Request   -> m (Maybe Text)-maybeBasicAuthId checkCreds AuthSettings{..} req =+maybeBasicAuthId checkCreds _ req =     case authorization of       Just (strategy, userpass)         | BS.map toLower strategy == "basic" ->-              authorizeCredentials $ BS.dropWhile isSpace userpass+              authorizeCredentials $ BS.dropWhile (== _space) userpass         | otherwise -> return Nothing       _ -> return Nothing   where-    authorization = BS.break isSpace+    authorization = BS.break (== _space)                     <$> lookup "Authorization" (requestHeaders req)     authorizeCredentials encoded =-      let (username, password') = BS.break (== _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+      case decode encoded of+        Left _ -> return Nothing+        Right decoded ->+          let (username, password') = BS.break (== _colon) decoded+          in case BS.uncons password' of+              Nothing -> return Nothing+              Just (_,password) -> do+                authorized <- liftIO $ checkCreds username password+                return $ if authorized+                           then either (const Nothing) Just $ T.decodeUtf8' username+                           else Nothing

@@ -5,37 +5,126 @@  module YesodAuthHttpBasicSpec where -import           Data.Monoid ((<>))+import           Control.Monad (forM_)+import           Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64 as Base64+import           Data.IORef+import qualified Data.Text.Encoding as T import           Test.Hspec import           Yesod       hiding (get)+import           Yesod.Auth.Http.Basic 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+spec = describe "Yesod HTTP Basic Authentication" $ do+  calls <- runIO $ newIORef 0+  yesodSpec (app calls) $ do+    forM_ validHeaders $ \(label, header, username) ->+      yit label $ do+        liftIO $ writeIORef calls 0+        requestWith $ Just header+        statusIs 200+        bodyEquals username+        -- The handler asks twice, but the checker runs only once per request.+        liftIO $ readIORef calls `shouldReturn` 1 +    forM_ malformedHeaders $ \(label, header) ->+      yit ("rejects " <> label <> " before checking credentials") $ do+        liftIO $ writeIORef calls 0+        requestWith $ Just header+        statusIs 401+        liftIO $ readIORef calls `shouldReturn` 0 +    yit "rejects missing Authorization without checking credentials" $ do+      liftIO $ writeIORef calls 0+      requestWith Nothing+      statusIs 401+      liftIO $ readIORef calls `shouldReturn` 0++    yit "caches a failed credential check within the request" $ do+      liftIO $ writeIORef calls 0+      requestWith $ Just $ basic "user:wrong"+      statusIs 401+      liftIO $ readIORef calls `shouldReturn` 1++    yit "rejects an invalid UTF-8 username even when the checker accepts its bytes" $ do+      liftIO $ writeIORef calls 0+      requestWith $ Just $ basic $ BS.singleton 255 <> ":secret"+      statusIs 401+      liftIO $ readIORef calls `shouldReturn` 1++    yit "does not reuse authentication between HTTP requests" $ do+      liftIO $ writeIORef calls 0+      requestWith $ Just $ basic "user:secret"+      statusIs 200+      requestWith $ Just $ basic "user:secret"+      statusIs 200+      liftIO $ readIORef calls `shouldReturn` 2++validHeaders :: [(String, ByteString, String)]+validHeaders =+  [ ("accepts standard Basic Auth", basic "user:secret", "user")+  , ("accepts a case-insensitive scheme", "bAsIc " <> payload, "user")+  , ("accepts multiple ASCII separator spaces", "Basic   " <> payload, "user")+  , ("preserves colons in the password and accepts Base64 needing no padding", basic "user:se:cret", "user")+  , ("preserves whitespace inside decoded credentials", basic " user : secret ", " user ")+  , ("allows the checker to accept an empty password", basic "user:", "user")+  , ("accepts a UTF-8 username", basic (utf8Username <> ":secret"), "josé")+  ]++malformedHeaders :: [(String, ByteString)]+malformedHeaders =+  [ ("double-quoted tokens", "Basic \"" <> payload <> "\"")+  , ("single-quoted tokens", "Basic '" <> payload <> "'")+  , ("punctuation inside Base64", "Basic " <> BS.take 4 payload <> "!" <> BS.drop 4 payload)+  , ("whitespace inside Base64", "Basic " <> BS.take 4 payload <> " " <> BS.drop 4 payload)+  , ("a tab separator", "Basic\t" <> payload)+  , ("a tab after a separator space", "Basic \t" <> payload)+  , ("a nonbreaking-space separator", "Basic\160" <> payload)+  , ("missing required padding", "Basic " <> BS.takeWhile (/= 61) payload)+  , ("excess padding", "Basic " <> payload <> "=")+  , ("trailing junk after padding", "Basic " <> payload <> "ignored")+  , ("a trailing quote after padding", "Basic " <> payload <> "\"")+  , ("an impossible Base64 length", basic "user:se:cret" <> "A")+  , ("credentials without a colon", basic "user")+  , ("an unsupported scheme", "Bearer " <> payload)+  , ("a missing separator", "Basic" <> payload)+  , ("an empty payload", "Basic ")+  ]++payload :: ByteString+payload = Base64.encode "user:secret"++basic :: ByteString -> ByteString+basic credentials = "Basic " <> Base64.encode credentials++utf8Username :: ByteString+utf8Username = T.encodeUtf8 "josé"++requestWith :: Maybe ByteString -> YesodExample LiteApp ()+requestWith header = request $ do+  setMethod "GET"+  setUrl $ LiteAppRoute []+  forM_ header $ \value -> addRequestHeader ("Authorization", value)++ instance RenderMessage LiteApp FormMessage where   renderMessage _ _ = defaultFormMessage  -app :: LiteApp-app = liteApp $+app :: IORef Int -> LiteApp+app calls = liteApp $   dispatchTo $ do-    mfoo <- lookupGetParam "foo"-    case mfoo of-     Nothing -> return "Hello world!"-     Just foo -> return $ "foo=" <> foo+    first <- defaultMaybeBasicAuthId checkCreds defaultAuthSettings+    second <- defaultMaybeBasicAuthId checkCreds defaultAuthSettings+    case (first, second) of+      (Just username, Just cachedUsername) | username == cachedUsername -> return username+      _ -> notAuthenticated+  where+    checkCreds username password = do+      modifyIORef calls (+ 1)+      return $ (username, password) `elem`+        [ ("user", "secret"), ("user", "se:cret"), (" user ", " secret "), ("user", "")+        , (utf8Username, "secret"), (BS.singleton 255, "secret") ]

@@ -1,47 +1,41 @@  name:                yesod-auth-basic-version:             0.1.0.3+version:             0.2.0.0 license:             BSD3 license-file:        LICENSE+extra-doc-files:     README.md, CHANGELOG.md 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+cabal-version:       2.0+synopsis:            HTTP Basic authentication for Yesod description:- An efficient Yesod middleware middleware for HTTP Basic- Authentication.+ HTTP Basic authentication with an application-supplied credential checker+ and request-local caching of successful and failed authentication results.  .- Utilizes Yesod request-local caching mechanisms to store valid auth- credentials found in the Authorization header.+ See the documentation for Yesod.Auth.Http.Basic for usage examples.+ Route authorization and HTTP challenges are handled by the application.   source-repository head   type:     git-  location: git://github.com/creichert/yesod-auth-basic.git+  location: https://github.com/creichert/yesod-auth-basic.git   library   exposed-modules:     Yesod.Auth.Http.Basic   ghc-options:         -Wall   default-language:    Haskell2010-  build-depends:       base               == 4.*+  build-depends:       base               >= 4.14 && < 5                      , base64-bytestring                      , bytestring-                     , exceptions                      , text                      , yesod                      , wai                      , word8-                     , monad-control -  if impl(ghc < 7.6)-    build-depends:-      iproute < 1.4-- test-suite spec   type:                exitcode-stdio-1.0   main-is:             Spec.hs@@ -49,7 +43,10 @@   other-modules:       YesodAuthHttpBasicSpec   ghc-options:         -Wall -threaded   default-language:    Haskell2010-  build-depends:       base                 == 4.*+  build-tool-depends:  hspec-discover:hspec-discover+  build-depends:       base                 >= 4.14 && < 5+                     , base64-bytestring+                     , bytestring                      , yesod                      , yesod-auth-basic                      , yesod-test