diff --git a/Aws/Route53/Core.hs b/Aws/Route53/Core.hs --- a/Aws/Route53/Core.hs +++ b/Aws/Route53/Core.hs @@ -116,7 +116,7 @@ instance DefaultServiceConfiguration (Route53Configuration NormalQuery) where defServiceConfig = route53 debugServiceConfig = route53 - + instance DefaultServiceConfiguration (Route53Configuration UriOnlyQuery) where defServiceConfig = route53 debugServiceConfig = route53 @@ -156,7 +156,7 @@ -- -------------------------------------------------------------------------- -- -- Metadata -data Route53Metadata = Route53Metadata +data Route53Metadata = Route53Metadata { requestId :: Maybe T.Text } deriving (Show, Typeable) @@ -171,17 +171,17 @@ -- -------------------------------------------------------------------------- -- -- Query -route53SignQuery :: Method - -> B.ByteString - -> [(B.ByteString, B.ByteString)] - -> Maybe XML.Element - -> Route53Configuration qt - -> SignatureData +route53SignQuery :: Method + -> B.ByteString + -> [(B.ByteString, B.ByteString)] + -> Maybe XML.Element + -> Route53Configuration qt + -> SignatureData -> SignedQuery route53SignQuery method resource query body Route53Configuration{..} sd = SignedQuery { sqMethod = method - , sqProtocol = route53Protocol + , sqProtocol = route53Protocol , sqHost = route53Endpoint , sqPort = route53Port , sqPath = route53ApiVersion `B.append` resource @@ -206,14 +206,14 @@ ] query' = ("AWSAccessKeyId", accessKeyId) : query - renderBody b = HTTP.RequestBodyLBS . XML.renderLBS XML.def $ XML.Document + renderBody b = HTTP.RequestBodyLBS . XML.renderLBS XML.def $ XML.Document { XML.documentPrologue = XML.Prologue [] Nothing [] , XML.documentRoot = b { elementAttributes = addNamespace (elementAttributes b) } , XML.documentEpilogue = [] } addNamespace attrs = insert "xmlns" route53XmlNamespace attrs - + -- -------------------------------------------------------------------------- -- -- Response @@ -244,7 +244,7 @@ route53CheckResponseType :: MonadThrow m => a -> Text -> Cu.Cursor -> m a -route53CheckResponseType a n c = do +route53CheckResponseType a n c = do _ <- force ("Expected response type " ++ unpack n) (Cu.laxElement n c) return a @@ -257,12 +257,12 @@ class Route53Id r where idQualifier :: r -> T.Text idText :: r -> T.Text - + asId :: T.Text -> r - asId t = asId' . fromJust .T.stripPrefix (qualifiedIdTextPrefix (undefined::r)) $ t + asId t = asId' . fromJust . T.stripPrefix (qualifiedIdTextPrefix (undefined::r)) $ t qualifiedIdTextPrefix :: r -> T.Text - qualifiedIdTextPrefix r = "/" `T.append` idQualifier r `T.append` "/" + qualifiedIdTextPrefix r = "/" `T.append` idQualifier r `T.append` "/" qualifiedIdText :: r -> T.Text qualifiedIdText r = qualifiedIdTextPrefix r `T.append` idText r @@ -280,7 +280,7 @@ -- -------------------------------------------------------------------------- -- -- DNS -data RecordType = A | AAAA | NS | TXT | MX | CNAME | SOA | PTR | SRV | SPF | UNKNOWN Int +data RecordType = A | AAAA | NS | TXT | MX | CNAME | SOA | PTR | SRV | SPF | UNKNOWN Int deriving (Eq, Show, Read) typeToString :: RecordType -> String @@ -308,7 +308,7 @@ type HostedZones = [HostedZone] -data HostedZone = HostedZone +data HostedZone = HostedZone { hzId :: HostedZoneId , hzName :: Domain , hzCallerReference :: T.Text @@ -352,7 +352,7 @@ type Nameserver = Domain -data DelegationSet = DelegationSet { dsNameserver1 :: Domain +data DelegationSet = DelegationSet { dsNameserver1 :: Domain , dsNameserver2 :: Domain , dsNameserver3 :: Domain , dsNameserver4 :: Domain @@ -373,7 +373,7 @@ sequence $ c $/ laxElement "Nameserver" &| r53Parse instance Route53Parseable Nameserver where - r53Parse cursor = + r53Parse cursor = force "Missing Nameserver element" $ cursor $.// elContent "Nameserver" &| Domain -- -------------------------------------------------------------------------- -- @@ -430,7 +430,7 @@ , rrsTTL :: Maybe Int , rrsRecords :: ResourceRecords } deriving (Show) - + type ResourceRecordSets = [ResourceRecordSet] instance Route53XmlSerializable ResourceRecordSet where @@ -440,7 +440,7 @@ #{typeToText rrsType} $maybe a <- rrsAliasTarget ^{[XML.NodeElement (toXml a)]} - $maybe i <- rrsSetIdentifier + $maybe i <- rrsSetIdentifier #{i} $maybe w <- rrsWeight #{intToText w} @@ -487,14 +487,19 @@ instance Route53Parseable AliasTarget where r53Parse cursor = do c <- force "Missing AliasTarget element" $ cursor $.// laxElement "AliasTarget" - zoneId <- force "Missing HostedZoneId element" $ c $/ elContent "HostedZoneId" &| asId + -- Note: `HostedZoneId` does not come with a `/hostname/` prefix. It can be thus directly + -- passed to the `HostZoneId` constructer instead of to `asId`. + zoneId <- force "Missing HostedZoneId element" $ c $/ elContent "HostedZoneId" &| HostedZoneId dnsName <- force "Missing DNSName element" $ c $/ elContent "DNSName" &| Domain return $ AliasTarget zoneId dnsName instance Route53Parseable ResourceRecords where r53Parse cursor = do - c <- force "Missing ResourceRecords element" $ cursor $.// laxElement "ResourceRecords" - sequence $ c $/ laxElement "ResourceRecord" &| r53Parse + -- `resourceRecords` might actually be missing. Return empty list if so. + let c = listToMaybe $ cursor $.// laxElement "ResourceRecords" + case c of + Nothing -> return [] + Just cur -> sequence $ cur $/ laxElement "ResourceRecord" &| r53Parse instance Route53Parseable ResourceRecord where r53Parse cursor = do @@ -545,25 +550,25 @@ class Route53Parseable r where r53Parse :: MonadThrow m => Cu.Cursor -> m r --- | Takes the first @n@ elements from a List and injects them into a 'MonadPlus'. --- Causes a failure in the 'Control.Failure' Monad if there are not enough elements --- in the List. +-- | Takes the first @n@ elements from a List and injects them into a 'MonadPlus'. +-- Causes a failure in the 'Control.Failure' Monad if there are not enough elements +-- in the List. forceTake :: (MonadThrow f, MonadPlus m) => Int -> String -> [a] -> f (m a) forceTake 0 _ _ = return mzero forceTake _ e [] = force e [] -forceTake n e l = do +forceTake n e l = do h <- force e l t <- forceTake (n-1) e (tail l) return $ return h `mplus` t class Route53XmlSerializable r where - toXml :: r -> XML.Element + toXml :: r -> XML.Element intToText :: Int -> T.Text intToText = T.pack . show -- -------------------------------------------------------------------------- -- --- Utility methods that extend the functionality of 'Network.HTTP.Types' +-- Utility methods that extend the functionality of 'Network.HTTP.Types' hRequestId :: HTTP.HeaderName hRequestId = "x-amzn-requestid" @@ -573,4 +578,3 @@ findHeaderValue :: [HTTP.Header] -> HTTP.HeaderName -> Maybe B.ByteString findHeaderValue headers hName = lookup hName headers - diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +# 0.1.2.2 - 26th February, 2016 + +* Fix bug with decoding ResourceRecordSet. + # 0.1.2.1 - 30th October, 2015 * Fix warning with GHC 7.10. diff --git a/aws-route53.cabal b/aws-route53.cabal --- a/aws-route53.cabal +++ b/aws-route53.cabal @@ -1,5 +1,5 @@ name: aws-route53 -version: 0.1.2.1 +version: 0.1.2.2 synopsis: Amazon Route53 DNS service plugin for the aws package. description: Amazon Route53 DNS service plugin for the aws package. license: BSD3 @@ -55,7 +55,7 @@ Source-repository this type: git location: https://github.com/memcachier/aws-route53.git - tag: 0.1.2.1 + tag: 0.1.2.2 Source-repository head type: git