aws-route53 (empty) → 0.0.1
raw patch · 14 files changed
+1218/−0 lines, 14 filesdep +awsdep +basedep +bytestringsetup-changed
Dependencies added: aws, base, bytestring, containers, failure, http-conduit, http-types, old-locale, text, time, xml-conduit, xml-hamlet
Files
- Aws/Route53.hs +12/−0
- Aws/Route53/Commands.hs +30/−0
- Aws/Route53/Commands/ChangeResourceRecordSets.hs +68/−0
- Aws/Route53/Commands/CreateHostedZone.hs +65/−0
- Aws/Route53/Commands/DeleteHostedZone.hs +57/−0
- Aws/Route53/Commands/GetChange.hs +49/−0
- Aws/Route53/Commands/GetDate.hs +64/−0
- Aws/Route53/Commands/GetHostedZone.hs +52/−0
- Aws/Route53/Commands/ListHostedZones.hs +63/−0
- Aws/Route53/Commands/ListResourceRecordSets.hs +97/−0
- Aws/Route53/Core.hs +565/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- aws-route53.cabal +64/−0
+ Aws/Route53.hs view
@@ -0,0 +1,12 @@+-- ------------------------------------------------------ --+-- Copyright © 2012 AlephCloud Systems, Inc.+-- ------------------------------------------------------ --++module Aws.Route53+( module Aws.Route53.Commands+, module Aws.Route53.Core+)+where++import Aws.Route53.Commands+import Aws.Route53.Core
+ Aws/Route53/Commands.hs view
@@ -0,0 +1,30 @@+-- ------------------------------------------------------ --+-- Copyright © 2012 AlephCloud Systems, Inc.+-- ------------------------------------------------------ --++module Aws.Route53.Commands+( -- * Actions on Hosted Zones+ module Aws.Route53.Commands.CreateHostedZone+, module Aws.Route53.Commands.GetHostedZone+, module Aws.Route53.Commands.DeleteHostedZone+, module Aws.Route53.Commands.ListHostedZones++ -- * Actions on Resource Record Sets+, module Aws.Route53.Commands.ChangeResourceRecordSets+, module Aws.Route53.Commands.ListResourceRecordSets+, module Aws.Route53.Commands.GetChange++ -- * Other Commands+, module Aws.Route53.Commands.GetDate+)+where++import Aws.Route53.Commands.CreateHostedZone+import Aws.Route53.Commands.GetHostedZone+import Aws.Route53.Commands.DeleteHostedZone+import Aws.Route53.Commands.ListHostedZones+import Aws.Route53.Commands.ChangeResourceRecordSets+import Aws.Route53.Commands.ListResourceRecordSets+import Aws.Route53.Commands.GetChange+import Aws.Route53.Commands.GetDate+
+ Aws/Route53/Commands/ChangeResourceRecordSets.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE QuasiQuotes #-}+-- ------------------------------------------------------ --+-- Copyright © 2012 AlephCloud Systems, Inc.+-- ------------------------------------------------------ --++-- | POST ChangeResourceRecordSetrs+--+-- Creates, changes, or deletes resource records sets.+--+-- <http://docs.amazonwebservices.com/Route53/latest/APIReference/API_ChangeResourceRecordSets.html>+--+module Aws.Route53.Commands.ChangeResourceRecordSets where++import Aws.Route53.Core+import Aws.Core+import Text.Hamlet.XML (xml)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Map (empty)+import qualified Text.XML as XML+import qualified Data.ByteString as B++data ACTION = CREATE | DELETE + deriving (Show)++-- TODO enforce constrains either via type or dynamically on creation or usage+data ChangeResourceRecordSets = ChangeResourceRecordSets+ { crrHostedZoneId :: HostedZoneId+ , crrComment :: Maybe T.Text+ , crrsChanges :: [(ACTION, ResourceRecordSet)]+ } deriving (Show)++data ChangeResourceRecordSetsResponse = ChangeResourceRecordSetsResponse+ { crrsrChangeInfo :: ChangeInfo+ } deriving (Show)++-- | ServiceConfiguration: 'Route53Configuration'+instance SignQuery ChangeResourceRecordSets where+ type ServiceConfiguration ChangeResourceRecordSets = Route53Configuration+ signQuery ChangeResourceRecordSets{..} = route53SignQuery method resource query body+ where+ method = Post+ resource = (T.encodeUtf8 . qualifiedIdText) crrHostedZoneId `B.append` "/rrset"+ query = []+ body = Just $ XML.Element "ChangeResourceRecordSetsRequest" empty+ [xml|+ <ChangeBatch>+ $maybe c <- crrComment+ <Comment>#{c}+ <Changes>+ $forall change <- crrsChanges+ <Change>+ <Action>#{T.pack (show (fst change))}+ ^{[XML.NodeElement (toXml (snd change))]}+ |]++instance ResponseConsumer r ChangeResourceRecordSetsResponse where+ type ResponseMetadata ChangeResourceRecordSetsResponse = Route53Metadata++ responseConsumer _ = route53ResponseConsumer parse+ where + parse cursor = do+ route53CheckResponseType () "ChangeResourceRecordSetsResponse" cursor+ changeInfo <- r53Parse cursor+ return $ ChangeResourceRecordSetsResponse changeInfo++instance Transaction ChangeResourceRecordSets ChangeResourceRecordSetsResponse+
+ Aws/Route53/Commands/CreateHostedZone.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE QuasiQuotes #-}+-- ------------------------------------------------------ --+-- Copyright © 2012 AlephCloud Systems, Inc.+-- ------------------------------------------------------ --++-- | POST CreateHostedZone+--+-- Create a new Route53 hosted zone.+--+-- <http://docs.amazonwebservices.com/Route53/latest/APIReference/API_CreateHostedZone.html>+--+module Aws.Route53.Commands.CreateHostedZone where++import Aws.Core+import Aws.Route53.Core+import Text.Hamlet.XML (xml)+import qualified Data.Text as T+import Data.Map (empty)+import qualified Text.XML as XML++data CreateHostedZone = CreateHostedZone+ { chzName :: Domain+ , chzCallerReference :: T.Text+ , chzComment :: T.Text+ } deriving (Show)++data CreateHostedZoneResponse = CreateHostedZoneResponse+ { chzrHostedZone :: HostedZone+ , chzrChangeInfo :: ChangeInfo+ , chzrDelegationSet :: DelegationSet+ } deriving (Show)++createHostedZone :: Domain -> T.Text -> T.Text -> CreateHostedZone+createHostedZone name callerReference comment = CreateHostedZone name callerReference comment++-- | ServiceConfiguration: 'Route53Configuration'+instance SignQuery CreateHostedZone where+ type ServiceConfiguration CreateHostedZone = Route53Configuration+ signQuery CreateHostedZone{..} = route53SignQuery method resource query body+ where+ method = Post+ resource = "/hostedzone"+ query = []+ body = Just $ XML.Element "CreateHostedZoneRequest" empty+ [xml|+ <Name>#{dText chzName}+ <CallerReference>#{chzCallerReference}+ <HostedZoneConfig>+ <Comment>#{chzComment}+ |]++instance ResponseConsumer r CreateHostedZoneResponse where+ type ResponseMetadata CreateHostedZoneResponse = Route53Metadata++ responseConsumer _ = route53ResponseConsumer parse+ where + parse cursor = do+ route53CheckResponseType () "CreateHostedZoneResponse" cursor+ zone <- r53Parse cursor+ changeInfo <- r53Parse cursor+ delegationSet <- r53Parse cursor+ return $ CreateHostedZoneResponse zone changeInfo delegationSet++instance Transaction CreateHostedZone CreateHostedZoneResponse+
+ Aws/Route53/Commands/DeleteHostedZone.hs view
@@ -0,0 +1,57 @@+-- ------------------------------------------------------ --+-- Copyright © 2012 AlephCloud Systems, Inc.+-- ------------------------------------------------------ --++-- | DELETE DeleteHostedZone+--+-- Delete a particular Route53 hosted zone identified through its 'hostedZoneId'.+-- The HostedZoneId is obtained in the response to 'Aws.Route53.Commands.CreateHostedZone'+-- or 'Aws.Route53.Commands.ListHostedZones'+--+-- Note that the hosted zone can be delete only after deleting all resource records other than+-- the default SOA record and the NS records.+--+-- <http://docs.amazonwebservices.com/Route53/latest/APIReference/API_DeleteHostedZone.html>+--+module Aws.Route53.Commands.DeleteHostedZone where++import Aws.Core+import Aws.Route53.Core+import qualified Data.Text.Encoding as T++data DeleteHostedZone = DeleteHostedZone+ { dhzHostedZoneId :: HostedZoneId+ } deriving (Show)++data DeleteHostedZoneResponse = DeleteHostedZoneResponse+ { dhzrChangeInfo :: ChangeInfo+ } deriving (Show)++deleteHostedZone :: HostedZoneId -> DeleteHostedZone+deleteHostedZone hostedZoneId = DeleteHostedZone hostedZoneId++-- Delete add convenience methods:+-- * Delete non-empty hosted zone++-- | ServiceConfiguration: 'Route53Configuration'+instance SignQuery DeleteHostedZone where+ type ServiceConfiguration DeleteHostedZone = Route53Configuration+ signQuery DeleteHostedZone{..} = route53SignQuery method resource query body+ where+ method = Delete+ resource = T.encodeUtf8 . qualifiedIdText $ dhzHostedZoneId+ query = []+ body = Nothing++instance ResponseConsumer r DeleteHostedZoneResponse where+ type ResponseMetadata DeleteHostedZoneResponse = Route53Metadata++ responseConsumer _ = route53ResponseConsumer parse+ where + parse cursor = do+ route53CheckResponseType () "DeleteHostedZoneResponse" cursor+ changeInfo <- r53Parse cursor+ return $ DeleteHostedZoneResponse changeInfo++instance Transaction DeleteHostedZone DeleteHostedZoneResponse+
+ Aws/Route53/Commands/GetChange.hs view
@@ -0,0 +1,49 @@+-- ------------------------------------------------------ --+-- Copyright © 2012 AlephCloud Systems, Inc.+-- ------------------------------------------------------ --++-- | GET GetChange+--+-- Returns the current status of change batch request.+--+-- <http://docs.amazonwebservices.com/Route53/latest/APIReference/API_GetChange.html>+--+module Aws.Route53.Commands.GetChange where++import Aws.Core+import Aws.Route53.Core+import qualified Data.Text.Encoding as T++data GetChange = GetChange+ { changeId :: ChangeId+ } deriving (Show)++data GetChangeResponse = GetChangeResponse+ { gcrChangeInfo :: ChangeInfo+ } deriving (Show)++getChange :: ChangeId -> GetChange+getChange changeId = GetChange changeId++-- | ServiceConfiguration: 'Route53Configuration'+instance SignQuery GetChange where+ type ServiceConfiguration GetChange = Route53Configuration+ signQuery GetChange{..} = route53SignQuery method resource query body+ where+ method = Get+ resource = T.encodeUtf8 . qualifiedIdText $ changeId+ query = []+ body = Nothing++instance ResponseConsumer r GetChangeResponse where+ type ResponseMetadata GetChangeResponse = Route53Metadata++ responseConsumer _ = route53ResponseConsumer parse+ where + parse cursor = do+ route53CheckResponseType () "GetChangeResponse" cursor+ changeInfo <- r53Parse cursor+ return $ GetChangeResponse changeInfo++instance Transaction GetChange GetChangeResponse+
+ Aws/Route53/Commands/GetDate.hs view
@@ -0,0 +1,64 @@+-- ------------------------------------------------------ --+-- Copyright © 2012 AlephCloud Systems, Inc.+-- ------------------------------------------------------ --++-- | GET GetDate+--+-- Receive current date string from Route53 service that can be used as date string for+-- authenticating REST requests to Route53.+--+-- <http://docs.amazonwebservices.com/Route53/latest/DeveloperGuide/RESTAuthentication.html>+-- +module Aws.Route53.Commands.GetDate where++import Aws.Core+import Aws.Route53.Core+import Data.Maybe+import Data.Time (UTCTime)+import Data.Time.Format (parseTime)+import System.Locale (defaultTimeLocale)+import Data.ByteString.Char8 (unpack)+import qualified Network.HTTP.Conduit as HTTP+import qualified Network.HTTP.Types as HTTP++data GetDate = GetDate deriving (Show)++newtype GetDateResponse = GetDateResponse { date :: UTCTime } deriving (Show)++-- | ServiceConfiguration: 'Route53Configuration'+instance SignQuery GetDate where+ type ServiceConfiguration GetDate = Route53Configuration+ signQuery GetDate info sd = SignedQuery + { sqMethod = Get+ , sqProtocol = route53Protocol info+ , sqHost = route53Endpoint info+ , sqPort = route53Port info+ , sqPath = "/date/"+ , sqQuery = []+ , sqDate = Just $ signatureTime sd+ , sqAuthorization = Nothing+ , sqContentType = Nothing+ , sqContentMd5 = Nothing+ , sqAmzHeaders = []+ , sqOtherHeaders = []+ , sqBody = Nothing+ , sqStringToSign = ""+ }++instance ResponseConsumer r GetDateResponse where+ type ResponseMetadata GetDateResponse = ()+ responseConsumer _ _ resp = return $ GetDateResponse date+ where+ -- TODO add proper error handling+ date = fromJust $ do+ str <- findHeaderValue (HTTP.responseHeaders resp) HTTP.hDate+ -- FIXME: this is probably to restrictive. We should support full rfc1123+ parseTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S %Z" (unpack str)++getDate :: GetDate+getDate = GetDate++instance Transaction GetDate GetDateResponse++instance Loggable () where+ toLogText _ = ""
+ Aws/Route53/Commands/GetHostedZone.hs view
@@ -0,0 +1,52 @@+-- ------------------------------------------------------ --+-- Copyright © 2012 AlephCloud Systems, Inc.+-- ------------------------------------------------------ --++-- | GET GetHostedZone+--+-- Get a particular Route53 hosted zone identified through its 'hostedZoneId'.+-- The HostedZoneId is obtained in the response to 'Aws.Route53.Commands.CreateHostedZone'+-- or 'Aws.Route53.Commands.ListHostedZones'+--+-- <http://docs.amazonwebservices.com/Route53/latest/APIReference/API_GetHostedZone.html>+--+module Aws.Route53.Commands.GetHostedZone where++import Aws.Core+import Aws.Route53.Core+import qualified Data.Text.Encoding as T++data GetHostedZone = GetHostedZone+ { hostedZoneId :: HostedZoneId+ } deriving (Show)++data GetHostedZoneResponse = GetHostedZoneResponse+ { ghzrHostedZone :: HostedZone+ , ghzrDelegationSet :: DelegationSet+ } deriving (Show)++getHostedZone :: HostedZoneId -> GetHostedZone+getHostedZone hostedZoneId = GetHostedZone hostedZoneId++-- | ServiceConfiguration: 'Route53Configuration'+instance SignQuery GetHostedZone where+ type ServiceConfiguration GetHostedZone = Route53Configuration+ signQuery GetHostedZone{..} = route53SignQuery method resource query Nothing+ where+ method = Get+ resource = T.encodeUtf8 . qualifiedIdText $ hostedZoneId+ query = []++instance ResponseConsumer r GetHostedZoneResponse where+ type ResponseMetadata GetHostedZoneResponse = Route53Metadata++ responseConsumer _ = route53ResponseConsumer parse+ where + parse cursor = do+ route53CheckResponseType () "GetHostedZoneResponse" cursor+ zone <- r53Parse cursor+ delegationSet <- r53Parse cursor+ return $ GetHostedZoneResponse zone delegationSet++instance Transaction GetHostedZone GetHostedZoneResponse+
+ Aws/Route53/Commands/ListHostedZones.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE TupleSections #-}+-- ------------------------------------------------------ --+-- Copyright © 2012 AlephCloud Systems, Inc.+-- ------------------------------------------------------ --++-- | GET ListHostedZones+--+-- List all Route53 hosted zones of the user, optionally paginated.+--+-- <http://docs.amazonwebservices.com/Route53/latest/APIReference/API_ListHostedZones.html>+--+module Aws.Route53.Commands.ListHostedZones where++import Aws.Core+import Aws.Route53.Core+import Data.Maybe+import Control.Applicative ((<$>), (<$))+import Text.XML.Cursor (($//))+import qualified Data.Text as T+import qualified Data.Text.Encoding as T++data ListHostedZones = ListHostedZones+ { lhzMaxNumberOfItems :: Maybe Int+ , lhzNextToken :: Maybe T.Text+ } deriving (Show)++data ListHostedZonesResponse = ListHostedZonesResponse+ { lhzrHostedZones :: HostedZones+ , lhzrNextToken :: Maybe T.Text+ } deriving (Show)++listHostedZones :: ListHostedZones+listHostedZones = ListHostedZones { lhzMaxNumberOfItems = Nothing, lhzNextToken = Nothing }++-- | ServiceConfiguration: 'Route53Configuration'+instance SignQuery ListHostedZones where+ type ServiceConfiguration ListHostedZones = Route53Configuration+ signQuery ListHostedZones{..} = route53SignQuery method resource query Nothing+ where+ method = Get+ resource = "/hostedzone"+ query = catMaybes+ [ ("MaxItems",) . T.encodeUtf8 . T.pack . show <$> lhzMaxNumberOfItems+ , ("NextToken",) . T.encodeUtf8 <$> lhzNextToken+ ]++instance ResponseConsumer r ListHostedZonesResponse where+ type ResponseMetadata ListHostedZonesResponse = Route53Metadata++ responseConsumer _ = route53ResponseConsumer parser+ where + parser cursor = do+ route53CheckResponseType () "ListHostedZonesResponse" cursor+ zones <- r53Parse cursor+ let nextToken = listToMaybe $ cursor $// elContent "NextMarker"+ return $ ListHostedZonesResponse zones nextToken++instance Transaction ListHostedZones ListHostedZonesResponse++instance IteratedTransaction ListHostedZones ListHostedZonesResponse where+ nextIteratedRequest req ListHostedZonesResponse{ lhzrNextToken = nt } = req { lhzNextToken = nt } <$ nt+ --combineIteratedResponse (ListHostedZonesResponse z0 _) (ListHostedZonesResponse z1 nt) = ListHostedZonesResponse (z0 ++ z1) nt+
+ Aws/Route53/Commands/ListResourceRecordSets.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE TupleSections #-}+-- ------------------------------------------------------ --+-- Copyright © 2012 AlephCloud Systems, Inc.+-- ------------------------------------------------------ --++-- | GET ListResourceRecordSets+--+-- Lists the resource record sets for a Route53 hosted zone. The hosted zone is identified by+-- the hostedZoneId which is retrieved in the response to 'Aws.Route53.Commands.ListHostedZones' +-- or 'Aws.Route53.Commands.CreateHostedZone'.+-- +-- <http://docs.amazonwebservices.com/Route53/latest/APIReference/API_ListResourceRecordSets.html>+--+-- NOTE: the parameter 'identifier' is required for weighted and latency resource record sets. This is+-- not enforced by the type.+--+module Aws.Route53.Commands.ListResourceRecordSets where++import Aws.Core+import Aws.Route53.Core+import Data.Maybe (catMaybes, listToMaybe)+import Control.Applicative ((<$>))+import Control.Monad (guard)+import Text.XML.Cursor (($//), (&|), ($/))+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.ByteString.Char8 as B++data ListResourceRecordSets = ListResourceRecordSets+ { lrrsHostedZoneId :: HostedZoneId+ , lrrsName :: Maybe Domain+ , lrrsRecordType :: Maybe RecordType+ , lrrsIdentifier :: Maybe T.Text -- ^ must be present for weighted or latency resource record sets. TODO introduce newtype wrapper+ , lrrsMaxItems :: Maybe Int -- ^ maximum effective value is 100+ } deriving (Show)++-- | A most general 'ListResourceRecordSets' query+listResourceRecordSets :: HostedZoneId -> ListResourceRecordSets+listResourceRecordSets hostedZoneId = ListResourceRecordSets hostedZoneId Nothing Nothing Nothing Nothing++data ListResourceRecordSetsResponse = ListResourceRecordSetsResponse+ { lrrsrResourceRecordSets :: ResourceRecordSets+ , lrrsrIsTruncated :: Bool+ , lrrsrMaxItems :: Maybe Int -- ^ The maxitems value from the request + , lrrsrNextRecordName :: Maybe Domain -- ^ TODO check constraint+ , lrrsrNextRecordType :: Maybe RecordType -- ^ TODO check constraint+ , lrrsrNextRecordIdentifier :: Maybe T.Text -- ^ TODO check constraint+ } deriving (Show)++-- | ServiceConfiguration: 'Route53Configuration'+instance SignQuery ListResourceRecordSets where+ type ServiceConfiguration ListResourceRecordSets = Route53Configuration+ signQuery ListResourceRecordSets{..} = route53SignQuery method resource query body+ where+ method = Get+ body = Nothing+ resource = (T.encodeUtf8 . qualifiedIdText) lrrsHostedZoneId `B.append` "/rrset"+ query = catMaybes [ ("name",) . T.encodeUtf8 . dText <$> lrrsName+ , ("type",) . B.pack . typeToString <$> lrrsRecordType+ , ("identifier",) . T.encodeUtf8 <$> lrrsIdentifier+ , ("maxitems",) . B.pack . show <$> lrrsMaxItems+ ]++instance ResponseConsumer r ListResourceRecordSetsResponse where+ type ResponseMetadata ListResourceRecordSetsResponse = Route53Metadata++ responseConsumer _ = route53ResponseConsumer parser+ where+ parser cursor = do+ route53CheckResponseType () "ListResourceRecordSetsResponse" cursor+ resourceRecordSets <- r53Parse cursor+ isTruncated <- force "Missing IsTruncated element" $ cursor $/ elCont "IsTruncated" &| ("true"==)+ maxItems <- listToMaybe <$> (sequence $ cursor $/ elCont "MaxItems" &| readInt)+ let nextRecordName = listToMaybe $ cursor $// elContent "NextRecordName" &| Domain+ let nextRecordType = listToMaybe $ cursor $// elCont "NextRecordType" &| read+ let nextRecordIdentifier = listToMaybe $ cursor $// elContent "NextRecordIdentifier"+ return $ ListResourceRecordSetsResponse resourceRecordSets isTruncated maxItems nextRecordName nextRecordType nextRecordIdentifier++instance Transaction ListResourceRecordSets ListResourceRecordSetsResponse++instance IteratedTransaction ListResourceRecordSets ListResourceRecordSetsResponse where+ nextIteratedRequest ListResourceRecordSets{..} ListResourceRecordSetsResponse{..} = do+ guard lrrsrIsTruncated+ return $ ListResourceRecordSets lrrsHostedZoneId + lrrsrNextRecordName + lrrsrNextRecordType + lrrsrNextRecordIdentifier + lrrsrMaxItems+{- combineIteratedResponse a b = ListResourceRecordSetsResponse+ { lrrsrResourceRecordSets = lrrsrResourceRecordSets a ++ lrrsrResourceRecordSets b+ , lrrsrIsTruncated = lrrsrIsTruncated b+ , lrrsrNextRecordName = lrrsrNextRecordName b+ , lrrsrNextRecordType = lrrsrNextRecordType b+ , lrrsrNextRecordIdentifier = lrrsrNextRecordIdentifier b+ , lrrsrMaxItems = lrrsrMaxItems b+ }-}+
+ Aws/Route53/Core.hs view
@@ -0,0 +1,565 @@+{-# LANGUAGE QuasiQuotes, FlexibleContexts, TypeSynonymInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- ------------------------------------------------------ --+-- Copyright © 2012 AlephCloud Systems, Inc.+-- ------------------------------------------------------ --++module Aws.Route53.Core+( -- * Configuration+ Route53Configuration(..)+, route53EndpointUsClassic+, route53++ -- * Error+, Route53Error(..)++ -- * Metadata+, Route53Metadata(..)++ -- * Query+, route53SignQuery++ -- * Response+, route53ResponseConsumer+, route53CheckResponseType++ -- * Model++ -- ** DNS+, RecordType(..)+, typeToString++ -- ** Hosted Zone+, HostedZone (..)+, HostedZones+, Domain(..)+, HostedZoneId(..)++ -- ** Delegation Set+, DelegationSet(..)+, Nameserver+, Nameservers+, dsNameservers++ -- ** Resource Record Set+, REGION(..)+, ResourceRecordSets+, ResourceRecordSet(..)+, ResourceRecords+, ResourceRecord(..)+, AliasTarget(..)++ -- ** Change Info+, ChangeInfo(..)+, ChangeInfoStatus(..)+, ChangeId(..)++ -- * Parser Utilities+, Route53Parseable(..)+, Route53XmlSerializable(..)+, Route53Id(..)++ -- * HTTP Utilites+ -- | This functions extend 'Network.HTTP.Types'+, findHeader+, findHeaderValue+, hRequestId+) where++import Aws.Core+import Data.IORef+import Data.Monoid+import Data.String+import Data.Typeable+import Control.Monad (MonadPlus, mzero, mplus, liftM)+import Data.List (find)+import Data.Map (insert, empty)+import Data.Maybe (fromMaybe, listToMaybe, fromJust)+import Data.Text (Text, unpack)+import Data.Text.Encoding (decodeUtf8)+import Data.Time (UTCTime)+import Data.Time.Format (parseTime)+import System.Locale (defaultTimeLocale)+import Text.Hamlet.XML (xml)+import Text.XML (elementAttributes)+import Text.XML.Cursor (($/), ($//), (&|), ($.//), laxElement)+import qualified Control.Exception as C+import qualified Control.Failure as F+import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Network.HTTP.Conduit as HTTP+import qualified Network.HTTP.Types as HTTP+import qualified Text.XML as XML+import qualified Text.XML.Cursor as Cu++-- -------------------------------------------------------------------------- --+-- Configuration++data Route53Configuration qt = Route53Configuration+ { route53Protocol :: Protocol+ , route53Endpoint :: B.ByteString+ , route53Port :: Int+ , route53ApiVersion :: B.ByteString+ , route53XmlNamespace :: T.Text++ } deriving (Show)++instance DefaultServiceConfiguration (Route53Configuration NormalQuery) where+ defServiceConfig = route53+ debugServiceConfig = route53+ +instance DefaultServiceConfiguration (Route53Configuration UriOnlyQuery) where+ defServiceConfig = route53+ debugServiceConfig = route53++route53EndpointUsClassic :: B.ByteString+route53EndpointUsClassic = "route53.amazonaws.com"++route53ApiVersionRecent :: B.ByteString+route53ApiVersionRecent = "2012-02-29"++route53XmlNamespaceRecent :: Text+route53XmlNamespaceRecent = "https://route53.amazonaws.com/doc/" `T.append` T.decodeUtf8 route53ApiVersionRecent `T.append` "/"++route53 :: Route53Configuration qt+route53 = Route53Configuration+ { route53Protocol = HTTPS+ , route53Endpoint = route53EndpointUsClassic+ , route53Port = defaultPort HTTPS+ , route53ApiVersion = route53ApiVersionRecent+ , route53XmlNamespace = route53XmlNamespaceRecent+ }++-- -------------------------------------------------------------------------- --+-- Error++-- TODO route53 documentation seem to indicate that there is also a type field in the error response body.+-- http://docs.amazonwebservices.com/Route53/latest/DeveloperGuide/ResponseHeader_RequestID.html++data Route53Error = Route53Error+ { route53StatusCode :: HTTP.Status+ , route53ErrorCode :: Text+ , route53ErrorMessage :: Text+ } deriving (Show, Typeable)++instance C.Exception Route53Error++-- -------------------------------------------------------------------------- --+-- Metadata++data Route53Metadata = Route53Metadata + { requestId :: Maybe T.Text+ } deriving (Show, Typeable)++instance Loggable Route53Metadata where+ toLogText (Route53Metadata rid) = "Route53: request ID=" `mappend`+ fromMaybe "<none>" rid++instance Monoid Route53Metadata where+ mempty = Route53Metadata Nothing+ Route53Metadata r1 `mappend` Route53Metadata r2 = Route53Metadata (r1 `mplus` r2)++-- -------------------------------------------------------------------------- --+-- Query++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 + , sqHost = route53Endpoint+ , sqPort = route53Port+ , sqPath = route53ApiVersion `B.append` resource+ , sqQuery = HTTP.simpleQueryToQuery query'+ , sqDate = Just $ signatureTime sd+ , sqAuthorization = Nothing+ , sqContentType = Nothing+ , sqContentMd5 = Nothing+ , sqAmzHeaders = [("X-Amzn-Authorization", authorization)]+ , sqOtherHeaders = []+ , sqBody = renderBody `fmap` body+ , sqStringToSign = stringToSign+ }+ where+ stringToSign = fmtRfc822Time (signatureTime sd)+ credentials = signatureCredentials sd+ accessKeyId = accessKeyID credentials+ authorization = B.concat [ "AWS3-HTTPS AWSAccessKeyId="+ , accessKeyId+ , ", Algorithm=HmacSHA256, Signature="+ , signature credentials HmacSHA256 stringToSign+ ]+ query' = ("AWSAccessKeyId", accessKeyId) : query++ 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++-- TODO: the documentation seems to indicate that in case of errors the requestId is returned in the body+-- Have a look at Ses/Response.hs how to parse the requestId element. We may try both (header and+-- body element) on each response and sum the results with `mplus` in the Maybe monad.+-- http://docs.amazonwebservices.com/Route53/latest/DeveloperGuide/ResponseHeader_RequestID.html++route53ResponseConsumer :: (Cu.Cursor -> Response Route53Metadata a)+ -> IORef Route53Metadata+ -> HTTPResponseConsumer a+route53ResponseConsumer inner metadataRef response =+ xmlCursorConsumer parse metadataRef response+ where+ status = (HTTP.responseStatus response)+ headers = (HTTP.responseHeaders response)++ parse cursor = do+ tellMetadata . Route53Metadata . fmap decodeUtf8 $ findHeaderValue headers hRequestId+ case cursor $/ Cu.laxElement "Error" of+ [] -> inner cursor+ (err:_) -> fromError err++ fromError cursor = do+ errCode <- force "Missing Error Code" $ cursor $// elContent "Code"+ errMessage <- force "Missing Error Message" $ cursor $// elContent "Message"+ F.failure $ Route53Error status errCode errMessage+++route53CheckResponseType :: F.Failure XmlException m => a -> Text -> Cu.Cursor -> m a+route53CheckResponseType a n c = do + _ <- force ("Expected response type " ++ unpack n) (Cu.laxElement n c)+ return a++-- TODO analyse the possible response types. I think there are common patterns.+-- Collect common code from the Commands here++-- -------------------------------------------------------------------------- --+-- Model++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++ qualifiedIdTextPrefix :: r -> T.Text+ qualifiedIdTextPrefix r = "/" `T.append` idQualifier r `T.append` "/" ++ qualifiedIdText :: r -> T.Text+ qualifiedIdText r = qualifiedIdTextPrefix r `T.append` idText r++ -- | Helper for defining 'asId'. Constructs 'r' from a 'T.Text' assuming that+ -- the qualifier with already stripped from the argument.+ --+ -- Define either this or 'asId'. Usually defining 'asId'' is easier.+ asId' :: (T.Text -> r)+ asId' t = asId $ qualifiedIdTextPrefix (undefined::r) `T.append` t++--instance (Route53Id r) => IsString r where+-- fromString = HostedZoneId . fromJust . T.stripPrefix (idPrefix undefined) . T.pack++-- -------------------------------------------------------------------------- --+-- DNS++data RecordType = A | AAAA | NS | TXT | MX | CNAME | SOA | PTR | SRV | SPF | UNKNOWN Int + deriving (Eq, Show, Read)++typeToString :: RecordType -> String+typeToString = show++typeToText :: RecordType -> T.Text+typeToText = T.pack . typeToString++-- -------------------------------------------------------------------------- --+-- HostedZone++newtype HostedZoneId = HostedZoneId { hziText :: T.Text }+ deriving (Show, IsString, Eq)++instance Route53Id HostedZoneId where+ idQualifier = const "hostedzone"+ idText = hziText+ asId' = HostedZoneId++newtype Domain = Domain { dText :: T.Text }+ deriving (Show, Eq)++instance IsString Domain where+ fromString = Domain . T.pack++type HostedZones = [HostedZone]++data HostedZone = HostedZone + { hzId :: HostedZoneId+ , hzName :: Domain+ , hzCallerReference :: T.Text+ , hzComment :: T.Text+ , hzResourceRecordSetCount :: Int+ } deriving (Show)++instance Route53Parseable HostedZones where+ r53Parse cursor = do+ c <- force "Missing HostedZones element" $ cursor $.// laxElement "HostedZones"+ sequence $ c $/ laxElement "HostedZone" &| r53Parse++instance Route53Parseable HostedZone where+ r53Parse cursor = do+ c <- force "Missing HostedZone element" $ cursor $.// laxElement "HostedZone"+ zoneId <- force "Missing hostedZoneId element" $ c $/ elContent "Id" &| asId+ name <- force "Missing Name element" $ c $/ elContent "Name" &| Domain+ callerReference <- force "Missing CallerReference element" $ c $/ elContent "CallerReference"+ let comment = case (c $// elContent "Comment") of { [] -> T.empty; (x:_) -> x }+ resourceRecordSetCount <- forceM "Missing ResourceRecordCount" $ c $/ elCont "ResourceRecordSetCount" &| readInt+ return $ HostedZone zoneId name callerReference comment resourceRecordSetCount++instance Route53XmlSerializable HostedZone where++ toXml HostedZone{..} = XML.Element "HostedZone" empty [xml|+ <Id>#{idText hzId}+ <Name>#{dText hzName}+ <CallerReference>#{hzCallerReference}+ <Config>+ <Comment>#{hzComment}+ <ResourceRecordSetCount>#{intToText hzResourceRecordSetCount}+ |]++instance Route53XmlSerializable HostedZones where+ toXml hostedZones = XML.Element "HostedZones" empty $ (XML.NodeElement . toXml) `map` hostedZones++-- -------------------------------------------------------------------------- --+-- Delegation Set++type Nameservers = [Nameserver]++type Nameserver = Domain++data DelegationSet = DelegationSet { dsNameserver1 :: Domain + , dsNameserver2 :: Domain+ , dsNameserver3 :: Domain+ , dsNameserver4 :: Domain+ } deriving (Show)++dsNameservers :: DelegationSet -> [Domain]+dsNameservers DelegationSet{..} = [dsNameserver1, dsNameserver2, dsNameserver3, dsNameserver4]++instance Route53Parseable DelegationSet where+ r53Parse cursor = do+ c <- force "Missing DelegationSet element" $ cursor $.// laxElement "DelegationSet"+ [ns1, ns2, ns3, ns4] <- forceTake 4 "Expected four nameservers in DelegationSet" =<< r53Parse c+ return $ DelegationSet ns1 ns2 ns3 ns4++instance Route53Parseable Nameservers where+ r53Parse cursor = do+ c <- force "Missing Nameservers element" $ cursor $.// laxElement "Nameservers"+ sequence $ c $/ laxElement "Nameserver" &| r53Parse++instance Route53Parseable Nameserver where+ r53Parse cursor = + force "Missing Nameserver element" $ cursor $.// elContent "Nameserver" &| Domain++-- -------------------------------------------------------------------------- --+-- ResourceRecordSet++data REGION = ApNorthEast1+ | ApSouthEast2+ | EuWest1+ | SaEast1+ | UsEast1+ | UsWest1+ | UsWest2+ | UnknownRegion+ deriving (Eq)++instance Show REGION where+ show ApNorthEast1 = "ap-north-east-1"+ show ApSouthEast2 = "ap-South-east-2"+ show EuWest1 = "eu-west-1"+ show SaEast1 = "sa-east-1"+ show UsEast1 = "us-east-1"+ show UsWest1 = "us-west-1"+ show UsWest2 = "us-west-2"+ show UnknownRegion = "unknown"++regionToText :: REGION -> T.Text+regionToText = T.pack . show++regionFromString :: String -> REGION+regionFromString "ap-north-east-1" = ApNorthEast1+regionFromString "ap-South-east-2" = ApSouthEast2+regionFromString "eu-west-1" = EuWest1+regionFromString "sa-east-1" = SaEast1+regionFromString "us-east-1" = UsEast1+regionFromString "us-west-1" = UsWest1+regionFromString "us-west-2" = UsWest2+regionFromString _ = UnknownRegion++type ResourceRecords = [ResourceRecord]++newtype ResourceRecord = ResourceRecord { value :: T.Text }+ deriving (Show, Eq)++data AliasTarget = AliasTarget { atHostedZoneId :: HostedZoneId+ , atDNSName :: Domain+ } deriving (Show)++data ResourceRecordSet = ResourceRecordSet { rrsName :: Domain+ , rrsType :: RecordType+ , rrsAliasTarget :: Maybe AliasTarget+ , rrsSetIdentifier :: Maybe T.Text+ , rrsWeight :: Maybe Int+ , rrsRegion :: Maybe REGION+ , rrsTTL :: Maybe Int+ , rrsRecords :: ResourceRecords+ } deriving (Show)+ +type ResourceRecordSets = [ResourceRecordSet]++instance Route53XmlSerializable ResourceRecordSet where++ toXml ResourceRecordSet{..} = XML.Element "ResourceRecordSet" empty [xml|+ <Name>#{dText rrsName}+ <Type>#{typeToText rrsType}+ $maybe a <- rrsAliasTarget+ <AliasTarget>+ ^{[XML.NodeElement (toXml a)]}+ $maybe i <- rrsSetIdentifier + <SetIdentifier>#{i}+ $maybe w <- rrsWeight+ <Weight>#{intToText w}+ $maybe r <- rrsRegion+ <Region>#{regionToText r}+ $maybe t <- rrsTTL+ <TTL>#{intToText t}+ <ResourceRecords>+ $forall record <- rrsRecords+ ^{[XML.NodeElement (toXml record)]}+ |]++instance Route53XmlSerializable ResourceRecord where+ toXml ResourceRecord{..} = XML.Element "ResourceRecord" empty [xml| <Value>#{value} |]++instance Route53XmlSerializable AliasTarget where+ toXml AliasTarget{..} = XML.Element "AliasTarget" empty [xml|+ <HostedZoneId>#{idText atHostedZoneId}+ <DNSName>#{dText atDNSName}+ |]++instance Route53Parseable ResourceRecordSets where+ r53Parse cursor = do+ c <- force "Missing ResourceRecordSets element" $ cursor $.// laxElement "ResourceRecordSets"+ sequence $ c $/ laxElement "ResourceRecordSet" &| r53Parse++instance Route53Parseable ResourceRecordSet where+ r53Parse cursor = do+ c <- force "Missing ResourceRecordSet element" $ cursor $.// laxElement "ResourceRecordSet"+ name <- force "Missing name element" $ c $/ elContent "Name" &| Domain+ dnsType <- force "Missing type element" $ c $/ elCont "Type" &| read+ ttl <- listToMaybe `liftM` (sequence $ c $/ elCont "TTL" &| readInt)+ alias <- listToMaybe `liftM` (sequence $ c $/ laxElement "AliasTarget" &| r53Parse)+ let setIdentifier = listToMaybe $ c $/ elContent "SetIdentifier"+ weight <- listToMaybe `liftM` (sequence $ c $/ elCont "Weight" &| readInt)+ let region = listToMaybe $ c $/ elCont "Region" &| regionFromString+ resourceRecords <- r53Parse c+ return $ ResourceRecordSet name dnsType alias setIdentifier weight region ttl resourceRecords++-- TODO is there any constraint on the number of records?+-- TODO check constraints on type++instance Route53Parseable AliasTarget where+ r53Parse cursor = do+ c <- force "Missing AliasTarget element" $ cursor $.// laxElement "AliasTarget"+ zoneId <- force "Missing HostedZoneId element" $ c $/ elContent "HostedZoneId" &| asId+ 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++instance Route53Parseable ResourceRecord where+ r53Parse cursor = do+ c <- force "Missing ResourceRecord element" $ cursor $.// laxElement "ResourceRecord"+ force "Missing Value element" $ c $/ elContent "Value" &| ResourceRecord++-- -------------------------------------------------------------------------- --+-- Change Info++data ChangeInfoStatus = PENDING | INSYNC+ deriving (Show, Read)++newtype ChangeId = ChangeId { changeIdText :: T.Text }+ deriving (Show, Eq)++instance Route53Id ChangeId where+ idQualifier = const "change"+ idText = changeIdText+ asId' = ChangeId++data ChangeInfo = ChangeInfo { ciId :: ChangeId+ , ciStatus :: ChangeInfoStatus+ , ciSubmittedAt :: UTCTime+ } deriving (Show)++instance Route53Parseable ChangeInfo where+ r53Parse cursor = do+ c <- force "Missing ChangeInfo element" $ cursor $.// laxElement "ChangeInfo"+ ciId <- force "Missing Id element" $ c $/ elContent "Id" &| asId+ status <- force "Missing Status element" $ c $/ elCont "Status" &| read+ submittedAt <- force "Missing SubmittedAt element" $ c $/ elCont "SubmittedAt" &| utcTime+ return $ ChangeInfo ciId status submittedAt+ where+ utcTime str = fromJust $ parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%Z" str++-- -------------------------------------------------------------------------- --+-- Parser and Serialization Utilities++-- | A class for Route53 XML response parsers+--+-- TODO there is a lot of Boilerplat here. With only little overhead serializatin and deserialization+-- could be derived from the instance declaration. Maybe some DLS would be a goold solution++class Route53Parseable r where+ r53Parse :: F.Failure XmlException 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. +forceTake :: (F.Failure XmlException f, MonadPlus m) => Int -> String -> [a] -> f (m a)+forceTake 0 _ _ = return mzero+forceTake _ e [] = force e []+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 ++intToText :: Int -> T.Text+intToText = T.pack . show++-- -------------------------------------------------------------------------- --+-- Utility methods that extend the functionality of 'Network.HTTP.Types' ++hRequestId :: HTTP.HeaderName+hRequestId = "x-amzn-requestid"++findHeader:: [HTTP.Header] -> HTTP.HeaderName -> Maybe HTTP.Header+findHeader headers hName = find ((==hName).fst) headers++findHeaderValue :: [HTTP.Header] -> HTTP.HeaderName -> Maybe B.ByteString+findHeaderValue headers hName = lookup hName headers+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Amit Aryeh Levy++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Amit Aryeh Levy nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ aws-route53.cabal view
@@ -0,0 +1,64 @@+-- Initial aws-route53.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: aws-route53+version: 0.0.1+synopsis: Route53 plugin for the aws package+description: Route53 plugin for the aws package+license: BSD3+license-file: LICENSE+author: Amit Aryeh Levy+maintainer: amit@amitlevy.com+-- copyright: +category: Web+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++Library+ Exposed-modules:+ Aws.Route53,+ Aws.Route53.Core+ Aws.Route53.Commands,+ Aws.Route53.Commands.ListHostedZones,+ Aws.Route53.Commands.ListResourceRecordSets,+ Aws.Route53.Commands.ChangeResourceRecordSets,+ Aws.Route53.Commands.GetHostedZone,+ Aws.Route53.Commands.CreateHostedZone,+ Aws.Route53.Commands.DeleteHostedZone,+ Aws.Route53.Commands.GetChange,+ Aws.Route53.Commands.GetDate++ Build-depends:+ aws,+ base >= 4 && < 6,+ bytestring >= 0.9,+ containers >= 0.4,+ failure >= 0.2.0.1,+ http-conduit >= 1.6,+ http-types >= 0.7,+ old-locale == 1.*,+ text >= 0.11,+ time >= 1.1.4,+ xml-conduit >= 1.0.1,+ xml-hamlet >= 0.3.0++ GHC-Options: -Wall++ Default-Language: Haskell2010+ Default-Extensions:+ RecordWildCards,+ TypeFamilies,+ MultiParamTypeClasses,+ FlexibleInstances,+ OverloadedStrings++Source-repository this+ type: git+ location: https://github.com/memcachier/aws-route53.git+ tag: 0.0.1++Source-repository head+ type: git+ location: https://github.com/memcachier/aws-route53.git+