{-# LANGUAGE DeriveDataTypeable #-}
{-# 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
  , cspMiddleware
  , EscapedURI
  , escapeAndParseURI
  , escapedTextForNonce
  , nonce
  , DirectiveList
  , Directive(..)
  , SourceList
  , Source(..)
  , SandboxOptions(..)
  , textSource
  ) where

import qualified Data.CaseInsensitive as CI
import           Data.Data          (Data)
import           Data.List.NonEmpty
import           Data.Text          (Text)
import qualified Data.Text          as T
import qualified Data.Text.Encoding as TE
import           Data.Typeable      (Typeable)
import           Network.URI
import           Yesod.Core
import           Network.Wai        (Middleware, mapResponseHeaders,
                                     modifyResponse)

-- | 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 :: forall (m :: * -> *). MonadHandler m => DirectiveList -> m ()
cspPolicy = Text -> Text -> m ()
forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
addHeader Text
cspHeaderName (Text -> m ()) -> (DirectiveList -> Text) -> DirectiveList -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectiveList -> Text
directiveListToHeader

cspHeaderName :: Text
cspHeaderName :: Text
cspHeaderName = Text
"Content-Security-Policy"

-- | Returns a generated Content-Security-Policy header.
getCspPolicy :: DirectiveList -> Text
getCspPolicy :: DirectiveList -> Text
getCspPolicy = DirectiveList -> Text
directiveListToHeader

-- | Creates a WAI 'Middleware' to add a Content-Security-Policy
-- header to every response.
cspMiddleware :: DirectiveList -> Middleware
cspMiddleware :: DirectiveList -> Middleware
cspMiddleware = Header -> Middleware
addHeaderMiddleware (Header -> Middleware)
-> (DirectiveList -> Header) -> DirectiveList -> Middleware
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Header
mkHeader (Text -> Header)
-> (DirectiveList -> Text) -> DirectiveList -> Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectiveList -> Text
directiveListToHeader
  where
    addHeaderMiddleware :: Header -> Middleware
addHeaderMiddleware = (Response -> Response) -> Middleware
modifyResponse ((Response -> Response) -> Middleware)
-> (Header -> Response -> Response) -> Header -> Middleware
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ResponseHeaders -> ResponseHeaders) -> Response -> Response
mapResponseHeaders ((ResponseHeaders -> ResponseHeaders) -> Response -> Response)
-> (Header -> ResponseHeaders -> ResponseHeaders)
-> Header
-> Response
-> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Header -> ResponseHeaders -> ResponseHeaders
forall a. Int -> a -> [a] -> [a]
insertAt Int
5
    mkHeader :: Text -> Header
mkHeader Text
dltext = (CI ByteString
cspHeaderNameBS, Text -> ByteString
TE.encodeUtf8 Text
dltext)
    cspHeaderNameBS :: CI ByteString
cspHeaderNameBS = ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
cspHeaderName

insertAt :: Int -> a -> [a] -> [a]
insertAt :: forall a. Int -> a -> [a] -> [a]
insertAt Int
n a
x [a]
xs =
  let ([a]
h, [a]
t) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
Prelude.splitAt Int
n [a]
xs
  in [a]
