powerdns 0.2.2 → 0.3.0

raw patch · 5 files changed

+118/−93 lines, 5 filesdep +hashablePVP ok

version bump matches the API change (PVP)

Dependencies added: hashable

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• PowerDNS/API/TSIGKeys.hs +11/−13
• PowerDNS/API/Zones.hs +80/−76
• powerdns.cabal +3/−2
• spec/Spec.hs +12/−2

@@ -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

@@ -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  ---------------------------------------------------------------------------------------- 

@@ -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

@@ -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,

@@ -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))