yesod-middleware-csp 1.2.0 → 1.3.0
raw patch · 7 files changed
+96/−96 lines, 7 filesdep +yesod-middleware-cspdep −classy-preludedep −classy-prelude-yesoddep −monad-loggerdep ~basedep ~base64-bytestringdep ~bytestring
Dependencies added: yesod-middleware-csp
Dependencies removed: classy-prelude, classy-prelude-yesod, monad-logger
Dependency ranges changed: base, base64-bytestring, bytestring, conduit, containers, directory, filepath, network-uri, template-haskell, text, time, uuid, wai-extra, yesod-core, yesod-static
Files
- README.md +8/−25
- changelog.md +9/−3
- src/Yesod/Middleware/CSP.hs +17/−13
- test/ExampleApp.hs +10/−9
- test/TestImport.hs +17/−8
- test/Yesod/Middleware/CSPSpec.hs +1/−0
- yesod-middleware-csp.cabal +34/−38
README.md view
@@ -11,42 +11,25 @@ Because there is no good way of enforcing CSP at typelevel in yesod,-It's best to override classy prelude with your-own custom prelude.-This allows hiding the addScript functions from-there with the ones provided by this library:+it's best to hide the addScript functions from+yesod with the ones provided by this library: ```haskell---- | Mirrors classy prelude yesod but with our supercede patches-module Supercede.Prelude.Yesod- ( -- * rexport- module X- -- ** use CSP variant instead of yesod's- , addScriptEither- , addScript- , addScriptRemote- ) where--import Supercede.Prelude as X hiding (delete, deleteBy, Handler (..))-import Yesod as X hiding (addScriptEither, addScript, addScriptRemote, addScriptAttrs, addScriptRemoteAttrs)--import Yesod.Middleware.CSP (addScriptEither, addScript, addScriptRemote)-+import Yesod hiding (addScript, addScriptRemote)+import Yesod.Middleware.CSP (addScript, addScriptRemote, addCSPMiddleware) ``` -Then in hlint you can simply dis-recommend usage of classy prelude:+Then wire up the middleware in your `Yesod` instance: ```haskell-- modules:- - {name: [ClassyPrelude], message: "Use Supercede.Prelude instead"}- - {name: [ClassyPrelude.Yesod], message: "Use Supercede.Prelude.Yesod instead"}+instance Yesod App where+ yesodMiddleware = addCSPMiddleware ``` ## How to run tests ```-cabal configure --enable-tests && cabal build && cabal test+nix build ``` ## Contributing
changelog.md view
@@ -2,17 +2,23 @@ This format is based on [Keep A Changelog](https://keepachangelog.com/en/1.0.0). +## 1.3.0 - 2026-04-28+++ Drop dependency on classy-prelude; use standard Prelude and explicit imports++ Loosen dependency bounds to support GHC 9.6 through 9.10++ Switch build tooling from Stack to Nix flakes++ Fix test suite to depend on the library instead of recompiling sources++ Bump cabal-version to 2.4+ ## 1.2.0 - 2023-06-14 + bump bounds-+ add upperboudns from cabal-gen-bounds++ add upperbounds from cabal-gen-bounds + add stackage ci ## 1.1.0 - 2022-07-15 + Add new directive ManifestSrc--## Unreleased ## 1.0.2 - 2022-07-12
src/Yesod/Middleware/CSP.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-}@@ -26,13 +25,17 @@ , getRequestNonce ) where -import ClassyPrelude import Conduit hiding (Source)+import Control.Monad (when) import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Lazy as L import qualified Data.Map.Strict as M+import Data.Maybe (fromMaybe) import qualified Data.Set as S+import Data.String (IsString(..))+import Data.Text (Text, pack, unpack) import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE import Data.UUID (toASCIIBytes)@@ -40,14 +43,14 @@ import Language.Haskell.TH import Language.Haskell.TH.Syntax as TH import System.Directory-import System.FilePath (takeDirectory)+import System.FilePath (takeDirectory, (</>), (<.>)) import qualified System.FilePath as F-import Yesod.Core(HandlerSite, MonadWidget, MonadHandler, HandlerFor)+import Yesod.Core (HandlerSite, MonadWidget, MonadHandler, HandlerFor) import qualified Yesod.Core as Core import Yesod.Static hiding (CombineSettings, combineScripts', combineStylesheets') -type DirSet = Map Directive (Set Source)+type DirSet = M.Map Directive (S.Set Source) newtype CSPNonce = CSPNonce { unCSPNonce :: Text } deriving (Eq, Ord) @@ -124,19 +127,19 @@ addCSP d s = cachedDirectives >>= Core.cacheSet . M.insertWith insertSource d (S.singleton s) -insertSource :: Set Source -> Set Source -> Set Source+insertSource :: S.Set Source -> S.Set Source -> S.Set Source insertSource a b = case S.toList a of [ None ] -> a _ -> a <> S.filter (`notElem` [None]) b -showSources :: Set Source -> Text+showSources :: S.Set Source -> Text showSources = pack . unwords . map show . S.toList -showDirective :: (Directive, Set Source) -> Text-showDirective (d, s) = tshow d <> " " <> showSources s+showDirective :: (Directive, S.Set Source) -> Text+showDirective (d, s) = pack (show d) <> " " <> showSources s showDirectives :: DirSet -> Text-showDirectives = intercalate "; " . map showDirective . M.toList+showDirectives = T.intercalate "; " . map showDirective . M.toList cspHeaderName :: Text cspHeaderName = "Content-Security-Policy"@@ -145,7 +148,7 @@ augment Nothing d = d augment (Just (CSPNonce n)) d = let srcs = S.fromList [ Nonce n ]- existingScriptSrcs = S.toList (fromMaybe S.empty (lookup ScriptSrc d))+ existingScriptSrcs = S.toList (fromMaybe S.empty (M.lookup ScriptSrc d)) in if any (`elem` existingScriptSrcs) [ None ] then d else M.insertWith insertSource ScriptSrc srcs d@@ -154,8 +157,9 @@ addCSPMiddleware handler = do (r, n) <- (,) <$> handler <*> Core.cacheGet d <- augment n <$> cachedDirectives- when (not (null (showDirectives d))) $- Core.addHeader cspHeaderName (showDirectives d)+ let header = showDirectives d+ when (not (T.null header)) $+ Core.addHeader cspHeaderName header pure r -- | Get a nonce for the request
test/ExampleApp.hs view
@@ -9,7 +9,8 @@ module ExampleApp where -import ClassyPrelude.Yesod hiding (addScript, addScriptRemote)+import Data.Text (Text)+import Yesod hiding (addScript, addScriptRemote) import Yesod.Core.Types (Logger) import Yesod.EmbeddedStatic import Yesod.Middleware.CSP@@ -39,19 +40,19 @@ addCSP ScriptSrc Https addCSP ScriptSrc StrictDynamic addCSP ObjectSrc None- toWidget $ asText ""+ toWidget ("" :: Text) getExample2 :: Handler Html getExample2 = defaultLayout $ do addCSP ScriptSrc None addCSP ScriptSrc Wildcard- toWidget $ asText ""+ toWidget ("" :: Text) getExample3 :: Handler Html getExample3 = defaultLayout $ do addCSP ScriptSrc Wildcard addCSP ScriptSrc None- toWidget $ asText ""+ toWidget ("" :: Text) getExample4 :: Handler Html getExample4 = defaultLayout $ do@@ -59,26 +60,26 @@ addCSP ScriptSrc None addCSP ScriptSrc DataScheme addCSP ScriptSrc Https- toWidget $ asText ""+ toWidget ("" :: Text) getExample5 :: Handler Html getExample5 = defaultLayout $ do addScript $ StaticR js_test_js- toWidget $ asText ""+ toWidget ("" :: Text) getExample6 :: Handler Html getExample6 = defaultLayout $ do addScriptRemote "https://example.com/test.js"- toWidget $ asText ""+ toWidget ("" :: Text) getExample7 :: Handler Html-getExample7 = defaultLayout $ toWidget $ asText ""+getExample7 = defaultLayout $ toWidget ("" :: Text) getExample8 :: Handler Html getExample8 = defaultLayout $ do addScript $ StaticR js_test_js addCSP ScriptSrc None- toWidget $ asText ""+ toWidget ("" :: Text) instance Yesod ExampleApp where yesodMiddleware = addCSPMiddleware
test/TestImport.hs view
@@ -6,12 +6,16 @@ , module X ) where +import qualified Data.ByteString as BS import qualified Data.Map.Strict as M+import Data.Maybe (listToMaybe)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8, decodeUtf8)+import qualified Data.Text as T import qualified System.Log.FastLogger as F import qualified Yesod import qualified Yesod.Default.Config2 as C -import ClassyPrelude as X hiding (Handler, delete, deleteBy) import Data.CaseInsensitive (CI) import ExampleApp as X import Network.Wai.Test (SResponse(..))@@ -24,22 +28,27 @@ logF <- F.newStdoutLoggerSet 1 >>= C.makeYesodLogger pure (ExampleApp logF eStatic, Yesod.defaultMiddlewaresNoLogging) -assertCSP :: HasCallStack => ByteString -> YesodExample site ()+assertCSP :: HasCallStack => BS.ByteString -> YesodExample site () assertCSP = assertHeader "Content-Security-Policy" -lookupResponseHeader :: CI ByteString -> YesodExample site (Maybe ByteString)+lookupResponseHeader :: CI BS.ByteString -> YesodExample site (Maybe BS.ByteString) lookupResponseHeader k = (lookupHeader =<<) <$> getResponse- where lookupHeader = lookup k . M.fromList . simpleHeaders+ where lookupHeader = M.lookup k . M.fromList . simpleHeaders -getNonceFromCSP :: YesodExample site (Maybe ByteString)+getNonceFromCSP :: YesodExample site (Maybe BS.ByteString) getNonceFromCSP = lookupResponseHeader "Content-Security-Policy"- >>= \h -> pure $ filter (isPrefixOf "'nonce-") . words . decodeUtf8 <$> h- >>= fmap (encodeUtf8 . dropEnd 1 . dropPrefix "'nonce-") . headMay+ >>= \h -> pure $ filter (T.isPrefixOf "'nonce-") . T.words . decodeUtf8 <$> h+ >>= fmap (encodeUtf8 . T.dropEnd 1 . dropPrefix "'nonce-") . listToMaybe +dropPrefix :: Text -> Text -> Text+dropPrefix prefix t = case T.stripPrefix prefix t of+ Just rest -> rest+ Nothing -> t+ getAttrFromResponseMatch :: Query -> Text -> YesodExample site (Maybe Text) getAttrFromResponseMatch q a = do body <- getAttr . simpleBody <<$>> getResponse- pure $ body >>= either (const Nothing) headMay >>= headMay+ pure $ body >>= either (const Nothing) listToMaybe >>= listToMaybe where getAttr b = findAttributeBySelector b q a infixl 4 <<$>>
test/Yesod/Middleware/CSPSpec.hs view
@@ -3,6 +3,7 @@ module Yesod.Middleware.CSPSpec (spec) where import Data.Maybe (fromJust)+import Data.Text.Encoding (encodeUtf8) import TestImport spec :: Spec
yesod-middleware-csp.cabal view
@@ -1,6 +1,6 @@-cabal-version: >=1.10+cabal-version: 2.4 name: yesod-middleware-csp-version: 1.2.0+version: 1.3.0 author: Jezen Thomas <jezen@supercede.com> maintainer: Jezen Thomas <jezen@supercede.com> license: MIT@@ -11,74 +11,70 @@ This is done by overriding the default yesod provided addScript functionalities and adding a nonce to the tag, and the right headers to the request.+homepage: https://github.com/SupercedeTech/yesod-middleware-csp+bug-reports: https://github.com/SupercedeTech/yesod-middleware-csp/issues+tested-with: GHC == 9.10.3 -extra-source-files:+extra-doc-files: changelog.md README.md++extra-source-files: test/static/js/*.js category: Web, Yesod synopsis: A middleware for building CSP headers on the fly +source-repository head+ type: git+ location: https://github.com/SupercedeTech/yesod-middleware-csp.git+ library default-language: Haskell2010 hs-source-dirs: src ghc-options: -Wall- default-extensions: NoImplicitPrelude exposed-modules: Yesod.Middleware.CSP build-depends:- base >=4 && <5- , base64-bytestring >=1.0.0 && <1.3- , bytestring >=0.9 && <0.12- , classy-prelude >=1.5.0 && <1.6- , conduit >=1.3.1 && <1.4- , containers >=0.6.0 && <0.7- , directory >=1.3.3 && <1.4- , filepath >=1.4.2 && <1.5- , http-client >=0.6.4 && <0.8- , network-uri >=2.6.1 && <2.7- , template-haskell >=2.14.0 && <3.0- , text >=1.2.3 && <3.0- , time >=1.8.0 && <2.0- , uuid >=1.3.13 && <1.4- , yesod >=1.6.0 && <1.7- , yesod-core >=1.6.16 && <1.7- , yesod-static >=1.6 && <1.7+ base >= 4.14 && < 5+ , base64-bytestring >= 1.0.0 && < 1.3+ , bytestring >= 0.10 && < 0.13+ , containers >= 0.6 && < 0.8+ , conduit >= 1.3.1 && < 1.4+ , directory >= 1.3.3 && < 1.4+ , filepath >= 1.4.2 && < 1.6+ , http-client >= 0.6.4 && < 0.8+ , network-uri >= 2.6.1 && < 2.7+ , template-haskell >= 2.14 && < 2.23+ , text >= 1.2.3 && < 2.2+ , time >= 1.8 && < 1.13+ , uuid >= 1.3.13 && < 1.4+ , yesod >= 1.6.0 && < 1.7+ , yesod-core >= 1.6.16 && < 1.7+ , yesod-static >= 1.6 && < 1.7 test-suite spec type: exitcode-stdio-1.0 default-language: Haskell2010- hs-source-dirs: src test+ hs-source-dirs: test ghc-options: -Wall- default-extensions: NoImplicitPrelude main-is: Spec.hs build-depends: base- , base64-bytestring- , bytestring >=0.9 + , bytestring , case-insensitive- , classy-prelude >=0.10.2- , classy-prelude-yesod >=1.1- , conduit , containers- , directory , fast-logger- , filepath , hspec , http-types- , monad-logger- , network-uri- , template-haskell , text- , uuid- , wai-extra >=3.0+ , wai-extra , yesod- , yesod-core >=1.6.15 - , yesod-static >=1.6 + , yesod-core+ , yesod-static , yesod-test+ , yesod-middleware-csp other-modules: ExampleApp TestImport- Yesod.Middleware.CSP Yesod.Middleware.CSPSpec