h [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
t

newtype EscapedURI = EscapedURI { EscapedURI -> URI
uri :: URI } deriving (EscapedURI -> EscapedURI -> Bool
(EscapedURI -> EscapedURI -> Bool)
-> (EscapedURI -> EscapedURI -> Bool) -> Eq EscapedURI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EscapedURI -> EscapedURI -> Bool
== :: EscapedURI -> EscapedURI -> Bool
$c/= :: EscapedURI -> EscapedURI -> Bool
/= :: EscapedURI -> EscapedURI -> Bool
Eq, Typeable EscapedURI
Typeable EscapedURI
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> EscapedURI -> c EscapedURI)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EscapedURI)
-> (EscapedURI -> Constr)
-> (EscapedURI -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EscapedURI))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c EscapedURI))
-> ((forall b. Data b => b -> b) -> EscapedURI -> EscapedURI)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> EscapedURI -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> EscapedURI -> r)
-> (forall u. (forall d. Data d => d -> u) -> EscapedURI -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EscapedURI -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> EscapedURI -> m EscapedURI)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EscapedURI -> m EscapedURI)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EscapedURI -> m EscapedURI)
-> Data EscapedURI
EscapedURI -> Constr
EscapedURI -> DataType
(forall b. Data b => b -> b) -> EscapedURI -> EscapedURI
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EscapedURI -> u
forall u. (forall d. Data d => d -> u) -> EscapedURI -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EscapedURI -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EscapedURI -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EscapedURI -> m EscapedURI
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EscapedURI -> m EscapedURI
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EscapedURI
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EscapedURI -> c EscapedURI
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EscapedURI)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EscapedURI)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EscapedURI -> c EscapedURI
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EscapedURI -> c EscapedURI
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EscapedURI
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EscapedURI
$ctoConstr :: EscapedURI -> Constr
toConstr :: EscapedURI -> Constr
$cdataTypeOf :: EscapedURI -> DataType
dataTypeOf :: EscapedURI -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EscapedURI)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EscapedURI)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EscapedURI)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EscapedURI)
$cgmapT :: (forall b. Data b => b -> b) -> EscapedURI -> EscapedURI
gmapT :: (forall b. Data b => b -> b) -> EscapedURI -> EscapedURI
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EscapedURI -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EscapedURI -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EscapedURI -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EscapedURI -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EscapedURI -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> EscapedURI -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EscapedURI -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EscapedURI -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EscapedURI -> m EscapedURI
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EscapedURI -> m EscapedURI
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EscapedURI -> m EscapedURI
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EscapedURI -> m EscapedURI
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EscapedURI -> m EscapedURI
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EscapedURI -> m EscapedURI
Data, Typeable)

newtype EscapedText = EscapedText { EscapedText -> String
text :: String } deriving (EscapedText -> EscapedText -> Bool
(EscapedText -> EscapedText -> Bool)
-> (EscapedText -> EscapedText -> Bool) -> Eq EscapedText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EscapedText -> EscapedText -> Bool
== :: EscapedText -> EscapedText -> Bool
$c/= :: EscapedText -> EscapedText -> Bool
/= :: EscapedText -> EscapedText -> Bool
Eq, Typeable EscapedText
Typeable EscapedText
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> EscapedText -> c EscapedText)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EscapedText)
-> (EscapedText -> Constr)
-> (EscapedText -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EscapedText))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c EscapedText))
-> ((forall b. Data b => b -> b) -> EscapedText -> EscapedText)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> EscapedText -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> EscapedText -> r)
-> (forall u. (forall d. Data d => d -> u) -> EscapedText -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EscapedText -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> EscapedText -> m EscapedText)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EscapedText -> m EscapedText)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EscapedText -> m EscapedText)
-> Data EscapedText
EscapedText -> Constr
EscapedText -> DataType
(forall b. Data b => b -> b) -> EscapedText -> EscapedText
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EscapedText -> u
forall u. (forall d. Data d => d -> u) -> EscapedText -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EscapedText -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EscapedText -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EscapedText -> m EscapedText
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EscapedText -> m EscapedText
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EscapedText
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EscapedText -> c EscapedText
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EscapedText)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EscapedText)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EscapedText -> c EscapedText
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EscapedText -> c EscapedText
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EscapedText
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EscapedText
$ctoConstr :: EscapedText -> Constr
toConstr :: EscapedText -> Constr
$cdataTypeOf :: EscapedText -> DataType
dataTypeOf :: EscapedText -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EscapedText)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EscapedText)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EscapedText)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EscapedText)
$cgmapT :: (forall b. Data b => b -> b) -> EscapedText -> EscapedText
gmapT :: (forall b. Data b => b -> b) -> EscapedText -> EscapedText
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EscapedText -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EscapedText -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EscapedText -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EscapedText -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EscapedText -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> EscapedText -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EscapedText -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EscapedText -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EscapedText -> m EscapedText
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EscapedText -> m EscapedText
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EscapedText -> m EscapedText
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EscapedText -> m EscapedText
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EscapedText -> m EscapedText
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EscapedText -> m EscapedText
Data, Typeable)

