yesod-csp (empty) → 0.1.1.0
raw patch · 6 files changed
+339/−0 lines, 6 filesdep +basedep +hspecdep +network-urisetup-changed
Dependencies added: base, hspec, network-uri, semigroups, text, yesod, yesod-core, yesod-csp, yesod-test
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- src/Yesod/Csp.hs +122/−0
- src/Yesod/Csp/Example.hs +100/−0
- test/Test.hs +49/−0
- yesod-csp.cabal +46/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Bob Long++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Yesod/Csp.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Add <http://content-security-policy.com/ CSP> headers to Yesod apps.+-- This helps reduce the risk of exposure to XSS and bad assets.+module Yesod.Csp (+ cspPolicy+ , getCspPolicy+ , DirectiveList+ , Directive(..)+ , SourceList+ , Source(..)+ , SandboxOptions(..)+ ) where++import Data.List.NonEmpty+import Data.Text hiding (filter, null)+import qualified Data.Text as T+import Network.URI+import Yesod.Core++-- | Adds a "Content-Security-Policy" header to your response.+--+-- > getExample1R :: Handler Html+-- > getExample1R = do+-- > -- only allow scripts from my website+-- > cspPolicy [ScriptSrc (Self :| [])]+-- > defaultLayout $ do+-- > addScriptRemote "http://httpbin.org/i_am_external"+-- > [whamlet|hello|]+--+cspPolicy :: (MonadHandler m) => DirectiveList -> m ()+cspPolicy = addHeader "Content-Security-Policy" . directiveListToHeader++-- | Returns a generated Content-Security-Policy header.+getCspPolicy :: DirectiveList -> Text+getCspPolicy = directiveListToHeader++withSpaces :: [Text] -> Text+withSpaces = T.intercalate " "++w :: Text -> SourceList -> Text+w = wrap++wrap :: Text -> SourceList -> Text+wrap k x = mconcat [k, " ", textSourceList x]++-- | Represents a location from which assets may be loaded.+data Source = Wildcard+ | None+ | Self+ | DataScheme+ | Host URI+ | Https+ | UnsafeInline+ | UnsafeEval deriving (Eq)++-- | A list of allowed sources for a directive.+type SourceList = NonEmpty Source++textSource :: Source -> Text+textSource Wildcard = "*"+textSource None = "'none'"+textSource Self = "'self'"+textSource DataScheme = "data:"+textSource (Host x) = (pack . show) x+textSource Https = "https:"+textSource UnsafeInline = "'unsafe-inline'"+textSource UnsafeEval = "'unsafe-eval'"++textSourceList :: SourceList -> Text+textSourceList = withSpaces . toList . filtered+ where filtered = fmap textSource . filterOut++-- * and none should be alone if present+filterOut :: SourceList -> SourceList+filterOut x | Wildcard `elem` x = Wildcard :| []+filterOut x | None `elem` x = None :| []+ | otherwise = x++-- | A list of restrictions to apply.+type DirectiveList = [Directive]++-- | A restriction on how assets can be loaded.+-- For example @ImgSrc@ concerns where images may be loaded from.+data Directive = DefaultSrc SourceList+ | ScriptSrc SourceList+ | StyleSrc SourceList+ | ImgSrc SourceList+ | ConnectSrc SourceList+ | FontSrc SourceList+ | ObjectSrc SourceList+ | MediaSrc SourceList+ | FrameSrc SourceList+ -- | Applies a sandbox to the result. <http://content-security-policy.com/ See here> for more info.+ | Sandbox [SandboxOptions]+ | ReportUri URI++-- | Configuration options for the sandbox.+data SandboxOptions = AllowForms+ | AllowScripts+ | AllowSameOrigin+ | AllowTopNavigation++directiveListToHeader :: DirectiveList -> Text+directiveListToHeader = T.intercalate "; " . fmap textDirective++textDirective :: Directive -> Text+textDirective (DefaultSrc x) = w "default-src" x+textDirective (ScriptSrc x) = w "script-src" x+textDirective (StyleSrc x) = w "style-src" x+textDirective (ImgSrc x) = w "img-src" x+textDirective (ConnectSrc x) = w "connect-src" x+textDirective (FontSrc x) = w "font-src" x+textDirective (ObjectSrc x) = w "object-src" x+textDirective (MediaSrc x) = w "media-src" x+textDirective (FrameSrc x) = w "frame-src" x+textDirective (ReportUri t) = mconcat ["report-uri ", (pack . show) t]+textDirective (Sandbox []) = "sandbox"+textDirective (Sandbox s) = mconcat ["sandbox ", withSpaces . fmap textSandbox $ s]+ where textSandbox AllowForms = "allow-forms"+ textSandbox AllowScripts = "allow-scripts"+ textSandbox AllowSameOrigin = "allow-same-origin"+ textSandbox AllowTopNavigation = "allow-top-navigation"
+ src/Yesod/Csp/Example.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+-- | Assorted examples demonstrating different policies.+module Yesod.Csp.Example where++import Data.List.NonEmpty+import Data.Maybe+import Network.URI+import Yesod hiding (get)+import Yesod.Csp++data Example = Example+mkYesod "Example" [parseRoutes|+ /1 Example1R GET+ /2 Example2R GET+ /3 Example3R GET+ /4 Example4R GET+ /5 Example5R GET+ /6 Example6R GET+ /7 Example7R GET POST+|]++instance Yesod Example++-- | Allows scripts from self.+getExample1R :: Handler Html+getExample1R = do+ cspPolicy [ScriptSrc (Self :| [])]+ defaultLayout $ do+ addScriptRemote "http://httpbin.org/i_am_external"+ [whamlet|hello|]++-- | Allows all styles over https.+getExample2R :: Handler Html+getExample2R = do+ cspPolicy [StyleSrc (Https :| [])]+ defaultLayout $ do+ addStylesheetRemote "http://httpbin.org/i_am_not_https"+ [whamlet|hello|]++-- | Allows images from a certain uri.+getExample3R :: Handler Html+getExample3R = do+ let dom = fromJust (parseURI "http://httpbin.org")+ cspPolicy [ImgSrc (Host dom :| [])]+ defaultLayout $+ [whamlet|+ <img src="http://httpbin.org/image">+ <!-- different scheme should not work: -->+ <img src="https://httpbin.org/image">+ |]++-- | Allows all images.+getExample4R :: Handler Html+getExample4R = do+ cspPolicy [ImgSrc (Wildcard :| [])]+ defaultLayout $+ [whamlet|+ <img src="http://httpbin.org/image">+ |]++-- | Disallows images entirely.+getExample5R :: Handler Html+getExample5R = do+ cspPolicy [ImgSrc (None :| [])]+ defaultLayout $+ [whamlet|+ <img src="http://httpbin.org/image">+ |]++-- | Blocks forms from being submitted+getExample6R :: Handler Html+getExample6R = do+ cspPolicy [Sandbox []]+ defaultLayout $+ [whamlet|+ <form method="post">+ <input type="submit">+ |]++getExample7R :: Handler Html+getExample7R = do+ cspPolicy [Sandbox [AllowForms]]+ defaultLayout $+ [whamlet|+ <form method="post">+ <input type="submit">+ |]++postExample7R :: Handler Html+postExample7R = do+ cspPolicy [Sandbox [AllowForms]]+ defaultLayout $+ [whamlet|yayyy|]++-- | Run a webserver to serve these examples at /1, /2, etc.+runExamples :: IO ()+runExamples = warp 4567 Example
+ test/Test.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++import Data.List.NonEmpty+import Data.Maybe+import Network.URI+import Test.Hspec+import Yesod hiding (get)+import Yesod.Csp+import Yesod.Test++data Test = Test+mkYesod "Test" [parseRoutes| / HomeR GET |]++instance Yesod Test++getHomeR :: Handler Html+getHomeR = do+ cspPolicy [ScriptSrc (Self :| []), StyleSrc (Https :| [Self])]+ defaultLayout [whamlet|hello|]++main :: IO ()+main = hspec $ yesodSpec Test $ do+ ydescribe "Generation" $ do+ yit "works" $ do+ let header = getCspPolicy [ScriptSrc (Self :| []), StyleSrc (Https :| [Self])]+ assertEqual "simple header" header "script-src 'self'; style-src https: 'self'"+ yit "works with domains" $ do+ let dom = fromJust $ parseURI "https://foo.com"+ header = getCspPolicy [ScriptSrc (Host dom :| [])]+ assertEqual "foo.com script-src" header "script-src https://foo.com"+ yit "works with report_uri" $ do+ let dom = fromJust $ parseURI "https://foo.com"+ header = getCspPolicy [ReportUri dom]+ assertEqual "report-uri" header "report-uri https://foo.com"+ ydescribe "Headers" $+ yit "get set" $ do+ get HomeR+ assertHeader "Content-Security-Policy" "script-src 'self'; style-src https: 'self'"+ ydescribe "Sandboxes" $ do+ yit "works when empty" $ do+ let header = getCspPolicy [Sandbox []]+ assertEqual "empty sandbox" header "sandbox"+ yit "works when not empty" $ do+ let header = getCspPolicy [Sandbox [AllowForms, AllowScripts]]+ assertEqual "empty sandbox" header "sandbox allow-forms allow-scripts"
+ yesod-csp.cabal view
@@ -0,0 +1,46 @@+-- Initial yesod-csp.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: yesod-csp+version: 0.1.1.0+synopsis: Add CSP headers to Yesod apps+description: Add CSP headers to Yesod apps. This helps reduce exposure to XSS attacks and bad assets.+license: MIT+license-file: LICENSE+author: Bob Long+maintainer: robertjflong@gmail.com+category: Web+build-type: Simple+cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/bobjflong/yesod-csp.git++library+ exposed-modules: Yesod.Csp+ , Yesod.Csp.Example+ -- other-extensions: + build-depends: base < 5+ , text+ , yesod-core+ , semigroups+ , network-uri+ , yesod+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall++test-suite tests+ ghc-options: -Wall+ type: exitcode-stdio-1.0+ main-is: Test.hs+ hs-source-dirs: test+ build-depends: base+ , yesod-csp+ , yesod-test+ , semigroups+ , yesod+ , hspec+ , network-uri+ default-language: Haskell2010