{-# LANGUAGE OverloadedStrings #-}

module Yesod.Csp.TH (
    source
    , withSourceList
    , reportUri
    , sandbox
    , sandboxOptions
    , directive
    , csp
  ) where

import           Control.Applicative
import           Data.Attoparsec.Text
import           Data.Generics
import           Data.List.NonEmpty        (NonEmpty (..))
import qualified Data.Text                 as T
import qualified Language.Haskell.TH       as TH
import           Language.Haskell.TH.Quote
import           Yesod.Csp

csp :: QuasiQuoter
csp :: QuasiQuoter
csp = QuasiQuoter {
      quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
str -> do
        let c :: Either [Char] DirectiveList
c = Parser DirectiveList -> Text -> Either [Char] DirectiveList
forall a. Parser a -> Text -> Either [Char] a
parseOnly Parser DirectiveList
directive ([Char] -> Text
T.pack [Char]
str)
        case Either [Char] DirectiveList
c of
          Left [Char]
err -> [Char] -> Q Exp
forall a. HasCallStack => [Char] -> a
error ([Char] -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char]
"csp parsing error: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err -- compile time error
          Right DirectiveList
x -> (forall b. Data b => b -> Maybe (Q Exp)) -> DirectiveList -> Q Exp
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ (Maybe (Q Exp) -> b -> Maybe (Q Exp)
forall a b. a -> b -> a
const Maybe (Q Exp)
forall a. Maybe a
Nothing (b -> Maybe (Q Exp))
-> (Source -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` Source -> Maybe (Q Exp)
antiCsp) DirectiveList
x
    , quotePat :: [Char] -> Q Pat
quotePat  = [Char] -> Q Pat
forall a. HasCallStack => a
undefined
    , quoteType :: [Char] -> Q Type
quoteType = [Char] -> Q Type
forall a. HasCallStack => a
undefined
    , quoteDec :: [Char] -> Q [Dec]
quoteDec  = [Char] -> Q [Dec]
forall a. HasCallStack => a
undefined
    }

antiCsp :: Source -> Maybe (TH.Q TH.Exp)
antiCsp :: Source -> Maybe (Q Exp)
antiCsp (MetaSource Text
x) = if Text -> Text -> Bool
T.isPrefixOf Text
noncePrefix Text
x
  then Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> (Exp -> Q Exp) -> Exp -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Maybe (Q Exp)) -> Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
TH.AppE (Name -> Exp
TH.VarE ([Char] -> Name
TH.mkName [Char]
"nonce")) (Name -> Exp
TH.VarE ([Char] -> Name
TH.mkName (Text -> [Char]
T.unpack (Text -> Text
nonceVar Text
x))))
  else Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> (Exp -> Q Exp) -> Exp -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Maybe (Q Exp)) -> Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
TH.AppE (Name -> Exp
TH.ConE ([Char] -> Name
TH.mkName [Char]
"Host")) (Name -> Exp
TH.VarE ([Char] -> Name
TH.mkName (Text -> [Char]
T.unpack Text
x)))
  where noncePrefix :: Text
noncePrefix = Text
"nonce-"
        nonceVar :: Text -> Text
nonceVar = Int -> Text -> Text
T.drop (Text -> Int
T.length Text
noncePrefix)
antiCsp Source
_ = Maybe (Q Exp)
forall a. Maybe a
Nothing

metaSource :: Parser Source
metaSource :: Parser Source
metaSource = do
  Char
_ <- Char -> Parser Char
char Char
'$'
  [Char]
x <- Parser Char -> Parser Text [Char]
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Char
digit Parser Char -> Parser Char -> Parser Char
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
letter Parser Char -> Parser Char -> Parser Char
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
char Char
'-')
  Source -> Parser Source
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Source -> Parser Source) -> Source -> Parser Source
forall a b. (a -> b) -> a -> b
$ Text -> Source
MetaSource ([Char] -> Text
T.pack [Char]
x)

source :: Parser Source
source :: Parser Source
source = Parser Source
wildcard
         Parser Source -> Parser Source -> Parser Source
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Source
none
         Parser Source -> Parser Source -> Parser Source
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Source
self
         Parser Source -> Parser Source -> Parser Source
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Source
dataScheme
         Parser Source -> Parser Source -> Parser Source
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Source
https
         Parser Source -> Parser Source -> Parser Source
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Source
host
         Parser Source -> Parser Source -> Parser Source
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Source
unsafeInline
         Parser Source -> Parser Source -> Parser Source
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Source
unsafeEval
         Parser Source -> Parser Source -> Parser Source
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Source
strictDynamic
         Parser Source -> Parser Source -> Parser Source
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Source
parseNonce
         Parser Source -> Parser Source -> Parser Source
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Source
metaSource
  where wildcard :: Parser Source
wildcard = Text -> Parser Text
string Text
"*" Parser Text -> Parser Source -> Parser Source
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Source -> Parser Source
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Source
Wildcard
        none :: Parser Source
none = Text -> Parser Text
string Text
"'none'" Parser Text -> Parser Source -> Parser Source
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Source -> Parser Source
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Source
None
        self :: Parser Source
self = Text -> Parser Text
string Text
"'self'" Parser Text -> Parser Source -> Parser Source
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Source -> Parser Source
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Source
Self
        dataScheme :: Parser Source
dataScheme = Text -> Parser Text
string Text
"data:" Parser Text -> Parser Source -> Parser Source
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Source -> Parser Source
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Source
DataScheme
        parseNonce :: Parser Source
        parseNonce :: Parser Source
parseNonce = do
          Char
_ <- Char -> Parser Char
char Char
'\''
          Text
_ <- Text -> Parser Text
string Text
"nonce"
          Char
_ <- Char -> Parser Char
char Char
'-'
          Text
n <- (Char -> Bool) -> Parser Text
takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'')
          Char
_ <- Char -> Parser Char
char Char
'\''
          Source -> Parser Source
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Source -> Parser Source) -> Source -> Parser Source
forall a b. (a -> b) -> a -> b
$ Text -> Source
nonce Text
n
        host :: Parser Source
        host :: Parser Source
host = do
          Text
u <- (Char -> Bool) -> Parser Text
takeTill Char -> Bool
separated
          case Text -> Maybe EscapedURI
escapeAndParseURI Text
u of
            Maybe EscapedURI
Nothing -> [Char] -> Parser Source
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"host"
            Just EscapedURI
uri -> Source -> Parser Source
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Source -> Parser Source) -> Source -> Parser Source
forall a b. (a -> b) -> a -> b
$ EscapedURI -> Source
Host EscapedURI
uri
        https :: Parser Source
https = do
          Text
_ <- Text -> Parser Text
string Text
"https:"
          Maybe Char
c <- Parser (Maybe Char)
peekChar
          case Maybe Char
c of
            (Just Char
' ') -> Source -> Parser Source
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Source
Https
            (Just Char
';') -> Source -> Parser Source
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Source
Https
            Maybe Char
Nothing -> Source -> Parser Source
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Source
Https
            Maybe Char
_ -> [Char] -> Parser Source
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"https"
        unsafeInline :: Parser Source
unsafeInline = Text -> Parser Text
string Text
"unsafe-inline" Parser Text -> Parser Source -> Parser Source
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Source -> Parser Source
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Source
UnsafeInline
        unsafeEval :: Parser Source
unsafeEval = Text -> Parser Text
string Text
"unsafe-eval" Parser Text -> Parser Source -> Parser Source
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Source -> Parser Source
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Source
UnsafeEval
        strictDynamic :: Parser Source
strictDynamic = Text -> Parser Text
string Text
"strict-dynamic" Parser Text -> Parser Source -> Parser Source
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Source -> Parser Source
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Source
StrictDynamic

separated :: Char -> Bool
separated :: Char -> Bool
separated Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '

-- Safe to head and tail these sources as they come from the `sepBy1` combinator
mkWithSource :: (NonEmpty Source -> Directive) -> [Source] -> Parser Directive
mkWithSource :: (NonEmpty Source -> Directive) -> [Source] -> Parser Directive
mkWithSource NonEmpty Source -> Directive
f [Source]
x = Directive -> Parser Directive
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Directive -> Parser Directive) -> Directive -> Parser Directive
forall a b. (a -> b) -> a -> b
$ NonEmpty Source -> Directive
f ([Source] -> Source
forall a. HasCallStack => [a] -> a
head [Source]
x Source -> [Source] -> NonEmpty Source
forall a. a -> [a] -> NonEmpty a
:| [Source] -> [Source]
forall a. HasCallStack => [a] -> [a]
tail [Source]
x)

withSourceList :: Parser Directive
withSourceList :: Parser Directive
withSourceList = Parser Directive
defaultSrc
                 Parser Directive -> Parser Directive -> Parser Directive
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Directive
scriptSrc
                 Parser Directive -> Parser Directive -> Parser Directive
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Directive
scriptSrc
                 Parser Directive -> Parser Directive -> Parser Directive
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Directive
styleSrc
                 Parser Directive -> Parser Directive -> Parser Directive
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Directive
imgSrc
                 Parser Directive -> Parser Directive -> Parser Directive
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Directive
connectSrc
                 Parser Directive -> Parser Directive -> Parser Directive
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Directive
fontSrc
                 Parser Directive -> Parser Directive -> Parser Directive
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Directive
objectSrc
                 Parser Directive -> Parser Directive -> Parser Directive
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Directive
mediaSrc
                 Parser Directive -> Parser Directive -> Parser Directive
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Directive
frameSrc
                 Parser Directive -> Parser Directive -> Parser Directive
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Directive
frameAncestors
  where defaultSrc :: Parser Directive
defaultSrc = Text -> (NonEmpty Source -> Directive) -> Parser Directive
d Text
"default-src" NonEmpty Source -> Directive
DefaultSrc
        scriptSrc :: Parser Directive
scriptSrc = Text -> (NonEmpty Source -> Directive) -> Parser Directive
d Text
"script-src" NonEmpty Source -> Directive
ScriptSrc
        styleSrc :: Parser Directive
styleSrc = Text -> (NonEmpty Source -> Directive) -> Parser Directive
d Text
"style-src" NonEmpty Source -> Directive
StyleSrc
        imgSrc :: Parser Directive
imgSrc = Text -> (NonEmpty Source -> Directive) -> Parser Directive
d Text
"img-src" NonEmpty Source -> Directive
ImgSrc
        connectSrc :: Parser Directive
connectSrc = Text -> (NonEmpty Source -> Directive) -> Parser Directive
d Text
"connect-src" NonEmpty Source -> Directive
ConnectSrc
        fontSrc :: Parser Directive
fontSrc = Text -> (NonEmpty Source -> Directive) -> Parser Directive
d Text
"font-src" NonEmpty Source -> Directive
FontSrc
        objectSrc :: Parser Directive
objectSrc = Text -> (NonEmpty Source -> Directive) -> Parser Directive
d Text
"object-src" NonEmpty Source -> Directive
ObjectSrc
        mediaSrc :: Parser Directive
mediaSrc = Text -> (NonEmpty Source -> Directive) -> Parser Directive
d Text
"media-src" NonEmpty Source -> Directive
MediaSrc
        frameSrc :: Parser Directive
frameSrc = Text -> (NonEmpty Source -> Directive) -> Parser Directive
d Text
"frame-src" NonEmpty Source -> Directive
FrameSrc
        frameAncestors :: Parser Directive
frameAncestors = Text -> (NonEmpty Source -> Directive) -> Parser Directive
d Text
"frame-ancestors" NonEmpty Source -> Directive
FrameAncestors
        d :: Text -> (NonEmpty Source -> Directive) -> Parser Directive
d Text
x NonEmpty Source -> Directive
y = Text -> Parser Text
string Text
x Parser Text -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text ()
s Parser Text () -> Parser Text [Source] -> Parser Text [Source]
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text [Source]
slist Parser Text [Source]
-> ([Source] -> Parser Directive) -> Parser Directive
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (NonEmpty Source -> Directive) -> [Source] -> Parser Directive
mkWithSource NonEmpty Source -> Directive
y
        slist :: Parser Text [Source]
slist = Parser Source -> Parser Char -> Parser Text [Source]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy1 Parser Source
source (Char -> Parser Char
char Char
' ')
        s :: Parser Text ()
s = Parser Text ()
spaces

spaces :: Parser ()
spaces :: Parser Text ()
spaces = Parser Char -> Parser Text [Char]
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Char
space Parser Text [Char] -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser Text ()
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

reportUri :: Parser Directive
reportUri :: Parser Directive
reportUri = do
  Text
_ <- Text -> Parser Text
string Text
"report-uri"
  ()
_ <- Parser Text ()
spaces
  Text
u <- (Char -> Bool) -> Parser Text
takeTill Char -> Bool
separated
  case Text -> Maybe EscapedURI
escapeAndParseURI Text
u of
    Maybe EscapedURI
Nothing -> [Char] -> Parser Directive
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"reportUri" -- n.b. compile time error
    Just EscapedURI
uri -> Directive -> Parser Directive
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Directive -> Parser Directive) -> Directive -> Parser Directive
forall a b. (a -> b) -> a -> b
$ EscapedURI -> Directive
ReportUri EscapedURI
uri

sandbox :: Parser Directive
sandbox :: Parser Directive
sandbox = do
  Text
_ <- Text -> Parser Text
string Text
"sandbox"
  ()
_ <- Parser Text ()
spaces
  [SandboxOptions]
x <- Parser Text SandboxOptions
-> Parser Text () -> Parser Text [SandboxOptions]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy Parser Text SandboxOptions
sandboxOptions Parser Text ()
spaces
  Directive -> Parser Directive
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Directive -> Parser Directive) -> Directive -> Parser Directive
forall a b. (a -> b) -> a -> b
$ [SandboxOptions] -> Directive
Sandbox [SandboxOptions]
x

sandboxOptions :: Parser SandboxOptions
sandboxOptions :: Parser Text SandboxOptions
sandboxOptions = Parser Text SandboxOptions
allowForms
                 Parser Text SandboxOptions
-> Parser Text SandboxOptions -> Parser Text SandboxOptions
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text SandboxOptions
allowScripts
                 Parser Text SandboxOptions
-> Parser Text SandboxOptions -> Parser Text SandboxOptions
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text SandboxOptions
allowSameOrigin
                 Parser Text SandboxOptions
-> Parser Text SandboxOptions -> Parser Text SandboxOptions
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text SandboxOptions
allowTopNavigation
  where allowForms :: Parser Text SandboxOptions
allowForms = Text -> Parser Text
string Text
"allow-forms" Parser Text
-> Parser Text SandboxOptions -> Parser Text SandboxOptions
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SandboxOptions -> Parser Text SandboxOptions
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SandboxOptions
AllowForms
        allowScripts :: Parser Text SandboxOptions
allowScripts = Text -> Parser Text
string Text
"allow-scripts" Parser Text
-> Parser Text SandboxOptions -> Parser Text SandboxOptions
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SandboxOptions -> Parser Text SandboxOptions
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SandboxOptions
AllowScripts
        allowSameOrigin :: Parser Text SandboxOptions
allowSameOrigin = Text -> Parser Text
string Text
"allow-same-origin" Parser Text
-> Parser Text SandboxOptions -> Parser Text SandboxOptions
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SandboxOptions -> Parser Text SandboxOptions
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SandboxOptions
AllowSameOrigin
        allowTopNavigation :: Parser Text SandboxOptions
allowTopNavigation = Text -> Parser Text
string Text
"allow-top-navigation" Parser Text
-> Parser Text SandboxOptions -> Parser Text SandboxOptions
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SandboxOptions -> Parser Text SandboxOptions
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SandboxOptions
AllowTopNavigation

separator :: Parser ()
separator :: Parser Text ()
separator = Parser Text
comma Parser Text -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text ()
spaces Parser Text () -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser Text ()
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  where comma :: Parser Text
comma = Text -> Parser Text
string Text
";"

directive :: Parser DirectiveList
directive :: Parser DirectiveList
directive = Parser Directive -> Parser Text () -> Parser DirectiveList
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy (Parser Text ()
spaces Parser Text () -> Parser Directive -> Parser Directive
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Directive
d) Parser Text ()
separator Parser DirectiveList -> Parser Text () -> Parser DirectiveList
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text ()
spaces Parser Text () -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput)
  where d :: Parser Directive
d = Parser Directive
withSourceList Parser Directive -> Parser Directive -> Parser Directive
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Directive
reportUri Parser Directive -> Parser Directive -> Parser Directive
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Directive
sandbox