instance Show EscapedURI where
  show :: EscapedURI -> String
show EscapedURI
x = URI -> String
forall a. Show a => a -> String
show (EscapedURI -> URI
uri EscapedURI
x)

instance Show EscapedText where
  show :: EscapedText -> String
show EscapedText
x = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"'nonce-", EscapedText -> String
text EscapedText
x, String
"'"]

toEscape :: String
toEscape :: String
toEscape = String
";'* "

notEscapable :: Char -> Bool
notEscapable :: Char -> Bool
notEscapable = Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> Bool) -> String -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
toEscape

-- | Escapes ';' '\'' and ' ', and parses to URI
escapeAndParseURI :: Text -> Maybe EscapedURI
escapeAndParseURI :: Text -> Maybe EscapedURI
escapeAndParseURI = (URI -> EscapedURI) -> Maybe URI -> Maybe EscapedURI
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap URI -> EscapedURI
EscapedURI (Maybe URI -> Maybe EscapedURI)
-> (Text -> Maybe URI) -> Text -> Maybe EscapedURI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe URI
parseURI (String -> Maybe URI) -> (Text -> String) -> Text -> Maybe URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
escapeURIString Char -> Bool
notEscapable ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | Escapes Text to be a valid nonce value
escapedTextForNonce :: String -> EscapedText
escapedTextForNonce :: String -> EscapedText
escapedTextForNonce = String -> EscapedText
EscapedText (String -> EscapedText) -> ShowS -> String -> EscapedText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter Char -> Bool
notEscapable

-- | Escapes a Text value, returning a valid Nonce
nonce :: Text -> Source
nonce :: Text -> Source
nonce = EscapedText -> Source
Nonce (EscapedText -> Source) -> (Text -> EscapedText) -> Text -> Source
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EscapedText
escapedTextForNonce (String -> EscapedText) -> (Text -> String) -> Text -> EscapedText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

directiveListToHeader :: DirectiveList -> Text
directiveListToHeader :: DirectiveList -> Text
directiveListToHeader = Text -> [Text] -> Text
T.intercalate Text
"; " ([Text] -> Text)
-> (DirectiveList -> [Text]) -> DirectiveList -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Directive -> Text) -> DirectiveList -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Directive -> Text
textDirective

w :: Text -> SourceList -> Text
w :: Text -> SourceList -> Text
w = Text -> SourceList -> Text
wrap

wrap :: Text -> SourceList -> Text
wrap :: Text -> SourceList -> Text
wrap Text
k SourceList
x = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
k, Text
" ", SourceList -> Text
textSourceList SourceList
x]

textSourceList :: SourceList -> Text
textSourceList :: SourceList -> Text
textSourceList = [Text] -> Text
T.unwords ([Text] -> Text) -> (SourceList -> [Text]) -> SourceList -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
toList (NonEmpty Text -> [Text])
-> (SourceList -> NonEmpty Text) -> SourceList -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceList -> NonEmpty Text
filtered
  where filtered :: SourceList -> NonEmpty Text
filtered = (Source -> Text) -> SourceList -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Source -> Text
textSource (SourceList -> NonEmpty Text)
-> (SourceList -> SourceList) -> SourceList -> NonEmpty Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceList -> SourceList
filterOut

-- * and none should be alone if present
filterOut :: SourceList -> SourceList
filterOut :: SourceList -> SourceList
filterOut SourceList
x | Source
Wildcard Source -> SourceList -> Bool
forall a. Eq a => a -> NonEmpty a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` SourceList
x = Source
Wildcard Source -> [Source] -> SourceList
forall a. a -> [a] -> NonEmpty a
:| []
filterOut SourceList
x | Source
None Source -> SourceList -> Bool
forall a. Eq a => a -> NonEmpty a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` SourceList
x = Source
None Source -> [Source] -> SourceList
forall a. a -> [a] -> NonEmpty a
:| []
            | Bool
