From 71f89c1a4f1a58b4315ce33973946a428bc6960a Mon Sep 17 00:00:00 2001
From: Eduardo Trujillo <ed@chromabits.com>
Date: Sun, 7 Jun 2020 19:02:59 -0700
Subject: [PATCH] Make CSP directives more Yaml/Json friendly
---
src/Network/Http/Csp.hs | 29 +++++++++++++++++++++++------
1 file changed, 23 insertions(+), 6 deletions(-)
diff --git a/src/Network/Http/Csp.hs b/src/Network/Http/Csp.hs
index 838f2d3..e39ebde 100644
--- a/src/Network/Http/Csp.hs
+++ b/src/Network/Http/Csp.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
-- |
--
@@ -40,15 +41,21 @@ type Parser = Parsec Void Text
data SchemePart = SchemePart Text deriving (Show, Eq, Generic)
data PortPart = SpecificPort Integer | AnyPort deriving (Show, Eq, Generic)
-data HostPart = AnyHostPart | DomainHostPart Bool Text deriving (Show, Eq, Generic)
+data HostPart
+ = AnyHostPart
+ | DomainHostPart
+ { wildcard :: Bool
+ , domain :: Text
+ }
+ deriving (Show, Eq, Generic)
data PathPart = PathPart Text deriving (Show, Eq, Generic)
instance ToCSP SchemePart where
- toCSP (SchemePart scheme) = scheme
+ toCSP (SchemePart scheme_) = scheme_
instance FromJSON SchemePart
instance ToCSP PortPart where
- toCSP (SpecificPort port) = T.pack . show $ port
+ toCSP (SpecificPort port_) = T.pack . show $ port_
toCSP AnyPort = "*"
instance FromJSON PortPart
@@ -60,7 +67,7 @@ instance ToCSP HostPart where
instance FromJSON HostPart
instance ToCSP PathPart where
- toCSP (PathPart path) = path
+ toCSP (PathPart path_) = path_
instance FromJSON PathPart
alphaChar :: Parser Char
@@ -198,7 +205,12 @@ pHashAlgorithm = choice
data SourceExpression
= SchemeSource SchemePart
- | HostSource (Maybe SchemePart) HostPart (Maybe PortPart) (Maybe PathPart)
+ | HostSource
+ { scheme :: Maybe SchemePart
+ , host :: HostPart
+ , port :: Maybe PortPart
+ , path :: Maybe PathPart
+ }
| KeywordSource Keyword
| NonceSource Text
| HashSource HashAlgorithm Text
@@ -247,7 +259,12 @@ pSourceExpression = choice
data AncestorSource
= AncestorSchemeSource SchemePart
- | AncestorHostSource (Maybe SchemePart) HostPart (Maybe PortPart) (Maybe PathPart)
+ | AncestorHostSource
+ { scheme :: Maybe SchemePart
+ , host :: HostPart
+ , port :: Maybe PortPart
+ , path :: Maybe PathPart
+ }
| AncestorSelfSource
deriving (Show, Eq, Generic)
--
GitLab