diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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 diff --git a/src/Yesod/Middleware/CSP.hs b/src/Yesod/Middleware/CSP.hs --- a/src/Yesod/Middleware/CSP.hs +++ b/src/Yesod/Middleware/CSP.hs @@ -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 diff --git a/test/ExampleApp.hs b/test/ExampleApp.hs --- a/test/ExampleApp.hs +++ b/test/ExampleApp.hs @@ -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 diff --git a/test/TestImport.hs b/test/TestImport.hs --- a/test/TestImport.hs +++ b/test/TestImport.hs @@ -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 <<$>> diff --git a/test/Yesod/Middleware/CSPSpec.hs b/test/Yesod/Middleware/CSPSpec.hs --- a/test/Yesod/Middleware/CSPSpec.hs +++ b/test/Yesod/Middleware/CSPSpec.hs @@ -3,6 +3,7 @@ module Yesod.Middleware.CSPSpec (spec) where import Data.Maybe (fromJust) +import Data.Text.Encoding (encodeUtf8) import TestImport spec :: Spec diff --git a/yesod-middleware-csp.cabal b/yesod-middleware-csp.cabal --- a/yesod-middleware-csp.cabal +++ b/yesod-middleware-csp.cabal @@ -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 maintainer: Jezen Thomas 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