otherwise = SourceList
x

-- | Represents a location from which assets may be loaded.
data Source = Wildcard
              | None
              | Self
              | DataScheme
              | Host EscapedURI
              | Https
              | UnsafeInline
              | UnsafeEval
              | StrictDynamic
              | Nonce EscapedText
              | MetaSource Text deriving (Source -> Source -> Bool
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
/= :: Source -> Source -> Bool
Eq, Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
(Int -> Source -> ShowS)
-> (Source -> String) -> ([Source] -> ShowS) -> Show Source
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Source -> ShowS
showsPrec :: Int -> Source -> ShowS
$cshow :: Source -> String
show :: Source -> String
$cshowList :: [Source] -> ShowS
showList :: [Source] -> ShowS
Show, Typeable Source
Typeable Source
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Source -> c Source)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Source)
-> (Source -> Constr)
-> (Source -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Source))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Source))
-> ((forall b. Data b => b -> b) -> Source -> Source)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Source -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Source -> r)
-> (forall u. (forall d. Data d => d -> u) -> Source -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Source -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Source -> m Source)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Source -> m Source)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Source -> m Source)
-> Data Source
Source -> Constr
Source -> DataType
(forall b. Data b => b -> b) -> Source -> Source
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Source -> u
forall u. (forall d. Data d => d -> u) -> Source -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Source -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Source -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Source -> m Source
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Source -> m Source
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Source
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Source -> c Source
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Source)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Source)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Source -> c Source
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Source -> c Source
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Source
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Source
$ctoConstr :: Source -> Constr
toConstr :: Source -> Constr
$cdataTypeOf :: Source -> DataType
dataTypeOf :: Source -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Source)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Source)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Source)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Source)
$cgmapT :: (forall b. Data b => b -> b) -> Source -> Source
gmapT :: (forall b. Data b => b -> b) -> Source -> Source
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Source -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Source -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Source -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Source -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Source -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Source -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Source -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Source -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Source -> m Source
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Source -> m Source
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Source -> m Source
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Source -> m Source
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Source -> m Source
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Source -> m Source
Data, Typeable)

-- | A list of allowed sources for a directive.
type SourceList = NonEmpty Source

