diff --git a/src/Network/Http/Csp.hs b/src/Network/Http/Csp.hs index 838f2d3e8439c86ce5a5d4722e98fc5bb596a942..e39ebde80d0e5ffc2aaa6e550cb1eb4b46dd4ab8 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)