diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,3 +14,15 @@ * Fix incorrect ToHttpApiData instance for ObjectType * Rename incorrectly named data constructor for CryptokeysAPI * Add versions endpoint + +## 0.2.1 -- 2022-01-12 +* Correctly parse and serialize ObjectType, Kind and ChangeType + +## 0.2.2 -- 2022-01-27 +* Adjust `Eq` on `Zone` and `RRSet` to compare up to limited case-sensitity + +## 0.3 -- 2022-03-02 + +* Rename typod field name `commant_modified_at` to `comment_modified_at` +* Wrap `rrset_name` and `zone_name` with new `CIText` wrappers for limited case-sensitivity +* Have `Ord` instances of `Zone` and `RRSet` correctly respect limited case-sensitivity diff --git a/PowerDNS/API/TSIGKeys.hs b/PowerDNS/API/TSIGKeys.hs --- a/PowerDNS/API/TSIGKeys.hs +++ b/PowerDNS/API/TSIGKeys.hs @@ -4,14 +4,14 @@ -- -- Implementation of the API endpoints described at [PowerDNS TSIGKeys API](https://doc.powerdns.com/authoritative/http-api/tsigkey.html) +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE CPP #-} module PowerDNS.API.TSIGKeys ( -- * API @@ -23,18 +23,16 @@ ) where +import qualified Control.Monad.Fail as Fail import Data.Char (toLower) -import Data.Functor ((<&>)) import Data.Data (Data) -import Control.Monad.Fail (MonadFail) +import Data.Functor ((<&>)) import Control.DeepSeq (NFData) -import Data.Aeson ( FromJSON(..), ToJSON(..), Value(String), allNullaryToStringTag - , constructorTagModifier, defaultOptions - , genericParseJSON - , genericToJSON, withObject, object - , (.:), (.:?), (.=) - ) +import Data.Aeson (FromJSON(..), ToJSON(..), Value(String), + allNullaryToStringTag, constructorTagModifier, + defaultOptions, genericParseJSON, genericToJSON, + object, withObject, (.:), (.:?), (.=)) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as BS64 import qualified Data.Text as T @@ -92,10 +90,10 @@ encode64 :: BS.ByteString -> T.Text encode64 = T.decodeUtf8 . BS64.encode -decode64 :: MonadFail m => T.Text -> m BS.ByteString +decode64 :: Fail.MonadFail m => T.Text -> m BS.ByteString decode64 i = case BS64.decode (T.encodeUtf8 i) of - Left err -> fail err - Right k -> pure k + Left err -> Fail.fail err + Right k -> pure k ---------------------------------------------------------------------------------------- diff --git a/PowerDNS/API/Zones.hs b/PowerDNS/API/Zones.hs --- a/PowerDNS/API/Zones.hs +++ b/PowerDNS/API/Zones.hs @@ -23,19 +23,29 @@ , Comment(..) , ChangeType(..) , RecordType(..) + + -- * Utilities + , CIText + , mkCIText + , original + , caseFolded ) where -import Data.Char (toUpper) -import Data.Coerce (coerce) +import Data.Char (ord, toUpper) import Data.Data (Data) +import Data.Function (on) +import Data.String (IsString(..)) import Data.Word (Word32) +import GHC.Base (unsafeChr) +import Text.Read (readPrec) -import Control.DeepSeq (NFData) +import Control.DeepSeq (NFData(..), deepseq) import Data.Aeson (FromJSON(..), ToJSON(..), allNullaryToStringTag, constructorTagModifier, defaultOptions, fieldLabelModifier, genericParseJSON, genericToJSON, omitNothingFields) +import Data.Hashable (Hashable(..)) import qualified Data.Text as T import Data.Time.Clock.POSIX (POSIXTime) import Servant.API @@ -91,11 +101,11 @@ -- | Zone according to [PowerDNS Documentation](https://doc.powerdns.com/authoritative/http-api/zone.html#zone). -- All fields are optional because the PowerDNS API differs on which fields are required depending on the endpoint. -- --- Note that the 'Eq' instance is up to limited case-sensitivity on 'zone_name' and equivalently contained rrset names +-- Note that 'Eq' and 'Ord' use limited case-sensitivity on 'zone_name' and equivalently contained rrset names -- as per [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343) data Zone = Zone { zone_id :: Maybe T.Text - , zone_name :: Maybe T.Text + , zone_name :: Maybe CIText , zone_type :: Maybe T.Text , zone_url :: Maybe T.Text , zone_kind :: Maybe Kind @@ -116,32 +126,7 @@ , zone_nameservers :: Maybe [T.Text] , zone_master_tsig_key_ids :: Maybe [T.Text] , zone_slave_tsig_key_ids :: Maybe [T.Text] - } deriving (Ord, Show, Generic, NFData, Data, Empty) - -instance Eq Zone where - l == r - = zone_id l == zone_id r - && (coerce (zone_name l) :: Maybe CI) == (coerce (zone_name r) :: Maybe CI) - && zone_type l == zone_type r - && zone_url l == zone_url r - && zone_kind l == zone_kind r - && zone_rrsets l == zone_rrsets r - && zone_serial l == zone_serial r - && zone_notified_serial l == zone_notified_serial r - && zone_edited_serial l == zone_edited_serial r - && zone_masters l == zone_masters r - && zone_dnssec l == zone_dnssec r - && zone_nsec3param l == zone_nsec3param r - && zone_nsec3narrow l == zone_nsec3narrow r - && zone_presigned l == zone_presigned r - && zone_soa_edit l == zone_soa_edit r - && zone_soa_edit_api l == zone_soa_edit_api r - && zone_api_rectify l == zone_api_rectify r - && zone_zone l == zone_zone r - && zone_account l == zone_account r - && zone_nameservers l == zone_nameservers r - && zone_master_tsig_key_ids l == zone_master_tsig_key_ids r - && zone_slave_tsig_key_ids l == zone_slave_tsig_key_ids r + } deriving (Eq, Ord, Show, Generic, NFData, Data, Empty) instance ToJSON Zone where toJSON = genericToJSON defaultOptions { fieldLabelModifier = strip "zone_"} @@ -172,60 +157,79 @@ ---------------------------------------------------------------------------------------- -newtype CI = CI T.Text +-- | A wrapper for 'T.Text' implementing limited case-sensitivity as per [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343). +-- Use 'mkCIText' for construction. +-- +-- See 'original' and 'caseFolded' for extracting a 'T.Text' back. +data CIText = CIText { ciOriginal :: T.Text, ciCaseFolded :: T.Text } deriving Data -instance Eq CI where - CI l == CI r = T.map caseFold l == T.map caseFold r - where - caseFold x = case x of - 'A' -> 'a' - 'B' -> 'b' - 'C' -> 'c' - 'D' -> 'd' - 'E' -> 'e' - 'F' -> 'f' - 'G' -> 'g' - 'H' -> 'h' - 'I' -> 'i' - 'J' -> 'j' - 'K' -> 'k' - 'L' -> 'l' - 'M' -> 'm' - 'N' -> 'n' - 'O' -> 'o' - 'P' -> 'p' - 'Q' -> 'q' - 'R' -> 'r' - 'S' -> 's' - 'T' -> 't' - 'U' -> 'u' - 'V' -> 'v' - 'W' -> 'w' - 'X' -> 'x' - 'Y' -> 'y' - 'Z' -> 'z' - _ -> x +-- | Obtain the original 'T.Text' from a 'CIText'. +original :: CIText -> T.Text +original = ciOriginal + +-- | Obtain a [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343) case-folded 'T.Text' from a 'CIText'. +caseFolded :: CIText -> T.Text +caseFolded = ciCaseFolded + +-- | Smart constructor for 'CIText'. +mkCIText :: T.Text -> CIText +mkCIText s = CIText s (T.map foldCase s) + +instance IsString CIText where + fromString = mkCIText . fromString + +instance Semigroup CIText where + CIText o1 f1 <> CIText o2 f2 = CIText (o1 <> o2) (f1 <> f2) + +instance Monoid CIText where + mempty = CIText mempty mempty + +instance Read CIText where + readPrec = fmap mkCIText readPrec + +instance Show CIText where + showsPrec p = showsPrec p . ciOriginal + +instance Ord CIText where + compare = compare `on` ciCaseFolded + +instance Eq CIText where + (==) = (==) `on` ciCaseFolded + +instance ToJSON CIText where + toJSON = toJSON . ciOriginal + +instance FromJSON CIText where + parseJSON = fmap mkCIText . parseJSON + +instance Hashable CIText where + hashWithSalt s = hashWithSalt s . ciCaseFolded + +instance NFData CIText where + rnf (CIText o f) = o `deepseq` f `deepseq` () + +{-# INLINE foldCase #-} +foldCase :: Char -> Char +foldCase x | x' <- fromIntegral (ord x) + , x' >= 0x41 + , x' <= 0x5A + = unsafeChr (x' + 32) + + | otherwise + = x + -- | RRSet according to [PowerDNS Documentation](https://doc.powerdns.com/authoritative/http-api/zone.html#rrset). -- --- Note that the 'Eq' instance is up to limited case-sensitivity on 'rrset_name' as per [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343) +-- Note that 'Eq' and 'Ord' use limited case-sensitivity on 'rrset_name' as per [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343) data RRSet = RRSet - { rrset_name :: T.Text + { rrset_name :: CIText , rrset_type :: RecordType , rrset_ttl :: Word32 , rrset_changetype :: Maybe ChangeType , rrset_records :: Maybe [Record] , rrset_comments :: Maybe [Comment] - } deriving (Ord, Show, Generic, NFData, Data) - -instance Eq RRSet where - l == r = - (coerce (rrset_name l) :: CI) == (coerce (rrset_name r) :: CI) - && rrset_type l == rrset_type r - && rrset_ttl l == rrset_ttl r - && rrset_changetype l == rrset_changetype r - && rrset_records l == rrset_records r - && rrset_comments l == rrset_comments r + } deriving (Eq, Ord, Show, Generic, NFData, Data) instance ToJSON RRSet where toJSON = genericToJSON defaultOptions { fieldLabelModifier = strip "rrset_" @@ -334,7 +338,7 @@ data Comment = Comment { comment_content :: Maybe T.Text , comment_account :: Maybe T.Text - , commant_modified_at :: Maybe POSIXTime + , comment_modified_at :: Maybe POSIXTime } deriving (Eq, Ord, Show, Generic, NFData, Data, Empty) instance ToJSON Comment where diff --git a/powerdns.cabal b/powerdns.cabal --- a/powerdns.cabal +++ b/powerdns.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: powerdns -version: 0.2.2 +version: 0.3.0 license: BSD3 license-file: LICENSE copyright: (c) 2021 Victor Nawothnig @@ -26,7 +26,7 @@ > main = do > uri <- parseBaseUrl "http://localhost:8081" > mgr <- newManager defaultManagerSettings - > env <- P.applyXApiKey "secret" <$> mkClientEnv + > let env = P.applyXApiKey "secret" (mkClientEnv mgr uri) > > Right r <- runClientM (P.statistics "localhost" Nothing Nothing) env) > traverse_ print r @@ -55,6 +55,7 @@ bytestring >=0.10.10 && <0.11, deepseq >=1.4.4 && <1.5, containers >=0.6.2 && <0.7, + hashable >= 1.3.5.0 && <1.4, text >=1.2.4 && <1.3, time >=1.9.3 && <1.10, base64-bytestring >=1.1.0 && <1.2, diff --git a/spec/Spec.hs b/spec/Spec.hs --- a/spec/Spec.hs +++ b/spec/Spec.hs @@ -48,11 +48,21 @@ otherSpecs :: TestTree otherSpecs = testGroup "Case-sensitivity" - [ testCase "RRSet does case-insensitive comparison on ASCII codepoints" $ + [ testCase "RRSet does case-insensitive compare on ASCII codepoints" $ + assertEqual "" (compare (RRSet "Foo." A 0 Nothing Nothing Nothing) + (RRSet "foo." A 0 Nothing Nothing Nothing)) + EQ + , testCase "RRSet does case-insensitive eq on ASCII codepoints" $ assertEqual "" (RRSet "Foo." A 0 Nothing Nothing Nothing) (RRSet "foo." A 0 Nothing Nothing Nothing) - , testCase "RRSet does case-sensitive comparison on non-ASCII codepoints" $ + , testCase "RRSet does case-sensitive compare on non-ASCII codepoints" $ + assertEqual "" (compare (RRSet "\335." A 0 Nothing Nothing Nothing) + (RRSet "\375." A 0 Nothing Nothing Nothing)) + LT + + + , testCase "RRSet does case-sensitive eq on non-ASCII codepoints" $ assertBool "" ((RRSet "\335." A 0 Nothing Nothing Nothing) /= (RRSet "\375." A 0 Nothing Nothing Nothing))