textSource :: Source -> Text
textSource :: Source -> Text
textSource Source
Wildcard = Text
"*"
textSource Source
None = Text
"'none'"
textSource Source
Self = Text
"'self'"
textSource Source
DataScheme = Text
"data:"
textSource (Host EscapedURI
x) = (String -> Text
T.pack (String -> Text) -> (EscapedURI -> String) -> EscapedURI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EscapedURI -> String
forall a. Show a => a -> String
show) EscapedURI
x
textSource Source
Https = Text
"https:"
textSource Source
UnsafeInline = Text
"'unsafe-inline'"
textSource Source
UnsafeEval = Text
"'unsafe-eval'"
textSource Source
StrictDynamic = Text
"'strict-dynamic'"
textSource (MetaSource Text
_) = Text
""
textSource (Nonce EscapedText
x) = (String -> Text
T.pack (String -> Text) -> (EscapedText -> String) -> EscapedText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EscapedText -> String
forall a. Show a => a -> String
show) EscapedText
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
                 | FrameAncestors SourceList
                 -- | Applies a sandbox to the result. <http://content-security-policy.com/ See here> for more info.
                 | Sandbox [SandboxOptions]
                 | ReportUri EscapedURI deriving (Directive -> Directive -> Bool
(Directive -> Directive -> Bool)
-> (Directive -> Directive -> Bool) -> Eq Directive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Directive -> Directive -> Bool
== :: Directive -> Directive -> Bool
$c/= :: Directive -> Directive -> Bool
/= :: Directive -> Directive -> Bool
Eq, Int -> Directive -> ShowS
DirectiveList -> ShowS
Directive -> String
(Int -> Directive -> ShowS)
-> (Directive -> String)
-> (DirectiveList -> ShowS)
-> Show Directive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Directive -> ShowS
showsPrec :: Int -> Directive -> ShowS
$cshow :: Directive -> String
show :: Directive -> String
$cshowList :: DirectiveList -> ShowS
showList :: DirectiveList -> ShowS
Show, Typeable Directive
Typeable Directive
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Directive -> c Directive)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Directive)
-> (Directive -> Constr)
-> (Directive -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Directive))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Directive))
-> ((forall b. Data b => b -> b) -> Directive -> Directive)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Directive -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Directive -> r)
-> (forall u. (forall d. Data d => d -> u) -> Directive -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Directive -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Directive -> m Directive)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Directive -> m Directive)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Directive -> m Directive)
-> Data Directive
Directive -> Constr
Directive -> DataType
(forall b. Data b => b -> b) -> Directive -> Directive
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Directive -> u
forall u. (forall d. Data d => d -> u) -> Directive -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Directive -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Directive -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Directive -> m Directive
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Directive -> m Directive
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Directive
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Directive -> c Directive
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Directive)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Directive)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Directive -> c Directive
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Directive -> c Directive
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Directive
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Directive
$ctoConstr :: Directive -> Constr
toConstr :: Directive -> Constr
$cdataTypeOf :: Directive -> DataType
dataTypeOf :: Directive -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Directive)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Directive)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Directive)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Directive)
$cgmapT :: (forall b. Data b => b -> b) -> Directive -> Directive
gmapT :: (forall b. Data b => b -> b) -> Directive -> Directive
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Directive -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Directive -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Directive -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Directive -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Directive -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Directive -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Directive -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Directive -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Directive -> m Directive
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Directive -> m Directive
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Directive -> m Directive
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Directive -> m Directive
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Directive -> m Directive
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Directive -> m Directive
Data, Typeable)

-- | Configuration options for the sandbox.
data SandboxOptions = AllowForms
                      | AllowScripts
                      | AllowSameOrigin
                      | AllowTopNavigation deriving (SandboxOptions -> SandboxOptions -> Bool
(SandboxOptions -> SandboxOptions -> Bool)
-> (SandboxOptions -> SandboxOptions -> Bool) -> Eq SandboxOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SandboxOptions -> SandboxOptions -> Bool
== :: SandboxOptions -> SandboxOptions -> Bool
$c/= :: SandboxOptions -> SandboxOptions -> Bool
/= :: SandboxOptions -> SandboxOptions -> Bool
Eq, Int -> SandboxOptions -> ShowS
[SandboxOptions] -> ShowS
SandboxOptions -> String
(Int -> SandboxOptions -> ShowS)
-> (SandboxOptions -> String)
-> ([SandboxOptions] -> ShowS)
-> Show SandboxOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SandboxOptions -> ShowS
showsPrec :: Int -> SandboxOptions -> ShowS
$cshow :: SandboxOptions -> String
show :: SandboxOptions -> String
$cshowList :: [SandboxOptions] -> ShowS
showList :: [SandboxOptions] -> ShowS
Show, Typeable SandboxOptions
Typeable SandboxOptions
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SandboxOptions -> c SandboxOptions)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SandboxOptions)
-> (SandboxOptions -> Constr)
-> (SandboxOptions -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SandboxOptions))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SandboxOptions))
-> ((forall b. Data b => b -> b)
    -> SandboxOptions -> SandboxOptions)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SandboxOptions -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SandboxOptions -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SandboxOptions -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SandboxOptions -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SandboxOptions -> m SandboxOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SandboxOptions -> m SandboxOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SandboxOptions -> m SandboxOptions)
