diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,18 @@ # Revision history for named-text +## 1.2.0.0 -- 2024-07-23 + +* Remove default Eq, Ord, and Hashable instances for all Named. An explicit or + derived instance must be declared for each NamedStyle and/or nameOf variant. + This is to allow a particular NamedStyle or nameOf variant to override the + instance implementation of these functions. Instances are provided the UTF8, + CaseInsensitive, Secure, HTMLStyle, and JSONStyle Named so any module using + only those styles will be backward compatible, but any external named instances + will likely need Eq, Ord, and Hashable instances provided. +* Add HTML NameStyle and conversions between HTML and UTF8 name styles. +* Add conversion from UTF8 to CaseInsensitive name styles (but not the reverse). +* Remove deprecated functions: name, caselessName, secureName + ## 1.1.4.0 -- 2023-10-01 * Update to allow Sayable 1.2.0.0 diff --git a/Data/Name.hs b/Data/Name.hs --- a/Data/Name.hs +++ b/Data/Name.hs @@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + {-| The 'Data.Name' type is designed to be used in place of plain 'String' or @@ -105,7 +107,7 @@ module Data.Name ( -- * Core type - Named + Named -- type only, no constructor or member references , nameOf , nameProxy , styleProxy @@ -138,16 +140,18 @@ -- * Regular (UTF-8) Names , UTF8 , type Name - , name -- * Case Insensitive Names , CaseInsensitive - , caselessName -- * Secure Names , Secure - , SecureName, secureName, secureNameBypass + , SecureName, secureNameBypass + -- * HTML-renderable Names + , HTMLStyle + , rawNamedHTML + -- * Constraining allowed names , ValidNames, validName @@ -157,14 +161,12 @@ ) where -import Control.DeepSeq ( NFData ) import Data.Hashable ( Hashable ) import Data.Proxy ( Proxy(Proxy) ) import Data.String ( IsString(fromString) ) import Data.Text ( Text ) import qualified Data.Text as T import GHC.Exts ( Proxy#, proxy#, IsList(fromList, toList), Item ) -import GHC.Generics ( Generic ) import GHC.TypeLits import Prettyprinter ( (<+>) ) import qualified Prettyprinter as PP @@ -174,32 +176,7 @@ import Numeric.Natural #endif --- | The 'Named' is a wrapper around any 'Data.Text' that identifies the type of --- 'Data.Text' via the @nameOf@ phantom symbol type, as well as a usage specified --- by the @style@ type parameter. Use of 'Named' should always be preferred to --- using a raw 'Data.Text' (or 'String'). - -newtype Named (style :: NameStyle) (nameOf :: Symbol) = Named { named :: Text } - deriving (Eq, Ord, Generic, NFData, Semigroup) - - --- | The NameStyle specifies how the name itself is styled. --- --- * The 'UTF8' default style is orthogonal to a normal String or Text. --- --- * The 'CaseInsensitive' style indicates that uppercase ASCII characters are --- equivalent to their lowercase form. --- --- * The 'Secure' style is case sensitive, but does not reveal the full contents --- unless the specific "secureName" accessor function is used. This is useful --- for storing secrets (e.g. passphrases, access tokens, etc.) that should not --- be fully visible in log messages and other miscellaneous output. --- --- These styles will be described in more detail below. - -type NameStyle = Symbol - -instance Hashable (Named style nameOf) +import Data.Name.Internal -- | Retrieve the @nameOf@ type parameter (the "what am I") of a Named as a text @@ -395,11 +372,6 @@ type Name = Named UTF8 -{-# DEPRECATED name "Use nameText instead" #-} -name :: Name nameOf -> Text -name = nameText - - instance IsList (Name s) where type Item (Name s) = Item Text fromList = fromText . fromList @@ -409,7 +381,11 @@ instance NameText UTF8 +deriving instance Eq (Named UTF8 nameOf) +deriving instance Ord (Named UTF8 nameOf) +deriving instance Hashable (Named UTF8 nameOf) + ---------------------------------------------------------------------- -- * CaseInsensitive Named objects @@ -427,15 +403,24 @@ instance KnownSymbol ty => PP.Pretty (Named CaseInsensitive ty) where pretty nm = (PP.pretty $ nameOf nm proxy#) - <+> PP.surround (PP.pretty (caselessName nm)) "«" "»" + <+> PP.surround (PP.pretty (nameText nm)) "«" "»" instance NameText CaseInsensitive -{-# DEPRECATED caselessName "Use nameText instead" #-} -caselessName :: Named CaseInsensitive nameOf -> Text -caselessName = nameText +instance ConvertNameStyle UTF8 CaseInsensitive nameTy +-- No ConvertNameStyle is defined for CaseInsensitive -> UTF8 because this cannot +-- be round-tripped. + +-- CaseInsensitive names are normalized during construction, so standard +-- instances are sufficient: + +deriving instance Eq (Named CaseInsensitive nameOf) +deriving instance Ord (Named CaseInsensitive nameOf) +deriving instance Hashable (Named CaseInsensitive nameOf) + + ---------------------------------------------------------------------- -- * Secure Named objects @@ -458,7 +443,6 @@ -- the full Secure Named text is needed, the 'secureNameBypass' accessor should -- be used instead. -{-# DEPRECATED secureName "Use nameText instead" #-} secureName :: Named Secure nameOf -> Text secureName nm = if T.length (named nm) < 5 then T.replicate 8 "#" @@ -477,8 +461,88 @@ instance NameText Secure where nameText = secureName +-- No ConvertNameStyle forms are defined for Secure because this is a lossy +-- conversion due to masking. +-- Secure names are constructed in a standard manner and differ only in +-- projection out of the Name, so standard instances are sufficient: + +deriving instance Eq (Named Secure nameOf) +deriving instance Ord (Named Secure nameOf) +deriving instance Hashable (Named Secure nameOf) + + ---------------------------------------------------------------------- +-- * HTML Names + +-- | The HTMLStyle type alias is useable as the @style@ parameter of a 'Named' +-- type. The type-string form may also be used but the type alias is designed to +-- allow abstraction from the raw type-string value. +-- +-- Text contained in these styles is safe to represent in HTML: angle brackets +-- are converted to their html representation, and ampersands and quotes are +-- escaped. + +-- n.b. JSON is a separate module for conditional compilation without introducing +-- additional dependencies, but there are no additional dependencies for +-- HTMLStyle. + +type HTMLStyle = "HTML" :: NameStyle + +instance {-# OVERLAPPING #-} IsString (Named HTMLStyle nameOf) where + fromString = Named . toHTMLSafe . fromString + +instance {-# OVERLAPPING #-} IsText (Named HTMLStyle nameOf) where + fromText = Named . toHTMLSafe + +instance KnownSymbol ty => PP.Pretty (Named HTMLStyle ty) where + pretty = PP.pretty . nameText + +instance NameText HTMLStyle + +-- | To create a Named HTMLStyle from Text that is raw HTML and shouldn't have +-- escaping performed. + +rawNamedHTML :: Text -> Named HTMLStyle nameOf +rawNamedHTML = Named + +toHTMLSafe :: Text -> Text +toHTMLSafe = T.replace "<" "<" + . T.replace ">" ">" + . T.replace "\"" """ + . T.replace "'" "'" + . T.replace "&" "&" -- do this first because & is added above + +fromSafeHTML :: Text -> Text +fromSafeHTML = T.replace "&" "&" + . T.replace ">" ">" + . T.replace "<" "<" + . T.replace """ "\"" + . T.replace "'" "'" + +instance IsList (Named HTMLStyle s) where + type Item (Named HTMLStyle s) = Item Text + fromList = fromText . fromList + toList = toList . nameText + +instance ConvertName HTMLStyle a a where convertName = id + +instance ConvertNameStyle UTF8 HTMLStyle nameTy +instance ConvertNameStyle HTMLStyle UTF8 nameTy where + convertStyle = fromText . fromSafeHTML . nameText + +-- HTMLStyle names are normalized during construction, so standard instances are +-- sufficient: + +deriving instance Eq (Named HTMLStyle nameOf) +deriving instance Ord (Named HTMLStyle nameOf) +deriving instance Hashable (Named HTMLStyle nameOf) + +-- Trigger faults in the code and trace them for impact + +-- GA has no MB experience, so don't know how much to expect or have any expectations. Fault triggering and detection would be the principle focus. + +---------------------------------------------------------------------- -- Constraining allowed names -- | The ValidNames constraint can be used to specify the list of allowed names @@ -514,7 +578,7 @@ , DisallowedNameType nty ntl ntl ) => ValidNames nty ntl where - validName _ = name + validName _ = nameText type family AllowedNameType (nty :: Symbol) (ntl :: [Symbol]) :: Nat where AllowedNameType nty (nty ': ntl) = 0 diff --git a/Data/Name/Internal.hs b/Data/Name/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/Name/Internal.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} + +module Data.Name.Internal where + +import Control.DeepSeq ( NFData ) +import Data.Text ( Text ) +import GHC.Generics ( Generic ) +import GHC.TypeLits + + +-- | The 'Named' is a wrapper around any 'Data.Text' that identifies the type of +-- 'Data.Text' via the @nameOf@ phantom symbol type, as well as a usage specified +-- by the @style@ type parameter. Use of 'Named' should always be preferred to +-- using a raw 'Data.Text' (or 'String'). + +newtype Named (style :: NameStyle) (nameOf :: Symbol) = Named { named :: Text } + deriving (Generic, NFData, Semigroup) + + +-- | The NameStyle specifies how the name itself is styled. +-- +-- * The 'UTF8' default style is orthogonal to a normal String or Text. +-- +-- * The 'CaseInsensitive' style indicates that uppercase ASCII characters are +-- equivalent to their lowercase form. +-- +-- * The 'Secure' style is case sensitive, but does not reveal the full contents +-- unless the specific "secureNameBypass" accessor function is used. This is +-- useful for storing secrets (e.g. passphrases, access tokens, etc.) that +-- should not be fully visible in log messages and other miscellaneous output. +-- +-- These styles will be described in more detail below. + +type NameStyle = Symbol diff --git a/Data/Name/JSON.hs b/Data/Name/JSON.hs --- a/Data/Name/JSON.hs +++ b/Data/Name/JSON.hs @@ -22,7 +22,9 @@ import Data.Aeson import Data.Aeson.Types import Data.Functor.Contravariant ( (>$<) ) +import Data.Hashable ( Hashable ) import Data.Name +import Data.Name.Internal import Data.String ( IsString(fromString) ) @@ -35,6 +37,13 @@ type JSONStyle = "JSON" :: NameStyle instance NameText JSONStyle + +-- JSON names have no special considerations, so standard instances are +-- sufficient: + +deriving instance Eq (Named JSONStyle nameOf) +deriving instance Ord (Named JSONStyle nameOf) +deriving instance Hashable (Named JSONStyle nameOf) instance ConvertNameStyle JSONStyle UTF8 nameOf instance ConvertNameStyle UTF8 JSONStyle nameOf diff --git a/named-text.cabal b/named-text.cabal --- a/named-text.cabal +++ b/named-text.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: named-text -version: 1.1.4.0 +version: 1.2.0.0 synopsis: A parameterized named text type and associated functionality. description: . @@ -58,13 +58,14 @@ import: bldspec hs-source-dirs: . default-language: Haskell2010 - build-depends: base >= 4.13 && < 4.19 + build-depends: base >= 4.13 && < 4.20 , deepseq , hashable , prettyprinter >= 1.7.0 && < 1.8 , sayable >= 1.0 && < 1.3 , text exposed-modules: Data.Name + other-modules: Data.Name.Internal if flag(with-json) build-depends: aeson >= 1.5 && < 2.2 exposed-modules: Data.Name.JSON diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -428,7 +428,6 @@ instance ConvertName Secure "CR43" "CR43 again" where convertName = fromText . secureNameBypass -instance ConvertNameStyle UTF8 CaseInsensitive "CR44" instance ConvertNameStyle UTF8 Secure "CR45" instance ConvertNameStyle CaseInsensitive UTF8 "CR46" instance ConvertNameStyle Secure UTF8 "CR47"