diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md index 2b991735..ba1aa905 100644 --- a/yesod-test/ChangeLog.md +++ b/yesod-test/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-test +## 1.6.7 + +Add `addBasicAuthHeader` function [#1632](https://github.com/yesodweb/yesod/pull/1632) + ## 1.6.6.2 addPostParam will now URL-encode keys and values to prevent corruption diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 79640a32..b7a176ed 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -66,6 +66,7 @@ module Yesod.Test , getLocation , request , addRequestHeader + , addBasicAuthHeader , setMethod , addPostParam , addGetParam @@ -156,6 +157,7 @@ import qualified Network.Socket.Internal as Sock #endif import Data.CaseInsensitive (CI) +import qualified Data.CaseInsensitive as CI import Network.Wai import Network.Wai.Test hiding (assertHeader, assertNoHeader, request) import Control.Monad.Trans.Reader (ReaderT (..)) @@ -189,6 +191,7 @@ type HasCallStack = (?callStack :: CallStack) import GHC.Exts (Constraint) type HasCallStack = (() :: Constraint) #endif +import Data.ByteArray.Encoding (convertToBase, Base(..)) {-# DEPRECATED byLabel "This function seems to have multiple bugs (ref: https://github.com/yesodweb/yesod/pull/1459). Use byLabelExact, byLabelContain, byLabelPrefix or byLabelSuffix instead" #-} {-# DEPRECATED fileByLabel "This function seems to have multiple bugs (ref: https://github.com/yesodweb/yesod/pull/1459). Use fileByLabelExact, fileByLabelContain, fileByLabelPrefix or fileByLabelSuffix instead" #-} @@ -1144,6 +1147,21 @@ addRequestHeader header = modifySIO $ \rbd -> rbd { rbdHeaders = header : rbdHeaders rbd } +-- | Adds a header for to the request +-- +-- ==== __Examples__ +-- +-- > request $ do +-- > addBasicAuthHeader "Aladdin" "OpenSesame" +-- +-- @since 1.6.7 +addBasicAuthHeader :: CI ByteString -- ^ Username + -> CI ByteString -- ^ Password + -> RequestBuilder site () +addBasicAuthHeader username password = + let credentials = convertToBase Base64 $ CI.original $ username <> ":" <> password + in addRequestHeader ("Authorization", "Basic " <> credentials) + -- | The general interface for performing requests. 'request' takes a 'RequestBuilder', -- constructs a request, and executes it. -- diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index d58a96e2..2d76c8ef 100644 --- a/yesod-test/test/main.hs +++ b/yesod-test/test/main.hs @@ -38,7 +38,7 @@ import Data.Either (isLeft, isRight) import Data.ByteString.Lazy.Char8 () import qualified Data.Map as Map import qualified Text.HTML.DOM as HD -import Network.HTTP.Types.Status (status301, status303, status422, unsupportedMediaType415) +import Network.HTTP.Types.Status (status301, status303, status403, status422, unsupportedMediaType415) import UnliftIO.Exception (tryAny, SomeException, try) import qualified Web.Cookie as Cookie import Data.Maybe (isNothing) @@ -444,6 +444,21 @@ main = hspec $ do loc <- getLocation liftIO $ assertBool "expected a Left when not a redirect" $ isLeft loc + describe "Basic Authentication" $ yesodSpec app $ do + yit "rejects no header" $ do + get ("checkBasicAuth" :: Text) + statusIs 403 + yit "rejects incorrect header" $ do + request $ do + setUrl ("checkBasicAuth" :: Text) + addBasicAuthHeader "Aladdin" "foo" + statusIs 403 + yit "accepts correct header" $ do + request $ do + setUrl ("checkBasicAuth" :: Text) + addBasicAuthHeader "Aladdin" "OpenSesame" + statusIs 200 + instance RenderMessage LiteApp FormMessage where renderMessage _ _ = defaultFormMessage @@ -530,6 +545,14 @@ app = liteApp $ do if actual == expected then return () else sendResponseStatus unsupportedMediaType415 () + onStatic "checkBasicAuth" $ dispatchTo $ do + headers <- requestHeaders <$> waiRequest + let authHeader = lookup "Authorization" headers + + -- Copied from the Wikipedia Aladdin:OpenSesame example + if authHeader == Just "Basic QWxhZGRpbjpPcGVuU2VzYW1l" + then return () + else sendResponseStatus status403 () cookieApp :: LiteApp cookieApp = liteApp $ do diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index c712e2b2..24ac3208 100644 --- a/yesod-test/yesod-test.cabal +++ b/yesod-test/yesod-test.cabal @@ -1,5 +1,5 @@ name: yesod-test -version: 1.6.6.2 +version: 1.6.7 license: MIT license-file: LICENSE author: Nubis @@ -28,6 +28,7 @@ library , html-conduit >= 0.1 , http-types >= 0.7 , network >= 2.2 + , memory , pretty-show >= 1.6 , semigroups , text