-> Data SandboxOptions
SandboxOptions -> Constr
SandboxOptions -> DataType
(forall b. Data b => b -> b) -> SandboxOptions -> SandboxOptions
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SandboxOptions -> u
forall u. (forall d. Data d => d -> u) -> SandboxOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SandboxOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SandboxOptions -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SandboxOptions -> m SandboxOptions
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SandboxOptions -> m SandboxOptions
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SandboxOptions
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SandboxOptions -> c SandboxOptions
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SandboxOptions)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SandboxOptions)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SandboxOptions -> c SandboxOptions
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SandboxOptions -> c SandboxOptions
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SandboxOptions
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SandboxOptions
$ctoConstr :: SandboxOptions -> Constr
toConstr :: SandboxOptions -> Constr
$cdataTypeOf :: SandboxOptions -> DataType
dataTypeOf :: SandboxOptions -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SandboxOptions)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SandboxOptions)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SandboxOptions)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SandboxOptions)
$cgmapT :: (forall b. Data b => b -> b) -> SandboxOptions -> SandboxOptions
gmapT :: (forall b. Data b => b -> b) -> SandboxOptions -> SandboxOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SandboxOptions -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SandboxOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SandboxOptions -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SandboxOptions -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SandboxOptions -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SandboxOptions -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SandboxOptions -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SandboxOptions -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SandboxOptions -> m SandboxOptions
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SandboxOptions -> m SandboxOptions
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SandboxOptions -> m SandboxOptions
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SandboxOptions -> m SandboxOptions
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SandboxOptions -> m SandboxOptions
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SandboxOptions -> m SandboxOptions
Data, Typeable)

textDirective :: Directive -> Text
textDirective :: Directive -> Text
textDirective (DefaultSrc SourceList
x) = Text -> SourceList -> Text
w Text
"default-src" SourceList
x
textDirective (ScriptSrc SourceList
x) =  Text -> SourceList -> Text
w Text
"script-src" SourceList
x
textDirective (StyleSrc SourceList
x) =  Text -> SourceList -> Text
w Text
"style-src" SourceList
x
textDirective (ImgSrc SourceList
x) =  Text -> SourceList -> Text
w Text
"img-src" SourceList
x
textDirective (ConnectSrc SourceList
x) =  Text -> SourceList -> Text
w Text
"connect-src" SourceList
x
textDirective (FontSrc SourceList
x) =  Text -> SourceList -> Text
w Text
"font-src" SourceList
x
textDirective (ObjectSrc SourceList
x) =  Text -> SourceList -> Text
w Text
"object-src" SourceList
x
textDirective (MediaSrc SourceList
x) =  Text -> SourceList -> Text
w Text
"media-src" SourceList
x
textDirective (FrameSrc SourceList
x) =  Text -> SourceList -> Text
w Text
"frame-src" SourceList
x
textDirective (FrameAncestors SourceList
x) =  Text -> SourceList -> Text
w Text
"frame-ancestors" SourceList
x
textDirective (ReportUri EscapedURI
t) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"report-uri ", (String -> Text
T.pack (String -> Text) -> (EscapedURI -> String) -> EscapedURI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EscapedURI -> String
forall a. Show a => a -> String
show) EscapedURI
t]
textDirective (Sandbox []) = Text
"sandbox"
textDirective (Sandbox [SandboxOptions]
s) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"sandbox ", [Text] -> Text
T.unwords ([Text] -> Text)
-> ([SandboxOptions] -> [Text]) -> [SandboxOptions] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SandboxOptions -> Text) -> [SandboxOptions] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SandboxOptions -> Text
forall {a}. IsString a => SandboxOptions -> a
textSandbox ([SandboxOptions] -> Text) -> [SandboxOptions] -> Text
forall a b. (a -> b) -> a -> b
$ [SandboxOptions]
s]
  where textSandbox :: SandboxOptions -> a
textSandbox SandboxOptions
AllowForms = a
"allow-forms"
        textSandbox SandboxOptions
AllowScripts = a
"allow-scripts"
        textSandbox SandboxOptions
AllowSameOrigin = a
"allow-same-origin"
        textSandbox SandboxOptions
AllowTopNavigation = a
"allow-top-navigation"