From be415267a2d925f7b52cc244cb60bdb6a041c0af Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sat, 21 Apr 2012 10:06:48 -0700
Subject: [PATCH 01/55] Initial bits for Route53

---
 Aws/Route53/Commands.hs                 |  7 ++++
 Aws/Route53/Commands/ListHostedZones.hs | 55 +++++++++++++++++++++++++
 Aws/Route53/Info.hs                     | 26 ++++++++++++
 Aws/Route53/Metadata.hs                 | 20 +++++++++
 Aws/Route53/Model.hs                    | 35 ++++++++++++++++
 Aws/Route53/Response.hs                 | 30 ++++++++++++++
 aws.cabal                               |  7 ++++
 7 files changed, 180 insertions(+)
 create mode 100644 Aws/Route53/Commands.hs
 create mode 100644 Aws/Route53/Commands/ListHostedZones.hs
 create mode 100644 Aws/Route53/Info.hs
 create mode 100644 Aws/Route53/Metadata.hs
 create mode 100644 Aws/Route53/Model.hs
 create mode 100644 Aws/Route53/Response.hs

diff --git a/Aws/Route53/Commands.hs b/Aws/Route53/Commands.hs
new file mode 100644
index 00000000..61a89d3c
--- /dev/null
+++ b/Aws/Route53/Commands.hs
@@ -0,0 +1,7 @@
+module Aws.Route53.Commands
+( module Aws.Route53.Commands.ListHostedZones
+)
+where
+
+import Aws.Route53.Commands.ListHostedZones
+
diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
new file mode 100644
index 00000000..5eb0174a
--- /dev/null
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}
+
+module Aws.Route53.Commands.ListHostedZones where
+
+import           Aws.Response
+import           Aws.Signature
+import           Aws.Route53.Info
+import           Aws.Route53.Model
+--import           Aws.Route53.Metadata
+--import           Aws.Route53.Query
+--import           Aws.Route53.Response
+import           Aws.Transaction
+import           Aws.Xml
+import           Control.Applicative
+import           Data.Maybe
+import           Text.XML.Cursor            (($//), (&|))
+import qualified Data.Text                  as T
+import qualified Data.Text.Encoding         as T
+import qualified Network.DNS.Types          as DNS
+
+data ListHostedZones = ListHostedZones
+                     { lhzMaxNumberOfItems :: Maybe Int
+                     , lhzNextToken :: Maybe T.Text
+                     } deriving (Show)
+
+data ListHostedZonesResponse = ListHostedZonesResponse
+                             { lhzrHostedZones :: [HostedZone]
+                             , lhzrNextToken :: Maybe T.Text
+                             } deriving (Show)
+
+listHostedZones :: ListHostedZones
+listHostedZones = ListHostedZones { lhzMaxNumberOfItems = Nothing, lhzNextToken = Nothing }
+
+-- TODO sign the date header
+instance SignQuery ListHostedZones where
+    type Info ListHostedZones = Route53Info
+    signQuery ListHostedZones{..} = undefined
+                                  --Route53SignQuery $ catMaybes
+                                  --[ Just ("Action", "ListDomains")
+                                  --, ("MaxNumberOfDomains",) . T.encodeUtf8 . T.pack . show <$> lhzMaxNumberOfItems
+                                  --, ("NextToken",) . T.encodeUtf8 <$> lhzNextToken
+                                  --]
+
+instance ResponseConsumer r ListHostedZonesResponse where
+    type ResponseMetadata ListHostedZonesResponse = Route53Metadata
+    responseConsumer _ =
+        route53ResponseConsumer parse
+        where 
+        parse cursor = do
+            route53CheckResponseType () "ListHostedZonesResponse" cursor
+            let names = cursor $// elContent "HostedZone" &| parseHostedZone
+            let nextToken = listToMaybe $ cursor $// elContent "NextMarker"
+            return $ ListHostedZonesResponse names nextToken
+
+instance Transaction ListHostedZones ListHostedZonesResponse
diff --git a/Aws/Route53/Info.hs b/Aws/Route53/Info.hs
new file mode 100644
index 00000000..ce39b9e4
--- /dev/null
+++ b/Aws/Route53/Info.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Aws.Route53.Info
+where
+
+import           Aws.Http
+import           Data.Time
+import qualified Data.ByteString as B
+
+--data Route53Authorization = Route53AuthorizationHeader 
+--                            deriving (Show)
+
+data Route53Info = Route53Info 
+    { route53Protocol :: Protocol
+    , route53Endpoint :: B.ByteString
+    , route53Port :: Int
+    } deriving (Show)
+
+route53EndpointUsClassic :: B.ByteString
+route53EndpointUsClassic = "route53.amazonaws.com"
+
+route53 :: Route53Info
+route53 = Route53Info 
+    { route53Protocol = HTTPS
+    , route53Endpoint = route53EndpointUsClassic
+    , route53Port = defaultPort HTTPS
+    }
diff --git a/Aws/Route53/Metadata.hs b/Aws/Route53/Metadata.hs
new file mode 100644
index 00000000..72cbabe7
--- /dev/null
+++ b/Aws/Route53/Metadata.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Aws.Route53.Metadata
+    ( Route53Metadata(..)
+    ) where
+
+import           Control.Monad
+import           Data.Monoid
+import           Data.Typeable
+import qualified Data.Text     as T
+
+data Route53Metadata
+    = Route53Metadata {
+        requestId :: Maybe T.Text
+      }
+    deriving (Show, Typeable)
+
+instance Monoid Route53Metadata where
+    mempty = Route53Metadata Nothing
+    Route53Metadata r1 `mappend` Route53Metadata r2 = Route53Metadata (r1 `mplus` r2)
+
diff --git a/Aws/Route53/Model.hs b/Aws/Route53/Model.hs
new file mode 100644
index 00000000..e59f35cb
--- /dev/null
+++ b/Aws/Route53/Model.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
+module Aws.Route53.Model
+( HostedZone (..)
+, parseHostedZone
+)
+
+where
+
+import           Aws.Xml
+import           Data.Time
+import           System.Locale
+import           Text.XML.Cursor (($/), ($//), (&|))
+import           Data.Text.Encoding (encodeUtf8)
+import qualified Control.Failure   as F
+import qualified Text.XML.Cursor   as Cu
+import qualified Data.Text         as T
+import qualified Network.DNS.Types as DNS
+
+
+data HostedZone = HostedZone 
+                  { hzId :: T.Text
+                  , hzName :: DNS.Domain
+                  , hzCallerReference :: T.Text
+                  , hzComment :: T.Text
+                  , hzResourceRecordSetCount :: Int
+                  } deriving (Show)
+
+parseHostedZone :: F.Failure XmlException m => Cu.Cursor -> m HostedZone
+parseHostedZone cursor = do
+    id_ <- force "Missing hosted zone id" $ cursor $/ elContent "Id"
+    name <- force "Missing hosted zone name" $ cursor $/ elContent "Name" &| encodeUtf8
+    callerReference <- force "Missing caller reference for hosted zone" $ cursor $/ elContent "CallerReference"
+    comment <- force "Missing comment for hosted zone" $ cursor $// elContent "Comment"
+    resourceRecordSetCount <- textReadInt =<< (force "Missing resourceRecordCount" $ cursor $/ elContent "ResourceRecordSetCount")
+    return $ HostedZone id_ name callerReference comment resourceRecordSetCount
diff --git a/Aws/Route53/Response.hs b/Aws/Route53/Response.hs
new file mode 100644
index 00000000..69d08bee
--- /dev/null
+++ b/Aws/Route53/Response.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, OverloadedStrings, TypeFamilies #-}
+module Aws.Route53.Response
+where
+
+import           Aws.Response
+import           Aws.Route53.Error
+import           Aws.Route53.Metadata
+import           Aws.Xml
+import           Data.IORef
+import           Data.Maybe
+import           Text.XML.Cursor            (($/), ($//))
+import qualified Control.Failure            as F
+import qualified Text.XML.Cursor            as Cu
+
+sesResponseConsumer :: (Cu.Cursor -> Response Route53Metadata a)
+                    -> IORef Route53Metadata
+                    -> HTTPResponseConsumer a
+sesResponseConsumer inner metadataRef status = xmlCursorConsumer parse metadataRef status
+    where
+      parse cursor = do
+        let requestId' = listToMaybe $ cursor $// elContent "RequestID"
+        tellMetadata $ Route53Metadata requestId'
+        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
diff --git a/aws.cabal b/aws.cabal
index 3d4e82f9..5b8b4c37 100644
--- a/aws.cabal
+++ b/aws.cabal
@@ -127,6 +127,12 @@ Library
                        Aws.Transaction,
                        Aws.Util,
                        Aws.Xml
+                       Aws.Route53,
+                       Aws.Route53.Commands,
+                       Aws.Route53.Commands.ListHostedZones
+                       Aws.Route53.Info,
+                       Aws.Route53.Model
+                       
 
   -- Packages needed in order to build this package.
   Build-depends:       attempt              >= 0.3.1.1 && < 0.5,
@@ -153,6 +159,7 @@ Library
                        transformers         >= 0.2.2.0 && < 0.4,
                        utf8-string          == 0.3.*,
                        xml-conduit          >= 0.7.0
+                       dns                  >= 0.3.3
 
   GHC-Options: -Wall
 

From a9097801af517aa47478d8173dc1e92a5f2bda0c Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sat, 21 Apr 2012 10:12:28 -0700
Subject: [PATCH 02/55] Fix aws.cabal add missing Aws/Route53.hs

---
 Aws/Route53.hs | 18 ++++++++++++++++++
 aws.cabal      |  4 ++--
 2 files changed, 20 insertions(+), 2 deletions(-)
 create mode 100644 Aws/Route53.hs

diff --git a/Aws/Route53.hs b/Aws/Route53.hs
new file mode 100644
index 00000000..e782ef63
--- /dev/null
+++ b/Aws/Route53.hs
@@ -0,0 +1,18 @@
+module Aws.Route53
+( module Aws.Route53.Commands
+--, module Aws.Route53.Error
+, module Aws.Route53.Info
+--, module Aws.Route53.Metadata
+, module Aws.Route53.Model
+--, module Aws.Route53.Query
+--, module Aws.Route53.Response
+)
+where
+
+import Aws.Route53.Commands
+--import Aws.Route53.Error
+import Aws.Route53.Info
+--import Aws.Route53.Metadata
+import Aws.Route53.Model
+--import Aws.Route53.Query
+--import Aws.Route53.Response
diff --git a/aws.cabal b/aws.cabal
index 5b8b4c37..4d3f981b 100644
--- a/aws.cabal
+++ b/aws.cabal
@@ -126,7 +126,7 @@ Library
                        Aws.Ses.Response,
                        Aws.Transaction,
                        Aws.Util,
-                       Aws.Xml
+                       Aws.Xml,
                        Aws.Route53,
                        Aws.Route53.Commands,
                        Aws.Route53.Commands.ListHostedZones
@@ -158,7 +158,7 @@ Library
                        time                 >= 1.1.4   && < 1.5,
                        transformers         >= 0.2.2.0 && < 0.4,
                        utf8-string          == 0.3.*,
-                       xml-conduit          >= 0.7.0
+                       xml-conduit          >= 0.7.0,
                        dns                  >= 0.3.3
 
   GHC-Options: -Wall

From 047c8dce871a69e2362af2da0bf4b08c329424cc Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sat, 21 Apr 2012 20:20:49 -0700
Subject: [PATCH 03/55] Aws/Query: add instance Show SignedQuery

---
 Aws/Query.hs | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/Aws/Query.hs b/Aws/Query.hs
index 2f69a3a5..f18829ae 100644
--- a/Aws/Query.hs
+++ b/Aws/Query.hs
@@ -34,6 +34,24 @@ data SignedQuery
       }
     --deriving (Show)
 
+instance Show SignedQuery where
+  show q = "SignedQuery {"
+        ++ " sqMethod = " ++ show (sqMethod q)
+        ++ ", sqProtocol = " ++ show (sqProtocol q)
+        ++ ", sqHost = " ++ show (sqHost q)
+        ++ ", sqPort = " ++ show (sqPort q)
+        ++ ", sqPath = " ++ show (sqPath q)
+        ++ ", sqQuery = " ++ show (sqQuery q)
+        ++ ", sqDate = " ++ show (sqDate q)
+        ++ ", sqAuthorization = " ++ show (sqAuthorization q)
+        ++ ", sqContentType = " ++ show (sqContentType q)
+        ++ ", sqContentMd5 = " ++ show (sqContentMd5 q)
+        ++ ", sqAmzHeaders = " ++ show (sqAmzHeaders q)
+        ++ ", sqOtherHeaders = " ++ show (sqOtherHeaders q)
+        ++ ", sqBody = " ++ "<ResourceT IO>"
+        ++ ", sqStringToSign = " ++ show (sqStringToSign q)
+        ++ " }"
+
 queryToHttpRequest :: SignedQuery -> HTTP.Request (C.ResourceT IO)
 queryToHttpRequest SignedQuery{..}
     = HTTP.def {

From 5d12ef0a4630f3f7f4dc945f1304b26cfbb31bae Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sat, 21 Apr 2012 20:29:51 -0700
Subject: [PATCH 04/55] Route53: Proof of concept by ListHostedZones

---
 Aws/Aws.hs                              |  9 ++++++
 Aws/Route53.hs                          | 16 +++++-----
 Aws/Route53/Commands/ListHostedZones.hs | 37 +++++++++++-----------
 Aws/Route53/Error.hs                    | 20 ++++++++++++
 Aws/Route53/Info.hs                     |  9 +++---
 Aws/Route53/Metadata.hs                 |  8 ++---
 Aws/Route53/Query.hs                    | 42 +++++++++++++++++++++++++
 Aws/Route53/Response.hs                 | 38 +++++++++++++++++-----
 aws.cabal                               |  6 +++-
 9 files changed, 141 insertions(+), 44 deletions(-)
 create mode 100644 Aws/Route53/Error.hs
 create mode 100644 Aws/Route53/Query.hs

diff --git a/Aws/Aws.hs b/Aws/Aws.hs
index 53bd1ba4..1e0758fe 100644
--- a/Aws/Aws.hs
+++ b/Aws/Aws.hs
@@ -11,6 +11,7 @@ import           Aws.Ses.Info
 import           Aws.Signature
 import           Aws.SimpleDb.Info
 import           Aws.Sqs.Info
+import           Aws.Route53.Info
 import           Aws.Transaction
 import           Control.Applicative
 import           Control.Monad.Trans  (liftIO)
@@ -44,6 +45,8 @@ data Configuration
       , sqsInfoUri :: SqsInfo
       , sesInfo :: SesInfo
       , sesInfoUri :: SesInfo
+      , route53Info :: Route53Info
+      , route53InfoUri :: Route53Info
       , logger :: LogLevel -> T.Text -> IO ()
       }
 
@@ -75,6 +78,10 @@ instance ConfigurationFetch SesInfo where
     configurationFetch = sesInfo
     configurationFetchUri = sesInfoUri
 
+instance ConfigurationFetch Route53Info where
+    configurationFetch = route53Info
+    configurationFetchUri = route53InfoUri
+
 baseConfiguration :: IO Configuration
 baseConfiguration = do
   Just cr <- loadCredentialsDefault
@@ -89,6 +96,8 @@ baseConfiguration = do
                     , sqsInfoUri = sqs HTTP sqsEndpointUsClassic True
                     , sesInfo = sesHttpsPost sesUsEast
                     , sesInfoUri = sesHttpsGet sesUsEast
+                    , route53Info = route53  -- TODO
+                    , route53InfoUri = route53 -- TODO
                     , logger = defaultLog Warning
                     }
 -- TODO: better error handling when credentials cannot be loaded
diff --git a/Aws/Route53.hs b/Aws/Route53.hs
index e782ef63..f84ae5aa 100644
--- a/Aws/Route53.hs
+++ b/Aws/Route53.hs
@@ -1,18 +1,18 @@
 module Aws.Route53
 ( module Aws.Route53.Commands
---, module Aws.Route53.Error
+, module Aws.Route53.Error
 , module Aws.Route53.Info
---, module Aws.Route53.Metadata
+, module Aws.Route53.Metadata
 , module Aws.Route53.Model
---, module Aws.Route53.Query
---, module Aws.Route53.Response
+, module Aws.Route53.Query
+, module Aws.Route53.Response
 )
 where
 
 import Aws.Route53.Commands
---import Aws.Route53.Error
+import Aws.Route53.Error
 import Aws.Route53.Info
---import Aws.Route53.Metadata
+import Aws.Route53.Metadata
 import Aws.Route53.Model
---import Aws.Route53.Query
---import Aws.Route53.Response
+import Aws.Route53.Query
+import Aws.Route53.Response
diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index 5eb0174a..fa81544f 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -1,22 +1,20 @@
 {-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}
-
 module Aws.Route53.Commands.ListHostedZones where
 
 import           Aws.Response
 import           Aws.Signature
 import           Aws.Route53.Info
 import           Aws.Route53.Model
---import           Aws.Route53.Metadata
---import           Aws.Route53.Query
---import           Aws.Route53.Response
+import           Aws.Route53.Metadata
+import           Aws.Route53.Query
+import           Aws.Route53.Response
 import           Aws.Transaction
 import           Aws.Xml
-import           Control.Applicative
 import           Data.Maybe
-import           Text.XML.Cursor            (($//), (&|))
+import           Control.Applicative        ((<$>))
+import           Text.XML.Cursor            (($//), (&/), laxElement)
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
-import qualified Network.DNS.Types          as DNS
 
 data ListHostedZones = ListHostedZones
                      { lhzMaxNumberOfItems :: Maybe Int
@@ -34,22 +32,25 @@ listHostedZones = ListHostedZones { lhzMaxNumberOfItems = Nothing, lhzNextToken
 -- TODO sign the date header
 instance SignQuery ListHostedZones where
     type Info ListHostedZones = Route53Info
-    signQuery ListHostedZones{..} = undefined
-                                  --Route53SignQuery $ catMaybes
-                                  --[ Just ("Action", "ListDomains")
-                                  --, ("MaxNumberOfDomains",) . T.encodeUtf8 . T.pack . show <$> lhzMaxNumberOfItems
-                                  --, ("NextToken",) . T.encodeUtf8 <$> lhzNextToken
-                                  --]
+    signQuery ListHostedZones{..} = route53SignQuery path query
+      where
+      path = "/hostedzone/"
+      query = catMaybes -- query info signatureData
+            [ ("Action",) <$> Just "hostedzone"
+            , ("MaxItems",) . T.encodeUtf8 . T.pack . show <$> lhzMaxNumberOfItems
+            , ("NextToken",) . T.encodeUtf8 <$> lhzNextToken
+            ]
 
 instance ResponseConsumer r ListHostedZonesResponse where
     type ResponseMetadata ListHostedZonesResponse = Route53Metadata
-    responseConsumer _ =
-        route53ResponseConsumer parse
+
+    responseConsumer _ = route53ResponseConsumer parse
         where 
         parse cursor = do
             route53CheckResponseType () "ListHostedZonesResponse" cursor
-            let names = cursor $// elContent "HostedZone" &| parseHostedZone
+            zones <- mapM parseHostedZone $ cursor $// laxElement "HostedZones" &/ laxElement "HostedZone"
             let nextToken = listToMaybe $ cursor $// elContent "NextMarker"
-            return $ ListHostedZonesResponse names nextToken
+            return $ ListHostedZonesResponse zones nextToken
+
+instance Transaction ListHostedZones ListHostedZonesResponse where
 
-instance Transaction ListHostedZones ListHostedZonesResponse
diff --git a/Aws/Route53/Error.hs b/Aws/Route53/Error.hs
new file mode 100644
index 00000000..4330d7d4
--- /dev/null
+++ b/Aws/Route53/Error.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, RecordWildCards #-}
+module Aws.Route53.Error
+    ( Route53Error(..)
+    ) where
+
+import           Data.Typeable
+import           Data.Text                 (Text)
+import qualified Control.Exception         as C
+import qualified Network.HTTP.Types        as HTTP
+
+-- 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
diff --git a/Aws/Route53/Info.hs b/Aws/Route53/Info.hs
index ce39b9e4..876e0416 100644
--- a/Aws/Route53/Info.hs
+++ b/Aws/Route53/Info.hs
@@ -1,14 +1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Aws.Route53.Info
-where
+( Route53Info(..)
+, route53EndpointUsClassic
+, route53
+) where
 
 import           Aws.Http
-import           Data.Time
 import qualified Data.ByteString as B
 
---data Route53Authorization = Route53AuthorizationHeader 
---                            deriving (Show)
-
 data Route53Info = Route53Info 
     { route53Protocol :: Protocol
     , route53Endpoint :: B.ByteString
diff --git a/Aws/Route53/Metadata.hs b/Aws/Route53/Metadata.hs
index 72cbabe7..ec97620e 100644
--- a/Aws/Route53/Metadata.hs
+++ b/Aws/Route53/Metadata.hs
@@ -8,11 +8,9 @@ import           Data.Monoid
 import           Data.Typeable
 import qualified Data.Text     as T
 
-data Route53Metadata
-    = Route53Metadata {
-        requestId :: Maybe T.Text
-      }
-    deriving (Show, Typeable)
+data Route53Metadata = Route53Metadata 
+    { requestId :: Maybe T.Text
+    } deriving (Show, Typeable)
 
 instance Monoid Route53Metadata where
     mempty = Route53Metadata Nothing
diff --git a/Aws/Route53/Query.hs b/Aws/Route53/Query.hs
new file mode 100644
index 00000000..3ff20b63
--- /dev/null
+++ b/Aws/Route53/Query.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Aws.Route53.Query
+    ( route53SignQuery
+    ) where
+
+import           Aws.Credentials
+import           Aws.Http
+import           Aws.Query
+import           Aws.Signature
+import           Aws.Route53.Info
+import           Aws.Util
+import qualified Data.ByteString                as B
+import qualified Network.HTTP.Types             as HTTP
+
+route53SignQuery :: B.ByteString -> [(B.ByteString, B.ByteString)] -> Route53Info -> SignatureData -> SignedQuery
+route53SignQuery path query si sd
+    = SignedQuery {
+        sqMethod        = Get -- TODO should not be hardcoded
+      , sqProtocol      = route53Protocol si
+      , sqHost          = route53Endpoint si
+      , sqPort          = route53Port si
+      , sqPath          = "/2012-02-29" `B.append`  path
+      , sqQuery         = HTTP.simpleQueryToQuery query'
+      , sqDate          = Just $ signatureTime sd
+      , sqAuthorization = Nothing
+      , sqContentType   = Nothing
+      , sqContentMd5    = Nothing
+      , sqAmzHeaders    = [("X-Amzn-Authorization", authorization)]
+      , sqOtherHeaders  = []
+      , sqBody          = Nothing
+      , 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
diff --git a/Aws/Route53/Response.hs b/Aws/Route53/Response.hs
index 69d08bee..2a63a6a7 100644
--- a/Aws/Route53/Response.hs
+++ b/Aws/Route53/Response.hs
@@ -7,19 +7,27 @@ import           Aws.Route53.Error
 import           Aws.Route53.Metadata
 import           Aws.Xml
 import           Data.IORef
-import           Data.Maybe
+import           Data.List                  (find)
+import           Data.Text                  (Text, unpack)
+import           Data.Text.Encoding         (decodeUtf8)
 import           Text.XML.Cursor            (($/), ($//))
 import qualified Control.Failure            as F
 import qualified Text.XML.Cursor            as Cu
+import qualified Network.HTTP.Types as HTTP
 
-sesResponseConsumer :: (Cu.Cursor -> Response Route53Metadata a)
-                    -> IORef Route53Metadata
-                    -> HTTPResponseConsumer a
-sesResponseConsumer inner metadataRef status = xmlCursorConsumer parse metadataRef status
+-- 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 status headers =
+    xmlCursorConsumer parse metadataRef status headers
     where
       parse cursor = do
-        let requestId' = listToMaybe $ cursor $// elContent "RequestID"
-        tellMetadata $ Route53Metadata requestId'
+        tellMetadata . Route53Metadata . fmap decodeUtf8 $ findHeaderValue headers headerRequestId
         case cursor $/ Cu.laxElement "Error" of
           []      -> inner cursor
           (err:_) -> fromError err
@@ -28,3 +36,19 @@ sesResponseConsumer inner metadataRef status = xmlCursorConsumer parse metadataR
         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
+
+headerRequestId :: HTTP.Ascii -> HTTP.Header
+headerRequestId = (,) "x-amzn-requestid"
+
+findHeader :: [HTTP.Header] -> (HTTP.Ascii -> HTTP.Header) -> Maybe HTTP.Header
+findHeader headers header = find (\h@(_,v) -> h == header v) headers
+
+findHeaderValue :: [HTTP.Header] -> (HTTP.Ascii -> HTTP.Header) -> Maybe HTTP.Ascii
+findHeaderValue headers = fmap snd . findHeader headers
+
diff --git a/aws.cabal b/aws.cabal
index 4d3f981b..634db64c 100644
--- a/aws.cabal
+++ b/aws.cabal
@@ -129,9 +129,13 @@ Library
                        Aws.Xml,
                        Aws.Route53,
                        Aws.Route53.Commands,
-                       Aws.Route53.Commands.ListHostedZones
+                       Aws.Route53.Commands.ListHostedZones,
                        Aws.Route53.Info,
                        Aws.Route53.Model
+                       Aws.Route53.Error,
+                       Aws.Route53.Metadata,
+                       Aws.Route53.Query,
+                       Aws.Route53.Response
                        
 
   -- Packages needed in order to build this package.

From e4dc9742fa64e61f497b257d861fce9cebdc81c3 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sun, 22 Apr 2012 02:03:57 -0700
Subject: [PATCH 05/55] Route53/Commands: Add GetDate and GetHostedZone.

---
 Aws/Route53/Commands.hs               |  4 ++
 Aws/Route53/Commands/GetDate.hs       | 55 +++++++++++++++++++++++++++
 Aws/Route53/Commands/GetHostedZone.hs | 53 ++++++++++++++++++++++++++
 aws.cabal                             |  2 +
 4 files changed, 114 insertions(+)
 create mode 100644 Aws/Route53/Commands/GetDate.hs
 create mode 100644 Aws/Route53/Commands/GetHostedZone.hs

diff --git a/Aws/Route53/Commands.hs b/Aws/Route53/Commands.hs
index 61a89d3c..3e954ace 100644
--- a/Aws/Route53/Commands.hs
+++ b/Aws/Route53/Commands.hs
@@ -1,7 +1,11 @@
 module Aws.Route53.Commands
 ( module Aws.Route53.Commands.ListHostedZones
+, module Aws.Route53.Commands.GetHostedZone
+, module Aws.Route53.Commands.GetDate
 )
 where
 
 import Aws.Route53.Commands.ListHostedZones
+import Aws.Route53.Commands.GetHostedZone
+import Aws.Route53.Commands.GetDate
 
diff --git a/Aws/Route53/Commands/GetDate.hs b/Aws/Route53/Commands/GetDate.hs
new file mode 100644
index 00000000..57d7451d
--- /dev/null
+++ b/Aws/Route53/Commands/GetDate.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}
+module Aws.Route53.Commands.GetDate where
+
+import           Aws.Query
+import           Aws.Http
+import           Data.Time (UTCTime)
+import           Data.Time.Format (parseTime)
+import           System.Locale (defaultTimeLocale)
+import           Aws.Response
+import           Aws.Signature
+import           Aws.Route53.Info
+import           Aws.Route53.Response
+import           Aws.Transaction
+import           Data.Maybe
+import           Data.ByteString.Char8      (unpack)
+import qualified Network.HTTP.Types         as HTTP
+
+data GetDate = GetDate deriving (Show)
+
+newtype GetDateResponse = GetDateResponse { date :: UTCTime } deriving (Show)
+
+instance SignQuery GetDate where
+  type Info GetDate = Route53Info
+  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 _ _ _ headers _ = return $ GetDateResponse date
+    where
+    -- TODO add proper error handling
+    date = fromJust $ do 
+      str <- findHeaderValue headers HTTP.headerDate
+      -- 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 where
+
diff --git a/Aws/Route53/Commands/GetHostedZone.hs b/Aws/Route53/Commands/GetHostedZone.hs
new file mode 100644
index 00000000..0e0b0d12
--- /dev/null
+++ b/Aws/Route53/Commands/GetHostedZone.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}
+module Aws.Route53.Commands.GetHostedZone where
+
+import           Aws.Response
+import           Aws.Signature
+import           Aws.Route53.Info
+import           Aws.Route53.Model
+import           Aws.Route53.Metadata
+import           Aws.Route53.Query
+import           Aws.Route53.Response
+import           Aws.Transaction
+import           Aws.Xml
+import qualified Network.DNS.Types          as DNS
+import           Text.XML.Cursor            (($//), (&/), (&|), laxElement)
+import qualified Data.Text                  as T
+import qualified Data.Text.Encoding         as T
+import qualified Data.ByteString            as B
+
+data GetHostedZone = GetHostedZone
+                   { hostedZoneId :: T.Text
+                   } deriving (Show)
+
+data GetHostedZoneResponse = GetHostedZoneResponse
+                             { ghzrHostedZone :: HostedZone
+                             , ghzrDelegationSet :: [DNS.Domain]
+                             } deriving (Show)
+
+getHostedZone :: T.Text -> GetHostedZone
+getHostedZone hostedZoneId = GetHostedZone hostedZoneId
+
+-- TODO sign the date header
+instance SignQuery GetHostedZone where
+    type Info GetHostedZone = Route53Info
+    signQuery GetHostedZone{..} = route53SignQuery path query
+      where
+      path = "/hostedzone/" `B.append` (T.encodeUtf8 hostedZoneId)
+      query = []
+
+instance ResponseConsumer r GetHostedZoneResponse where
+    type ResponseMetadata GetHostedZoneResponse = Route53Metadata
+
+    responseConsumer _ = route53ResponseConsumer parse
+        where 
+        parse cursor = do
+            route53CheckResponseType () "GetHostedZoneResponse" cursor
+            -- TODO fail more gracefully (with a meaningful message)
+            (zone:_) <- mapM parseHostedZone $ cursor $// laxElement "HostedZone"
+            -- TODO assert that there are exactly four nameservers
+            let delegationSet = cursor $// laxElement "DelegationSet" &/ laxElement "Nameservers" &/ elContent "Nameserver" &| T.encodeUtf8
+            return $ GetHostedZoneResponse zone delegationSet
+
+instance Transaction GetHostedZone GetHostedZoneResponse where
+
diff --git a/aws.cabal b/aws.cabal
index 634db64c..ac93bad2 100644
--- a/aws.cabal
+++ b/aws.cabal
@@ -130,6 +130,8 @@ Library
                        Aws.Route53,
                        Aws.Route53.Commands,
                        Aws.Route53.Commands.ListHostedZones,
+                       Aws.Route53.Commands.GetHostedZone,
+                       Aws.Route53.Commands.GetDate,
                        Aws.Route53.Info,
                        Aws.Route53.Model
                        Aws.Route53.Error,

From f21bad26eb5cb69dfa11b641b7d14054c306798e Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sun, 22 Apr 2012 12:14:10 -0700
Subject: [PATCH 06/55] Aws/Route53/Query: Add a TODO comment

---
 Aws/Route53/Query.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Aws/Route53/Query.hs b/Aws/Route53/Query.hs
index 3ff20b63..db57133d 100644
--- a/Aws/Route53/Query.hs
+++ b/Aws/Route53/Query.hs
@@ -19,7 +19,7 @@ route53SignQuery path query si sd
       , sqProtocol      = route53Protocol si
       , sqHost          = route53Endpoint si
       , sqPort          = route53Port si
-      , sqPath          = "/2012-02-29" `B.append`  path
+      , sqPath          = "/2012-02-29" `B.append`  path -- TODO move the protocol version into info
       , sqQuery         = HTTP.simpleQueryToQuery query'
       , sqDate          = Just $ signatureTime sd
       , sqAuthorization = Nothing

From fa4ba9feadc32fca99e9c2d3484731737c66ddc3 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sun, 22 Apr 2012 12:15:34 -0700
Subject: [PATCH 07/55] Route53/GetHostedZone: Fail Gracefully if there is no
 HostedZone in the Response

Additionally remove an outdated TODO
---
 Aws/Route53/Commands/GetHostedZone.hs | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/Aws/Route53/Commands/GetHostedZone.hs b/Aws/Route53/Commands/GetHostedZone.hs
index 0e0b0d12..9b67526b 100644
--- a/Aws/Route53/Commands/GetHostedZone.hs
+++ b/Aws/Route53/Commands/GetHostedZone.hs
@@ -28,7 +28,6 @@ data GetHostedZoneResponse = GetHostedZoneResponse
 getHostedZone :: T.Text -> GetHostedZone
 getHostedZone hostedZoneId = GetHostedZone hostedZoneId
 
--- TODO sign the date header
 instance SignQuery GetHostedZone where
     type Info GetHostedZone = Route53Info
     signQuery GetHostedZone{..} = route53SignQuery path query
@@ -43,8 +42,7 @@ instance ResponseConsumer r GetHostedZoneResponse where
         where 
         parse cursor = do
             route53CheckResponseType () "GetHostedZoneResponse" cursor
-            -- TODO fail more gracefully (with a meaningful message)
-            (zone:_) <- mapM parseHostedZone $ cursor $// laxElement "HostedZone"
+            zone <- forceM "Missing a HostedZone element" $ cursor $// laxElement "HostedZone" &| parseHostedZone
             -- TODO assert that there are exactly four nameservers
             let delegationSet = cursor $// laxElement "DelegationSet" &/ laxElement "Nameservers" &/ elContent "Nameserver" &| T.encodeUtf8
             return $ GetHostedZoneResponse zone delegationSet

From e215c2c2846b4da4b5ba40240e0c8db2f29286e6 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sun, 22 Apr 2012 12:28:21 -0700
Subject: [PATCH 08/55] Route53: add route53ApiVersion to Route53Info

---
 Aws/Route53/Commands/GetHostedZone.hs   |  4 ++--
 Aws/Route53/Commands/ListHostedZones.hs |  7 +++----
 Aws/Route53/Info.hs                     |  5 +++++
 Aws/Route53/Query.hs                    | 12 ++++++------
 4 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/Aws/Route53/Commands/GetHostedZone.hs b/Aws/Route53/Commands/GetHostedZone.hs
index 9b67526b..94ba09e9 100644
--- a/Aws/Route53/Commands/GetHostedZone.hs
+++ b/Aws/Route53/Commands/GetHostedZone.hs
@@ -30,9 +30,9 @@ getHostedZone hostedZoneId = GetHostedZone hostedZoneId
 
 instance SignQuery GetHostedZone where
     type Info GetHostedZone = Route53Info
-    signQuery GetHostedZone{..} = route53SignQuery path query
+    signQuery GetHostedZone{..} = route53SignQuery resource query
       where
-      path = "/hostedzone/" `B.append` (T.encodeUtf8 hostedZoneId)
+      resource = "/hostedzone/" `B.append` (T.encodeUtf8 hostedZoneId)
       query = []
 
 instance ResponseConsumer r GetHostedZoneResponse where
diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index fa81544f..d7bb5dc5 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -32,12 +32,11 @@ listHostedZones = ListHostedZones { lhzMaxNumberOfItems = Nothing, lhzNextToken
 -- TODO sign the date header
 instance SignQuery ListHostedZones where
     type Info ListHostedZones = Route53Info
-    signQuery ListHostedZones{..} = route53SignQuery path query
+    signQuery ListHostedZones{..} = route53SignQuery resource query
       where
-      path = "/hostedzone/"
+      resource = "/hostedzone"
       query = catMaybes -- query info signatureData
-            [ ("Action",) <$> Just "hostedzone"
-            , ("MaxItems",) . T.encodeUtf8 . T.pack . show <$> lhzMaxNumberOfItems
+            [ ("MaxItems",) . T.encodeUtf8 . T.pack . show <$> lhzMaxNumberOfItems
             , ("NextToken",) . T.encodeUtf8 <$> lhzNextToken
             ]
 
diff --git a/Aws/Route53/Info.hs b/Aws/Route53/Info.hs
index 876e0416..86b81dea 100644
--- a/Aws/Route53/Info.hs
+++ b/Aws/Route53/Info.hs
@@ -12,14 +12,19 @@ data Route53Info = Route53Info
     { route53Protocol :: Protocol
     , route53Endpoint :: B.ByteString
     , route53Port :: Int
+    , route53ApiVersion :: B.ByteString
     } deriving (Show)
 
 route53EndpointUsClassic :: B.ByteString
 route53EndpointUsClassic = "route53.amazonaws.com"
 
+route53ApiVersionRecent :: B.ByteString
+route53ApiVersionRecent = "2012-02-29"
+
 route53 :: Route53Info
 route53 = Route53Info 
     { route53Protocol = HTTPS
     , route53Endpoint = route53EndpointUsClassic
     , route53Port = defaultPort HTTPS
+    , route53ApiVersion = route53ApiVersionRecent
     }
diff --git a/Aws/Route53/Query.hs b/Aws/Route53/Query.hs
index db57133d..ce0f9d5e 100644
--- a/Aws/Route53/Query.hs
+++ b/Aws/Route53/Query.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
 module Aws.Route53.Query
     ( route53SignQuery
     ) where
@@ -13,13 +13,13 @@ import qualified Data.ByteString                as B
 import qualified Network.HTTP.Types             as HTTP
 
 route53SignQuery :: B.ByteString -> [(B.ByteString, B.ByteString)] -> Route53Info -> SignatureData -> SignedQuery
-route53SignQuery path query si sd
+route53SignQuery resource query Route53Info{..} sd
     = SignedQuery {
         sqMethod        = Get -- TODO should not be hardcoded
-      , sqProtocol      = route53Protocol si
-      , sqHost          = route53Endpoint si
-      , sqPort          = route53Port si
-      , sqPath          = "/2012-02-29" `B.append`  path -- TODO move the protocol version into info
+      , sqProtocol      = route53Protocol 
+      , sqHost          = route53Endpoint
+      , sqPort          = route53Port
+      , sqPath          = route53ApiVersion `B.append` resource
       , sqQuery         = HTTP.simpleQueryToQuery query'
       , sqDate          = Just $ signatureTime sd
       , sqAuthorization = Nothing

From 2e9c862390b78e4ba4962f6caab3da3ffd5202cd Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sun, 22 Apr 2012 22:47:37 -0700
Subject: [PATCH 09/55] Route53: add class Route53Parseable, add types for
 ResourceRecordSets.

---
 Aws/Route53/Commands/GetDate.hs         |   2 +-
 Aws/Route53/Commands/GetHostedZone.hs   |  10 +-
 Aws/Route53/Commands/ListHostedZones.hs |  19 ++-
 Aws/Route53/Model.hs                    | 177 +++++++++++++++++++++---
 Aws/Route53/Response.hs                 |  12 +-
 5 files changed, 181 insertions(+), 39 deletions(-)

diff --git a/Aws/Route53/Commands/GetDate.hs b/Aws/Route53/Commands/GetDate.hs
index 57d7451d..fb3ebc20 100644
--- a/Aws/Route53/Commands/GetDate.hs
+++ b/Aws/Route53/Commands/GetDate.hs
@@ -9,7 +9,7 @@ import           System.Locale (defaultTimeLocale)
 import           Aws.Response
 import           Aws.Signature
 import           Aws.Route53.Info
-import           Aws.Route53.Response
+import           Aws.Route53.Model
 import           Aws.Transaction
 import           Data.Maybe
 import           Data.ByteString.Char8      (unpack)
diff --git a/Aws/Route53/Commands/GetHostedZone.hs b/Aws/Route53/Commands/GetHostedZone.hs
index 94ba09e9..1e7acd9e 100644
--- a/Aws/Route53/Commands/GetHostedZone.hs
+++ b/Aws/Route53/Commands/GetHostedZone.hs
@@ -9,9 +9,6 @@ import           Aws.Route53.Metadata
 import           Aws.Route53.Query
 import           Aws.Route53.Response
 import           Aws.Transaction
-import           Aws.Xml
-import qualified Network.DNS.Types          as DNS
-import           Text.XML.Cursor            (($//), (&/), (&|), laxElement)
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
 import qualified Data.ByteString            as B
@@ -22,7 +19,7 @@ data GetHostedZone = GetHostedZone
 
 data GetHostedZoneResponse = GetHostedZoneResponse
                              { ghzrHostedZone :: HostedZone
-                             , ghzrDelegationSet :: [DNS.Domain]
+                             , ghzrDelegationSet :: DelegationSet
                              } deriving (Show)
 
 getHostedZone :: T.Text -> GetHostedZone
@@ -42,9 +39,8 @@ instance ResponseConsumer r GetHostedZoneResponse where
         where 
         parse cursor = do
             route53CheckResponseType () "GetHostedZoneResponse" cursor
-            zone <- forceM "Missing a HostedZone element" $ cursor $// laxElement "HostedZone" &| parseHostedZone
-            -- TODO assert that there are exactly four nameservers
-            let delegationSet = cursor $// laxElement "DelegationSet" &/ laxElement "Nameservers" &/ elContent "Nameserver" &| T.encodeUtf8
+            zone <- r53Parse cursor
+            delegationSet <- r53Parse cursor
             return $ GetHostedZoneResponse zone delegationSet
 
 instance Transaction GetHostedZone GetHostedZoneResponse where
diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index d7bb5dc5..e1b7fbcb 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -1,4 +1,11 @@
-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}
+{-# LANGUAGE RecordWildCards
+  , TypeFamilies
+  , FlexibleInstances
+  , MultiParamTypeClasses
+  , OverloadedStrings
+  , TupleSections 
+  , ScopedTypeVariables
+  #-}
 module Aws.Route53.Commands.ListHostedZones where
 
 import           Aws.Response
@@ -12,7 +19,7 @@ import           Aws.Transaction
 import           Aws.Xml
 import           Data.Maybe
 import           Control.Applicative        ((<$>))
-import           Text.XML.Cursor            (($//), (&/), laxElement)
+import           Text.XML.Cursor            (($//))
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
 
@@ -22,7 +29,7 @@ data ListHostedZones = ListHostedZones
                      } deriving (Show)
 
 data ListHostedZonesResponse = ListHostedZonesResponse
-                             { lhzrHostedZones :: [HostedZone]
+                             { lhzrHostedZones :: HostedZones
                              , lhzrNextToken :: Maybe T.Text
                              } deriving (Show)
 
@@ -43,11 +50,11 @@ instance SignQuery ListHostedZones where
 instance ResponseConsumer r ListHostedZonesResponse where
     type ResponseMetadata ListHostedZonesResponse = Route53Metadata
 
-    responseConsumer _ = route53ResponseConsumer parse
+    responseConsumer _ = route53ResponseConsumer parser
         where 
-        parse cursor = do
+        parser cursor = do
             route53CheckResponseType () "ListHostedZonesResponse" cursor
-            zones <- mapM parseHostedZone $ cursor $// laxElement "HostedZones" &/ laxElement "HostedZone"
+            (zones::HostedZones) <- r53Parse cursor
             let nextToken = listToMaybe $ cursor $// elContent "NextMarker"
             return $ ListHostedZonesResponse zones nextToken
 
diff --git a/Aws/Route53/Model.hs b/Aws/Route53/Model.hs
index e59f35cb..ff1f2666 100644
--- a/Aws/Route53/Model.hs
+++ b/Aws/Route53/Model.hs
@@ -1,22 +1,40 @@
-{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, RecordWildCards, TypeSynonymInstances #-}
 module Aws.Route53.Model
 ( HostedZone (..)
-, parseHostedZone
+, HostedZones
+, DelegationSet(..)
+, Nameserver
+, Nameservers
+, dsNameservers
+, ResourceRecordSets
+, ResourceRecordSet(..)
+, ResourceRecords
+, ResourceRecord(..)
+, findHeader
+, findHeaderValue
+, headerRequestId
+, Route53Parseable(..)
 )
 
 where
 
+import           Control.Monad
 import           Aws.Xml
-import           Data.Time
-import           System.Locale
-import           Text.XML.Cursor (($/), ($//), (&|))
+import           Text.XML.Cursor    (($/), ($//), (&|), ($.//), laxElement)
 import           Data.Text.Encoding (encodeUtf8)
-import qualified Control.Failure   as F
-import qualified Text.XML.Cursor   as Cu
-import qualified Data.Text         as T
-import qualified Network.DNS.Types as DNS
+import           Data.List          (find)
+import qualified Control.Failure    as F
+import qualified Text.XML.Cursor    as Cu
+import qualified Data.Text          as T
+import qualified Data.Text.Encoding as T
+import qualified Network.DNS.Types  as DNS
+import qualified Network.HTTP.Types as HTTP
 
+-- * HostedZone
 
+type HostedZones = [HostedZone]
+
+-- | A hosted zone is
 data HostedZone = HostedZone 
                   { hzId :: T.Text
                   , hzName :: DNS.Domain
@@ -25,11 +43,136 @@ data HostedZone = HostedZone
                   , hzResourceRecordSetCount :: Int
                   } deriving (Show)
 
-parseHostedZone :: F.Failure XmlException m => Cu.Cursor -> m HostedZone
-parseHostedZone cursor = do
-    id_ <- force "Missing hosted zone id" $ cursor $/ elContent "Id"
-    name <- force "Missing hosted zone name" $ cursor $/ elContent "Name" &| encodeUtf8
-    callerReference <- force "Missing caller reference for hosted zone" $ cursor $/ elContent "CallerReference"
-    comment <- force "Missing comment for hosted zone" $ cursor $// elContent "Comment"
-    resourceRecordSetCount <- textReadInt =<< (force "Missing resourceRecordCount" $ cursor $/ elContent "ResourceRecordSetCount")
-    return $ HostedZone id_ name callerReference comment resourceRecordSetCount
+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"
+    name <- force "Missing Name element" $ c $/ elContent "Name" &| encodeUtf8
+    callerReference <- force "Missing CallerReference element" $ c $/ elContent "CallerReference"
+    comment <- force "Missing Comment element" $ c $// elContent "Comment"
+    resourceRecordSetCount <- forceM "Missing ResourceRecordCount" $ c $/ elCont "ResourceRecordSetCount" &| readInt
+    return $ HostedZone zoneId name callerReference comment resourceRecordSetCount
+
+-- * Delegation Set
+
+-- | Currently only internally used for composing parsers
+type Nameservers = [Nameserver]
+
+-- | Currently only internally used for composing parsers
+type Nameserver = DNS.Domain
+
+data DelegationSet = DelegationSet { dsNameserver1 :: DNS.Domain 
+                                   , dsNameserver2 :: DNS.Domain
+                                   , dsNameserver3 :: DNS.Domain
+                                   , dsNameserver4 :: DNS.Domain
+                                   } deriving (Show)
+
+dsNameservers :: DelegationSet -> [DNS.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" &| T.encodeUtf8
+
+
+-- * RsourceRecordSet
+
+type ResourceRecords = [ResourceRecord]
+
+newtype ResourceRecord = ResourceRecord { value :: T.Text }
+                         deriving (Show)
+
+-- TODO make this complete from the spec. Do not just use the exmpales!
+data ResourceRecordSet = ResourceRecordSet { rrsName :: DNS.Domain
+                                           , rrsType :: DNS.TYPE
+                                           , rrsTTL  :: Int
+                                           , rrsRecords :: ResourceRecords
+                                           } deriving (Show)
+                                           
+type ResourceRecordSets = [ResourceRecordSet]
+
+instance Route53Parseable ResourceRecordSet where
+  r53Parse cursor = do
+    c <- force "Missing ResourceRecordSet element" $ cursor $.// laxElement "ResourceRecordSet"
+    name <- force "Missing name element" $ c $/ elContent "Name" &| encodeUtf8
+    dnsType <- force "Missing type element" $ c $/ elCont "Type" &| DNS.toType 
+    ttl <- forceM "Missing TTL element" $ c $/ elCont "TTL" &| readInt
+    resourceRecords <- r53Parse c
+    return $ ResourceRecordSet name dnsType ttl resourceRecords
+
+-- TODO is there any constraint on the number of records?
+-- TODO check constraints on type
+
+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
+
+-- * Parser Utilities
+
+-- | A class for Route53 XML response parsers
+--
+--   TODO Move these utilties to another module, for instance 'Aws.Route53.ParserUtils'
+--
+--   Parsers work with the following scheme:
+--
+--   * A parsers target either a single node or a set of ndoes.
+--
+--   * A parser that targets a single node will parse the first matching node that it finds.
+--   
+--   * A cursor with a node that is the target node it self or a parent of the target nodes.
+--   
+--   * The parser fails if it targets a single node and that nodes does not exist.
+--   
+--   * For multiple target nodes the parser may return the empty list.
+--
+--  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
+
+-- * Utility methods that extend the functionality of 'Network.DNS.Types'
+
+headerRequestId :: HTTP.Ascii -> HTTP.Header
+headerRequestId = (,) "x-amzn-requestid"
+
+findHeader :: [HTTP.Header] -> (HTTP.Ascii -> HTTP.Header) -> Maybe HTTP.Header
+findHeader headers header = find (\h@(_,v) -> h == header v) headers
+
+findHeaderValue :: [HTTP.Header] -> (HTTP.Ascii -> HTTP.Header) -> Maybe HTTP.Ascii
+findHeaderValue headers = fmap snd . findHeader headers
+
diff --git a/Aws/Route53/Response.hs b/Aws/Route53/Response.hs
index 2a63a6a7..6438e2bc 100644
--- a/Aws/Route53/Response.hs
+++ b/Aws/Route53/Response.hs
@@ -4,16 +4,15 @@ where
 
 import           Aws.Response
 import           Aws.Route53.Error
+import           Aws.Route53.Model
 import           Aws.Route53.Metadata
 import           Aws.Xml
 import           Data.IORef
-import           Data.List                  (find)
 import           Data.Text                  (Text, unpack)
 import           Data.Text.Encoding         (decodeUtf8)
 import           Text.XML.Cursor            (($/), ($//))
 import qualified Control.Failure            as F
 import qualified Text.XML.Cursor            as Cu
-import qualified Network.HTTP.Types as HTTP
 
 -- 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
@@ -43,12 +42,9 @@ route53CheckResponseType a n c = do
     _ <- force ("Expected response type " ++ unpack n) (Cu.laxElement n c)
     return a
 
-headerRequestId :: HTTP.Ascii -> HTTP.Header
-headerRequestId = (,) "x-amzn-requestid"
+-- * Response types
 
-findHeader :: [HTTP.Header] -> (HTTP.Ascii -> HTTP.Header) -> Maybe HTTP.Header
-findHeader headers header = find (\h@(_,v) -> h == header v) headers
+-- TODO analyse the possible response types. I think there are common patterns.
+-- Collect common code from the Commands here
 
-findHeaderValue :: [HTTP.Header] -> (HTTP.Ascii -> HTTP.Header) -> Maybe HTTP.Ascii
-findHeaderValue headers = fmap snd . findHeader headers
 

From 552b9fc5fffe83b9bcda78523a96595450d8352c Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Mon, 23 Apr 2012 02:35:18 -0700
Subject: [PATCH 10/55] Route53: small code cleanup in Commands.ListHostedZones

---
 Aws/Route53/Commands/ListHostedZones.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index e1b7fbcb..445ca6d3 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -4,7 +4,6 @@
   , MultiParamTypeClasses
   , OverloadedStrings
   , TupleSections 
-  , ScopedTypeVariables
   #-}
 module Aws.Route53.Commands.ListHostedZones where
 
@@ -54,7 +53,7 @@ instance ResponseConsumer r ListHostedZonesResponse where
         where 
         parser cursor = do
             route53CheckResponseType () "ListHostedZonesResponse" cursor
-            (zones::HostedZones) <- r53Parse cursor
+            zones <- r53Parse cursor
             let nextToken = listToMaybe $ cursor $// elContent "NextMarker"
             return $ ListHostedZonesResponse zones nextToken
 

From 0677bfc6c90d9adb18b7a2de27b287c6ea3161df Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Mon, 23 Apr 2012 02:36:17 -0700
Subject: [PATCH 11/55] Route53: added command GET ListResourceRecordSets

---
 Aws/Route53/Commands.hs                       |  2 +
 .../Commands/ListResourceRecordSets.hs        | 87 +++++++++++++++++++
 Aws/Route53/Model.hs                          | 73 ++++++++++++++--
 aws.cabal                                     |  1 +
 4 files changed, 158 insertions(+), 5 deletions(-)
 create mode 100644 Aws/Route53/Commands/ListResourceRecordSets.hs

diff --git a/Aws/Route53/Commands.hs b/Aws/Route53/Commands.hs
index 3e954ace..f89de8d2 100644
--- a/Aws/Route53/Commands.hs
+++ b/Aws/Route53/Commands.hs
@@ -2,10 +2,12 @@ module Aws.Route53.Commands
 ( module Aws.Route53.Commands.ListHostedZones
 , module Aws.Route53.Commands.GetHostedZone
 , module Aws.Route53.Commands.GetDate
+, module Aws.Route53.Commands.ListResourceRecordSets
 )
 where
 
 import Aws.Route53.Commands.ListHostedZones
 import Aws.Route53.Commands.GetHostedZone
 import Aws.Route53.Commands.GetDate
+import Aws.Route53.Commands.ListResourceRecordSets
 
diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
new file mode 100644
index 00000000..489a729d
--- /dev/null
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE 
+    RecordWildCards
+  , TypeFamilies
+  , FlexibleInstances
+  , MultiParamTypeClasses
+  , OverloadedStrings
+  , TupleSections
+  , ScopedTypeVariables
+  #-}
+module Aws.Route53.Commands.ListResourceRecordSets where
+
+import           Aws.Response
+import           Aws.Signature
+import           Aws.Route53.Info
+import           Aws.Route53.Model
+import           Aws.Route53.Metadata
+import           Aws.Route53.Query
+import           Aws.Route53.Response
+import           Aws.Transaction
+import           Aws.Xml
+import           Data.Maybe                 (catMaybes, listToMaybe)
+import           Control.Applicative        ((<$>))
+import qualified Network.DNS.Types          as DNS
+import           Text.XML.Cursor            (($//), (&|), ($/))
+import qualified Data.Text                  as T
+import qualified Data.Text.Encoding         as T
+import qualified Data.ByteString.Char8      as B
+
+-- | GET ListResourceRecordSets
+-- 
+-- <http://docs.amazonwebservices.com/Route53/latest/APIReference/API_ListResourceRecordSets.html>
+--
+-- NOTE: route53 supports record type @SPF@ which is not supported in 'Network.DNS.Types' and can thus
+-- not be queried through this bindings.
+--
+-- NOTE: the parameter 'identifier' is required for Weighted and altency resource record sets. This is
+-- not enforced by the type.
+
+data ListResourceRecordSets = ListResourceRecordSets
+                   { lrrsHostedZoneId :: T.Text
+                   , name :: Maybe DNS.Domain
+                   , recordType :: Maybe DNS.TYPE   -- ^ /note that SPF is currently not supported/
+                   , identifier :: Maybe T.Text     -- ^ must be present for weighted or latency resource record sets
+                   , maxitems :: Maybe Int          -- ^ maximum effective value is 100
+                   } deriving (Show)
+
+-- | A most general 'ListResourceRecordSets' query
+listResourceRecordSets :: T.Text -> ListResourceRecordSets
+listResourceRecordSets hostedZoneId = ListResourceRecordSets hostedZoneId Nothing Nothing Nothing Nothing
+
+data ListResourceRecordSetsResponse = ListResourceRecordSetsResponse
+                             { lrrsrResourceRecordSets :: ResourceRecordSets
+                             , lrrsIsTruncated :: Bool
+                             , lrrsMaxItems :: Maybe Int                 -- ^ The maxitems value from the request (TODO is it Maybe?)
+                             , lrrsNextRecordName :: Maybe DNS.Domain    -- ^ TODO check constraint
+                             , lrrsNextRecordType :: Maybe DNS.TYPE      -- ^ TODO check constraint
+                             , lrrsNextRecordIdentifier :: Maybe T.Text  -- ^ TODO check constraint
+                             } deriving (Show)
+
+instance SignQuery ListResourceRecordSets where
+    type Info ListResourceRecordSets = Route53Info
+    signQuery ListResourceRecordSets{..} = route53SignQuery resource query
+      where
+      resource = "/hostedzone/" `B.append` (T.encodeUtf8 lrrsHostedZoneId) `B.append` "/rrset"
+      query = catMaybes [ ("name",) <$> name
+                        , ("type",) . B.pack . typeToString <$> recordType
+                        , ("identifier",) . T.encodeUtf8 <$> identifier
+                        , ("maxitems",) . B.pack . show <$> maxitems
+                        ]
+
+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" &| T.encodeUtf8
+            let nextRecordType = listToMaybe $ cursor $// elCont "NextRecordType" &| DNS.toType
+            let nextRecordIdentifier = listToMaybe $ cursor $// elContent "NextRecordIdentifier"
+            return $ ListResourceRecordSetsResponse resourceRecordSets isTruncated maxItems nextRecordName nextRecordType nextRecordIdentifier
+
+instance Transaction ListResourceRecordSets ListResourceRecordSetsResponse where
+
diff --git a/Aws/Route53/Model.hs b/Aws/Route53/Model.hs
index ff1f2666..b2b76aec 100644
--- a/Aws/Route53/Model.hs
+++ b/Aws/Route53/Model.hs
@@ -1,4 +1,9 @@
-{-# LANGUAGE OverloadedStrings, FlexibleContexts, RecordWildCards, TypeSynonymInstances #-}
+{-# LANGUAGE 
+    OverloadedStrings
+  , FlexibleContexts
+  , RecordWildCards
+  , TypeSynonymInstances 
+  #-}
 module Aws.Route53.Model
 ( HostedZone (..)
 , HostedZones
@@ -10,19 +15,22 @@ module Aws.Route53.Model
 , ResourceRecordSet(..)
 , ResourceRecords
 , ResourceRecord(..)
+, AliasTarget(..)
 , findHeader
 , findHeaderValue
 , headerRequestId
 , Route53Parseable(..)
+, typeToString
 )
 
 where
 
-import           Control.Monad
+import           Control.Monad      (MonadPlus, mzero, mplus, liftM)
 import           Aws.Xml
 import           Text.XML.Cursor    (($/), ($//), (&|), ($.//), laxElement)
 import           Data.Text.Encoding (encodeUtf8)
 import           Data.List          (find)
+import           Data.Maybe         (listToMaybe)
 import qualified Control.Failure    as F
 import qualified Text.XML.Cursor    as Cu
 import qualified Data.Text          as T
@@ -90,35 +98,88 @@ instance Route53Parseable Nameserver where
   r53Parse cursor = 
     force "Missing Nameserver element" $ cursor $.// elContent "Nameserver" &| T.encodeUtf8
 
-
 -- * RsourceRecordSet
 
+data REGION = ApNorthEast1
+            | ApSouthEast2
+            | EuWest1
+            | SaEast1
+            | UsEast1
+            | UsWest1
+            | UsWest2
+            | UnknownRegion
+
+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"
+
+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)
 
+data AliasTarget = AliasTarget { atHostedZoneId :: T.Text
+                               , atDNSName :: DNS.Domain
+                               } deriving (Show)
+
 -- TODO make this complete from the spec. Do not just use the exmpales!
 data ResourceRecordSet = ResourceRecordSet { rrsName :: DNS.Domain
                                            , rrsType :: DNS.TYPE
+                                           , rrsAliasTarget :: Maybe AliasTarget
+                                           , rrsSetIdentifier :: Maybe T.Text
+                                           , rrsWeight :: Maybe Int
+                                           , rssRegion :: Maybe REGION
                                            , rrsTTL  :: Int
                                            , rrsRecords :: ResourceRecords
                                            } deriving (Show)
                                            
 type ResourceRecordSets = [ResourceRecordSet]
 
+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" &| encodeUtf8
     dnsType <- force "Missing type element" $ c $/ elCont "Type" &| DNS.toType 
     ttl <- forceM "Missing TTL element" $ 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 ttl resourceRecords
+    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"
+    dnsName <- force "Missing DNSName element" $ c $/ elContent "DNSName" &| encodeUtf8
+    return $ AliasTarget zoneId dnsName
+
+
 instance Route53Parseable ResourceRecords where
   r53Parse cursor = do
     c <- force "Missing ResourceRecords element" $ cursor $.// laxElement "ResourceRecords"
@@ -165,7 +226,7 @@ forceTake n e l = do
   t <- forceTake (n-1) e (tail l)
   return $ return h  `mplus` t
 
--- * Utility methods that extend the functionality of 'Network.DNS.Types'
+-- * Utility methods that extend the functionality of 'Network.HTTP.Types' and 'Network.DNS.Types'
 
 headerRequestId :: HTTP.Ascii -> HTTP.Header
 headerRequestId = (,) "x-amzn-requestid"
@@ -176,3 +237,5 @@ findHeader headers header = find (\h@(_,v) -> h == header v) headers
 findHeaderValue :: [HTTP.Header] -> (HTTP.Ascii -> HTTP.Header) -> Maybe HTTP.Ascii
 findHeaderValue headers = fmap snd . findHeader headers
 
+typeToString :: DNS.TYPE -> String
+typeToString = show
diff --git a/aws.cabal b/aws.cabal
index ac93bad2..c5644ed6 100644
--- a/aws.cabal
+++ b/aws.cabal
@@ -130,6 +130,7 @@ Library
                        Aws.Route53,
                        Aws.Route53.Commands,
                        Aws.Route53.Commands.ListHostedZones,
+                       Aws.Route53.Commands.ListResourceRecordSets,
                        Aws.Route53.Commands.GetHostedZone,
                        Aws.Route53.Commands.GetDate,
                        Aws.Route53.Info,

From 212d4ac905cd97ad4d309fb07eebf71f9dadae85 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Tue, 24 Apr 2012 01:11:19 -0700
Subject: [PATCH 12/55] Route53: improve documentation

---
 Aws/Route53/Commands/GetDate.hs               |  8 ++++
 Aws/Route53/Commands/GetHostedZone.hs         |  9 +++++
 Aws/Route53/Commands/ListHostedZones.hs       |  7 ++++
 .../Commands/ListResourceRecordSets.hs        | 25 +++++++-----
 Aws/Route53/Model.hs                          | 39 ++++++++++++-------
 5 files changed, 65 insertions(+), 23 deletions(-)

diff --git a/Aws/Route53/Commands/GetDate.hs b/Aws/Route53/Commands/GetDate.hs
index fb3ebc20..d599c22a 100644
--- a/Aws/Route53/Commands/GetDate.hs
+++ b/Aws/Route53/Commands/GetDate.hs
@@ -1,4 +1,12 @@
 {-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}
+
+-- | 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.Query
diff --git a/Aws/Route53/Commands/GetHostedZone.hs b/Aws/Route53/Commands/GetHostedZone.hs
index 1e7acd9e..46f0a738 100644
--- a/Aws/Route53/Commands/GetHostedZone.hs
+++ b/Aws/Route53/Commands/GetHostedZone.hs
@@ -1,4 +1,13 @@
 {-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}
+
+-- | 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.Response
diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index 445ca6d3..d7c74392 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -5,6 +5,13 @@
   , OverloadedStrings
   , TupleSections 
   #-}
+
+-- | 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.Response
diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
index 489a729d..9d546568 100644
--- a/Aws/Route53/Commands/ListResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -7,6 +7,21 @@
   , TupleSections
   , ScopedTypeVariables
   #-}
+
+-- | GET ListResourceRecordSets
+--
+--   Lists the resource record sets for a Route53 hosted zone. The hosted zone is identifed 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: Route53 supports record type @SPF@ which is not supported in 'Network.DNS.Types' and can thus
+--   not be queried through this bindings.
+--
+--   NOTE: the parameter 'identifier' is required for weighted and laltency resource record sets. This is
+--   not enforced by the type.
+--
 module Aws.Route53.Commands.ListResourceRecordSets where
 
 import           Aws.Response
@@ -26,16 +41,6 @@ import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
 import qualified Data.ByteString.Char8      as B
 
--- | GET ListResourceRecordSets
--- 
--- <http://docs.amazonwebservices.com/Route53/latest/APIReference/API_ListResourceRecordSets.html>
---
--- NOTE: route53 supports record type @SPF@ which is not supported in 'Network.DNS.Types' and can thus
--- not be queried through this bindings.
---
--- NOTE: the parameter 'identifier' is required for Weighted and altency resource record sets. This is
--- not enforced by the type.
-
 data ListResourceRecordSets = ListResourceRecordSets
                    { lrrsHostedZoneId :: T.Text
                    , name :: Maybe DNS.Domain
diff --git a/Aws/Route53/Model.hs b/Aws/Route53/Model.hs
index b2b76aec..ec323a46 100644
--- a/Aws/Route53/Model.hs
+++ b/Aws/Route53/Model.hs
@@ -4,26 +4,36 @@
   , RecordWildCards
   , TypeSynonymInstances 
   #-}
+  
 module Aws.Route53.Model
-( HostedZone (..)
+( -- * Hosted Zone
+  HostedZone (..)
 , HostedZones
+
+  -- * Delegation Set
 , DelegationSet(..)
 , Nameserver
 , Nameservers
 , dsNameservers
+
+  -- * Resource Record Set
+, REGION(..)
 , ResourceRecordSets
 , ResourceRecordSet(..)
 , ResourceRecords
 , ResourceRecord(..)
 , AliasTarget(..)
+
+  -- * Parser Utilities
+, Route53Parseable(..)
+
+  -- * DNS and HTTP Utilites
+  -- | This functions extend 'Network.HTTP.Types' and 'Network.DNS.Types'
 , findHeader
 , findHeaderValue
 , headerRequestId
-, Route53Parseable(..)
 , typeToString
-)
-
-where
+) where
 
 import           Control.Monad      (MonadPlus, mzero, mplus, liftM)
 import           Aws.Xml
@@ -38,11 +48,11 @@ import qualified Data.Text.Encoding as T
 import qualified Network.DNS.Types  as DNS
 import qualified Network.HTTP.Types as HTTP
 
--- * HostedZone
+-- -------------------------------------------------------------------------- --
+-- HostedZone
 
 type HostedZones = [HostedZone]
 
--- | A hosted zone is
 data HostedZone = HostedZone 
                   { hzId :: T.Text
                   , hzName :: DNS.Domain
@@ -66,12 +76,11 @@ instance Route53Parseable HostedZone where
     resourceRecordSetCount <- forceM "Missing ResourceRecordCount" $ c $/ elCont "ResourceRecordSetCount" &| readInt
     return $ HostedZone zoneId name callerReference comment resourceRecordSetCount
 
--- * Delegation Set
+-- -------------------------------------------------------------------------- --
+-- Delegation Set
 
--- | Currently only internally used for composing parsers
 type Nameservers = [Nameserver]
 
--- | Currently only internally used for composing parsers
 type Nameserver = DNS.Domain
 
 data DelegationSet = DelegationSet { dsNameserver1 :: DNS.Domain 
@@ -98,7 +107,8 @@ instance Route53Parseable Nameserver where
   r53Parse cursor = 
     force "Missing Nameserver element" $ cursor $.// elContent "Nameserver" &| T.encodeUtf8
 
--- * RsourceRecordSet
+-- -------------------------------------------------------------------------- --
+-- RsourceRecordSet
 
 data REGION = ApNorthEast1
             | ApSouthEast2
@@ -190,7 +200,8 @@ instance Route53Parseable ResourceRecord where
     c <- force "Missing ResourceRecord element" $ cursor $.// laxElement "ResourceRecord"
     force "Missing Value element" $ c $/ elContent "Value" &| ResourceRecord
 
--- * Parser Utilities
+-- -------------------------------------------------------------------------- --
+-- Parser Utilities
 
 -- | A class for Route53 XML response parsers
 --
@@ -226,7 +237,9 @@ forceTake n e l = do
   t <- forceTake (n-1) e (tail l)
   return $ return h  `mplus` t
 
--- * Utility methods that extend the functionality of 'Network.HTTP.Types' and 'Network.DNS.Types'
+-- -------------------------------------------------------------------------- --
+-- Utility methods that extend the functionality of 'Network.HTTP.Types' 
+-- and 'Network.DNS.Types'
 
 headerRequestId :: HTTP.Ascii -> HTTP.Header
 headerRequestId = (,) "x-amzn-requestid"

From bdf814f76e317a696ebf8f206bcd0b7faf71026e Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Tue, 24 Apr 2012 01:51:43 -0700
Subject: [PATCH 13/55] Route53: add command GetChange

---
 Aws/Route53/Commands.hs           |  2 ++
 Aws/Route53/Commands/GetChange.hs | 59 +++++++++++++++++++++++++++++++
 Aws/Route53/Model.hs              | 29 ++++++++++++++-
 aws.cabal                         |  1 +
 4 files changed, 90 insertions(+), 1 deletion(-)
 create mode 100644 Aws/Route53/Commands/GetChange.hs

diff --git a/Aws/Route53/Commands.hs b/Aws/Route53/Commands.hs
index f89de8d2..890b4a5a 100644
--- a/Aws/Route53/Commands.hs
+++ b/Aws/Route53/Commands.hs
@@ -2,6 +2,7 @@ module Aws.Route53.Commands
 ( module Aws.Route53.Commands.ListHostedZones
 , module Aws.Route53.Commands.GetHostedZone
 , module Aws.Route53.Commands.GetDate
+, module Aws.Route53.Commands.GetChange
 , module Aws.Route53.Commands.ListResourceRecordSets
 )
 where
@@ -9,5 +10,6 @@ where
 import Aws.Route53.Commands.ListHostedZones
 import Aws.Route53.Commands.GetHostedZone
 import Aws.Route53.Commands.GetDate
+import Aws.Route53.Commands.GetChange
 import Aws.Route53.Commands.ListResourceRecordSets
 
diff --git a/Aws/Route53/Commands/GetChange.hs b/Aws/Route53/Commands/GetChange.hs
new file mode 100644
index 00000000..1ebde352
--- /dev/null
+++ b/Aws/Route53/Commands/GetChange.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE 
+    RecordWildCards
+  , TypeFamilies
+  , FlexibleInstances
+  , MultiParamTypeClasses
+  , OverloadedStrings
+  , TupleSections 
+  #-}
+
+-- | 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.Response
+import           Aws.Signature
+import           Aws.Route53.Info
+import           Aws.Route53.Model
+import           Aws.Route53.Metadata
+import           Aws.Route53.Query
+import           Aws.Route53.Response
+import           Aws.Transaction
+import qualified Data.Text                  as T
+import qualified Data.Text.Encoding         as T
+import qualified Data.ByteString            as B
+
+data GetChange = GetChange
+               { changeId :: T.Text
+               } deriving (Show)
+
+data GetChangeResponse = GetChangeResponse
+                       { gcrChangeInfo :: ChangeInfo
+                       } deriving (Show)
+
+getChange :: T.Text -> GetChange
+getChange changeId = GetChange changeId
+
+instance SignQuery GetChange where
+    type Info GetChange = Route53Info
+    signQuery GetChange{..} = route53SignQuery resource query
+      where
+      resource = "/change/" `B.append` (T.encodeUtf8 changeId)
+      query = []
+
+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 where
+
diff --git a/Aws/Route53/Model.hs b/Aws/Route53/Model.hs
index ec323a46..44588d47 100644
--- a/Aws/Route53/Model.hs
+++ b/Aws/Route53/Model.hs
@@ -24,6 +24,9 @@ module Aws.Route53.Model
 , ResourceRecord(..)
 , AliasTarget(..)
 
+  -- * Change Info
+, ChangeInfo(..)
+
   -- * Parser Utilities
 , Route53Parseable(..)
 
@@ -40,7 +43,10 @@ import           Aws.Xml
 import           Text.XML.Cursor    (($/), ($//), (&|), ($.//), laxElement)
 import           Data.Text.Encoding (encodeUtf8)
 import           Data.List          (find)
-import           Data.Maybe         (listToMaybe)
+import           Data.Maybe         (listToMaybe, fromJust)
+import           Data.Time          (UTCTime)
+import           Data.Time.Format   (parseTime)
+import           System.Locale      (defaultTimeLocale)
 import qualified Control.Failure    as F
 import qualified Text.XML.Cursor    as Cu
 import qualified Data.Text          as T
@@ -200,6 +206,27 @@ instance Route53Parseable ResourceRecord where
     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)
+
+data ChangeInfo = ChangeInfo { ciId :: T.Text
+                             , 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"
+    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 Utilities
 
diff --git a/aws.cabal b/aws.cabal
index c5644ed6..3b7c6d97 100644
--- a/aws.cabal
+++ b/aws.cabal
@@ -132,6 +132,7 @@ Library
                        Aws.Route53.Commands.ListHostedZones,
                        Aws.Route53.Commands.ListResourceRecordSets,
                        Aws.Route53.Commands.GetHostedZone,
+                       Aws.Route53.Commands.GetChange,
                        Aws.Route53.Commands.GetDate,
                        Aws.Route53.Info,
                        Aws.Route53.Model

From 57a58191c662179709b2337d8fa8dfb91b3aebac Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Tue, 24 Apr 2012 02:30:35 -0700
Subject: [PATCH 14/55] Route53: make Method a query parameter

---
 Aws/Route53/Commands/GetChange.hs              | 4 +++-
 Aws/Route53/Commands/GetHostedZone.hs          | 4 +++-
 Aws/Route53/Commands/ListHostedZones.hs        | 4 +++-
 Aws/Route53/Commands/ListResourceRecordSets.hs | 4 +++-
 Aws/Route53/Query.hs                           | 6 +++---
 5 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/Aws/Route53/Commands/GetChange.hs b/Aws/Route53/Commands/GetChange.hs
index 1ebde352..ff5f1e72 100644
--- a/Aws/Route53/Commands/GetChange.hs
+++ b/Aws/Route53/Commands/GetChange.hs
@@ -23,6 +23,7 @@ import           Aws.Route53.Metadata
 import           Aws.Route53.Query
 import           Aws.Route53.Response
 import           Aws.Transaction
+import           Aws.Http                   (Method(..))
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
 import qualified Data.ByteString            as B
@@ -40,8 +41,9 @@ getChange changeId = GetChange changeId
 
 instance SignQuery GetChange where
     type Info GetChange = Route53Info
-    signQuery GetChange{..} = route53SignQuery resource query
+    signQuery GetChange{..} = route53SignQuery method resource query
       where
+      method = Get
       resource = "/change/" `B.append` (T.encodeUtf8 changeId)
       query = []
 
diff --git a/Aws/Route53/Commands/GetHostedZone.hs b/Aws/Route53/Commands/GetHostedZone.hs
index 46f0a738..3cc4f253 100644
--- a/Aws/Route53/Commands/GetHostedZone.hs
+++ b/Aws/Route53/Commands/GetHostedZone.hs
@@ -18,6 +18,7 @@ import           Aws.Route53.Metadata
 import           Aws.Route53.Query
 import           Aws.Route53.Response
 import           Aws.Transaction
+import           Aws.Http                   (Method(..))
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
 import qualified Data.ByteString            as B
@@ -36,8 +37,9 @@ getHostedZone hostedZoneId = GetHostedZone hostedZoneId
 
 instance SignQuery GetHostedZone where
     type Info GetHostedZone = Route53Info
-    signQuery GetHostedZone{..} = route53SignQuery resource query
+    signQuery GetHostedZone{..} = route53SignQuery method resource query
       where
+      method = Get
       resource = "/hostedzone/" `B.append` (T.encodeUtf8 hostedZoneId)
       query = []
 
diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index d7c74392..db0ff3b6 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -24,6 +24,7 @@ import           Aws.Route53.Response
 import           Aws.Transaction
 import           Aws.Xml
 import           Data.Maybe
+import           Aws.Http                   (Method(..))
 import           Control.Applicative        ((<$>))
 import           Text.XML.Cursor            (($//))
 import qualified Data.Text                  as T
@@ -45,8 +46,9 @@ listHostedZones = ListHostedZones { lhzMaxNumberOfItems = Nothing, lhzNextToken
 -- TODO sign the date header
 instance SignQuery ListHostedZones where
     type Info ListHostedZones = Route53Info
-    signQuery ListHostedZones{..} = route53SignQuery resource query
+    signQuery ListHostedZones{..} = route53SignQuery method resource query
       where
+      method = Get
       resource = "/hostedzone"
       query = catMaybes -- query info signatureData
             [ ("MaxItems",) . T.encodeUtf8 . T.pack . show <$> lhzMaxNumberOfItems
diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
index 9d546568..98e1db9c 100644
--- a/Aws/Route53/Commands/ListResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -33,6 +33,7 @@ import           Aws.Route53.Query
 import           Aws.Route53.Response
 import           Aws.Transaction
 import           Aws.Xml
+import           Aws.Http                   (Method(..))
 import           Data.Maybe                 (catMaybes, listToMaybe)
 import           Control.Applicative        ((<$>))
 import qualified Network.DNS.Types          as DNS
@@ -64,8 +65,9 @@ data ListResourceRecordSetsResponse = ListResourceRecordSetsResponse
 
 instance SignQuery ListResourceRecordSets where
     type Info ListResourceRecordSets = Route53Info
-    signQuery ListResourceRecordSets{..} = route53SignQuery resource query
+    signQuery ListResourceRecordSets{..} = route53SignQuery method resource query
       where
+      method = Get
       resource = "/hostedzone/" `B.append` (T.encodeUtf8 lrrsHostedZoneId) `B.append` "/rrset"
       query = catMaybes [ ("name",) <$> name
                         , ("type",) . B.pack . typeToString <$> recordType
diff --git a/Aws/Route53/Query.hs b/Aws/Route53/Query.hs
index ce0f9d5e..25a7cc00 100644
--- a/Aws/Route53/Query.hs
+++ b/Aws/Route53/Query.hs
@@ -12,10 +12,10 @@ import           Aws.Util
 import qualified Data.ByteString                as B
 import qualified Network.HTTP.Types             as HTTP
 
-route53SignQuery :: B.ByteString -> [(B.ByteString, B.ByteString)] -> Route53Info -> SignatureData -> SignedQuery
-route53SignQuery resource query Route53Info{..} sd
+route53SignQuery :: Method -> B.ByteString -> [(B.ByteString, B.ByteString)] -> Route53Info -> SignatureData -> SignedQuery
+route53SignQuery method resource query Route53Info{..} sd
     = SignedQuery {
-        sqMethod        = Get -- TODO should not be hardcoded
+        sqMethod        = method
       , sqProtocol      = route53Protocol 
       , sqHost          = route53Endpoint
       , sqPort          = route53Port

From bfdf885f1652cbdaf61f049c663084cd74575c55 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Tue, 24 Apr 2012 03:01:37 -0700
Subject: [PATCH 15/55] Route53: add command DeleteHostedZone

---
 Aws/Route53/Commands.hs                  |  2 +
 Aws/Route53/Commands/DeleteHostedZone.hs | 59 ++++++++++++++++++++++++
 aws.cabal                                |  1 +
 3 files changed, 62 insertions(+)
 create mode 100644 Aws/Route53/Commands/DeleteHostedZone.hs

diff --git a/Aws/Route53/Commands.hs b/Aws/Route53/Commands.hs
index 890b4a5a..54d1aa72 100644
--- a/Aws/Route53/Commands.hs
+++ b/Aws/Route53/Commands.hs
@@ -1,6 +1,7 @@
 module Aws.Route53.Commands
 ( module Aws.Route53.Commands.ListHostedZones
 , module Aws.Route53.Commands.GetHostedZone
+, module Aws.Route53.Commands.DeleteHostedZone
 , module Aws.Route53.Commands.GetDate
 , module Aws.Route53.Commands.GetChange
 , module Aws.Route53.Commands.ListResourceRecordSets
@@ -9,6 +10,7 @@ where
 
 import Aws.Route53.Commands.ListHostedZones
 import Aws.Route53.Commands.GetHostedZone
+import Aws.Route53.Commands.DeleteHostedZone
 import Aws.Route53.Commands.GetDate
 import Aws.Route53.Commands.GetChange
 import Aws.Route53.Commands.ListResourceRecordSets
diff --git a/Aws/Route53/Commands/DeleteHostedZone.hs b/Aws/Route53/Commands/DeleteHostedZone.hs
new file mode 100644
index 00000000..949491d1
--- /dev/null
+++ b/Aws/Route53/Commands/DeleteHostedZone.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}
+
+-- | 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.Response
+import           Aws.Signature
+import           Aws.Route53.Info
+import           Aws.Route53.Model
+import           Aws.Route53.Metadata
+import           Aws.Route53.Query
+import           Aws.Route53.Response
+import           Aws.Transaction
+import           Aws.Http                   (Method(..))
+import qualified Data.Text                  as T
+import qualified Data.Text.Encoding         as T
+import qualified Data.ByteString            as B
+
+data DeleteHostedZone = DeleteHostedZone
+                   { dhzHostedZoneId :: T.Text
+                   } deriving (Show)
+
+data DeleteHostedZoneResponse = DeleteHostedZoneResponse
+                              { dhzrChangeInfo :: ChangeInfo
+                              } deriving (Show)
+
+deleteHostedZone :: T.Text -> DeleteHostedZone
+deleteHostedZone hostedZoneId = DeleteHostedZone hostedZoneId
+
+instance SignQuery DeleteHostedZone where
+    type Info DeleteHostedZone = Route53Info
+    signQuery DeleteHostedZone{..} = route53SignQuery method resource query
+      where
+      method = Delete
+      resource = "/hostedzone/" `B.append` (T.encodeUtf8 dhzHostedZoneId)
+      query = []
+
+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 where
+
diff --git a/aws.cabal b/aws.cabal
index 3b7c6d97..f39d63aa 100644
--- a/aws.cabal
+++ b/aws.cabal
@@ -132,6 +132,7 @@ Library
                        Aws.Route53.Commands.ListHostedZones,
                        Aws.Route53.Commands.ListResourceRecordSets,
                        Aws.Route53.Commands.GetHostedZone,
+                       Aws.Route53.Commands.DeleteHostedZone,
                        Aws.Route53.Commands.GetChange,
                        Aws.Route53.Commands.GetDate,
                        Aws.Route53.Info,

From 32cf87e0c71654eb91ead5047f77546616874e2c Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Tue, 24 Apr 2012 22:31:55 -0700
Subject: [PATCH 16/55] Route53: add command CreateHosted Zone; some code
 cleanup

---
 Aws/Route53/Commands.hs                       | 21 ++++--
 Aws/Route53/Commands/CreateHostedZone.hs      | 75 +++++++++++++++++++
 Aws/Route53/Commands/DeleteHostedZone.hs      |  8 +-
 Aws/Route53/Commands/GetChange.hs             | 17 ++---
 Aws/Route53/Commands/GetHostedZone.hs         |  9 ++-
 Aws/Route53/Commands/ListHostedZones.hs       |  2 +-
 .../Commands/ListResourceRecordSets.hs        | 19 +++--
 Aws/Route53/Model.hs                          | 35 +++++++--
 Aws/Route53/Query.hs                          | 18 ++++-
 aws.cabal                                     |  4 +-
 10 files changed, 166 insertions(+), 42 deletions(-)
 create mode 100644 Aws/Route53/Commands/CreateHostedZone.hs

diff --git a/Aws/Route53/Commands.hs b/Aws/Route53/Commands.hs
index 54d1aa72..f71e3592 100644
--- a/Aws/Route53/Commands.hs
+++ b/Aws/Route53/Commands.hs
@@ -1,17 +1,26 @@
 module Aws.Route53.Commands
-( module Aws.Route53.Commands.ListHostedZones
+( -- * Actions on Hosted Zones
+  module Aws.Route53.Commands.CreateHostedZone
 , module Aws.Route53.Commands.GetHostedZone
 , module Aws.Route53.Commands.DeleteHostedZone
-, module Aws.Route53.Commands.GetDate
-, module Aws.Route53.Commands.GetChange
+, 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.ListHostedZones
+import Aws.Route53.Commands.CreateHostedZone
 import Aws.Route53.Commands.GetHostedZone
 import Aws.Route53.Commands.DeleteHostedZone
-import Aws.Route53.Commands.GetDate
-import Aws.Route53.Commands.GetChange
+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
 
diff --git a/Aws/Route53/Commands/CreateHostedZone.hs b/Aws/Route53/Commands/CreateHostedZone.hs
new file mode 100644
index 00000000..51559ea9
--- /dev/null
+++ b/Aws/Route53/Commands/CreateHostedZone.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TypeFamilies #-} 
+{-# LANGUAGE FlexibleInstances #-} 
+{-# LANGUAGE MultiParamTypeClasses #-} 
+{-# LANGUAGE OverloadedStrings #-} 
+{-# LANGUAGE TupleSections #-} 
+
+-- | 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.Response
+import           Aws.Signature
+import           Aws.Route53.Info
+import           Aws.Route53.Model
+import           Aws.Route53.Metadata
+import           Aws.Route53.Query
+import           Aws.Route53.Response
+import           Aws.Transaction
+import           Aws.Http                   (Method(..))
+import qualified Data.Text                  as T
+import qualified Data.Text.Encoding         as T
+import qualified Network.DNS.Types          as DNS
+import qualified Text.XML                   as XML
+import           Text.Hamlet.XML            (xml)
+
+data CreateHostedZone = CreateHostedZone
+                      { chzName :: DNS.Domain
+                      , chzCallerReference :: T.Text
+                      , chzComment :: T.Text
+                      } deriving (Show)
+
+data CreateHostedZoneResponse = CreateHostedZoneResponse
+                              { chzrHostedZone :: HostedZone
+                              , chzrChangeInfo :: ChangeInfo
+                              , chzrDelegationSet :: DelegationSet
+                              } deriving (Show)
+
+createHostedZone :: DNS.Domain -> T.Text -> T.Text -> CreateHostedZone
+createHostedZone name callerReference comment = CreateHostedZone name callerReference comment
+
+instance SignQuery CreateHostedZone where
+    type Info CreateHostedZone = Route53Info
+    signQuery CreateHostedZone{..} = route53SignQuery method resource query body
+      where
+      method = Post
+      resource = "/hostedzone"
+      query = []
+      body = Just $ XML.Element "{https://route53.amazonaws.com/doc/2012-02-29/}CreateHostedZoneRequest" []
+             [xml|
+             <Name>#{T.decodeUtf8 chzName}
+             <CallerReference>${chzCallerReference}
+             <HostedZoneConfig>
+               <Comment>${chzComment}
+             |]
+
+instance ResponseConsumer r CreateHostedZoneResponse where
+    type ResponseMetadata CreateHostedZoneResponse = Route53Metadata
+
+    responseConsumer _ = route53ResponseConsumer parse
+        where 
+        parse cursor = do
+            route53CheckResponseType () "GetHostedZoneResponse" cursor
+            zone <- r53Parse cursor
+            changeInfo <- r53Parse cursor
+            delegationSet <- r53Parse cursor
+            return $ CreateHostedZoneResponse zone changeInfo delegationSet
+
+instance Transaction CreateHostedZone CreateHostedZoneResponse where
+
diff --git a/Aws/Route53/Commands/DeleteHostedZone.hs b/Aws/Route53/Commands/DeleteHostedZone.hs
index 949491d1..7ba4edd9 100644
--- a/Aws/Route53/Commands/DeleteHostedZone.hs
+++ b/Aws/Route53/Commands/DeleteHostedZone.hs
@@ -37,13 +37,19 @@ data DeleteHostedZoneResponse = DeleteHostedZoneResponse
 deleteHostedZone :: T.Text -> DeleteHostedZone
 deleteHostedZone hostedZoneId = DeleteHostedZone hostedZoneId
 
+-- Delete add convenience methods:
+-- * Delete non-empty hosted zone
+-- * extract zoneId (maybe we should always strip the start of the string? Haskell is typed!)
+-- * Extract bare Model from responses (that are heavily wrapped...)
+
 instance SignQuery DeleteHostedZone where
     type Info DeleteHostedZone = Route53Info
-    signQuery DeleteHostedZone{..} = route53SignQuery method resource query
+    signQuery DeleteHostedZone{..} = route53SignQuery method resource query body
       where
       method = Delete
       resource = "/hostedzone/" `B.append` (T.encodeUtf8 dhzHostedZoneId)
       query = []
+      body = Nothing
 
 instance ResponseConsumer r DeleteHostedZoneResponse where
     type ResponseMetadata DeleteHostedZoneResponse = Route53Metadata
diff --git a/Aws/Route53/Commands/GetChange.hs b/Aws/Route53/Commands/GetChange.hs
index ff5f1e72..2f38225c 100644
--- a/Aws/Route53/Commands/GetChange.hs
+++ b/Aws/Route53/Commands/GetChange.hs
@@ -1,11 +1,9 @@
-{-# LANGUAGE 
-    RecordWildCards
-  , TypeFamilies
-  , FlexibleInstances
-  , MultiParamTypeClasses
-  , OverloadedStrings
-  , TupleSections 
-  #-}
+{-# LANGUAGE RecordWildCards #-} 
+{-# LANGUAGE TypeFamilies #-} 
+{-# LANGUAGE FlexibleInstances #-} 
+{-# LANGUAGE MultiParamTypeClasses #-} 
+{-# LANGUAGE OverloadedStrings #-} 
+{-# LANGUAGE TupleSections #-}  
 
 -- | GET GetChange
 --
@@ -41,11 +39,12 @@ getChange changeId = GetChange changeId
 
 instance SignQuery GetChange where
     type Info GetChange = Route53Info
-    signQuery GetChange{..} = route53SignQuery method resource query
+    signQuery GetChange{..} = route53SignQuery method resource query body
       where
       method = Get
       resource = "/change/" `B.append` (T.encodeUtf8 changeId)
       query = []
+      body = Nothing
 
 instance ResponseConsumer r GetChangeResponse where
     type ResponseMetadata GetChangeResponse = Route53Metadata
diff --git a/Aws/Route53/Commands/GetHostedZone.hs b/Aws/Route53/Commands/GetHostedZone.hs
index 3cc4f253..2da52a25 100644
--- a/Aws/Route53/Commands/GetHostedZone.hs
+++ b/Aws/Route53/Commands/GetHostedZone.hs
@@ -1,4 +1,9 @@
-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 
 -- | GET GetHostedZone
 --
@@ -37,7 +42,7 @@ getHostedZone hostedZoneId = GetHostedZone hostedZoneId
 
 instance SignQuery GetHostedZone where
     type Info GetHostedZone = Route53Info
-    signQuery GetHostedZone{..} = route53SignQuery method resource query
+    signQuery GetHostedZone{..} = route53SignQuery method resource query Nothing
       where
       method = Get
       resource = "/hostedzone/" `B.append` (T.encodeUtf8 hostedZoneId)
diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index db0ff3b6..00d99e90 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -46,7 +46,7 @@ listHostedZones = ListHostedZones { lhzMaxNumberOfItems = Nothing, lhzNextToken
 -- TODO sign the date header
 instance SignQuery ListHostedZones where
     type Info ListHostedZones = Route53Info
-    signQuery ListHostedZones{..} = route53SignQuery method resource query
+    signQuery ListHostedZones{..} = route53SignQuery method resource query Nothing
       where
       method = Get
       resource = "/hostedzone"
diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
index 98e1db9c..921e4a86 100644
--- a/Aws/Route53/Commands/ListResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -1,12 +1,10 @@
-{-# LANGUAGE 
-    RecordWildCards
-  , TypeFamilies
-  , FlexibleInstances
-  , MultiParamTypeClasses
-  , OverloadedStrings
-  , TupleSections
-  , ScopedTypeVariables
-  #-}
+{-# LANGUAGE RecordWildCards #-} 
+{-# LANGUAGE TypeFamilies #-} 
+{-# LANGUAGE FlexibleInstances #-} 
+{-# LANGUAGE MultiParamTypeClasses #-} 
+{-# LANGUAGE OverloadedStrings #-} 
+{-# LANGUAGE TupleSections #-} 
+{-# LANGUAGE ScopedTypeVariables #-} 
 
 -- | GET ListResourceRecordSets
 --
@@ -65,9 +63,10 @@ data ListResourceRecordSetsResponse = ListResourceRecordSetsResponse
 
 instance SignQuery ListResourceRecordSets where
     type Info ListResourceRecordSets = Route53Info
-    signQuery ListResourceRecordSets{..} = route53SignQuery method resource query
+    signQuery ListResourceRecordSets{..} = route53SignQuery method resource query body
       where
       method = Get
+      body = Nothing
       resource = "/hostedzone/" `B.append` (T.encodeUtf8 lrrsHostedZoneId) `B.append` "/rrset"
       query = catMaybes [ ("name",) <$> name
                         , ("type",) . B.pack . typeToString <$> recordType
diff --git a/Aws/Route53/Model.hs b/Aws/Route53/Model.hs
index 44588d47..456e0b92 100644
--- a/Aws/Route53/Model.hs
+++ b/Aws/Route53/Model.hs
@@ -1,9 +1,8 @@
-{-# LANGUAGE 
-    OverloadedStrings
-  , FlexibleContexts
-  , RecordWildCards
-  , TypeSynonymInstances 
-  #-}
+{-# LANGUAGE OverloadedStrings #-} 
+{-# LANGUAGE QuasiQuotes #-} 
+{-# LANGUAGE FlexibleContexts #-} 
+{-# LANGUAGE RecordWildCards #-} 
+{-# LANGUAGE TypeSynonymInstances #-}  
   
 module Aws.Route53.Model
 ( -- * Hosted Zone
@@ -29,6 +28,7 @@ module Aws.Route53.Model
 
   -- * Parser Utilities
 , Route53Parseable(..)
+, Route53XmlSerializable(..)
 
   -- * DNS and HTTP Utilites
   -- | This functions extend 'Network.HTTP.Types' and 'Network.DNS.Types'
@@ -41,7 +41,9 @@ module Aws.Route53.Model
 import           Control.Monad      (MonadPlus, mzero, mplus, liftM)
 import           Aws.Xml
 import           Text.XML.Cursor    (($/), ($//), (&|), ($.//), laxElement)
-import           Data.Text.Encoding (encodeUtf8)
+import qualified Text.XML           as XML
+import           Text.Hamlet.XML    (xml)
+import           Data.Text.Encoding (encodeUtf8, decodeUtf8)
 import           Data.List          (find)
 import           Data.Maybe         (listToMaybe, fromJust)
 import           Data.Time          (UTCTime)
@@ -82,6 +84,20 @@ instance Route53Parseable HostedZone where
     resourceRecordSetCount <- forceM "Missing ResourceRecordCount" $ c $/ elCont "ResourceRecordSetCount" &| readInt
     return $ HostedZone zoneId name callerReference comment resourceRecordSetCount
 
+instance Route53XmlSerializable HostedZone where
+
+  toXml HostedZone{..} = XML.Element "HostedZone" [] [xml|
+    <Id>#{hzId}
+    <Name>#{decodeUtf8 hzName}
+    <CallerReference>${hzCallerReference}
+    <Config>
+      <Comment>#{hzComment}
+    <ResourceRecordSetCount>${T.pack . show $ hzResourceRecordCount}
+    |]
+
+instance Route53XmlSerializable HostedZones where
+  toXml hostedZones = XML.Element "HostedZones" [] $ (XML.NodeElement . toXml) `map` hostedZones
+
 -- -------------------------------------------------------------------------- --
 -- Delegation Set
 
@@ -228,7 +244,7 @@ instance Route53Parseable ChangeInfo where
     utcTime str = fromJust $ parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%Z" str
 
 -- -------------------------------------------------------------------------- --
--- Parser Utilities
+-- Parser and Serialization Utilities
 
 -- | A class for Route53 XML response parsers
 --
@@ -264,6 +280,9 @@ forceTake n e l = do
   t <- forceTake (n-1) e (tail l)
   return $ return h  `mplus` t
 
+class Route53XmlSerializable r where
+  toXml :: r -> XML.Element 
+
 -- -------------------------------------------------------------------------- --
 -- Utility methods that extend the functionality of 'Network.HTTP.Types' 
 -- and 'Network.DNS.Types'
diff --git a/Aws/Route53/Query.hs b/Aws/Route53/Query.hs
index 25a7cc00..0c31f005 100644
--- a/Aws/Route53/Query.hs
+++ b/Aws/Route53/Query.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-} 
+
 module Aws.Route53.Query
     ( route53SignQuery
     ) where
@@ -9,11 +11,13 @@ import           Aws.Query
 import           Aws.Signature
 import           Aws.Route53.Info
 import           Aws.Util
+import qualified Text.XML                       as XML
 import qualified Data.ByteString                as B
 import qualified Network.HTTP.Types             as HTTP
+import qualified Network.HTTP.Conduit           as HTTP
 
-route53SignQuery :: Method -> B.ByteString -> [(B.ByteString, B.ByteString)] -> Route53Info -> SignatureData -> SignedQuery
-route53SignQuery method resource query Route53Info{..} sd
+route53SignQuery :: Method -> B.ByteString -> [(B.ByteString, B.ByteString)] -> Maybe XML.Element -> Route53Info -> SignatureData -> SignedQuery
+route53SignQuery method resource query body Route53Info{..} sd
     = SignedQuery {
         sqMethod        = method
       , sqProtocol      = route53Protocol 
@@ -27,7 +31,7 @@ route53SignQuery method resource query Route53Info{..} sd
       , sqContentMd5    = Nothing
       , sqAmzHeaders    = [("X-Amzn-Authorization", authorization)]
       , sqOtherHeaders  = []
-      , sqBody          = Nothing
+      , sqBody          = renderBody `fmap` body
       , sqStringToSign  = stringToSign
       }
     where
@@ -40,3 +44,9 @@ route53SignQuery method resource query Route53Info{..} sd
                                , 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
+                     , XML.documentEpilogue = []
+                     }
diff --git a/aws.cabal b/aws.cabal
index f39d63aa..297cd1a9 100644
--- a/aws.cabal
+++ b/aws.cabal
@@ -132,6 +132,7 @@ Library
                        Aws.Route53.Commands.ListHostedZones,
                        Aws.Route53.Commands.ListResourceRecordSets,
                        Aws.Route53.Commands.GetHostedZone,
+                       Aws.Route53.Commands.CreateHostedZone,
                        Aws.Route53.Commands.DeleteHostedZone,
                        Aws.Route53.Commands.GetChange,
                        Aws.Route53.Commands.GetDate,
@@ -168,7 +169,8 @@ Library
                        transformers         >= 0.2.2.0 && < 0.4,
                        utf8-string          == 0.3.*,
                        xml-conduit          >= 0.7.0,
-                       dns                  >= 0.3.3
+                       dns                  >= 0.3.3,
+                       xml-hamlet           >= 0.3.0
 
   GHC-Options: -Wall
 

From ecfac96f719946c94a106c41478da65b74e8e15c Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Wed, 25 Apr 2012 01:26:04 -0700
Subject: [PATCH 17/55] Route53: add crude proof of concept implementation of
 ChangeResourceRecordSets

---
 Aws/Route53/Commands.hs                       |  4 +-
 .../Commands/ChangeResourceRecordSets.hs      | 76 +++++++++++++++++++
 Aws/Route53/Commands/CreateHostedZone.hs      |  4 +-
 Aws/Route53/Model.hs                          | 57 ++++++++++++--
 4 files changed, 132 insertions(+), 9 deletions(-)
 create mode 100644 Aws/Route53/Commands/ChangeResourceRecordSets.hs

diff --git a/Aws/Route53/Commands.hs b/Aws/Route53/Commands.hs
index f71e3592..359a775d 100644
--- a/Aws/Route53/Commands.hs
+++ b/Aws/Route53/Commands.hs
@@ -6,7 +6,7 @@ module Aws.Route53.Commands
 , module Aws.Route53.Commands.ListHostedZones
 
   -- * Actions on Resource Record Sets
-  -- module Aws.Route53.Commands.ChangeResourceRecordSets
+, module Aws.Route53.Commands.ChangeResourceRecordSets
 , module Aws.Route53.Commands.ListResourceRecordSets
 , module Aws.Route53.Commands.GetChange
 
@@ -19,7 +19,7 @@ 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.ChangeResourceRecordSets
 import Aws.Route53.Commands.ListResourceRecordSets
 import Aws.Route53.Commands.GetChange
 import Aws.Route53.Commands.GetDate
diff --git a/Aws/Route53/Commands/ChangeResourceRecordSets.hs b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
new file mode 100644
index 00000000..b2c9ba5e
--- /dev/null
+++ b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TypeFamilies #-} 
+{-# LANGUAGE FlexibleInstances #-} 
+{-# LANGUAGE MultiParamTypeClasses #-} 
+{-# LANGUAGE OverloadedStrings #-} 
+{-# LANGUAGE TupleSections #-} 
+
+-- | 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.Response
+import           Aws.Signature
+import           Aws.Route53.Info
+import           Aws.Route53.Model
+import           Aws.Route53.Metadata
+import           Aws.Route53.Query
+import           Aws.Route53.Response
+import           Aws.Transaction
+import           Aws.Http                   (Method(..))
+import qualified Data.Text                  as T
+import qualified Data.Text.Encoding         as T
+import qualified Text.XML                   as XML
+import           Text.Hamlet.XML            (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 :: T.Text
+                      , crrComment :: Maybe T.Text
+                      , crrsChanges :: [(ACTION, ResourceRecordSet)]
+                      } deriving (Show)
+
+data ChangeResourceRecordSetsResponse = ChangeResourceRecordSetsResponse
+  { crrsrChangeInfo :: ChangeInfo
+  } deriving (Show)
+
+instance SignQuery ChangeResourceRecordSets where
+    type Info ChangeResourceRecordSets = Route53Info
+    signQuery ChangeResourceRecordSets{..} = route53SignQuery method resource query body
+      where
+      method = Post
+      resource = "/hostedzone/" `B.append` T.encodeUtf8 crrHostedZoneId `B.append` "/rrset"
+      query = []
+      body = Just $ XML.Element "{https://route53.amazonaws.com/doc/2012-02-29/}ChangeResourceRecordSetsRequest" []
+             [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 where
+
diff --git a/Aws/Route53/Commands/CreateHostedZone.hs b/Aws/Route53/Commands/CreateHostedZone.hs
index 51559ea9..cc559b88 100644
--- a/Aws/Route53/Commands/CreateHostedZone.hs
+++ b/Aws/Route53/Commands/CreateHostedZone.hs
@@ -54,9 +54,9 @@ instance SignQuery CreateHostedZone where
       body = Just $ XML.Element "{https://route53.amazonaws.com/doc/2012-02-29/}CreateHostedZoneRequest" []
              [xml|
              <Name>#{T.decodeUtf8 chzName}
-             <CallerReference>${chzCallerReference}
+             <CallerReference>#{chzCallerReference}
              <HostedZoneConfig>
-               <Comment>${chzComment}
+               <Comment>#{chzComment}
              |]
 
 instance ResponseConsumer r CreateHostedZoneResponse where
diff --git a/Aws/Route53/Model.hs b/Aws/Route53/Model.hs
index 456e0b92..5bee8b50 100644
--- a/Aws/Route53/Model.hs
+++ b/Aws/Route53/Model.hs
@@ -89,10 +89,10 @@ instance Route53XmlSerializable HostedZone where
   toXml HostedZone{..} = XML.Element "HostedZone" [] [xml|
     <Id>#{hzId}
     <Name>#{decodeUtf8 hzName}
-    <CallerReference>${hzCallerReference}
+    <CallerReference>#{hzCallerReference}
     <Config>
       <Comment>#{hzComment}
-    <ResourceRecordSetCount>${T.pack . show $ hzResourceRecordCount}
+    <ResourceRecordSetCount>#{intToText hzResourceRecordSetCount}
     |]
 
 instance Route53XmlSerializable HostedZones where
@@ -151,6 +151,9 @@ instance Show REGION where
   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
@@ -171,18 +174,55 @@ data AliasTarget = AliasTarget { atHostedZoneId :: T.Text
                                } deriving (Show)
 
 -- TODO make this complete from the spec. Do not just use the exmpales!
+-- We may e.g. have different type for alias resource record sets
 data ResourceRecordSet = ResourceRecordSet { rrsName :: DNS.Domain
                                            , rrsType :: DNS.TYPE
                                            , rrsAliasTarget :: Maybe AliasTarget
                                            , rrsSetIdentifier :: Maybe T.Text
                                            , rrsWeight :: Maybe Int
-                                           , rssRegion :: Maybe REGION
-                                           , rrsTTL  :: Int
+                                           , rrsRegion :: Maybe REGION
+                                           , rrsTTL  :: Maybe Int
                                            , rrsRecords :: ResourceRecords
                                            } deriving (Show)
                                            
 type ResourceRecordSets = [ResourceRecordSet]
 
+instance Route53XmlSerializable ResourceRecordSet where
+
+  toXml ResourceRecordSet{..} = XML.Element "ResourceRecordSet" [] [xml|
+    <Name>#{decodeUtf8 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" [] [xml|  <Value>#{value} |]
+
+instance Route53XmlSerializable AliasTarget where
+  
+  toXml AliasTarget{..} = XML.Element "AliasTarget" [] [xml|
+    <HostedZoneId>#{atHostedZoneId}
+    <DNSName>#{decodeUtf8 atDNSName}
+    |]
+
+--instance Route53XmlSerializable HostedZones where
+--  toXml hostedZones = XML.Element "HostedZones" [] $ (XML.NodeElement . toXml) `map` hostedZones
+
+
 instance Route53Parseable ResourceRecordSets where
   r53Parse cursor = do
     c <- force "Missing ResourceRecordSets element" $ cursor $.// laxElement "ResourceRecordSets"
@@ -193,7 +233,7 @@ instance Route53Parseable ResourceRecordSet where
     c <- force "Missing ResourceRecordSet element" $ cursor $.// laxElement "ResourceRecordSet"
     name <- force "Missing name element" $ c $/ elContent "Name" &| encodeUtf8
     dnsType <- force "Missing type element" $ c $/ elCont "Type" &| DNS.toType 
-    ttl <- forceM "Missing TTL element" $ c $/ elCont "TTL" &| readInt
+    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)
@@ -283,6 +323,9 @@ forceTake n e l = do
 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' 
 -- and 'Network.DNS.Types'
@@ -298,3 +341,7 @@ findHeaderValue headers = fmap snd . findHeader headers
 
 typeToString :: DNS.TYPE -> String
 typeToString = show
+
+typeToText :: DNS.TYPE -> T.Text
+typeToText = T.pack . typeToString
+

From 6dc3d7fdc3193b23610da8391e911c22133daff8 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Mon, 30 Apr 2012 22:17:59 -0700
Subject: [PATCH 18/55] Route53: introduce class Route53Id and newtype wrappers
 for HostedZoneId, ChangeId, and Domain

---
 Aws/Route53/Model.hs | 93 +++++++++++++++++++++++++++++---------------
 1 file changed, 61 insertions(+), 32 deletions(-)

diff --git a/Aws/Route53/Model.hs b/Aws/Route53/Model.hs
index 5bee8b50..ef88a5df 100644
--- a/Aws/Route53/Model.hs
+++ b/Aws/Route53/Model.hs
@@ -1,8 +1,11 @@
-{-# LANGUAGE OverloadedStrings #-} 
-{-# LANGUAGE QuasiQuotes #-} 
-{-# LANGUAGE FlexibleContexts #-} 
-{-# LANGUAGE RecordWildCards #-} 
-{-# LANGUAGE TypeSynonymInstances #-}  
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
   
 module Aws.Route53.Model
 ( -- * Hosted Zone
@@ -38,12 +41,12 @@ module Aws.Route53.Model
 , typeToString
 ) where
 
+import           Data.String
 import           Control.Monad      (MonadPlus, mzero, mplus, liftM)
 import           Aws.Xml
 import           Text.XML.Cursor    (($/), ($//), (&|), ($.//), laxElement)
 import qualified Text.XML           as XML
 import           Text.Hamlet.XML    (xml)
-import           Data.Text.Encoding (encodeUtf8, decodeUtf8)
 import           Data.List          (find)
 import           Data.Maybe         (listToMaybe, fromJust)
 import           Data.Time          (UTCTime)
@@ -52,18 +55,37 @@ import           System.Locale      (defaultTimeLocale)
 import qualified Control.Failure    as F
 import qualified Text.XML.Cursor    as Cu
 import qualified Data.Text          as T
-import qualified Data.Text.Encoding as T
 import qualified Network.DNS.Types  as DNS
 import qualified Network.HTTP.Types as HTTP
 
+class Route53Id r where
+  idText :: r -> T.Text
+  asId :: T.Text -> r
+
+--instance (Route53Id r) => IsString r where
+--  fromString = HostedZoneId . fromJust . T.stripPrefix (idPrefix undefined) . T.pack
+
 -- -------------------------------------------------------------------------- --
 -- HostedZone
 
+newtype HostedZoneId = HostedZoneId { hostedZoneIdText :: T.Text }
+                        deriving (Show, IsString)
+
+instance Route53Id HostedZoneId where
+  idText = hostedZoneIdText
+  asId = HostedZoneId . fromJust . T.stripPrefix "/hostedzone/"
+
+newtype Domain = Domain { domainText :: T.Text }
+                 deriving (Show)
+
+instance IsString Domain where
+  fromString = Domain . T.pack
+
 type HostedZones = [HostedZone]
 
 data HostedZone = HostedZone 
-                  { hzId :: T.Text
-                  , hzName :: DNS.Domain
+                  { hzId :: HostedZoneId
+                  , hzName :: Domain
                   , hzCallerReference :: T.Text
                   , hzComment :: T.Text
                   , hzResourceRecordSetCount :: Int
@@ -77,8 +99,8 @@ instance Route53Parseable HostedZones where
 instance Route53Parseable HostedZone where
   r53Parse cursor = do
     c <- force "Missing HostedZone element" $ cursor $.// laxElement "HostedZone"
-    zoneId <- force "Missing hostedZoneId element" $ c $/ elContent "Id"
-    name <- force "Missing Name element" $ c $/ elContent "Name" &| encodeUtf8
+    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"
     comment <- force "Missing Comment element" $ c $// elContent "Comment"
     resourceRecordSetCount <- forceM "Missing ResourceRecordCount" $ c $/ elCont "ResourceRecordSetCount" &| readInt
@@ -87,8 +109,8 @@ instance Route53Parseable HostedZone where
 instance Route53XmlSerializable HostedZone where
 
   toXml HostedZone{..} = XML.Element "HostedZone" [] [xml|
-    <Id>#{hzId}
-    <Name>#{decodeUtf8 hzName}
+    <Id>#{idText hzId}
+    <Name>#{domainText hzName}
     <CallerReference>#{hzCallerReference}
     <Config>
       <Comment>#{hzComment}
@@ -103,15 +125,15 @@ instance Route53XmlSerializable HostedZones where
 
 type Nameservers = [Nameserver]
 
-type Nameserver = DNS.Domain
+type Nameserver = Domain
 
-data DelegationSet = DelegationSet { dsNameserver1 :: DNS.Domain 
-                                   , dsNameserver2 :: DNS.Domain
-                                   , dsNameserver3 :: DNS.Domain
-                                   , dsNameserver4 :: DNS.Domain
+data DelegationSet = DelegationSet { dsNameserver1 :: Domain 
+                                   , dsNameserver2 :: Domain
+                                   , dsNameserver3 :: Domain
+                                   , dsNameserver4 :: Domain
                                    } deriving (Show)
 
-dsNameservers :: DelegationSet -> [DNS.Domain]
+dsNameservers :: DelegationSet -> [Domain]
 dsNameservers DelegationSet{..} = [dsNameserver1, dsNameserver2, dsNameserver3, dsNameserver4]
 
 instance Route53Parseable DelegationSet where
@@ -127,7 +149,7 @@ instance Route53Parseable Nameservers where
 
 instance Route53Parseable Nameserver where
   r53Parse cursor = 
-    force "Missing Nameserver element" $ cursor $.// elContent "Nameserver" &| T.encodeUtf8
+    force "Missing Nameserver element" $ cursor $.// elContent "Nameserver" &| Domain
 
 -- -------------------------------------------------------------------------- --
 -- RsourceRecordSet
@@ -169,13 +191,13 @@ type ResourceRecords = [ResourceRecord]
 newtype ResourceRecord = ResourceRecord { value :: T.Text }
                          deriving (Show)
 
-data AliasTarget = AliasTarget { atHostedZoneId :: T.Text
-                               , atDNSName :: DNS.Domain
+data AliasTarget = AliasTarget { atHostedZoneId :: HostedZoneId
+                               , atDNSName :: Domain
                                } deriving (Show)
 
 -- TODO make this complete from the spec. Do not just use the exmpales!
 -- We may e.g. have different type for alias resource record sets
-data ResourceRecordSet = ResourceRecordSet { rrsName :: DNS.Domain
+data ResourceRecordSet = ResourceRecordSet { rrsName :: Domain
                                            , rrsType :: DNS.TYPE
                                            , rrsAliasTarget :: Maybe AliasTarget
                                            , rrsSetIdentifier :: Maybe T.Text
@@ -190,8 +212,8 @@ type ResourceRecordSets = [ResourceRecordSet]
 instance Route53XmlSerializable ResourceRecordSet where
 
   toXml ResourceRecordSet{..} = XML.Element "ResourceRecordSet" [] [xml|
-    <Name>#{decodeUtf8 rrsName}
-    <Type>#{ typeToText rrsType }
+    <Name>#{domainText rrsName}
+    <Type>#{typeToText rrsType}
     $maybe a <- rrsAliasTarget
       <AliasTarget>
         ^{[XML.NodeElement (toXml a)]}
@@ -215,8 +237,8 @@ instance Route53XmlSerializable ResourceRecord where
 instance Route53XmlSerializable AliasTarget where
   
   toXml AliasTarget{..} = XML.Element "AliasTarget" [] [xml|
-    <HostedZoneId>#{atHostedZoneId}
-    <DNSName>#{decodeUtf8 atDNSName}
+    <HostedZoneId>#{idText atHostedZoneId}
+    <DNSName>#{domainText atDNSName}
     |]
 
 --instance Route53XmlSerializable HostedZones where
@@ -231,7 +253,7 @@ instance Route53Parseable ResourceRecordSets where
 instance Route53Parseable ResourceRecordSet where
   r53Parse cursor = do
     c <- force "Missing ResourceRecordSet element" $ cursor $.// laxElement "ResourceRecordSet"
-    name <- force "Missing name element" $ c $/ elContent "Name" &| encodeUtf8
+    name <- force "Missing name element" $ c $/ elContent "Name" &| Domain
     dnsType <- force "Missing type element" $ c $/ elCont "Type" &| DNS.toType 
     ttl <- listToMaybe `liftM` (sequence $ c $/ elCont "TTL" &| readInt)
     alias <- listToMaybe `liftM` (sequence $ c $/ laxElement "AliasTarget" &| r53Parse)
@@ -247,8 +269,8 @@ instance Route53Parseable ResourceRecordSet where
 instance Route53Parseable AliasTarget where
   r53Parse cursor = do
     c <- force "Missing AliasTarget element" $ cursor $.// laxElement "AliasTarget"
-    zoneId <- force "Missing HostedZoneId element" $ c $/ elContent "HostedZoneId"
-    dnsName <- force "Missing DNSName element" $ c $/ elContent "DNSName" &| encodeUtf8
+    zoneId <- force "Missing HostedZoneId element" $ c $/ elContent "HostedZoneId" &| asId
+    dnsName <- force "Missing DNSName element" $ c $/ elContent "DNSName" &| Domain
     return $ AliasTarget zoneId dnsName
 
 
@@ -268,7 +290,14 @@ instance Route53Parseable ResourceRecord where
 data ChangeInfoStatus = PENDING | INSYNC
                         deriving (Show, Read)
 
-data ChangeInfo = ChangeInfo { ciId :: T.Text
+newtype ChangeId = ChangeId { changeIdText :: T.Text }
+                   deriving (Show)
+
+instance Route53Id ChangeId where
+  idText = changeIdText
+  asId = ChangeId . fromJust. T.stripPrefix "/changeid/"
+
+data ChangeInfo = ChangeInfo { ciId :: ChangeId
                              , ciStatus :: ChangeInfoStatus
                              , ciSubmittedAt :: UTCTime
                              } deriving (Show)
@@ -276,7 +305,7 @@ data ChangeInfo = ChangeInfo { ciId :: T.Text
 instance Route53Parseable ChangeInfo where
   r53Parse cursor = do
     c <- force "Missing ChangeInfo element" $ cursor $.// laxElement "ChangeInfo"
-    ciId <- force "Missing Id element" $ c $/ elContent "Id"
+    ciId <- force "Missing Id element" $ c $/ elContent "Id" &| ChangeId
     status <- force "Missing Status element" $ c $/ elCont "Status" &| read
     submittedAt <- force "Missing SubmittedAt element" $ c $/ elCont "SubmittedAt" &| utcTime
     return $ ChangeInfo ciId status submittedAt

From 08caa3ca329eb82f3a56e6383f74d39fdf4695eb Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Mon, 30 Apr 2012 22:19:11 -0700
Subject: [PATCH 19/55] Route53: fix nameing of record fields in
 ListResourceRecordSets

---
 .../Commands/ListResourceRecordSets.hs        | 26 +++++++++----------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
index 921e4a86..5afbc71d 100644
--- a/Aws/Route53/Commands/ListResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -42,10 +42,10 @@ import qualified Data.ByteString.Char8      as B
 
 data ListResourceRecordSets = ListResourceRecordSets
                    { lrrsHostedZoneId :: T.Text
-                   , name :: Maybe DNS.Domain
-                   , recordType :: Maybe DNS.TYPE   -- ^ /note that SPF is currently not supported/
-                   , identifier :: Maybe T.Text     -- ^ must be present for weighted or latency resource record sets
-                   , maxitems :: Maybe Int          -- ^ maximum effective value is 100
+                   , lrrsName :: Maybe DNS.Domain
+                   , lrrsRecordType :: Maybe DNS.TYPE   -- ^ /note that SPF is currently not supported/
+                   , lrrsIdentifier :: Maybe T.Text     -- ^ must be present for weighted or latency resource record sets
+                   , lrrsMaxItems :: Maybe Int          -- ^ maximum effective value is 100
                    } deriving (Show)
 
 -- | A most general 'ListResourceRecordSets' query
@@ -54,11 +54,11 @@ listResourceRecordSets hostedZoneId = ListResourceRecordSets hostedZoneId Nothin
 
 data ListResourceRecordSetsResponse = ListResourceRecordSetsResponse
                              { lrrsrResourceRecordSets :: ResourceRecordSets
-                             , lrrsIsTruncated :: Bool
-                             , lrrsMaxItems :: Maybe Int                 -- ^ The maxitems value from the request (TODO is it Maybe?)
-                             , lrrsNextRecordName :: Maybe DNS.Domain    -- ^ TODO check constraint
-                             , lrrsNextRecordType :: Maybe DNS.TYPE      -- ^ TODO check constraint
-                             , lrrsNextRecordIdentifier :: Maybe T.Text  -- ^ TODO check constraint
+                             , lrrsrIsTruncated :: Bool
+                             , lrrsrMaxItems :: Maybe Int                 -- ^ The maxitems value from the request (TODO is it Maybe?)
+                             , lrrsrNextRecordName :: Maybe DNS.Domain    -- ^ TODO check constraint
+                             , lrrsrNextRecordType :: Maybe DNS.TYPE      -- ^ TODO check constraint
+                             , lrrsrNextRecordIdentifier :: Maybe T.Text  -- ^ TODO check constraint
                              } deriving (Show)
 
 instance SignQuery ListResourceRecordSets where
@@ -68,10 +68,10 @@ instance SignQuery ListResourceRecordSets where
       method = Get
       body = Nothing
       resource = "/hostedzone/" `B.append` (T.encodeUtf8 lrrsHostedZoneId) `B.append` "/rrset"
-      query = catMaybes [ ("name",) <$> name
-                        , ("type",) . B.pack . typeToString <$> recordType
-                        , ("identifier",) . T.encodeUtf8 <$> identifier
-                        , ("maxitems",) . B.pack . show <$> maxitems
+      query = catMaybes [ ("name",) <$> lrrsName
+                        , ("type",) . B.pack . typeToString <$> lrrsRecordType
+                        , ("identifier",) . T.encodeUtf8 <$> lrrsIdentifier
+                        , ("maxitems",) . B.pack . show <$> lrrsMaxItems
                         ]
 
 instance ResponseConsumer r ListResourceRecordSetsResponse where

From 5701f771f534cc2e398ebfd026672ffa40716a82 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Thu, 3 May 2012 20:46:45 -0700
Subject: [PATCH 20/55] Route53: export Route53Id and use it in
 ListResourceRecordSets.

---
 .../Commands/ListResourceRecordSets.hs        | 16 +++---
 Aws/Route53/Model.hs                          | 51 ++++++++++++++-----
 2 files changed, 47 insertions(+), 20 deletions(-)

diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
index 5afbc71d..117a1218 100644
--- a/Aws/Route53/Commands/ListResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -41,22 +41,22 @@ import qualified Data.Text.Encoding         as T
 import qualified Data.ByteString.Char8      as B
 
 data ListResourceRecordSets = ListResourceRecordSets
-                   { lrrsHostedZoneId :: T.Text
-                   , lrrsName :: Maybe DNS.Domain
+                   { lrrsHostedZoneId :: HostedZoneId
+                   , lrrsName :: Maybe Domain
                    , lrrsRecordType :: Maybe DNS.TYPE   -- ^ /note that SPF is currently not supported/
-                   , lrrsIdentifier :: Maybe T.Text     -- ^ must be present for weighted or latency resource record sets
+                   , 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 :: T.Text -> ListResourceRecordSets
+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 (TODO is it Maybe?)
-                             , lrrsrNextRecordName :: Maybe DNS.Domain    -- ^ TODO check constraint
+                             , lrrsrNextRecordName :: Maybe Domain        -- ^ TODO check constraint
                              , lrrsrNextRecordType :: Maybe DNS.TYPE      -- ^ TODO check constraint
                              , lrrsrNextRecordIdentifier :: Maybe T.Text  -- ^ TODO check constraint
                              } deriving (Show)
@@ -67,8 +67,8 @@ instance SignQuery ListResourceRecordSets where
       where
       method = Get
       body = Nothing
-      resource = "/hostedzone/" `B.append` (T.encodeUtf8 lrrsHostedZoneId) `B.append` "/rrset"
-      query = catMaybes [ ("name",) <$> lrrsName
+      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
@@ -84,7 +84,7 @@ instance ResponseConsumer r ListResourceRecordSetsResponse where
             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" &| T.encodeUtf8
+            let nextRecordName = listToMaybe $ cursor $// elContent "NextRecordName" &| Domain
             let nextRecordType = listToMaybe $ cursor $// elCont "NextRecordType" &| DNS.toType
             let nextRecordIdentifier = listToMaybe $ cursor $// elContent "NextRecordIdentifier"
             return $ ListResourceRecordSetsResponse resourceRecordSets isTruncated maxItems nextRecordName nextRecordType nextRecordIdentifier
diff --git a/Aws/Route53/Model.hs b/Aws/Route53/Model.hs
index ef88a5df..21aa2ca6 100644
--- a/Aws/Route53/Model.hs
+++ b/Aws/Route53/Model.hs
@@ -6,11 +6,14 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
   
 module Aws.Route53.Model
 ( -- * Hosted Zone
   HostedZone (..)
 , HostedZones
+, Domain(..)
+, HostedZoneId(..)
 
   -- * Delegation Set
 , DelegationSet(..)
@@ -28,10 +31,13 @@ module Aws.Route53.Model
 
   -- * Change Info
 , ChangeInfo(..)
+, ChangeInfoStatus(..)
+, ChangeId(..)
 
   -- * Parser Utilities
 , Route53Parseable(..)
 , Route53XmlSerializable(..)
+, Route53Id(..)
 
   -- * DNS and HTTP Utilites
   -- | This functions extend 'Network.HTTP.Types' and 'Network.DNS.Types'
@@ -59,8 +65,24 @@ import qualified Network.DNS.Types  as DNS
 import qualified Network.HTTP.Types as HTTP
 
 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
@@ -68,15 +90,17 @@ class Route53Id r where
 -- -------------------------------------------------------------------------- --
 -- HostedZone
 
-newtype HostedZoneId = HostedZoneId { hostedZoneIdText :: T.Text }
-                        deriving (Show, IsString)
+newtype HostedZoneId = HostedZoneId { hziText :: T.Text }
+                        deriving (Show, IsString, Eq)
 
 instance Route53Id HostedZoneId where
-  idText = hostedZoneIdText
-  asId = HostedZoneId . fromJust . T.stripPrefix "/hostedzone/"
+  idQualifier = const "hostedzone"
+  idText = hziText
+  --asId r = HostedZoneId . fromJust . T.stripPrefix (qualifiedIdTextPrefix (undefined::HostedZoneId)) $ r
+  asId' = HostedZoneId
 
-newtype Domain = Domain { domainText :: T.Text }
-                 deriving (Show)
+newtype Domain = Domain { dText :: T.Text }
+                 deriving (Show, Eq)
 
 instance IsString Domain where
   fromString = Domain . T.pack
@@ -110,7 +134,7 @@ instance Route53XmlSerializable HostedZone where
 
   toXml HostedZone{..} = XML.Element "HostedZone" [] [xml|
     <Id>#{idText hzId}
-    <Name>#{domainText hzName}
+    <Name>#{dText hzName}
     <CallerReference>#{hzCallerReference}
     <Config>
       <Comment>#{hzComment}
@@ -162,6 +186,7 @@ data REGION = ApNorthEast1
             | UsWest1
             | UsWest2
             | UnknownRegion
+            deriving (Eq)
 
 instance Show REGION where
   show ApNorthEast1  = "ap-north-east-1"
@@ -189,7 +214,7 @@ regionFromString _                 = UnknownRegion
 type ResourceRecords = [ResourceRecord]
 
 newtype ResourceRecord = ResourceRecord { value :: T.Text }
-                         deriving (Show)
+                         deriving (Show, Eq)
 
 data AliasTarget = AliasTarget { atHostedZoneId :: HostedZoneId
                                , atDNSName :: Domain
@@ -212,7 +237,7 @@ type ResourceRecordSets = [ResourceRecordSet]
 instance Route53XmlSerializable ResourceRecordSet where
 
   toXml ResourceRecordSet{..} = XML.Element "ResourceRecordSet" [] [xml|
-    <Name>#{domainText rrsName}
+    <Name>#{dText rrsName}
     <Type>#{typeToText rrsType}
     $maybe a <- rrsAliasTarget
       <AliasTarget>
@@ -238,7 +263,7 @@ instance Route53XmlSerializable AliasTarget where
   
   toXml AliasTarget{..} = XML.Element "AliasTarget" [] [xml|
     <HostedZoneId>#{idText atHostedZoneId}
-    <DNSName>#{domainText atDNSName}
+    <DNSName>#{dText atDNSName}
     |]
 
 --instance Route53XmlSerializable HostedZones where
@@ -291,11 +316,13 @@ data ChangeInfoStatus = PENDING | INSYNC
                         deriving (Show, Read)
 
 newtype ChangeId = ChangeId { changeIdText :: T.Text }
-                   deriving (Show)
+                   deriving (Show, Eq)
 
 instance Route53Id ChangeId where
+  idQualifier = const "changeId"
   idText = changeIdText
-  asId = ChangeId . fromJust. T.stripPrefix "/changeid/"
+  asId' = ChangeId
+  --asId = ChangeId . fromJust. T.stripPrefix "/changeid/"
 
 data ChangeInfo = ChangeInfo { ciId :: ChangeId
                              , ciStatus :: ChangeInfoStatus

From 45111b4567b1ee9a5c5b7648757d7eb4b22f419d Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Thu, 3 May 2012 22:21:11 -0700
Subject: [PATCH 21/55] Route53: convert to new module layout scheme

---
 Aws/Aws.hs                                    |   2 +-
 .../Commands/ChangeResourceRecordSets.hs      |   8 +-
 Aws/Route53/Commands/CreateHostedZone.hs      |   8 +-
 Aws/Route53/Commands/DeleteHostedZone.hs      |   6 +-
 Aws/Route53/Commands/GetChange.hs             |   6 +-
 Aws/Route53/Commands/GetDate.hs               |   9 +-
 Aws/Route53/Commands/GetHostedZone.hs         |   6 +-
 Aws/Route53/Commands/ListHostedZones.hs       |   6 +-
 .../Commands/ListResourceRecordSets.hs        |   6 +-
 Aws/Route53/{Model.hs => Core.hs}             | 209 +++++++++++++++---
 Aws/Route53/Error.hs                          |  20 --
 Aws/Route53/Info.hs                           |  30 ---
 Aws/Route53/Metadata.hs                       |  18 --
 Aws/Route53/Query.hs                          |  48 ----
 Aws/Route53/Response.hs                       |  49 ----
 aws.cabal                                     |   9 +-
 16 files changed, 198 insertions(+), 242 deletions(-)
 rename Aws/Route53/{Model.hs => Core.hs} (68%)
 delete mode 100644 Aws/Route53/Error.hs
 delete mode 100644 Aws/Route53/Info.hs
 delete mode 100644 Aws/Route53/Metadata.hs
 delete mode 100644 Aws/Route53/Query.hs
 delete mode 100644 Aws/Route53/Response.hs

diff --git a/Aws/Aws.hs b/Aws/Aws.hs
index f61f99dd..0a5f852b 100644
--- a/Aws/Aws.hs
+++ b/Aws/Aws.hs
@@ -28,7 +28,7 @@ import           Aws.S3.Core
 import           Aws.Ses.Core
 import           Aws.SimpleDb.Core
 import           Aws.Sqs.Core
-import           Aws.Route53.Info
+import           Aws.Route53.Core
 import           Control.Applicative
 import           Control.Monad.Trans  (liftIO)
 import           Data.Attempt         (attemptIO)
diff --git a/Aws/Route53/Commands/ChangeResourceRecordSets.hs b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
index 26c2a577..ee1f990f 100644
--- a/Aws/Route53/Commands/ChangeResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
@@ -14,16 +14,12 @@
 --
 module Aws.Route53.Commands.ChangeResourceRecordSets where
 
-import           Aws.Route53.Info
-import           Aws.Route53.Model
-import           Aws.Route53.Metadata
-import           Aws.Route53.Query
-import           Aws.Route53.Response
+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 qualified Text.XML                   as XML
-import           Text.Hamlet.XML            (xml)
 import qualified Data.ByteString            as B
 
 data ACTION = CREATE | DELETE 
diff --git a/Aws/Route53/Commands/CreateHostedZone.hs b/Aws/Route53/Commands/CreateHostedZone.hs
index 3a2f29f4..99af3e3f 100644
--- a/Aws/Route53/Commands/CreateHostedZone.hs
+++ b/Aws/Route53/Commands/CreateHostedZone.hs
@@ -15,16 +15,12 @@
 module Aws.Route53.Commands.CreateHostedZone where
 
 import           Aws.Core
-import           Aws.Route53.Info
-import           Aws.Route53.Model
-import           Aws.Route53.Metadata
-import           Aws.Route53.Query
-import           Aws.Route53.Response
+import           Aws.Route53.Core
+import           Text.Hamlet.XML            (xml)
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
 import qualified Network.DNS.Types          as DNS
 import qualified Text.XML                   as XML
-import           Text.Hamlet.XML            (xml)
 
 data CreateHostedZone = CreateHostedZone
                       { chzName :: DNS.Domain
diff --git a/Aws/Route53/Commands/DeleteHostedZone.hs b/Aws/Route53/Commands/DeleteHostedZone.hs
index 249336fc..11b2b0f0 100644
--- a/Aws/Route53/Commands/DeleteHostedZone.hs
+++ b/Aws/Route53/Commands/DeleteHostedZone.hs
@@ -14,11 +14,7 @@
 module Aws.Route53.Commands.DeleteHostedZone where
 
 import           Aws.Core
-import           Aws.Route53.Info
-import           Aws.Route53.Model
-import           Aws.Route53.Metadata
-import           Aws.Route53.Query
-import           Aws.Route53.Response
+import           Aws.Route53.Core
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
 import qualified Data.ByteString            as B
diff --git a/Aws/Route53/Commands/GetChange.hs b/Aws/Route53/Commands/GetChange.hs
index 4bf09e3c..27ac8b88 100644
--- a/Aws/Route53/Commands/GetChange.hs
+++ b/Aws/Route53/Commands/GetChange.hs
@@ -14,11 +14,7 @@
 module Aws.Route53.Commands.GetChange where
 
 import           Aws.Core
-import           Aws.Route53.Info
-import           Aws.Route53.Model
-import           Aws.Route53.Metadata
-import           Aws.Route53.Query
-import           Aws.Route53.Response
+import           Aws.Route53.Core
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
 import qualified Data.ByteString            as B
diff --git a/Aws/Route53/Commands/GetDate.hs b/Aws/Route53/Commands/GetDate.hs
index 1399121e..836b4598 100644
--- a/Aws/Route53/Commands/GetDate.hs
+++ b/Aws/Route53/Commands/GetDate.hs
@@ -10,12 +10,11 @@
 module Aws.Route53.Commands.GetDate where
 
 import           Aws.Core
-import           Data.Time (UTCTime)
-import           Data.Time.Format (parseTime)
-import           System.Locale (defaultTimeLocale)
-import           Aws.Route53.Info
-import           Aws.Route53.Model
+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.Types         as HTTP
 
diff --git a/Aws/Route53/Commands/GetHostedZone.hs b/Aws/Route53/Commands/GetHostedZone.hs
index 136ec098..1cb51789 100644
--- a/Aws/Route53/Commands/GetHostedZone.hs
+++ b/Aws/Route53/Commands/GetHostedZone.hs
@@ -16,11 +16,7 @@
 module Aws.Route53.Commands.GetHostedZone where
 
 import           Aws.Core
-import           Aws.Route53.Info
-import           Aws.Route53.Model
-import           Aws.Route53.Metadata
-import           Aws.Route53.Query
-import           Aws.Route53.Response
+import           Aws.Route53.Core
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
 import qualified Data.ByteString            as B
diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index 1a9bbd8e..79e7617d 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -15,11 +15,7 @@
 module Aws.Route53.Commands.ListHostedZones where
 
 import           Aws.Core
-import           Aws.Route53.Info
-import           Aws.Route53.Model
-import           Aws.Route53.Metadata
-import           Aws.Route53.Query
-import           Aws.Route53.Response
+import           Aws.Route53.Core
 import           Data.Maybe
 import           Control.Applicative        ((<$>))
 import           Text.XML.Cursor            (($//))
diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
index 835b141f..f179c93a 100644
--- a/Aws/Route53/Commands/ListResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -23,11 +23,7 @@
 module Aws.Route53.Commands.ListResourceRecordSets where
 
 import           Aws.Core
-import           Aws.Route53.Info
-import           Aws.Route53.Model
-import           Aws.Route53.Metadata
-import           Aws.Route53.Query
-import           Aws.Route53.Response
+import           Aws.Route53.Core
 import           Data.Maybe                 (catMaybes, listToMaybe)
 import           Control.Applicative        ((<$>))
 import qualified Network.DNS.Types          as DNS
diff --git a/Aws/Route53/Model.hs b/Aws/Route53/Core.hs
similarity index 68%
rename from Aws/Route53/Model.hs
rename to Aws/Route53/Core.hs
index 2ee82391..1a582354 100644
--- a/Aws/Route53/Model.hs
+++ b/Aws/Route53/Core.hs
@@ -1,27 +1,49 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-} 
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
   
-module Aws.Route53.Model
-( -- * Hosted Zone
-  HostedZone (..)
+module Aws.Route53.Core
+( -- * Info
+  Route53Info(..)
+, route53EndpointUsClassic
+, route53
+
+  -- * Error
+, Route53Error(..)
+
+  -- * Metadata
+, Route53Metadata(..)
+
+  -- * Query
+, route53SignQuery
+
+  -- * Response
+, route53ResponseConsumer
+, route53CheckResponseType
+
+  -- * Model
+
+  -- ** Hosted Zone
+, HostedZone (..)
 , HostedZones
 , Domain(..)
 , HostedZoneId(..)
 
-  -- * Delegation Set
+  -- ** Delegation Set
 , DelegationSet(..)
 , Nameserver
 , Nameservers
 , dsNameservers
 
-  -- * Resource Record Set
+  -- ** Resource Record Set
 , REGION(..)
 , ResourceRecordSets
 , ResourceRecordSet(..)
@@ -29,7 +51,7 @@ module Aws.Route53.Model
 , ResourceRecord(..)
 , AliasTarget(..)
 
-  -- * Change Info
+  -- ** Change Info
 , ChangeInfo(..)
 , ChangeInfoStatus(..)
 , ChangeId(..)
@@ -48,21 +70,155 @@ module Aws.Route53.Model
 ) where
 
 import           Aws.Core
+import           Data.IORef
+import           Data.Monoid
 import           Data.String
-import           Control.Monad      (MonadPlus, mzero, mplus, liftM)
-import           Text.XML.Cursor    (($/), ($//), (&|), ($.//), laxElement)
-import qualified Text.XML           as XML
-import           Text.Hamlet.XML    (xml)
-import           Data.List          (find)
-import           Data.Maybe         (listToMaybe, fromJust)
-import           Data.Time          (UTCTime)
-import           Data.Time.Format   (parseTime)
-import           System.Locale      (defaultTimeLocale)
-import qualified Control.Failure    as F
-import qualified Text.XML.Cursor    as Cu
-import qualified Data.Text          as T
-import qualified Network.DNS.Types  as DNS
-import qualified Network.HTTP.Types as HTTP
+import           Data.Typeable
+import           Control.Monad        (MonadPlus, mzero, mplus, liftM)
+import           Data.List            (find)
+import           Data.Maybe           (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.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 Network.DNS.Types    as DNS
+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
+
+-- -------------------------------------------------------------------------- --
+-- Info
+
+data Route53Info = Route53Info 
+    { route53Protocol :: Protocol
+    , route53Endpoint :: B.ByteString
+    , route53Port :: Int
+    , route53ApiVersion :: B.ByteString
+    } deriving (Show)
+
+route53EndpointUsClassic :: B.ByteString
+route53EndpointUsClassic = "route53.amazonaws.com"
+
+route53ApiVersionRecent :: B.ByteString
+route53ApiVersionRecent = "2012-02-29"
+
+route53 :: Route53Info
+route53 = Route53Info 
+    { route53Protocol = HTTPS
+    , route53Endpoint = route53EndpointUsClassic
+    , route53Port = defaultPort HTTPS
+    , route53ApiVersion = route53ApiVersionRecent
+    }
+
+-- -------------------------------------------------------------------------- --
+-- 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 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 -> Route53Info -> SignatureData -> SignedQuery
+route53SignQuery method resource query body Route53Info{..} 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
+                     , XML.documentEpilogue = []
+                     }
+
+-- -------------------------------------------------------------------------- --
+-- 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 status headers =
+    xmlCursorConsumer parse metadataRef status headers
+    where
+      parse cursor = do
+        tellMetadata . Route53Metadata . fmap decodeUtf8 $ findHeaderValue headers headerRequestId
+        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
+
+-- ** Response types
+
+-- 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
@@ -269,7 +425,6 @@ instance Route53XmlSerializable AliasTarget where
 --instance Route53XmlSerializable HostedZones where
 --  toXml hostedZones = XML.Element "HostedZones" [] $ (XML.NodeElement . toXml) `map` hostedZones
 
-
 instance Route53Parseable ResourceRecordSets where
   r53Parse cursor = do
     c <- force "Missing ResourceRecordSets element" $ cursor $.// laxElement "ResourceRecordSets"
diff --git a/Aws/Route53/Error.hs b/Aws/Route53/Error.hs
deleted file mode 100644
index 4330d7d4..00000000
--- a/Aws/Route53/Error.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, RecordWildCards #-}
-module Aws.Route53.Error
-    ( Route53Error(..)
-    ) where
-
-import           Data.Typeable
-import           Data.Text                 (Text)
-import qualified Control.Exception         as C
-import qualified Network.HTTP.Types        as HTTP
-
--- 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
diff --git a/Aws/Route53/Info.hs b/Aws/Route53/Info.hs
deleted file mode 100644
index f25a2219..00000000
--- a/Aws/Route53/Info.hs
+++ /dev/null
@@ -1,30 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Aws.Route53.Info
-( Route53Info(..)
-, route53EndpointUsClassic
-, route53
-) where
-
-import           Aws.Core
-import qualified Data.ByteString as B
-
-data Route53Info = Route53Info 
-    { route53Protocol :: Protocol
-    , route53Endpoint :: B.ByteString
-    , route53Port :: Int
-    , route53ApiVersion :: B.ByteString
-    } deriving (Show)
-
-route53EndpointUsClassic :: B.ByteString
-route53EndpointUsClassic = "route53.amazonaws.com"
-
-route53ApiVersionRecent :: B.ByteString
-route53ApiVersionRecent = "2012-02-29"
-
-route53 :: Route53Info
-route53 = Route53Info 
-    { route53Protocol = HTTPS
-    , route53Endpoint = route53EndpointUsClassic
-    , route53Port = defaultPort HTTPS
-    , route53ApiVersion = route53ApiVersionRecent
-    }
diff --git a/Aws/Route53/Metadata.hs b/Aws/Route53/Metadata.hs
deleted file mode 100644
index ec97620e..00000000
--- a/Aws/Route53/Metadata.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-module Aws.Route53.Metadata
-    ( Route53Metadata(..)
-    ) where
-
-import           Control.Monad
-import           Data.Monoid
-import           Data.Typeable
-import qualified Data.Text     as T
-
-data Route53Metadata = Route53Metadata 
-    { requestId :: Maybe T.Text
-    } deriving (Show, Typeable)
-
-instance Monoid Route53Metadata where
-    mempty = Route53Metadata Nothing
-    Route53Metadata r1 `mappend` Route53Metadata r2 = Route53Metadata (r1 `mplus` r2)
-
diff --git a/Aws/Route53/Query.hs b/Aws/Route53/Query.hs
deleted file mode 100644
index 09f1046b..00000000
--- a/Aws/Route53/Query.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-} 
-
-module Aws.Route53.Query
-    ( route53SignQuery
-    ) where
-
-import           Aws.Core
-import           Aws.Route53.Info
-import qualified Text.XML                       as XML
-import qualified Data.ByteString                as B
-import qualified Network.HTTP.Types             as HTTP
-import qualified Network.HTTP.Conduit           as HTTP
-
-route53SignQuery :: Method -> B.ByteString -> [(B.ByteString, B.ByteString)] -> Maybe XML.Element -> Route53Info -> SignatureData -> SignedQuery
-route53SignQuery method resource query body Route53Info{..} 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
-                     , XML.documentEpilogue = []
-                     }
diff --git a/Aws/Route53/Response.hs b/Aws/Route53/Response.hs
deleted file mode 100644
index 87758969..00000000
--- a/Aws/Route53/Response.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, OverloadedStrings, TypeFamilies #-}
-module Aws.Route53.Response
-where
-
-import           Aws.Core
-import           Aws.Route53.Error
-import           Aws.Route53.Model
-import           Aws.Route53.Metadata
-import           Data.IORef
-import           Data.Text                  (Text, unpack)
-import           Data.Text.Encoding         (decodeUtf8)
-import           Text.XML.Cursor            (($/), ($//))
-import qualified Control.Failure            as F
-import qualified Text.XML.Cursor            as Cu
-
--- 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 status headers =
-    xmlCursorConsumer parse metadataRef status headers
-    where
-      parse cursor = do
-        tellMetadata . Route53Metadata . fmap decodeUtf8 $ findHeaderValue headers headerRequestId
-        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
-
--- * Response types
-
--- TODO analyse the possible response types. I think there are common patterns.
--- Collect common code from the Commands here
-
-
diff --git a/aws.cabal b/aws.cabal
index 041c5510..6a6b1585 100644
--- a/aws.cabal
+++ b/aws.cabal
@@ -87,6 +87,7 @@ Library
                        Aws.Ses.Commands.SendRawEmail,
                        Aws.Ses.Core
                        Aws.Route53,
+                       Aws.Route53.Core
                        Aws.Route53.Commands,
                        Aws.Route53.Commands.ListHostedZones,
                        Aws.Route53.Commands.ListResourceRecordSets,
@@ -94,13 +95,7 @@ Library
                        Aws.Route53.Commands.CreateHostedZone,
                        Aws.Route53.Commands.DeleteHostedZone,
                        Aws.Route53.Commands.GetChange,
-                       Aws.Route53.Commands.GetDate,
-                       Aws.Route53.Info,
-                       Aws.Route53.Model
-                       Aws.Route53.Error,
-                       Aws.Route53.Metadata,
-                       Aws.Route53.Query,
-                       Aws.Route53.Response
+                       Aws.Route53.Commands.GetDate
                        
 
   -- Packages needed in order to build this package.

From 953284f24f447a2e2a2ba00e52b7f319fca34148 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Thu, 3 May 2012 23:13:36 -0700
Subject: [PATCH 22/55] Route53: fix Aws.Route53 to not export the modules of
 the old scheme

---
 Aws/Route53.hs | 14 ++------------
 1 file changed, 2 insertions(+), 12 deletions(-)

diff --git a/Aws/Route53.hs b/Aws/Route53.hs
index f84ae5aa..4ac434c4 100644
--- a/Aws/Route53.hs
+++ b/Aws/Route53.hs
@@ -1,18 +1,8 @@
 module Aws.Route53
 ( module Aws.Route53.Commands
-, module Aws.Route53.Error
-, module Aws.Route53.Info
-, module Aws.Route53.Metadata
-, module Aws.Route53.Model
-, module Aws.Route53.Query
-, module Aws.Route53.Response
+, module Aws.Route53.Core
 )
 where
 
 import Aws.Route53.Commands
-import Aws.Route53.Error
-import Aws.Route53.Info
-import Aws.Route53.Metadata
-import Aws.Route53.Model
-import Aws.Route53.Query
-import Aws.Route53.Response
+import Aws.Route53.Core

From 00ae58d853f7cf4b069e31019a22b3b9aae90f11 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Fri, 4 May 2012 00:55:44 -0700
Subject: [PATCH 23/55] Route53: fix prefix in Route53Id instance of ChangeId

---
 Aws/Route53/Core.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/Aws/Route53/Core.hs b/Aws/Route53/Core.hs
index 1a582354..0d729923 100644
--- a/Aws/Route53/Core.hs
+++ b/Aws/Route53/Core.hs
@@ -474,10 +474,9 @@ newtype ChangeId = ChangeId { changeIdText :: T.Text }
                    deriving (Show, Eq)
 
 instance Route53Id ChangeId where
-  idQualifier = const "changeId"
+  idQualifier = const "change"
   idText = changeIdText
   asId' = ChangeId
-  --asId = ChangeId . fromJust. T.stripPrefix "/changeid/"
 
 data ChangeInfo = ChangeInfo { ciId :: ChangeId
                              , ciStatus :: ChangeInfoStatus

From 69f613d06af7142736d446e5a2a5bd931a1df4f7 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Fri, 4 May 2012 00:58:24 -0700
Subject: [PATCH 24/55] Route53: more pointless encoding of resource in
 ListResourceRecordSets query

---
 Aws/Route53/Commands/ListResourceRecordSets.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
index f179c93a..d74d34be 100644
--- a/Aws/Route53/Commands/ListResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -59,7 +59,7 @@ instance SignQuery ListResourceRecordSets where
       where
       method = Get
       body = Nothing
-      resource = T.encodeUtf8 (qualifiedIdText lrrsHostedZoneId) `B.append` "/rrset"
+      resource = (T.encodeUtf8 . qualifiedIdText) lrrsHostedZoneId `B.append` "/rrset"
       query = catMaybes [ ("name",) . T.encodeUtf8 . dText <$> lrrsName
                         , ("type",) . B.pack . typeToString <$> lrrsRecordType
                         , ("identifier",) . T.encodeUtf8 <$> lrrsIdentifier

From 1caec0164d47ac2879c9168594785d8367e3aed8 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Fri, 4 May 2012 01:06:11 -0700
Subject: [PATCH 25/55] Route53: actually use ChangeId in GetChange

---
 Aws/Route53/Commands/GetChange.hs | 6 +++---
 Aws/Route53/Core.hs               | 2 +-
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/Aws/Route53/Commands/GetChange.hs b/Aws/Route53/Commands/GetChange.hs
index 27ac8b88..51e39fc5 100644
--- a/Aws/Route53/Commands/GetChange.hs
+++ b/Aws/Route53/Commands/GetChange.hs
@@ -20,14 +20,14 @@ import qualified Data.Text.Encoding         as T
 import qualified Data.ByteString            as B
 
 data GetChange = GetChange
-               { changeId :: T.Text
+               { changeId :: ChangeId
                } deriving (Show)
 
 data GetChangeResponse = GetChangeResponse
                        { gcrChangeInfo :: ChangeInfo
                        } deriving (Show)
 
-getChange :: T.Text -> GetChange
+getChange :: ChangeId -> GetChange
 getChange changeId = GetChange changeId
 
 instance SignQuery GetChange where
@@ -35,7 +35,7 @@ instance SignQuery GetChange where
     signQuery GetChange{..} = route53SignQuery method resource query body
       where
       method = Get
-      resource = "/change/" `B.append` (T.encodeUtf8 changeId)
+      resource = T.encodeUtf8 . qualifiedIdText $ changeId
       query = []
       body = Nothing
 
diff --git a/Aws/Route53/Core.hs b/Aws/Route53/Core.hs
index 0d729923..54d6f648 100644
--- a/Aws/Route53/Core.hs
+++ b/Aws/Route53/Core.hs
@@ -486,7 +486,7 @@ data ChangeInfo = ChangeInfo { ciId :: ChangeId
 instance Route53Parseable ChangeInfo where
   r53Parse cursor = do
     c <- force "Missing ChangeInfo element" $ cursor $.// laxElement "ChangeInfo"
-    ciId <- force "Missing Id element" $ c $/ elContent "Id" &| ChangeId
+    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

From 9a7dd3458b1e27ddfe7effb4a4e9e277eb36c74b Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Fri, 4 May 2012 01:07:17 -0700
Subject: [PATCH 26/55] Route35: use HostedZoneId in GetHostedZone and
 ChangeResourceRecordSets

---
 Aws/Route53/Commands/ChangeResourceRecordSets.hs | 4 ++--
 Aws/Route53/Commands/GetHostedZone.hs            | 6 +++---
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/Aws/Route53/Commands/ChangeResourceRecordSets.hs b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
index ee1f990f..c03a95e0 100644
--- a/Aws/Route53/Commands/ChangeResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
@@ -27,7 +27,7 @@ data ACTION = CREATE | DELETE
 
 -- TODO enforce constrains either via type or dynamically on creation or usage
 data ChangeResourceRecordSets = ChangeResourceRecordSets
-                      { crrHostedZoneId :: T.Text
+                      { crrHostedZoneId :: HostedZoneId
                       , crrComment :: Maybe T.Text
                       , crrsChanges :: [(ACTION, ResourceRecordSet)]
                       } deriving (Show)
@@ -41,7 +41,7 @@ instance SignQuery ChangeResourceRecordSets where
     signQuery ChangeResourceRecordSets{..} = route53SignQuery method resource query body
       where
       method = Post
-      resource = "/hostedzone/" `B.append` T.encodeUtf8 crrHostedZoneId `B.append` "/rrset"
+      resource = (T.encodeUtf8 . qualifiedIdText) crrHostedZoneId `B.append` "/rrset"
       query = []
       body = Just $ XML.Element "{https://route53.amazonaws.com/doc/2012-02-29/}ChangeResourceRecordSetsRequest" []
              [xml|
diff --git a/Aws/Route53/Commands/GetHostedZone.hs b/Aws/Route53/Commands/GetHostedZone.hs
index 1cb51789..ef2d7901 100644
--- a/Aws/Route53/Commands/GetHostedZone.hs
+++ b/Aws/Route53/Commands/GetHostedZone.hs
@@ -22,7 +22,7 @@ import qualified Data.Text.Encoding         as T
 import qualified Data.ByteString            as B
 
 data GetHostedZone = GetHostedZone
-                   { hostedZoneId :: T.Text
+                   { hostedZoneId :: HostedZoneId
                    } deriving (Show)
 
 data GetHostedZoneResponse = GetHostedZoneResponse
@@ -30,7 +30,7 @@ data GetHostedZoneResponse = GetHostedZoneResponse
                              , ghzrDelegationSet :: DelegationSet
                              } deriving (Show)
 
-getHostedZone :: T.Text -> GetHostedZone
+getHostedZone :: HostedZoneId -> GetHostedZone
 getHostedZone hostedZoneId = GetHostedZone hostedZoneId
 
 instance SignQuery GetHostedZone where
@@ -38,7 +38,7 @@ instance SignQuery GetHostedZone where
     signQuery GetHostedZone{..} = route53SignQuery method resource query Nothing
       where
       method = Get
-      resource = "/hostedzone/" `B.append` (T.encodeUtf8 hostedZoneId)
+      resource = T.encodeUtf8 . qualifiedIdText $ hostedZoneId
       query = []
 
 instance ResponseConsumer r GetHostedZoneResponse where

From 911aa8a598bc8d7fbf5ec1941109f2ffa7808853 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Fri, 4 May 2012 01:08:24 -0700
Subject: [PATCH 27/55] Route53: Fix xmlns in ChangeResourceRecordSets request
 body

---
 Aws/Route53/Commands/ChangeResourceRecordSets.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Aws/Route53/Commands/ChangeResourceRecordSets.hs b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
index c03a95e0..066646b4 100644
--- a/Aws/Route53/Commands/ChangeResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
@@ -43,7 +43,7 @@ instance SignQuery ChangeResourceRecordSets where
       method = Post
       resource = (T.encodeUtf8 . qualifiedIdText) crrHostedZoneId `B.append` "/rrset"
       query = []
-      body = Just $ XML.Element "{https://route53.amazonaws.com/doc/2012-02-29/}ChangeResourceRecordSetsRequest" []
+      body = Just $ XML.Element "ChangeResourceRecordSetsRequest" [("xmlns","https://route53.amazonaws.com/doc/2012-02-29/")]
              [xml|
              <ChangeBatch>
                $maybe c <- crrComment

From 36a4466865092e86390045597d5c9bbf5206ed7e Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Fri, 4 May 2012 22:01:13 -0700
Subject: [PATCH 28/55] Route53: remove dependency on Network.DNS.Types and fix
 xmlns in request bodies

---
 .../Commands/ChangeResourceRecordSets.hs      |  2 +-
 Aws/Route53/Commands/CreateHostedZone.hs      | 10 ++--
 Aws/Route53/Commands/DeleteHostedZone.hs      |  8 ++--
 Aws/Route53/Commands/GetChange.hs             |  2 -
 Aws/Route53/Commands/GetHostedZone.hs         |  2 -
 .../Commands/ListResourceRecordSets.hs        | 10 ++--
 Aws/Route53/Core.hs                           | 47 +++++++++++++------
 aws.cabal                                     |  1 -
 8 files changed, 43 insertions(+), 39 deletions(-)

diff --git a/Aws/Route53/Commands/ChangeResourceRecordSets.hs b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
index 066646b4..40428754 100644
--- a/Aws/Route53/Commands/ChangeResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
@@ -43,7 +43,7 @@ instance SignQuery ChangeResourceRecordSets where
       method = Post
       resource = (T.encodeUtf8 . qualifiedIdText) crrHostedZoneId `B.append` "/rrset"
       query = []
-      body = Just $ XML.Element "ChangeResourceRecordSetsRequest" [("xmlns","https://route53.amazonaws.com/doc/2012-02-29/")]
+      body = Just $ XML.Element "ChangeResourceRecordSetsRequest" []
              [xml|
              <ChangeBatch>
                $maybe c <- crrComment
diff --git a/Aws/Route53/Commands/CreateHostedZone.hs b/Aws/Route53/Commands/CreateHostedZone.hs
index 99af3e3f..a80d1509 100644
--- a/Aws/Route53/Commands/CreateHostedZone.hs
+++ b/Aws/Route53/Commands/CreateHostedZone.hs
@@ -18,12 +18,10 @@ import           Aws.Core
 import           Aws.Route53.Core
 import           Text.Hamlet.XML            (xml)
 import qualified Data.Text                  as T
-import qualified Data.Text.Encoding         as T
-import qualified Network.DNS.Types          as DNS
 import qualified Text.XML                   as XML
 
 data CreateHostedZone = CreateHostedZone
-                      { chzName :: DNS.Domain
+                      { chzName :: Domain
                       , chzCallerReference :: T.Text
                       , chzComment :: T.Text
                       } deriving (Show)
@@ -34,7 +32,7 @@ data CreateHostedZoneResponse = CreateHostedZoneResponse
                               , chzrDelegationSet :: DelegationSet
                               } deriving (Show)
 
-createHostedZone :: DNS.Domain -> T.Text -> T.Text -> CreateHostedZone
+createHostedZone :: Domain -> T.Text -> T.Text -> CreateHostedZone
 createHostedZone name callerReference comment = CreateHostedZone name callerReference comment
 
 instance SignQuery CreateHostedZone where
@@ -44,9 +42,9 @@ instance SignQuery CreateHostedZone where
       method = Post
       resource = "/hostedzone"
       query = []
-      body = Just $ XML.Element "{https://route53.amazonaws.com/doc/2012-02-29/}CreateHostedZoneRequest" []
+      body = Just $ XML.Element "CreateHostedZoneRequest" []
              [xml|
-             <Name>#{T.decodeUtf8 chzName}
+             <Name>#{dText chzName}
              <CallerReference>#{chzCallerReference}
              <HostedZoneConfig>
                <Comment>#{chzComment}
diff --git a/Aws/Route53/Commands/DeleteHostedZone.hs b/Aws/Route53/Commands/DeleteHostedZone.hs
index 11b2b0f0..c7186d96 100644
--- a/Aws/Route53/Commands/DeleteHostedZone.hs
+++ b/Aws/Route53/Commands/DeleteHostedZone.hs
@@ -15,19 +15,17 @@ module Aws.Route53.Commands.DeleteHostedZone where
 
 import           Aws.Core
 import           Aws.Route53.Core
-import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
-import qualified Data.ByteString            as B
 
 data DeleteHostedZone = DeleteHostedZone
-                   { dhzHostedZoneId :: T.Text
+                   { dhzHostedZoneId :: HostedZoneId
                    } deriving (Show)
 
 data DeleteHostedZoneResponse = DeleteHostedZoneResponse
                               { dhzrChangeInfo :: ChangeInfo
                               } deriving (Show)
 
-deleteHostedZone :: T.Text -> DeleteHostedZone
+deleteHostedZone :: HostedZoneId -> DeleteHostedZone
 deleteHostedZone hostedZoneId = DeleteHostedZone hostedZoneId
 
 -- Delete add convenience methods:
@@ -40,7 +38,7 @@ instance SignQuery DeleteHostedZone where
     signQuery DeleteHostedZone{..} = route53SignQuery method resource query body
       where
       method = Delete
-      resource = "/hostedzone/" `B.append` (T.encodeUtf8 dhzHostedZoneId)
+      resource = T.encodeUtf8 . qualifiedIdText $ dhzHostedZoneId
       query = []
       body = Nothing
 
diff --git a/Aws/Route53/Commands/GetChange.hs b/Aws/Route53/Commands/GetChange.hs
index 51e39fc5..6b89ec9c 100644
--- a/Aws/Route53/Commands/GetChange.hs
+++ b/Aws/Route53/Commands/GetChange.hs
@@ -15,9 +15,7 @@ module Aws.Route53.Commands.GetChange where
 
 import           Aws.Core
 import           Aws.Route53.Core
-import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
-import qualified Data.ByteString            as B
 
 data GetChange = GetChange
                { changeId :: ChangeId
diff --git a/Aws/Route53/Commands/GetHostedZone.hs b/Aws/Route53/Commands/GetHostedZone.hs
index ef2d7901..e70bf492 100644
--- a/Aws/Route53/Commands/GetHostedZone.hs
+++ b/Aws/Route53/Commands/GetHostedZone.hs
@@ -17,9 +17,7 @@ module Aws.Route53.Commands.GetHostedZone where
 
 import           Aws.Core
 import           Aws.Route53.Core
-import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
-import qualified Data.ByteString            as B
 
 data GetHostedZone = GetHostedZone
                    { hostedZoneId :: HostedZoneId
diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
index d74d34be..7ef33d20 100644
--- a/Aws/Route53/Commands/ListResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -14,9 +14,6 @@
 -- 
 --   <http://docs.amazonwebservices.com/Route53/latest/APIReference/API_ListResourceRecordSets.html>
 --
---   NOTE: Route53 supports record type @SPF@ which is not supported in 'Network.DNS.Types' and can thus
---   not be queried through this bindings.
---
 --   NOTE: the parameter 'identifier' is required for weighted and laltency resource record sets. This is
 --   not enforced by the type.
 --
@@ -26,7 +23,6 @@ import           Aws.Core
 import           Aws.Route53.Core
 import           Data.Maybe                 (catMaybes, listToMaybe)
 import           Control.Applicative        ((<$>))
-import qualified Network.DNS.Types          as DNS
 import           Text.XML.Cursor            (($//), (&|), ($/))
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
@@ -35,7 +31,7 @@ import qualified Data.ByteString.Char8      as B
 data ListResourceRecordSets = ListResourceRecordSets
                    { lrrsHostedZoneId :: HostedZoneId
                    , lrrsName :: Maybe Domain
-                   , lrrsRecordType :: Maybe DNS.TYPE   -- ^ /note that SPF is currently not supported/
+                   , 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)
@@ -49,7 +45,7 @@ data ListResourceRecordSetsResponse = ListResourceRecordSetsResponse
                              , lrrsrIsTruncated :: Bool
                              , lrrsrMaxItems :: Maybe Int                 -- ^ The maxitems value from the request (TODO is it Maybe?)
                              , lrrsrNextRecordName :: Maybe Domain        -- ^ TODO check constraint
-                             , lrrsrNextRecordType :: Maybe DNS.TYPE      -- ^ TODO check constraint
+                             , lrrsrNextRecordType :: Maybe RecordType    -- ^ TODO check constraint
                              , lrrsrNextRecordIdentifier :: Maybe T.Text  -- ^ TODO check constraint
                              } deriving (Show)
 
@@ -77,7 +73,7 @@ instance ResponseConsumer r ListResourceRecordSetsResponse where
             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" &| DNS.toType
+            let nextRecordType = listToMaybe $ cursor $// elCont "NextRecordType" &| read
             let nextRecordIdentifier = listToMaybe $ cursor $// elContent "NextRecordIdentifier"
             return $ ListResourceRecordSetsResponse resourceRecordSets isTruncated maxItems nextRecordName nextRecordType nextRecordIdentifier
 
diff --git a/Aws/Route53/Core.hs b/Aws/Route53/Core.hs
index 54d6f648..bdf7a33a 100644
--- a/Aws/Route53/Core.hs
+++ b/Aws/Route53/Core.hs
@@ -31,6 +31,10 @@ module Aws.Route53.Core
 
   -- * Model
 
+  -- ** DNS
+, RecordType(..)
+, typeToString
+
   -- ** Hosted Zone
 , HostedZone (..)
 , HostedZones
@@ -61,12 +65,11 @@ module Aws.Route53.Core
 , Route53XmlSerializable(..)
 , Route53Id(..)
 
-  -- * DNS and HTTP Utilites
-  -- | This functions extend 'Network.HTTP.Types' and 'Network.DNS.Types'
+  -- * HTTP Utilites
+  -- | This functions extend 'Network.HTTP.Types'
 , findHeader
 , findHeaderValue
 , headerRequestId
-, typeToString
 ) where
 
 import           Aws.Core
@@ -83,12 +86,13 @@ 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 Network.DNS.Types    as DNS
+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
@@ -102,6 +106,8 @@ data Route53Info = Route53Info
     , route53Endpoint :: B.ByteString
     , route53Port :: Int
     , route53ApiVersion :: B.ByteString
+    , route53XmlNamespace :: T.Text
+
     } deriving (Show)
 
 route53EndpointUsClassic :: B.ByteString
@@ -110,12 +116,16 @@ route53EndpointUsClassic = "route53.amazonaws.com"
 route53ApiVersionRecent :: B.ByteString
 route53ApiVersionRecent = "2012-02-29"
 
+route53XmlNamespaceRecent :: Text
+route53XmlNamespaceRecent = "https://route53amazonaw.com/doc/" `T.append` T.decodeUtf8 route53ApiVersionRecent `T.append` "/"
+
 route53 :: Route53Info
 route53 = Route53Info 
     { route53Protocol = HTTPS
     , route53Endpoint = route53EndpointUsClassic
     , route53Port = defaultPort HTTPS
     , route53ApiVersion = route53ApiVersionRecent
+    , route53XmlNamespace = route53XmlNamespaceRecent
     }
 
 -- -------------------------------------------------------------------------- --
@@ -177,9 +187,11 @@ route53SignQuery method resource query body Route53Info{..} sd
 
       renderBody b = HTTP.RequestBodyLBS . XML.renderLBS XML.def $ XML.Document 
                      { XML.documentPrologue = XML.Prologue [] Nothing []
-                     , XML.documentRoot = b
+                     , XML.documentRoot = b { elementAttributes = addNamespace (elementAttributes b) }
                      , XML.documentEpilogue = []
                      }
+      addNamespace attrs = maybe (("xmlns",route53XmlNamespace):attrs) (const attrs) $ lookup "xmlns" attrs
+                           
 
 -- -------------------------------------------------------------------------- --
 -- Response
@@ -243,6 +255,18 @@ class Route53Id r where
 --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
 
@@ -332,7 +356,7 @@ instance Route53Parseable Nameserver where
     force "Missing Nameserver element" $ cursor $.// elContent "Nameserver" &| Domain
 
 -- -------------------------------------------------------------------------- --
--- RsourceRecordSet
+-- ResourceRecordSet
 
 data REGION = ApNorthEast1
             | ApSouthEast2
@@ -379,7 +403,7 @@ data AliasTarget = AliasTarget { atHostedZoneId :: HostedZoneId
 -- TODO make this complete from the spec. Do not just use the exmpales!
 -- We may e.g. have different type for alias resource record sets
 data ResourceRecordSet = ResourceRecordSet { rrsName :: Domain
-                                           , rrsType :: DNS.TYPE
+                                           , rrsType :: RecordType
                                            , rrsAliasTarget :: Maybe AliasTarget
                                            , rrsSetIdentifier :: Maybe T.Text
                                            , rrsWeight :: Maybe Int
@@ -434,7 +458,7 @@ 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" &| DNS.toType 
+    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"
@@ -538,7 +562,6 @@ intToText = T.pack . show
 
 -- -------------------------------------------------------------------------- --
 -- Utility methods that extend the functionality of 'Network.HTTP.Types' 
--- and 'Network.DNS.Types'
 
 headerRequestId :: HTTP.Ascii -> HTTP.Header
 headerRequestId = (,) "x-amzn-requestid"
@@ -549,9 +572,3 @@ findHeader headers header = find (\h@(_,v) -> h == header v) headers
 findHeaderValue :: [HTTP.Header] -> (HTTP.Ascii -> HTTP.Header) -> Maybe HTTP.Ascii
 findHeaderValue headers = fmap snd . findHeader headers
 
-typeToString :: DNS.TYPE -> String
-typeToString = show
-
-typeToText :: DNS.TYPE -> T.Text
-typeToText = T.pack . typeToString
-
diff --git a/aws.cabal b/aws.cabal
index 6a6b1585..6f4f0a0e 100644
--- a/aws.cabal
+++ b/aws.cabal
@@ -123,7 +123,6 @@ Library
                        transformers         >= 0.2.2.0 && < 0.4,
                        utf8-string          == 0.3.*,
                        xml-conduit          >= 0.7.0,
-                       dns                  >= 0.3.3,
                        xml-hamlet           >= 0.3.0
 
   GHC-Options: -Wall

From aa8e75549079f6c73ee41e54ad5ffeb99b335e63 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Fri, 4 May 2012 23:26:57 -0700
Subject: [PATCH 29/55] Route53: fix spelling of request body xml namespace.

---
 Aws/Route53/Core.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Aws/Route53/Core.hs b/Aws/Route53/Core.hs
index bdf7a33a..8f54d846 100644
--- a/Aws/Route53/Core.hs
+++ b/Aws/Route53/Core.hs
@@ -117,7 +117,7 @@ route53ApiVersionRecent :: B.ByteString
 route53ApiVersionRecent = "2012-02-29"
 
 route53XmlNamespaceRecent :: Text
-route53XmlNamespaceRecent = "https://route53amazonaw.com/doc/" `T.append` T.decodeUtf8 route53ApiVersionRecent `T.append` "/"
+route53XmlNamespaceRecent = "https://route53.amazonaws.com/doc/" `T.append` T.decodeUtf8 route53ApiVersionRecent `T.append` "/"
 
 route53 :: Route53Info
 route53 = Route53Info 

From 2062c62dd23cec3c49f4661e1671a4b8f285196c Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sat, 5 May 2012 11:25:28 -0700
Subject: [PATCH 30/55] Route53: code usage examples for Aws.Route53 module.

---
 Examples/Route53Examples.hs | 183 ++++++++++++++++++++++++++++++++++++
 1 file changed, 183 insertions(+)
 create mode 100644 Examples/Route53Examples.hs

diff --git a/Examples/Route53Examples.hs b/Examples/Route53Examples.hs
new file mode 100644
index 00000000..ed15c298
--- /dev/null
+++ b/Examples/Route53Examples.hs
@@ -0,0 +1,183 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Route53.Samples where
+
+import qualified Data.Text as T
+import qualified Aws as AWS
+import           Aws.Route53
+import           Data.Attempt
+import           Control.Applicative ((<$>))
+import           Network.HTTP.Conduit
+import           Control.Monad.IO.Class (liftIO)
+import           Data.List (find)
+import           Data.Maybe (fromJust)
+
+-- -------------------------------------------------------------------------- --
+-- Request Utils
+
+-- | A class for transactions with batched responses. Provides methods
+--   for iterating and concatenating all responses.
+--
+--   Minimal complete implementation: 'merge' and 'nextRequest'.
+class (AWS.Transaction request response) => Batched request response  where
+  merge :: response -> response -> response
+  nextRequest :: request -> response -> Maybe request
+
+  requestAll :: (request -> IO response) -> request -> IO response
+  requestAll mkRequest request = do
+    response <- mkRequest request
+    case nextRequest request response of
+      Nothing -> return response
+      Just r -> merge response <$> requestAll mkRequest r
+
+
+-- | Given a configuration, a manager, and request the function executes the request
+--   and extracts the enclosed response body and returns it within the IO monad.
+--
+--   Executes 'getResult' in the IO monad and will thus cause an error if the 
+--   request is not successful.
+makeRequest :: (AWS.Transaction request response, AWS.ConfigurationFetch (AWS.Info request), Show request) 
+            => AWS.Configuration -> Manager -> request -> IO response
+makeRequest cfg manager request = AWS.aws cfg manager request >>= getResult
+
+-- | Executes the given request using the default configuration and a fresh connection manager.
+--   Extracts the enclosed response body and returns it within the IO monad.
+--
+--   Will result in an error in if request is not successful
+makeSimpleRequest :: (AWS.Transaction request response, AWS.ConfigurationFetch (AWS.Info request), Show request) 
+            => request -> IO response
+makeSimpleRequest r = do
+  cfg <- AWS.baseConfiguration
+  withManager $ \m -> do
+    liftIO $ makeRequest cfg m r
+
+-- | Given a Changeid returns the change info status for the corresponding request
+getChangeStatus :: ChangeId -> IO ChangeInfoStatus
+getChangeStatus changeId = ciStatus . gcrChangeInfo <$> (makeSimpleRequest $ getChange changeId)
+
+-- | Extracts the result from a response within an FromAttempt Monad (IO, [], Maybe, etc)
+getResult :: (FromAttempt error) => AWS.Response meta r -> error r
+getResult (AWS.Response _ r) = fromAttempt r
+
+-- | Extracts the ChangeId from a response using the given function to extract the ChangeInfo from the response
+getChangeId :: Functor f => (a -> ChangeInfo) -> f a -> f ChangeId
+getChangeId changeInfoExtractor response = ciId . changeInfoExtractor <$> response
+
+-- | Example usage of getChangeId
+getChangeResourceRecordSetsResponseChangeId :: Functor f => f ChangeResourceRecordSetsResponse -> f ChangeId
+getChangeResourceRecordSetsResponseChangeId response = getChangeId crrsrChangeInfo response
+
+-- TODO implement wait for INSYNC
+
+-- -------------------------------------------------------------------------- --
+-- Hosted Zones
+
+instance Batched ListHostedZones ListHostedZonesResponse where
+  
+  a `merge` b = ListHostedZonesResponse { lhzrHostedZones = lhzrHostedZones a ++ lhzrHostedZones b
+                                        , lhzrNextToken = lhzrNextToken b
+                                        }
+
+  nextRequest _ ListHostedZonesResponse{..} = maybe Nothing (\x -> Just $ ListHostedZones Nothing (Just x)) lhzrNextToken
+
+-- | Get all hosted zones of the user.
+getAllZones :: IO HostedZones
+getAllZones = do
+  cfg <- AWS.baseConfiguration
+  withManager $ \m -> do
+    ListHostedZonesResponse zones _ <- liftIO $ requestAll (\r -> makeRequest cfg m r) listHostedZones
+    return zones
+
+-- | Get a hosted zone by its 'HostedZoneId'
+getZoneById :: HostedZoneId -> IO HostedZone
+getZoneById hzid = ghzrHostedZone <$> makeSimpleRequest (getHostedZone hzid)
+
+-- | Get a hosted zone by its domain name.
+--   
+--   Results in an error if no hosted zone exists for the given domain name.
+getZoneByName :: Domain -> IO HostedZone
+getZoneByName z = fromJust . find ((z==) . hzName) <$> getAllZones
+
+-- | Returns the hosted zone id of the hosted zone for the given domain
+getZoneIdByName :: Domain -> IO HostedZoneId
+getZoneIdByName hzName = hzId <$> getZoneByName hzName
+
+-- -------------------------------------------------------------------------- --
+-- Resource Records Sets
+
+-- | Simplified construction for a ResourceRecordSet
+simpleResourceRecordSet :: Domain -> RecordType -> Int -> T.Text -> ResourceRecordSet
+simpleResourceRecordSet domain rtype ttl value = ResourceRecordSet domain rtype Nothing Nothing Nothing Nothing (Just ttl) [(ResourceRecord value)]
+
+instance Batched ListResourceRecordSets ListResourceRecordSetsResponse where
+  a `merge` b = ListResourceRecordSetsResponse
+                { lrrsrResourceRecordSets = lrrsrResourceRecordSets a ++ lrrsrResourceRecordSets b
+                , lrrsrIsTruncated = lrrsrIsTruncated b
+                , lrrsrNextRecordName = lrrsrNextRecordName b
+                , lrrsrNextRecordType = lrrsrNextRecordType b
+                , lrrsrNextRecordIdentifier = lrrsrNextRecordIdentifier b
+                , lrrsrMaxItems = lrrsrMaxItems b
+                }
+  nextRequest ListResourceRecordSets{..} ListResourceRecordSetsResponse{..} = 
+    if lrrsrIsTruncated
+      then Just $ ListResourceRecordSets lrrsHostedZoneId lrrsrNextRecordName lrrsrNextRecordType lrrsrNextRecordIdentifier lrrsrMaxItems
+      else Nothing
+
+-- | Returns the resource record sets in the hosted zone with the given domain name
+--
+--   Note the 'zName' is the domain name of the hosted zone itself.
+getResourceRecordSetsByHostedZoneName :: Domain -> IO ResourceRecordSets
+getResourceRecordSetsByHostedZoneName zName = do
+  cfg <- AWS.baseConfiguration
+  hzid <- getZoneIdByName zName
+  withManager $ \m -> do
+    ListResourceRecordSetsResponse rs _ _ _ _ _ <- liftIO $ requestAll (\r -> makeRequest cfg m r) (listResourceRecordSets hzid)
+    return rs
+
+-- | Lists all resource record sets in the hosted zone with the given hosted zone id.
+getResourceRecordSets :: HostedZoneId -> IO ResourceRecordSets
+getResourceRecordSets hzid = do
+  cfg <- AWS.baseConfiguration
+  withManager $ \m -> do
+    ListResourceRecordSetsResponse rs _ _ _ _ _ <- liftIO $ requestAll (\r -> makeRequest cfg m r) (listResourceRecordSets hzid)
+    return rs
+
+-- | Lists all resource record sets in the given hosted zone for the given domain.
+getResourceRecordSetsByDomain :: HostedZoneId -> Domain -> IO ResourceRecordSets
+getResourceRecordSetsByDomain hzid domain = do
+  cfg <- AWS.baseConfiguration
+  withManager $ \m -> do
+    ListResourceRecordSetsResponse rs _ _ _ _ _ <- liftIO $ requestAll (\r -> makeRequest cfg m r) ((listResourceRecordSets hzid){ lrrsName = Just domain})
+    return rs
+
+-- | Returns all resource records sets in the hosted zone with the given hosted zone id for the given DNS record type.
+getResourceRecordSetsByType :: HostedZoneId -> RecordType -> IO ResourceRecordSets
+getResourceRecordSetsByType hzid dnsRecordType = filter ((== dnsRecordType) . rrsType) <$> getResourceRecordSets hzid
+
+-- | Returns the resource record set of the given type for the given domain in the given hosted zone.
+getResourceRecords :: HostedZoneId -> Domain -> RecordType -> IO ResourceRecordSet
+getResourceRecords cid domain rtype = head . lrrsrResourceRecordSets <$> (makeSimpleRequest $ ListResourceRecordSets cid (Just domain) (Just rtype) Nothing (Just 1))
+
+-- | Updates the resouce records of the given type for the given domain in the given hosted zone using the given mapping function.
+--
+--   Recall that the functions in this module are example usages of the Aws.Route53 module. In a production
+--   environment one would reuse the same connection manager and configuration for all involved requests.
+updateRecords :: HostedZoneId -> Domain -> RecordType -> ([ResourceRecord] -> [ResourceRecord]) -> IO (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse)
+updateRecords cid domain rtype f = do
+  -- Fixme fail more gracefully
+  rrs <- getResourceRecords cid domain rtype
+  let rrs' = rrs { rrsRecords = f (rrsRecords rrs) }
+  -- Handle errors gracefully. What if we fail in the middle?
+  r1 <- makeSimpleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
+  r2 <- makeSimpleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rrs')]
+  return (r1, r2)
+
+-- | Updates the A record for the given domain in the given zone to the given IP address (encoded as Text)
+updateARecord :: HostedZoneId -> Domain -> T.Text -> IO (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse)
+updateARecord cid domain newIP = updateRecords cid domain A (const [ResourceRecord newIP])
+
+

From ddb7cecf530494b395e03b5a0a15bb1c6d5a4663 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sat, 5 May 2012 11:26:26 -0700
Subject: [PATCH 31/55] ghci.hs: import Aws.Route53

---
 ghci.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/ghci.hs b/ghci.hs
index 6e17692c..edcb44e4 100644
--- a/ghci.hs
+++ b/ghci.hs
@@ -5,3 +5,4 @@ import qualified Aws.S3               as S3
 import qualified Aws.SimpleDb         as Sdb
 import qualified Aws.Sqs              as Sqs
 import qualified Aws.Ses              as Ses
+import qualified Aws.Route53          as Route53

From a6270170ea37b8a398ca94771e7e4d085792b6bb Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sat, 5 May 2012 11:27:56 -0700
Subject: [PATCH 32/55] Route53: fix formating of LANGUAGE pragma

---
 Aws/Route53/Commands/ListHostedZones.hs | 13 ++++++-------
 1 file changed, 6 insertions(+), 7 deletions(-)

diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index 79e7617d..090a3829 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -1,10 +1,9 @@
-{-# LANGUAGE RecordWildCards
-  , TypeFamilies
-  , FlexibleInstances
-  , MultiParamTypeClasses
-  , OverloadedStrings
-  , TupleSections 
-  #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 
 -- | GET ListHostedZones
 --

From 348f9b119e2e97038bc77409599dcdc2c6b0c066 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sat, 5 May 2012 11:29:35 -0700
Subject: [PATCH 33/55] Route53: add copyright notice to all file in
 Aws/Route53

---
 Aws/Route53.hs                                   | 4 ++++
 Aws/Route53/Commands.hs                          | 4 ++++
 Aws/Route53/Commands/ChangeResourceRecordSets.hs | 4 ++++
 Aws/Route53/Commands/CreateHostedZone.hs         | 4 ++++
 Aws/Route53/Commands/DeleteHostedZone.hs         | 4 ++++
 Aws/Route53/Commands/GetChange.hs                | 4 ++++
 Aws/Route53/Commands/GetDate.hs                  | 4 ++++
 Aws/Route53/Commands/GetHostedZone.hs            | 4 ++++
 Aws/Route53/Commands/ListHostedZones.hs          | 4 ++++
 Aws/Route53/Commands/ListResourceRecordSets.hs   | 4 ++++
 Aws/Route53/Core.hs                              | 4 ++++
 11 files changed, 44 insertions(+)

diff --git a/Aws/Route53.hs b/Aws/Route53.hs
index 4ac434c4..748dadb4 100644
--- a/Aws/Route53.hs
+++ b/Aws/Route53.hs
@@ -1,3 +1,7 @@
+--
+-- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
+-- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
+--
 module Aws.Route53
 ( module Aws.Route53.Commands
 , module Aws.Route53.Core
diff --git a/Aws/Route53/Commands.hs b/Aws/Route53/Commands.hs
index 359a775d..fd2aa48b 100644
--- a/Aws/Route53/Commands.hs
+++ b/Aws/Route53/Commands.hs
@@ -1,3 +1,7 @@
+--
+-- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
+-- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
+--
 module Aws.Route53.Commands
 ( -- * Actions on Hosted Zones
   module Aws.Route53.Commands.CreateHostedZone
diff --git a/Aws/Route53/Commands/ChangeResourceRecordSets.hs b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
index 40428754..9c1ffb06 100644
--- a/Aws/Route53/Commands/ChangeResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
@@ -1,3 +1,7 @@
+--
+-- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
+-- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
+--
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TypeFamilies #-} 
diff --git a/Aws/Route53/Commands/CreateHostedZone.hs b/Aws/Route53/Commands/CreateHostedZone.hs
index a80d1509..9a900f03 100644
--- a/Aws/Route53/Commands/CreateHostedZone.hs
+++ b/Aws/Route53/Commands/CreateHostedZone.hs
@@ -1,3 +1,7 @@
+--
+-- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
+-- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
+--
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TypeFamilies #-} 
diff --git a/Aws/Route53/Commands/DeleteHostedZone.hs b/Aws/Route53/Commands/DeleteHostedZone.hs
index c7186d96..c274b657 100644
--- a/Aws/Route53/Commands/DeleteHostedZone.hs
+++ b/Aws/Route53/Commands/DeleteHostedZone.hs
@@ -1,3 +1,7 @@
+--
+-- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
+-- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
+--
 {-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}
 
 -- | DELETE DeleteHostedZone
diff --git a/Aws/Route53/Commands/GetChange.hs b/Aws/Route53/Commands/GetChange.hs
index 6b89ec9c..3dfc9371 100644
--- a/Aws/Route53/Commands/GetChange.hs
+++ b/Aws/Route53/Commands/GetChange.hs
@@ -1,3 +1,7 @@
+--
+-- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
+-- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
+--
 {-# LANGUAGE RecordWildCards #-} 
 {-# LANGUAGE TypeFamilies #-} 
 {-# LANGUAGE FlexibleInstances #-} 
diff --git a/Aws/Route53/Commands/GetDate.hs b/Aws/Route53/Commands/GetDate.hs
index 836b4598..de35c7f4 100644
--- a/Aws/Route53/Commands/GetDate.hs
+++ b/Aws/Route53/Commands/GetDate.hs
@@ -1,3 +1,7 @@
+--
+-- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
+-- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
+--
 {-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}
 
 -- | GET GetDate
diff --git a/Aws/Route53/Commands/GetHostedZone.hs b/Aws/Route53/Commands/GetHostedZone.hs
index e70bf492..a076243f 100644
--- a/Aws/Route53/Commands/GetHostedZone.hs
+++ b/Aws/Route53/Commands/GetHostedZone.hs
@@ -1,3 +1,7 @@
+--
+-- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
+-- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
+--
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleInstances #-}
diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index 090a3829..7ed9a3cc 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -1,3 +1,7 @@
+--
+-- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
+-- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
+--
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleInstances #-}
diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
index 7ef33d20..14690f1d 100644
--- a/Aws/Route53/Commands/ListResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -1,3 +1,7 @@
+--
+-- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
+-- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
+--
 {-# LANGUAGE RecordWildCards #-} 
 {-# LANGUAGE TypeFamilies #-} 
 {-# LANGUAGE FlexibleInstances #-} 
diff --git a/Aws/Route53/Core.hs b/Aws/Route53/Core.hs
index 8f54d846..7adcf98b 100644
--- a/Aws/Route53/Core.hs
+++ b/Aws/Route53/Core.hs
@@ -1,3 +1,7 @@
+--
+-- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
+-- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
+--
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}

From 3af90f19a6c9f9717f9ad0a6a113e7bfa44114c6 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sat, 5 May 2012 12:16:56 -0700
Subject: [PATCH 34/55] Route53: some cleanup of comments

---
 Aws/Route53/Commands/DeleteHostedZone.hs      |  2 --
 Aws/Route53/Commands/ListHostedZones.hs       |  3 +--
 .../Commands/ListResourceRecordSets.hs        |  2 +-
 Aws/Route53/Core.hs                           | 26 -------------------
 4 files changed, 2 insertions(+), 31 deletions(-)

diff --git a/Aws/Route53/Commands/DeleteHostedZone.hs b/Aws/Route53/Commands/DeleteHostedZone.hs
index c274b657..19618f9e 100644
--- a/Aws/Route53/Commands/DeleteHostedZone.hs
+++ b/Aws/Route53/Commands/DeleteHostedZone.hs
@@ -34,8 +34,6 @@ deleteHostedZone hostedZoneId = DeleteHostedZone hostedZoneId
 
 -- Delete add convenience methods:
 -- * Delete non-empty hosted zone
--- * extract zoneId (maybe we should always strip the start of the string? Haskell is typed!)
--- * Extract bare Model from responses (that are heavily wrapped...)
 
 instance SignQuery DeleteHostedZone where
     type Info DeleteHostedZone = Route53Info
diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index 7ed9a3cc..39693461 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -38,14 +38,13 @@ data ListHostedZonesResponse = ListHostedZonesResponse
 listHostedZones :: ListHostedZones
 listHostedZones = ListHostedZones { lhzMaxNumberOfItems = Nothing, lhzNextToken = Nothing }
 
--- TODO sign the date header
 instance SignQuery ListHostedZones where
     type Info ListHostedZones = Route53Info
     signQuery ListHostedZones{..} = route53SignQuery method resource query Nothing
       where
       method = Get
       resource = "/hostedzone"
-      query = catMaybes -- query info signatureData
+      query = catMaybes
             [ ("MaxItems",) . T.encodeUtf8 . T.pack . show <$> lhzMaxNumberOfItems
             , ("NextToken",) . T.encodeUtf8 <$> lhzNextToken
             ]
diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
index 14690f1d..d0805b49 100644
--- a/Aws/Route53/Commands/ListResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -47,7 +47,7 @@ listResourceRecordSets hostedZoneId = ListResourceRecordSets hostedZoneId Nothin
 data ListResourceRecordSetsResponse = ListResourceRecordSetsResponse
                              { lrrsrResourceRecordSets :: ResourceRecordSets
                              , lrrsrIsTruncated :: Bool
-                             , lrrsrMaxItems :: Maybe Int                 -- ^ The maxitems value from the request (TODO is it Maybe?)
+                             , 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
diff --git a/Aws/Route53/Core.hs b/Aws/Route53/Core.hs
index 7adcf98b..2d5aea0e 100644
--- a/Aws/Route53/Core.hs
+++ b/Aws/Route53/Core.hs
@@ -228,8 +228,6 @@ route53CheckResponseType a n c = do
     _ <- force ("Expected response type " ++ unpack n) (Cu.laxElement n c)
     return a
 
--- ** Response types
-
 -- TODO analyse the possible response types. I think there are common patterns.
 -- Collect common code from the Commands here
 
@@ -280,7 +278,6 @@ newtype HostedZoneId = HostedZoneId { hziText :: T.Text }
 instance Route53Id HostedZoneId where
   idQualifier = const "hostedzone"
   idText = hziText
-  --asId r = HostedZoneId . fromJust . T.stripPrefix (qualifiedIdTextPrefix (undefined::HostedZoneId)) $ r
   asId' = HostedZoneId
 
 newtype Domain = Domain { dText :: T.Text }
@@ -404,8 +401,6 @@ data AliasTarget = AliasTarget { atHostedZoneId :: HostedZoneId
                                , atDNSName :: Domain
                                } deriving (Show)
 
--- TODO make this complete from the spec. Do not just use the exmpales!
--- We may e.g. have different type for alias resource record sets
 data ResourceRecordSet = ResourceRecordSet { rrsName :: Domain
                                            , rrsType :: RecordType
                                            , rrsAliasTarget :: Maybe AliasTarget
@@ -440,19 +435,14 @@ instance Route53XmlSerializable ResourceRecordSet where
     |]
 
 instance Route53XmlSerializable ResourceRecord where
-  
   toXml ResourceRecord{..} = XML.Element "ResourceRecord" [] [xml|  <Value>#{value} |]
 
 instance Route53XmlSerializable AliasTarget where
-  
   toXml AliasTarget{..} = XML.Element "AliasTarget" [] [xml|
     <HostedZoneId>#{idText atHostedZoneId}
     <DNSName>#{dText atDNSName}
     |]
 
---instance Route53XmlSerializable HostedZones where
---  toXml hostedZones = XML.Element "HostedZones" [] $ (XML.NodeElement . toXml) `map` hostedZones
-
 instance Route53Parseable ResourceRecordSets where
   r53Parse cursor = do
     c <- force "Missing ResourceRecordSets element" $ cursor $.// laxElement "ResourceRecordSets"
@@ -481,7 +471,6 @@ instance Route53Parseable AliasTarget where
     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"
@@ -526,25 +515,10 @@ instance Route53Parseable ChangeInfo where
 
 -- | A class for Route53 XML response parsers
 --
---   TODO Move these utilties to another module, for instance 'Aws.Route53.ParserUtils'
---
---   Parsers work with the following scheme:
---
---   * A parsers target either a single node or a set of ndoes.
---
---   * A parser that targets a single node will parse the first matching node that it finds.
---   
---   * A cursor with a node that is the target node it self or a parent of the target nodes.
---   
---   * The parser fails if it targets a single node and that nodes does not exist.
---   
---   * For multiple target nodes the parser may return the empty list.
---
 --  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'. 

From 65c492d9870c2c2cda2fe3bedb838f0d889c0f89 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@alephcloud.com>
Date: Thu, 31 May 2012 23:46:20 -0700
Subject: [PATCH 35/55] Route53: Add missing language pragma in Core.hs

---
 Aws/Route53/Core.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/Aws/Route53/Core.hs b/Aws/Route53/Core.hs
index 525e1d4d..95b911f5 100644
--- a/Aws/Route53/Core.hs
+++ b/Aws/Route53/Core.hs
@@ -4,6 +4,7 @@
 --
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}

From b9b16ba35a0726b3ff008809439e4c6bb7c539cb Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Thu, 12 Jul 2012 13:18:07 -0700
Subject: [PATCH 36/55] Add Route53.Commands.ChangeResourceRecordSets to
 Exposed-modules

---
 aws.cabal | 1 +
 1 file changed, 1 insertion(+)

diff --git a/aws.cabal b/aws.cabal
index 8d2c608b..86462387 100644
--- a/aws.cabal
+++ b/aws.cabal
@@ -92,6 +92,7 @@ Library
                        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,

From 5bad4e3dff72d42cf2c21551f682b065b6e9f624 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Thu, 12 Jul 2012 21:09:30 -0700
Subject: [PATCH 37/55] Assign Route53 Copyright to AlephCloud Systems, Inc.

---
 Aws/Route53.hs                                   | 8 ++++----
 Aws/Route53/Commands.hs                          | 8 ++++----
 Aws/Route53/Commands/ChangeResourceRecordSets.hs | 8 ++++----
 Aws/Route53/Commands/CreateHostedZone.hs         | 8 ++++----
 Aws/Route53/Commands/DeleteHostedZone.hs         | 8 ++++----
 Aws/Route53/Commands/GetChange.hs                | 8 ++++----
 Aws/Route53/Commands/GetDate.hs                  | 8 ++++----
 Aws/Route53/Commands/GetHostedZone.hs            | 8 ++++----
 Aws/Route53/Commands/ListHostedZones.hs          | 8 ++++----
 Aws/Route53/Commands/ListResourceRecordSets.hs   | 8 ++++----
 Aws/Route53/Core.hs                              | 8 ++++----
 Examples/Route53Examples.hs                      | 4 ++++
 12 files changed, 48 insertions(+), 44 deletions(-)

diff --git a/Aws/Route53.hs b/Aws/Route53.hs
index 748dadb4..6c4f54f8 100644
--- a/Aws/Route53.hs
+++ b/Aws/Route53.hs
@@ -1,7 +1,7 @@
---
--- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
--- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
---
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 module Aws.Route53
 ( module Aws.Route53.Commands
 , module Aws.Route53.Core
diff --git a/Aws/Route53/Commands.hs b/Aws/Route53/Commands.hs
index fd2aa48b..ecbe75b8 100644
--- a/Aws/Route53/Commands.hs
+++ b/Aws/Route53/Commands.hs
@@ -1,7 +1,7 @@
---
--- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
--- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
---
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 module Aws.Route53.Commands
 ( -- * Actions on Hosted Zones
   module Aws.Route53.Commands.CreateHostedZone
diff --git a/Aws/Route53/Commands/ChangeResourceRecordSets.hs b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
index 808b369a..d53b9d6a 100644
--- a/Aws/Route53/Commands/ChangeResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
@@ -1,7 +1,7 @@
---
--- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
--- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
---
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TypeFamilies #-} 
diff --git a/Aws/Route53/Commands/CreateHostedZone.hs b/Aws/Route53/Commands/CreateHostedZone.hs
index ea662b68..c2974693 100644
--- a/Aws/Route53/Commands/CreateHostedZone.hs
+++ b/Aws/Route53/Commands/CreateHostedZone.hs
@@ -1,7 +1,7 @@
---
--- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
--- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
---
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TypeFamilies #-} 
diff --git a/Aws/Route53/Commands/DeleteHostedZone.hs b/Aws/Route53/Commands/DeleteHostedZone.hs
index bbadfe71..57590b39 100644
--- a/Aws/Route53/Commands/DeleteHostedZone.hs
+++ b/Aws/Route53/Commands/DeleteHostedZone.hs
@@ -1,7 +1,7 @@
---
--- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
--- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
---
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 {-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}
 
 -- | DELETE DeleteHostedZone
diff --git a/Aws/Route53/Commands/GetChange.hs b/Aws/Route53/Commands/GetChange.hs
index fa066ff3..8b869b4f 100644
--- a/Aws/Route53/Commands/GetChange.hs
+++ b/Aws/Route53/Commands/GetChange.hs
@@ -1,7 +1,7 @@
---
--- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
--- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
---
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 {-# LANGUAGE RecordWildCards #-} 
 {-# LANGUAGE TypeFamilies #-} 
 {-# LANGUAGE FlexibleInstances #-} 
diff --git a/Aws/Route53/Commands/GetDate.hs b/Aws/Route53/Commands/GetDate.hs
index c6e2b5fc..34c023dd 100644
--- a/Aws/Route53/Commands/GetDate.hs
+++ b/Aws/Route53/Commands/GetDate.hs
@@ -1,7 +1,7 @@
---
--- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
--- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
---
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 {-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}
 
 -- | GET GetDate
diff --git a/Aws/Route53/Commands/GetHostedZone.hs b/Aws/Route53/Commands/GetHostedZone.hs
index 22ade1bc..6a4cf573 100644
--- a/Aws/Route53/Commands/GetHostedZone.hs
+++ b/Aws/Route53/Commands/GetHostedZone.hs
@@ -1,7 +1,7 @@
---
--- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
--- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
---
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleInstances #-}
diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index d19166c9..154d3344 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -1,7 +1,7 @@
---
--- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
--- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
---
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleInstances #-}
diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
index cecbf9ef..5e1a7213 100644
--- a/Aws/Route53/Commands/ListResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -1,7 +1,7 @@
---
--- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
--- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
---
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 {-# LANGUAGE RecordWildCards #-} 
 {-# LANGUAGE TypeFamilies #-} 
 {-# LANGUAGE FlexibleInstances #-} 
diff --git a/Aws/Route53/Core.hs b/Aws/Route53/Core.hs
index 084fa239..9fd50c11 100644
--- a/Aws/Route53/Core.hs
+++ b/Aws/Route53/Core.hs
@@ -1,7 +1,7 @@
---
--- Copyright (c) 2012 Lars Kuhtz - http://lars.kuhtz.eu/
--- License: BSD3 (see https://raw.github.com/aristidb/aws/master/LICENSE)
---
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
diff --git a/Examples/Route53Examples.hs b/Examples/Route53Examples.hs
index a20b43d6..7bd4dace 100644
--- a/Examples/Route53Examples.hs
+++ b/Examples/Route53Examples.hs
@@ -1,3 +1,7 @@
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}

From c9d683b0afab8b00a9fefef5223ed76624b90a34 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Thu, 12 Jul 2012 21:11:10 -0700
Subject: [PATCH 38/55] Fix and clean up Route53 example.

---
 Examples/Route53Examples.hs | 287 +++++++++++++++++++++++-------------
 1 file changed, 182 insertions(+), 105 deletions(-)

diff --git a/Examples/Route53Examples.hs b/Examples/Route53Examples.hs
index 7bd4dace..6d17dff2 100644
--- a/Examples/Route53Examples.hs
+++ b/Examples/Route53Examples.hs
@@ -7,71 +7,118 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 module Route53.Samples where
 
-import qualified Data.Text as T
-import qualified Aws as AWS
-import           Aws.Route53
-import           Data.Attempt
-import           Control.Applicative ((<$>))
-import           Network.HTTP.Conduit
-import           Control.Monad.IO.Class (liftIO)
-import           Data.List (find)
-import           Data.Maybe (fromJust)
+import Data.Text              (Text)
+import Data.List              (find)
+import Data.Maybe             (fromJust)
+import Data.Attempt           (Attempt(..), fromAttempt)
+import Data.Semigroup         (Semigroup, (<>))
+import Data.Monoid            (Monoid, mempty, mappend)
+
+import Control.Monad (guard)
+import Control.Applicative    ((<$>))
+import Control.Monad.IO.Class (MonadIO)
+
+import Network.HTTP.Conduit   (Manager, withManager)
+
+import Aws                    (aws, Response(..), Transaction, DefaultServiceConfiguration, 
+                               ServiceConfiguration, defaultConfiguration, baseConfiguration,
+                               ResponseMetadata)
+import Aws.Route53
 
 -- -------------------------------------------------------------------------- --
 -- Request Utils
 
--- | A class for transactions with batched responses. Provides methods
---   for iterating and concatenating all responses.
+instance (Monoid m, Semigroup a) => Semigroup (Response m a) where
+     (Response m0 (Success a0)) <> (Response m1 (Success a1)) = Response (m0 `mappend` m1) (Success (a0 <> a1))
+     (Response m0 (Success _))  <> (Response m1 (Failure e))  = Response (m0 `mappend` m1) (Failure e)
+     (Response m0 (Failure e))  <> (Response m1 _)            = Response (m0 `mappend` m1) (Failure e)
+
+-- | extract result of an 'Attempt' from a 'Response'
 --
---   Minimal complete implementation: 'merge' and 'nextRequest'.
-class (AWS.Transaction request response) => Batched request response  where
-  merge :: response -> response -> response
-  nextRequest :: request -> response -> Maybe request
+getResult :: Response m a -> Attempt a
+getResult (Response _ a) = a
 
-  requestAll :: (request -> IO response) -> request -> IO response
-  requestAll mkRequest request = do
+-- | A class for transactions with batched responses. Allows to
+--   iterate and concatenate all responses.
+--
+--   Minimal complete implementation: 'nextRequest'.
+--
+class (Transaction r a, Semigroup a) => Batched r a  where
+    nextRequest :: r -> (Response (ResponseMetadata a) a) -> Maybe r
+
+requestAll :: (Batched r a, MonadIO m, Functor m) 
+           => (r -> m (Response (ResponseMetadata a) a)) 
+           -> r 
+           -> m (Response (ResponseMetadata a) a) 
+requestAll mkRequest request = do
     response <- mkRequest request
     case nextRequest request response of
-      Nothing -> return response
-      Just r -> merge response <$> requestAll mkRequest r
+        Nothing -> return response
+        Just r -> (response <>) <$> requestAll mkRequest r
 
-
--- | Given a configuration, a manager, and request the function executes the request
---   and extracts the enclosed response body and returns it within the IO monad.
+-- | Make a request using with the base configuration and the default
+--   service configuration
 --
---   Executes 'getResult' in the IO monad and will thus cause an error if the 
---   request is not successful.
-makeRequest :: (AWS.Transaction request response, Show request) 
-            => Route53Configuration -> Manager -> request -> IO response
-makeRequest cfg manager request = AWS.aws cfg manager request >>= getResult
-
--- | Executes the given request using the default configuration and a fresh connection manager.
---   Extracts the enclosed response body and returns it within the IO monad.
+makeDefaultRequest :: ( Transaction r a
+                      , Functor m
+                      , MonadIO m
+                      , DefaultServiceConfiguration (ServiceConfiguration r)
+                      ) 
+                   => Manager -> r -> m (Response (ResponseMetadata a) a)
+makeDefaultRequest manager request = do
+    cfg <- baseConfiguration
+    let scfg = defaultConfiguration
+    aws cfg scfg manager request
+
+-- | Executes the given request using the default configuration and a fresh 
+--   connection manager. Extracts the enclosed response body and returns it 
+--   within the IO monad.
+--
+--   The result is wrapped in an 'Attempt'.
+--
+makeSingleRequest :: (Transaction r a
+                     , Show r
+                     , DefaultServiceConfiguration (ServiceConfiguration r)
+                     ) 
+                  => r -> IO a
+makeSingleRequest r = do
+    fromAttempt =<< getResult <$> (withManager (\m -> makeDefaultRequest m r))
+
+-- | Iterates request with batched responses until all batched are received 
+--   using the default configuration and a fresh connection manager. The 
+--   enclosed response bodies are extracted, concatenated (using 'mappend'
+--   from 'Data.Monoid'), and returned within the IO monad.
+--
+--   The result is wrapped in an 'Attempt'.
+--
+makeSingleRequestAll :: (Transaction r a
+                        , Batched r a
+                        , Show r
+                        , DefaultServiceConfiguration (ServiceConfiguration r)
+                        ) 
+                     => r -> IO a
+makeSingleRequestAll r = 
+    fromAttempt =<< getResult <$> withManager (\m -> requestAll (makeDefaultRequest m) r)
+
+-- | Given a Changeid returns the change info status for the corresponding 
+--   request.
 --
---   Will result in an error in if request is not successful
-makeSimpleRequest :: (AWS.Transaction request response, Show request) 
-            => request -> IO response
-makeSimpleRequest r = do
-  cfg <- AWS.defaultConfiguration
-  withManager $ \m -> do
-    liftIO $ makeRequest cfg m r
-
--- | Given a Changeid returns the change info status for the corresponding request
 getChangeStatus :: ChangeId -> IO ChangeInfoStatus
-getChangeStatus changeId = ciStatus . gcrChangeInfo <$> (makeSimpleRequest $ getChange changeId)
-
--- | Extracts the result from a response within an FromAttempt Monad (IO, [], Maybe, etc)
-getResult :: (FromAttempt error) => AWS.Response meta r -> error r
-getResult (AWS.Response _ r) = fromAttempt r
+getChangeStatus changeId = 
+    ciStatus . gcrChangeInfo <$> (makeSingleRequest $ getChange changeId)
 
--- | Extracts the ChangeId from a response using the given function to extract the ChangeInfo from the response
+-- | Extracts the ChangeId from a response using the given function to extract
+--   the ChangeInfo from the response.
+--
 getChangeId :: Functor f => (a -> ChangeInfo) -> f a -> f ChangeId
 getChangeId changeInfoExtractor response = ciId . changeInfoExtractor <$> response
 
--- | Example usage of getChangeId
+-- | Example usage of getChangeId.
+--
 getChangeResourceRecordSetsResponseChangeId :: Functor f => f ChangeResourceRecordSetsResponse -> f ChangeId
 getChangeResourceRecordSetsResponseChangeId response = getChangeId crrsrChangeInfo response
 
@@ -80,108 +127,138 @@ getChangeResourceRecordSetsResponseChangeId response = getChangeId crrsrChangeIn
 -- -------------------------------------------------------------------------- --
 -- Hosted Zones
 
-instance Batched ListHostedZones ListHostedZonesResponse where
-  
-  a `merge` b = ListHostedZonesResponse { lhzrHostedZones = lhzrHostedZones a ++ lhzrHostedZones b
-                                        , lhzrNextToken = lhzrNextToken b
-                                        }
+instance Semigroup ListHostedZonesResponse where
+    a <> b = ListHostedZonesResponse 
+           { lhzrHostedZones = lhzrHostedZones a <> lhzrHostedZones b
+           , lhzrNextToken = lhzrNextToken b
+           }
+
 
-  nextRequest _ ListHostedZonesResponse{..} = maybe Nothing (\x -> Just $ ListHostedZones Nothing (Just x)) lhzrNextToken
+instance Batched ListHostedZones ListHostedZonesResponse where
+    nextRequest _ (Response _ (Failure _)) = Nothing
+    nextRequest _ (Response _ (Success ListHostedZonesResponse{..})) = 
+        ListHostedZones Nothing . Just <$> lhzrNextToken
 
 -- | Get all hosted zones of the user.
+--
 getAllZones :: IO HostedZones
-getAllZones = do
-  cfg <- AWS.defaultConfiguration
-  withManager $ \m -> do
-    ListHostedZonesResponse zones _ <- liftIO $ requestAll (\r -> makeRequest cfg m r) listHostedZones
-    return zones
+getAllZones = lhzrHostedZones <$> makeSingleRequestAll listHostedZones
 
--- | Get a hosted zone by its 'HostedZoneId'
+-- | Get a hosted zone by its 'HostedZoneId'.
+--
 getZoneById :: HostedZoneId -> IO HostedZone
-getZoneById hzid = ghzrHostedZone <$> makeSimpleRequest (getHostedZone hzid)
+getZoneById hzid = ghzrHostedZone <$> makeSingleRequest (getHostedZone hzid)
 
 -- | Get a hosted zone by its domain name.
 --   
 --   Results in an error if no hosted zone exists for the given domain name.
+--
 getZoneByName :: Domain -> IO HostedZone
 getZoneByName z = fromJust . find ((z==) . hzName) <$> getAllZones
 
--- | Returns the hosted zone id of the hosted zone for the given domain
+-- | Returns the hosted zone id of the hosted zone for the given domain.
+--
 getZoneIdByName :: Domain -> IO HostedZoneId
 getZoneIdByName hzName = hzId <$> getZoneByName hzName
 
 -- -------------------------------------------------------------------------- --
 -- Resource Records Sets
 
--- | Simplified construction for a ResourceRecordSet
-simpleResourceRecordSet :: Domain -> RecordType -> Int -> T.Text -> ResourceRecordSet
-simpleResourceRecordSet domain rtype ttl value = ResourceRecordSet domain rtype Nothing Nothing Nothing Nothing (Just ttl) [(ResourceRecord value)]
+-- | Simplified construction for a ResourceRecordSet.
+--
+simpleResourceRecordSet :: Domain -> RecordType -> Int -> Text -> ResourceRecordSet
+simpleResourceRecordSet domain rtype ttl value = 
+    ResourceRecordSet domain rtype Nothing Nothing Nothing Nothing (Just ttl) [(ResourceRecord value)]
+
+instance Semigroup ListResourceRecordSetsResponse where
+    a <> b = ListResourceRecordSetsResponse
+           { lrrsrResourceRecordSets = lrrsrResourceRecordSets a ++ lrrsrResourceRecordSets b
+           , lrrsrIsTruncated = lrrsrIsTruncated b
+           , lrrsrNextRecordName = lrrsrNextRecordName b
+           , lrrsrNextRecordType = lrrsrNextRecordType b
+           , lrrsrNextRecordIdentifier = lrrsrNextRecordIdentifier b
+           , lrrsrMaxItems = lrrsrMaxItems b
+           }
 
 instance Batched ListResourceRecordSets ListResourceRecordSetsResponse where
-  a `merge` b = ListResourceRecordSetsResponse
-                { lrrsrResourceRecordSets = lrrsrResourceRecordSets a ++ lrrsrResourceRecordSets b
-                , lrrsrIsTruncated = lrrsrIsTruncated b
-                , lrrsrNextRecordName = lrrsrNextRecordName b
-                , lrrsrNextRecordType = lrrsrNextRecordType b
-                , lrrsrNextRecordIdentifier = lrrsrNextRecordIdentifier b
-                , lrrsrMaxItems = lrrsrMaxItems b
-                }
-  nextRequest ListResourceRecordSets{..} ListResourceRecordSetsResponse{..} = 
-    if lrrsrIsTruncated
-      then Just $ ListResourceRecordSets lrrsHostedZoneId lrrsrNextRecordName lrrsrNextRecordType lrrsrNextRecordIdentifier lrrsrMaxItems
-      else Nothing
-
--- | Returns the resource record sets in the hosted zone with the given domain name
+    nextRequest _ (Response _ (Failure _)) = Nothing 
+    nextRequest ListResourceRecordSets{..} (Response _ (Success ListResourceRecordSetsResponse{..})) = do
+        guard (lrrsrIsTruncated)
+        return $ ListResourceRecordSets lrrsHostedZoneId 
+                                        lrrsrNextRecordName 
+                                        lrrsrNextRecordType 
+                                        lrrsrNextRecordIdentifier 
+                                        lrrsrMaxItems
+
+-- | Returns the resource record sets in the hosted zone with the given domain
+--   name.
 --
 --   Note the 'zName' is the domain name of the hosted zone itself.
+--
 getResourceRecordSetsByHostedZoneName :: Domain -> IO ResourceRecordSets
 getResourceRecordSetsByHostedZoneName zName = do
-  cfg <- AWS.defaultConfiguration
-  hzid <- getZoneIdByName zName
-  withManager $ \m -> do
-    ListResourceRecordSetsResponse rs _ _ _ _ _ <- liftIO $ requestAll (\r -> makeRequest cfg m r) (listResourceRecordSets hzid)
-    return rs
+    hzid <- getZoneIdByName zName
+    lrrsrResourceRecordSets <$> makeSingleRequestAll (listResourceRecordSets hzid)
 
--- | Lists all resource record sets in the hosted zone with the given hosted zone id.
+-- | Lists all resource record sets in the hosted zone with the given hosted 
+--   zone id.
+--
 getResourceRecordSets :: HostedZoneId -> IO ResourceRecordSets
-getResourceRecordSets hzid = do
-  cfg <- AWS.defaultConfiguration
-  withManager $ \m -> do
-    ListResourceRecordSetsResponse rs _ _ _ _ _ <- liftIO $ requestAll (\r -> makeRequest cfg m r) (listResourceRecordSets hzid)
-    return rs
+getResourceRecordSets hzid = 
+    lrrsrResourceRecordSets <$> makeSingleRequestAll (listResourceRecordSets hzid)
 
--- | Lists all resource record sets in the given hosted zone for the given domain.
+-- | Lists all resource record sets in the given hosted zone for the given 
+--   domain.
+--
 getResourceRecordSetsByDomain :: HostedZoneId -> Domain -> IO ResourceRecordSets
 getResourceRecordSetsByDomain hzid domain = do
-  cfg <- AWS.defaultConfiguration
-  withManager $ \m -> do
-    ListResourceRecordSetsResponse rs _ _ _ _ _ <- liftIO $ requestAll (\r -> makeRequest cfg m r) ((listResourceRecordSets hzid){ lrrsName = Just domain})
-    return rs
+    let req = (listResourceRecordSets hzid) { lrrsName = Just domain }
+    lrrsrResourceRecordSets <$> makeSingleRequestAll req
 
--- | Returns all resource records sets in the hosted zone with the given hosted zone id for the given DNS record type.
+-- | Returns all resource records sets in the hosted zone with the given hosted
+--   zone id for the given DNS record type.
+--
 getResourceRecordSetsByType :: HostedZoneId -> RecordType -> IO ResourceRecordSets
-getResourceRecordSetsByType hzid dnsRecordType = filter ((== dnsRecordType) . rrsType) <$> getResourceRecordSets hzid
+getResourceRecordSetsByType hzid dnsRecordType = 
+    filter ((== dnsRecordType) . rrsType) <$> getResourceRecordSets hzid
 
--- | Returns the resource record set of the given type for the given domain in the given hosted zone.
+-- | Returns the resource record set of the given type for the given domain in 
+--   the given hosted zone.
+--
 getResourceRecords :: HostedZoneId -> Domain -> RecordType -> IO ResourceRecordSet
-getResourceRecords cid domain rtype = head . lrrsrResourceRecordSets <$> (makeSimpleRequest $ ListResourceRecordSets cid (Just domain) (Just rtype) Nothing (Just 1))
+getResourceRecords cid domain rtype = do
+    let req = ListResourceRecordSets cid (Just domain) (Just rtype) Nothing (Just 1)
+    head . lrrsrResourceRecordSets <$> (makeSingleRequest $ req)
 
--- | Updates the resouce records of the given type for the given domain in the given hosted zone using the given mapping function.
+-- | Updates the resouce records of the given type for the given domain in the 
+--   given hosted zone using the given mapping function.
+--
+--   Recall that the functions in this module are example usages of the 
+--   Aws.Route53 module. In a production environment one would reuse the same 
+--   connection manager and configuration for all involved requests.
 --
---   Recall that the functions in this module are example usages of the Aws.Route53 module. In a production
---   environment one would reuse the same connection manager and configuration for all involved requests.
-updateRecords :: HostedZoneId -> Domain -> RecordType -> ([ResourceRecord] -> [ResourceRecord]) -> IO (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse)
+updateRecords :: HostedZoneId 
+              -> Domain 
+              -> RecordType 
+              -> ([ResourceRecord] 
+              -> [ResourceRecord]) 
+              -> IO (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse)
 updateRecords cid domain rtype f = do
   -- Fixme fail more gracefully
   rrs <- getResourceRecords cid domain rtype
   let rrs' = rrs { rrsRecords = f (rrsRecords rrs) }
   -- Handle errors gracefully. What if we fail in the middle?
-  r1 <- makeSimpleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
-  r2 <- makeSimpleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rrs')]
+  r1 <- makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
+  r2 <- makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rrs')]
   return (r1, r2)
 
--- | Updates the A record for the given domain in the given zone to the given IP address (encoded as Text)
-updateARecord :: HostedZoneId -> Domain -> T.Text -> IO (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse)
+-- | Updates the A record for the given domain in the given zone to the given 
+--   IP address (encoded as Text).
+--
+updateARecord :: HostedZoneId 
+              -> Domain 
+              -> Text 
+              -> IO (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse)
 updateARecord cid domain newIP = updateRecords cid domain A (const [ResourceRecord newIP])
 
 

From 7ae14f98ebdf013669f97642d5626c23d29e7593 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Thu, 12 Jul 2012 21:25:38 -0700
Subject: [PATCH 39/55] Some Route53 code cleanup.

---
 Aws/Route53/Commands/ChangeResourceRecordSets.hs | 3 ++-
 Aws/Route53/Commands/CreateHostedZone.hs         | 3 ++-
 Aws/Route53/Commands/DeleteHostedZone.hs         | 3 ++-
 Aws/Route53/Commands/GetChange.hs                | 3 ++-
 Aws/Route53/Commands/GetDate.hs                  | 3 ++-
 Aws/Route53/Commands/GetHostedZone.hs            | 3 ++-
 Aws/Route53/Commands/ListHostedZones.hs          | 3 ++-
 Aws/Route53/Commands/ListResourceRecordSets.hs   | 3 ++-
 Examples/Route53Examples.hs                      | 2 +-
 9 files changed, 17 insertions(+), 9 deletions(-)

diff --git a/Aws/Route53/Commands/ChangeResourceRecordSets.hs b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
index d53b9d6a..373eec39 100644
--- a/Aws/Route53/Commands/ChangeResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ChangeResourceRecordSets.hs
@@ -41,6 +41,7 @@ data ChangeResourceRecordSetsResponse = ChangeResourceRecordSetsResponse
   { crrsrChangeInfo :: ChangeInfo
   } deriving (Show)
 
+-- | ServiceConfiguration: 'Route53Configuration'
 instance SignQuery ChangeResourceRecordSets where
     type ServiceConfiguration ChangeResourceRecordSets = Route53Configuration
     signQuery ChangeResourceRecordSets{..} = route53SignQuery method resource query body
@@ -70,5 +71,5 @@ instance ResponseConsumer r ChangeResourceRecordSetsResponse where
             changeInfo <- r53Parse cursor
             return $ ChangeResourceRecordSetsResponse changeInfo
 
-instance Transaction ChangeResourceRecordSets ChangeResourceRecordSetsResponse where
+instance Transaction ChangeResourceRecordSets ChangeResourceRecordSetsResponse
 
diff --git a/Aws/Route53/Commands/CreateHostedZone.hs b/Aws/Route53/Commands/CreateHostedZone.hs
index c2974693..099b5b93 100644
--- a/Aws/Route53/Commands/CreateHostedZone.hs
+++ b/Aws/Route53/Commands/CreateHostedZone.hs
@@ -40,6 +40,7 @@ data CreateHostedZoneResponse = CreateHostedZoneResponse
 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
@@ -67,5 +68,5 @@ instance ResponseConsumer r CreateHostedZoneResponse where
             delegationSet <- r53Parse cursor
             return $ CreateHostedZoneResponse zone changeInfo delegationSet
 
-instance Transaction CreateHostedZone CreateHostedZoneResponse where
+instance Transaction CreateHostedZone CreateHostedZoneResponse
 
diff --git a/Aws/Route53/Commands/DeleteHostedZone.hs b/Aws/Route53/Commands/DeleteHostedZone.hs
index 57590b39..169d5c03 100644
--- a/Aws/Route53/Commands/DeleteHostedZone.hs
+++ b/Aws/Route53/Commands/DeleteHostedZone.hs
@@ -35,6 +35,7 @@ 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
@@ -54,5 +55,5 @@ instance ResponseConsumer r DeleteHostedZoneResponse where
             changeInfo <- r53Parse cursor
             return $ DeleteHostedZoneResponse changeInfo
 
-instance Transaction DeleteHostedZone DeleteHostedZoneResponse where
+instance Transaction DeleteHostedZone DeleteHostedZoneResponse
 
diff --git a/Aws/Route53/Commands/GetChange.hs b/Aws/Route53/Commands/GetChange.hs
index 8b869b4f..63291725 100644
--- a/Aws/Route53/Commands/GetChange.hs
+++ b/Aws/Route53/Commands/GetChange.hs
@@ -32,6 +32,7 @@ data GetChangeResponse = GetChangeResponse
 getChange :: ChangeId -> GetChange
 getChange changeId = GetChange changeId
 
+-- | ServiceConfiguration: 'Route53Configuration'
 instance SignQuery GetChange where
     type ServiceConfiguration GetChange = Route53Configuration
     signQuery GetChange{..} = route53SignQuery method resource query body
@@ -51,5 +52,5 @@ instance ResponseConsumer r GetChangeResponse where
             changeInfo <- r53Parse cursor
             return $ GetChangeResponse changeInfo
 
-instance Transaction GetChange GetChangeResponse where
+instance Transaction GetChange GetChangeResponse
 
diff --git a/Aws/Route53/Commands/GetDate.hs b/Aws/Route53/Commands/GetDate.hs
index 34c023dd..ac1d2bb9 100644
--- a/Aws/Route53/Commands/GetDate.hs
+++ b/Aws/Route53/Commands/GetDate.hs
@@ -26,6 +26,7 @@ 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 
@@ -58,5 +59,5 @@ instance ResponseConsumer r GetDateResponse where
 getDate :: GetDate
 getDate = GetDate
 
-instance Transaction GetDate GetDateResponse where
+instance Transaction GetDate GetDateResponse
 
diff --git a/Aws/Route53/Commands/GetHostedZone.hs b/Aws/Route53/Commands/GetHostedZone.hs
index 6a4cf573..2b3a8f7e 100644
--- a/Aws/Route53/Commands/GetHostedZone.hs
+++ b/Aws/Route53/Commands/GetHostedZone.hs
@@ -35,6 +35,7 @@ data GetHostedZoneResponse = GetHostedZoneResponse
 getHostedZone :: HostedZoneId -> GetHostedZone
 getHostedZone hostedZoneId = GetHostedZone hostedZoneId
 
+-- | ServiceConfiguration: 'Route53Configuration'
 instance SignQuery GetHostedZone where
     type ServiceConfiguration GetHostedZone = Route53Configuration
     signQuery GetHostedZone{..} = route53SignQuery method resource query Nothing
@@ -54,5 +55,5 @@ instance ResponseConsumer r GetHostedZoneResponse where
             delegationSet <- r53Parse cursor
             return $ GetHostedZoneResponse zone delegationSet
 
-instance Transaction GetHostedZone GetHostedZoneResponse where
+instance Transaction GetHostedZone GetHostedZoneResponse
 
diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index 154d3344..f0eee87f 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -38,6 +38,7 @@ data ListHostedZonesResponse = ListHostedZonesResponse
 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
@@ -60,5 +61,5 @@ instance ResponseConsumer r ListHostedZonesResponse where
             let nextToken = listToMaybe $ cursor $// elContent "NextMarker"
             return $ ListHostedZonesResponse zones nextToken
 
-instance Transaction ListHostedZones ListHostedZonesResponse where
+instance Transaction ListHostedZones ListHostedZonesResponse
 
diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
index 5e1a7213..e7b9ce5e 100644
--- a/Aws/Route53/Commands/ListResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -53,6 +53,7 @@ data ListResourceRecordSetsResponse = ListResourceRecordSetsResponse
                              , 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
@@ -81,5 +82,5 @@ instance ResponseConsumer r ListResourceRecordSetsResponse where
             let nextRecordIdentifier = listToMaybe $ cursor $// elContent "NextRecordIdentifier"
             return $ ListResourceRecordSetsResponse resourceRecordSets isTruncated maxItems nextRecordName nextRecordType nextRecordIdentifier
 
-instance Transaction ListResourceRecordSets ListResourceRecordSetsResponse where
+instance Transaction ListResourceRecordSets ListResourceRecordSetsResponse
 
diff --git a/Examples/Route53Examples.hs b/Examples/Route53Examples.hs
index 6d17dff2..f0e2a8f1 100644
--- a/Examples/Route53Examples.hs
+++ b/Examples/Route53Examples.hs
@@ -16,7 +16,7 @@ import Data.List              (find)
 import Data.Maybe             (fromJust)
 import Data.Attempt           (Attempt(..), fromAttempt)
 import Data.Semigroup         (Semigroup, (<>))
-import Data.Monoid            (Monoid, mempty, mappend)
+import Data.Monoid            (Monoid, mappend)
 
 import Control.Monad (guard)
 import Control.Applicative    ((<$>))

From 815be70fbbfb17a21f248a36a26aa2e955d25439 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Fri, 13 Jul 2012 14:34:49 -0700
Subject: [PATCH 40/55] Route53: minor code cleanup in Route53.Samples.

---
 Examples/Route53Examples.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/Examples/Route53Examples.hs b/Examples/Route53Examples.hs
index f0e2a8f1..b6635109 100644
--- a/Examples/Route53Examples.hs
+++ b/Examples/Route53Examples.hs
@@ -34,8 +34,8 @@ import Aws.Route53
 
 instance (Monoid m, Semigroup a) => Semigroup (Response m a) where
      (Response m0 (Success a0)) <> (Response m1 (Success a1)) = Response (m0 `mappend` m1) (Success (a0 <> a1))
-     (Response m0 (Success _))  <> (Response m1 (Failure e))  = Response (m0 `mappend` m1) (Failure e)
-     (Response m0 (Failure e))  <> (Response m1 _)            = Response (m0 `mappend` m1) (Failure e)
+     (Response m0 (Success _))  <> (Response m1 e)            = Response (m0 `mappend` m1) e
+     r                          <> _                          = r
 
 -- | extract result of an 'Attempt' from a 'Response'
 --

From caaf0fd99c1665c93f94047c68ee39c00fce5c4c Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Fri, 20 Jul 2012 10:11:29 -0700
Subject: [PATCH 41/55] Route53Examples: Add setARecord and a slightly improved
 exception handling

---
 Examples/Route53Examples.hs | 83 ++++++++++++++++++++++---------------
 1 file changed, 49 insertions(+), 34 deletions(-)

diff --git a/Examples/Route53Examples.hs b/Examples/Route53Examples.hs
index d19f03b3..660a84e8 100644
--- a/Examples/Route53Examples.hs
+++ b/Examples/Route53Examples.hs
@@ -11,23 +11,25 @@
 
 module Route53.Samples where
 
-import Data.Text              (Text)
-import Data.List              (find)
-import Data.Maybe             (fromJust)
-import Data.Attempt           (Attempt(..), fromAttempt)
-import Data.Semigroup         (Semigroup, (<>))
-import Data.Monoid            (Monoid, mappend)
-
-import Control.Monad (guard)
-import Control.Applicative    ((<$>))
-import Control.Monad.IO.Class (MonadIO)
-
-import Network.HTTP.Conduit   (Manager, withManager)
-
-import Aws                    (aws, Response(..), Transaction, DefaultServiceConfiguration, 
-                               ServiceConfiguration, defServiceConfig, baseConfiguration,
-                               ResponseMetadata)
-import Aws.Core               (NormalQuery)
+import Data.Text                 (Text)
+import Data.List                 (find)
+import Data.Maybe                (fromJust, listToMaybe)
+import Data.Attempt              (Attempt(..), fromAttempt)
+import Data.Semigroup            (Semigroup, (<>))
+import Data.Monoid               (Monoid, mappend)
+
+import Control.Monad             (guard, mzero, mplus)
+import Control.Applicative       ((<$>))
+import Control.Monad.IO.Class    (MonadIO, liftIO)
+import Control.Monad.Trans.Maybe (runMaybeT)
+import Control.Monad.Trans.List  (runListT)
+
+import Network.HTTP.Conduit      (Manager, withManager)
+
+import Aws                       (aws, Response(..), Transaction, DefaultServiceConfiguration, 
+                                  ServiceConfiguration, defServiceConfig, baseConfiguration,
+                                  ResponseMetadata)
+import Aws.Core                  (NormalQuery)
 import Aws.Route53
 
 -- -------------------------------------------------------------------------- --
@@ -226,10 +228,10 @@ getResourceRecordSetsByType hzid dnsRecordType =
 -- | Returns the resource record set of the given type for the given domain in 
 --   the given hosted zone.
 --
-getResourceRecords :: HostedZoneId -> Domain -> RecordType -> IO ResourceRecordSet
+getResourceRecords :: HostedZoneId -> Domain -> RecordType -> IO (Maybe ResourceRecordSet)
 getResourceRecords cid domain rtype = do
     let req = ListResourceRecordSets cid (Just domain) (Just rtype) Nothing (Just 1)
-    head . lrrsrResourceRecordSets <$> (makeSingleRequest $ req)
+    listToMaybe . lrrsrResourceRecordSets <$> (makeSingleRequest $ req)
 
 -- | Updates the resouce records of the given type for the given domain in the 
 --   given hosted zone using the given mapping function.
@@ -238,20 +240,20 @@ getResourceRecords cid domain rtype = do
 --   Aws.Route53 module. In a production environment one would reuse the same 
 --   connection manager and configuration for all involved requests.
 --
-updateRecords :: HostedZoneId 
+modifyRecords :: HostedZoneId 
               -> Domain 
               -> RecordType 
-              -> ([ResourceRecord] 
-              -> [ResourceRecord]) 
-              -> IO (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse)
-updateRecords cid domain rtype f = do
-  -- Fixme fail more gracefully
-  rrs <- getResourceRecords cid domain rtype
-  let rrs' = rrs { rrsRecords = f (rrsRecords rrs) }
-  -- Handle errors gracefully. What if we fail in the middle?
-  r1 <- makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
-  r2 <- makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rrs')]
-  return (r1, r2)
+              -> ([ResourceRecord] -> [ResourceRecord]) 
+              -> IO (Maybe (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse))
+modifyRecords cid domain rtype f = runMaybeT $ do
+    -- Fixme fail more gracefully
+    Just rrs <- liftIO $ getResourceRecords cid domain rtype
+    let rrs' = rrs { rrsRecords = f (rrsRecords rrs) }
+    
+    -- Handle errors gracefully. What if we fail in the middle?
+    r1 <- liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
+    r2 <- liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rrs')]
+    return (r1, r2)
 
 -- | Updates the A record for the given domain in the given zone to the given 
 --   IP address (encoded as Text).
@@ -259,7 +261,20 @@ updateRecords cid domain rtype f = do
 updateARecord :: HostedZoneId 
               -> Domain 
               -> Text 
-              -> IO (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse)
-updateARecord cid domain newIP = updateRecords cid domain A (const [ResourceRecord newIP])
-
+              -> IO (Maybe (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse))
+updateARecord cid domain newIP = modifyRecords cid domain A (const [ResourceRecord newIP])
+
+setARecord :: HostedZoneId
+           -> Domain
+           -> Int
+           -> Text
+           -> IO [ChangeResourceRecordSetsResponse]
+setARecord cid domain ttl ip = runListT $ do
+       maybeRrs <- liftIO $ getResourceRecords cid domain A
+       case maybeRrs of
+           Just rrs -> liftIO $ makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
+           Nothing -> mzero
+        `mplus` do
+            let rr = simpleResourceRecordSet domain A ttl ip
+            liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
 

From 433ebef2b8719bdec00cb6797d6b9970ddd32380 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Fri, 20 Jul 2012 12:09:57 -0700
Subject: [PATCH 42/55] Port Route53Examples to use IteratedTransaction.

---
 Aws/Route53/Commands/ListHostedZones.hs       |   6 +-
 .../Commands/ListResourceRecordSets.hs        |  18 +++
 Examples/Route53Examples.hs                   | 113 +++++-------------
 3 files changed, 52 insertions(+), 85 deletions(-)

diff --git a/Aws/Route53/Commands/ListHostedZones.hs b/Aws/Route53/Commands/ListHostedZones.hs
index d0750a13..f4062506 100644
--- a/Aws/Route53/Commands/ListHostedZones.hs
+++ b/Aws/Route53/Commands/ListHostedZones.hs
@@ -13,7 +13,7 @@ module Aws.Route53.Commands.ListHostedZones where
 import           Aws.Core
 import           Aws.Route53.Core
 import           Data.Maybe
-import           Control.Applicative        ((<$>))
+import           Control.Applicative        ((<$>), (<$))
 import           Text.XML.Cursor            (($//))
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as T
@@ -56,3 +56,7 @@ instance ResponseConsumer r ListHostedZonesResponse where
 
 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
+
diff --git a/Aws/Route53/Commands/ListResourceRecordSets.hs b/Aws/Route53/Commands/ListResourceRecordSets.hs
index 67609251..65e13792 100644
--- a/Aws/Route53/Commands/ListResourceRecordSets.hs
+++ b/Aws/Route53/Commands/ListResourceRecordSets.hs
@@ -19,6 +19,7 @@ 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
@@ -76,3 +77,20 @@ instance ResponseConsumer r ListResourceRecordSetsResponse where
 
 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
+           }
+
diff --git a/Examples/Route53Examples.hs b/Examples/Route53Examples.hs
index 660a84e8..a7d24d0e 100644
--- a/Examples/Route53Examples.hs
+++ b/Examples/Route53Examples.hs
@@ -2,12 +2,9 @@
 -- Copyright © 2012 AlephCloud Systems, Inc.
 -- ------------------------------------------------------ --
 
-{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
 
 module Route53.Samples where
 
@@ -15,10 +12,8 @@ import Data.Text                 (Text)
 import Data.List                 (find)
 import Data.Maybe                (fromJust, listToMaybe)
 import Data.Attempt              (Attempt(..), fromAttempt)
-import Data.Semigroup            (Semigroup, (<>))
-import Data.Monoid               (Monoid, mappend)
 
-import Control.Monad             (guard, mzero, mplus)
+import Control.Monad             (mzero, mplus)
 import Control.Applicative       ((<$>))
 import Control.Monad.IO.Class    (MonadIO, liftIO)
 import Control.Monad.Trans.Maybe (runMaybeT)
@@ -28,43 +23,20 @@ import Network.HTTP.Conduit      (Manager, withManager)
 
 import Aws                       (aws, Response(..), Transaction, DefaultServiceConfiguration, 
                                   ServiceConfiguration, defServiceConfig, baseConfiguration,
-                                  ResponseMetadata)
-import Aws.Core                  (NormalQuery)
+                                  ResponseMetadata, awsIteratedAll)
+import Aws.Core                  (NormalQuery, IteratedTransaction)
 import Aws.Route53
 
 -- -------------------------------------------------------------------------- --
 -- Request Utils
 
-instance (Monoid m, Semigroup a) => Semigroup (Response m a) where
-     (Response m0 (Success a0)) <> (Response m1 (Success a1)) = Response (m0 `mappend` m1) (Success (a0 <> a1))
-     (Response m0 (Success _))  <> (Response m1 e)            = Response (m0 `mappend` m1) e
-     r                          <> _                          = r
-
 -- | extract result of an 'Attempt' from a 'Response'
 --
 getResult :: Response m a -> Attempt a
 getResult (Response _ a) = a
 
--- | A class for transactions with batched responses. Allows to
---   iterate and concatenate all responses.
---
---   Minimal complete implementation: 'nextRequest'.
---
-class (Transaction r a, Semigroup a) => Batched r a  where
-    nextRequest :: r -> (Response (ResponseMetadata a) a) -> Maybe r
-
-requestAll :: (Batched r a, MonadIO m, Functor m) 
-           => (r -> m (Response (ResponseMetadata a) a)) 
-           -> r 
-           -> m (Response (ResponseMetadata a) a) 
-requestAll mkRequest request = do
-    response <- mkRequest request
-    case nextRequest request response of
-        Nothing -> return response
-        Just r -> (response <>) <$> requestAll mkRequest r
-
--- | Make a request using with the base configuration and the default
---   service configuration
+-- | Make a request using the base configuration and the default
+--   service configuration.
 --
 makeDefaultRequest :: ( Transaction r a
                       , Functor m
@@ -77,6 +49,20 @@ makeDefaultRequest manager request = do
     let scfg = defServiceConfig
     aws cfg scfg manager request
 
+-- | Make an iterated request using the base configuration and the default
+--   service configuration.
+--
+makeDefaultRequestAll :: ( IteratedTransaction r a
+                         , Functor m
+                         , MonadIO m
+                         , DefaultServiceConfiguration (ServiceConfiguration r NormalQuery)
+                         ) 
+                      => Manager -> r -> m (Response [ResponseMetadata a] a)
+makeDefaultRequestAll manager request = do
+    cfg <- baseConfiguration
+    let scfg = defServiceConfig
+    awsIteratedAll cfg scfg manager request
+
 -- | Executes the given request using the default configuration and a fresh 
 --   connection manager. Extracts the enclosed response body and returns it 
 --   within the IO monad.
@@ -91,21 +77,19 @@ makeSingleRequest :: (Transaction r a
 makeSingleRequest r = do
     fromAttempt =<< getResult <$> (withManager (\m -> makeDefaultRequest m r))
 
--- | Iterates request with batched responses until all batched are received 
---   using the default configuration and a fresh connection manager. The 
---   enclosed response bodies are extracted, concatenated (using 'mappend'
---   from 'Data.Monoid'), and returned within the IO monad.
+-- | Executes the given iterated request using the default configuration and a fresh 
+--   connection manager. Extracts the enclosed response body and returns it 
+--   within the IO monad.
 --
 --   The result is wrapped in an 'Attempt'.
 --
-makeSingleRequestAll :: (Transaction r a
-                        , Batched r a
+makeSingleRequestAll :: (IteratedTransaction r a
                         , Show r
                         , DefaultServiceConfiguration (ServiceConfiguration r NormalQuery)
                         ) 
                      => r -> IO a
-makeSingleRequestAll r = 
-    fromAttempt =<< getResult <$> withManager (\m -> requestAll (makeDefaultRequest m) r)
+makeSingleRequestAll r = do
+    fromAttempt =<< getResult <$> (withManager (\m -> makeDefaultRequestAll m r))
 
 -- | Given a Changeid returns the change info status for the corresponding 
 --   request.
@@ -130,18 +114,6 @@ getChangeResourceRecordSetsResponseChangeId response = getChangeId crrsrChangeIn
 -- -------------------------------------------------------------------------- --
 -- Hosted Zones
 
-instance Semigroup ListHostedZonesResponse where
-    a <> b = ListHostedZonesResponse 
-           { lhzrHostedZones = lhzrHostedZones a <> lhzrHostedZones b
-           , lhzrNextToken = lhzrNextToken b
-           }
-
-
-instance Batched ListHostedZones ListHostedZonesResponse where
-    nextRequest _ (Response _ (Failure _)) = Nothing
-    nextRequest _ (Response _ (Success ListHostedZonesResponse{..})) = 
-        ListHostedZones Nothing . Just <$> lhzrNextToken
-
 -- | Get all hosted zones of the user.
 --
 getAllZones :: IO HostedZones
@@ -173,26 +145,6 @@ simpleResourceRecordSet :: Domain -> RecordType -> Int -> Text -> ResourceRecord
 simpleResourceRecordSet domain rtype ttl value = 
     ResourceRecordSet domain rtype Nothing Nothing Nothing Nothing (Just ttl) [(ResourceRecord value)]
 
-instance Semigroup ListResourceRecordSetsResponse where
-    a <> b = ListResourceRecordSetsResponse
-           { lrrsrResourceRecordSets = lrrsrResourceRecordSets a ++ lrrsrResourceRecordSets b
-           , lrrsrIsTruncated = lrrsrIsTruncated b
-           , lrrsrNextRecordName = lrrsrNextRecordName b
-           , lrrsrNextRecordType = lrrsrNextRecordType b
-           , lrrsrNextRecordIdentifier = lrrsrNextRecordIdentifier b
-           , lrrsrMaxItems = lrrsrMaxItems b
-           }
-
-instance Batched ListResourceRecordSets ListResourceRecordSetsResponse where
-    nextRequest _ (Response _ (Failure _)) = Nothing 
-    nextRequest ListResourceRecordSets{..} (Response _ (Success ListResourceRecordSetsResponse{..})) = do
-        guard (lrrsrIsTruncated)
-        return $ ListResourceRecordSets lrrsHostedZoneId 
-                                        lrrsrNextRecordName 
-                                        lrrsrNextRecordType 
-                                        lrrsrNextRecordIdentifier 
-                                        lrrsrMaxItems
-
 -- | Returns the resource record sets in the hosted zone with the given domain
 --   name.
 --
@@ -258,16 +210,10 @@ modifyRecords cid domain rtype f = runMaybeT $ do
 -- | Updates the A record for the given domain in the given zone to the given 
 --   IP address (encoded as Text).
 --
-updateARecord :: HostedZoneId 
-              -> Domain 
-              -> Text 
-              -> IO (Maybe (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse))
-updateARecord cid domain newIP = modifyRecords cid domain A (const [ResourceRecord newIP])
-
-setARecord :: HostedZoneId
-           -> Domain
-           -> Int
-           -> Text
+setARecord :: HostedZoneId -- ^ Zone ID
+           -> Domain       -- ^ Domain
+           -> Int          -- ^ TTL for the record
+           -> Text         -- ^ The new value for the A record, an IPv4 address
            -> IO [ChangeResourceRecordSetsResponse]
 setARecord cid domain ttl ip = runListT $ do
        maybeRrs <- liftIO $ getResourceRecords cid domain A
@@ -277,4 +223,3 @@ setARecord cid domain ttl ip = runListT $ do
         `mplus` do
             let rr = simpleResourceRecordSet domain A ttl ip
             liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
-

From 2a0f5849beeef52054429bdef27ee86f2c0fd13c Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Tue, 24 Jul 2012 12:38:02 -0700
Subject: [PATCH 43/55] Add DynDNS client as Route53 example. Move Route53 into
 subdirectory.

--HG--
rename : Examples/Route53Examples.hs => Examples/Route53/Utils.hs
---
 Examples/Route53/AttemptT.hs                  |  67 +++++++
 Examples/Route53/DynDNS.hs                    | 171 ++++++++++++++++++
 .../{Route53Examples.hs => Route53/Utils.hs}  | 145 ++++++++++-----
 3 files changed, 334 insertions(+), 49 deletions(-)
 create mode 100644 Examples/Route53/AttemptT.hs
 create mode 100644 Examples/Route53/DynDNS.hs
 rename Examples/{Route53Examples.hs => Route53/Utils.hs} (56%)

diff --git a/Examples/Route53/AttemptT.hs b/Examples/Route53/AttemptT.hs
new file mode 100644
index 00000000..8eb1fcbc
--- /dev/null
+++ b/Examples/Route53/AttemptT.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module AttemptT 
+( AttemptT(..)
+, mapAttemptT
+) where
+
+import Data.Typeable
+import Data.Attempt
+
+import Control.Monad.Trans.Class
+import Control.Monad.IO.Class
+import Control.Applicative
+import Control.Monad
+
+import Control.Exception
+
+-- -------------------------------------------------------------------------- --
+-- AttemptT
+
+newtype AttemptT m a = AttemptT { runAttemptT :: m (Attempt a) }
+
+mapAttemptT :: (m (Attempt a) -> n (Attempt b)) -> AttemptT m a -> AttemptT n b
+mapAttemptT f = AttemptT . f . runAttemptT
+
+instance (Functor m) => Functor (AttemptT m) where
+    fmap f = mapAttemptT (fmap (fmap f))
+
+instance (Functor m, Monad m) => Applicative (AttemptT m) where
+    pure = return
+    (<*>) = ap
+
+instance (Functor m, Monad m) => Alternative (AttemptT m) where
+     empty = mzero
+     (<|>) = mplus
+
+data AttemptException = FailException String
+                      | EmptyException
+    deriving (Show, Typeable)
+
+instance Exception AttemptException
+
+instance (Monad m) => Monad (AttemptT m) where
+    fail e = AttemptT $ return (Failure (FailException e))
+    return a = AttemptT $ return (Success a)
+    m >>= k = AttemptT $ do
+        a <- runAttemptT m
+        case a of 
+            Failure e -> return (Failure e)
+            Success s -> runAttemptT (k s)
+
+instance (Monad m) => MonadPlus (AttemptT m) where
+    mzero = AttemptT $ return (Failure EmptyException)
+    m `mplus` n = AttemptT $ do
+        a <- runAttemptT m
+        case a of
+            Failure _ -> runAttemptT n
+            Success s -> return (Success s)
+
+instance MonadTrans AttemptT where
+    lift m = AttemptT $ do
+        a <- m
+        return (Success a)
+
+instance (MonadIO m) => MonadIO (AttemptT m) where
+    liftIO = lift . liftIO
+
diff --git a/Examples/Route53/DynDNS.hs b/Examples/Route53/DynDNS.hs
new file mode 100644
index 00000000..4f5ec30b
--- /dev/null
+++ b/Examples/Route53/DynDNS.hs
@@ -0,0 +1,171 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Main where
+
+import Prelude hiding (lookup)
+
+import System.IO (hPutStrLn, stderr)
+
+import Network.HTTP.Conduit (simpleHttp)
+import qualified Data.ByteString.Lazy.Char8 as B8 (unpack)
+import Data.Text (unpack, pack, append)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Attempt
+import Data.IP (IPv4)
+import Control.Applicative ((<$>))
+import Control.Concurrent (threadDelay)
+import Control.Monad.IO.Class (liftIO)
+
+import Network.DNS (lookup, makeResolvSeed, defaultResolvConf, withResolver, TYPE(A), RDATA(RD_A))
+
+import Aws.Route53 (Domain(..), ChangeResourceRecordSetsResponse)
+import Utils hiding (retry)
+import qualified Utils (retry)
+import AttemptT
+
+import System.Console.CmdArgs
+
+-- -------------------------------------------------------------------------- --
+-- Command Line Arguments and Configuration
+--
+data DynDnsArgs = DynDnsArgs 
+                { hosted_zone :: String
+                , subdomain :: String
+                , ttl :: Int
+                , sleep :: Int
+                , retry :: Int
+                , retry_sleep :: Int
+                } deriving (Show, Data, Typeable)
+
+dyndnsargs :: DynDnsArgs
+dyndnsargs = DynDnsArgs
+           { ttl = 60 &= help "The time to live header for the A record of the subdomain" &= typ "SECONDS"
+           , sleep = 60 &= help "The time to sleep after each check and possible reset of the A record of the subdomain" &= typ "SECONDS"
+           , retry = 4 &= help "The number of times network requests are retried" &= typ "INTEGER"
+           , retry_sleep = 1 &= help "The time to wait between two retries" &= typ "SECONDS"
+           , hosted_zone = def &= argPos 0 &= typ "HostedZone" -- &= help "The domain of the Route53 hosted zone" &= typ "ABSOLUTE DNSNAME"
+           , subdomain = def &= argPos 1 &= typ "SubDomain" -- &= help "The subdomain (relative to hosted zone domain)" &= typ "RELATIVE DNSNAME"
+           }
+           &= verbosity
+           &= program "DynDNS"
+           &= summary "DynDNS v0.1, (C) AlephCloud System, Inc. 2012"
+           &= help "Regulary check and set the A record of the DNS name local machine to the effective public IP address"
+           &= details [ "Uses AWS Route53 as DNS server backend."
+                      , "An Route53 account is need with a configured hosted zone."
+                      , "The subdomain must be choosen for the hosted zone."
+                      , "The Haskell AWS package must be configured with the default access key in place."
+                      , ""
+                      , "You must provide the domain of the hosted zone as absolute DNS name (ends with a dot)"
+                      , "and the subdomain relative to the hosted zone domain."
+                      ]
+
+data Config = Config
+            { confHostedZone :: Domain
+            , confDomain :: Domain
+            , confTtl :: Int
+            , confSleep :: Int
+            , confRetry :: Int
+            , confRetrySleep :: Int
+            }
+
+logError :: String -> IO ()
+logError = hPutStrLn stderr
+
+logNormal :: String -> IO ()
+logNormal = whenNormal . putStrLn
+
+logVerbose :: String -> IO ()
+logVerbose = whenLoud . putStrLn
+
+-- -------------------------------------------------------------------------- --
+-- Utils
+--
+realip :: IO IPv4
+realip = read . B8.unpack <$> simpleHttp  "http://api.externalip.net/ip/"
+
+-- TODO Retry depneding on the error. Do not retry on startup.
+dnsip :: Config -> IO [IPv4]
+dnsip conf = do
+    rs <- makeResolvSeed defaultResolvConf
+    withResolver rs $ \resolver -> do
+        result <- ret $ lookup resolver (toDnsDomain dom) A
+        case result of
+            Just ips -> return . map (\(RD_A ip) -> ip) $ ips
+            Nothing -> do
+                logError $ "WARNING: DNS lookup for " ++ unpack dom ++ " without result."
+                return []
+
+    where
+    dom = dText . confDomain $ conf
+    toDnsDomain = encodeUtf8
+    ret = Utils.retry (confRetrySleep conf) (confRetry conf)
+
+check :: Config -> [IPv4] -> IO ()
+
+check conf [ip] = do
+    rip <- realip
+    logVerbose $ "Current public visible IP of the local machine is " ++ show rip ++ "."
+    
+    ip' <- if ip == rip 
+        then return [ip]
+        else do
+            logNormal $ "INFO: real IPv4 address does not match the DNS IPv4 address."
+            sip <- setip conf rip
+            case sip of
+                Failure _ -> return [ip]
+                Success _ -> return [rip]
+    threadDelay $ (confSleep conf) * 1000000
+    check conf ip'
+
+check conf _ = do
+    logVerbose $ "No valid single IPv4 address (A record) in DNS." 
+    
+    rip <- realip
+    logVerbose $ "Current public visible IP of the local machine is " ++ show rip ++ "."
+    
+    sip <- setip conf rip
+    ip' <- case sip of
+        Failure _ -> do
+            logError $ "WARNING: Failed to update ip address for " ++ unpack dom ++ " to " ++ show rip ++ "."
+            return []
+        Success _ -> do
+            logNormal $ "INFO: Successfully updated ip address for " ++ unpack dom ++ " to " ++ show rip ++ "."
+            return [rip]
+    threadDelay $ (confSleep conf) * 1000000
+    check conf ip'
+    where
+    dom = dText (confDomain conf)
+
+setip :: Config -> IPv4 -> IO (Attempt [ChangeResourceRecordSetsResponse])
+setip conf ip = runAttemptT $ do
+    zid <- ret . AttemptT . liftIO $ getZoneIdByName (confHostedZone conf)
+    ret . AttemptT . liftIO $ setARecordRetry zid (confDomain conf) (confTtl conf) ip
+    where
+    ret = Utils.retry (confRetrySleep conf) (confRetry conf)
+
+-- -------------------------------------------------------------------------- --
+-- Main
+--
+main :: IO ()
+main = do
+    a <- cmdArgs dyndnsargs
+
+    let conf = Config
+             { confHostedZone = Domain . pack . hosted_zone $ a
+             , confDomain = Domain $ (pack (subdomain a)) `append` "." `append` (pack (hosted_zone a))
+             , confTtl = ttl a
+             , confSleep = sleep a
+             , confRetry = retry a
+             , confRetrySleep = retry_sleep a
+             }
+
+    let dom        = dText (confDomain conf)
+        hostedzone = dText (confHostedZone conf)
+
+    logNormal $ "Start DynDNS client for domain " ++ unpack dom ++ " in hosted zone " ++ unpack hostedzone ++ "."
+    dip <- dnsip conf
+
+    logNormal $ "Current IPv4 address (A record) in DNS is " ++ show dip ++ "." 
+    check conf dip
+
diff --git a/Examples/Route53Examples.hs b/Examples/Route53/Utils.hs
similarity index 56%
rename from Examples/Route53Examples.hs
rename to Examples/Route53/Utils.hs
index a7d24d0e..821a36a4 100644
--- a/Examples/Route53Examples.hs
+++ b/Examples/Route53/Utils.hs
@@ -5,21 +5,24 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
-module Route53.Samples where
+module Utils where
 
-import Data.Text                 (Text)
+import Data.Text                 (Text, pack)
 import Data.List                 (find)
 import Data.Maybe                (fromJust, listToMaybe)
-import Data.Attempt              (Attempt(..), fromAttempt)
+import Data.Attempt              (Attempt(..))
 
-import Control.Monad             (mzero, mplus)
+import Control.Monad             (MonadPlus, mzero, mplus)
 import Control.Applicative       ((<$>))
 import Control.Monad.IO.Class    (MonadIO, liftIO)
-import Control.Monad.Trans.Maybe (runMaybeT)
+import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.List  (runListT)
+import Control.Concurrent        (threadDelay)
 
 import Network.HTTP.Conduit      (Manager, withManager)
+import Data.IP                   (IPv4)
 
 import Aws                       (aws, Response(..), Transaction, DefaultServiceConfiguration, 
                                   ServiceConfiguration, defServiceConfig, baseConfiguration,
@@ -27,6 +30,8 @@ import Aws                       (aws, Response(..), Transaction, DefaultService
 import Aws.Core                  (NormalQuery, IteratedTransaction)
 import Aws.Route53
 
+import AttemptT
+
 -- -------------------------------------------------------------------------- --
 -- Request Utils
 
@@ -67,36 +72,32 @@ makeDefaultRequestAll manager request = do
 --   connection manager. Extracts the enclosed response body and returns it 
 --   within the IO monad.
 --
---   The result is wrapped in an 'Attempt'.
---
-makeSingleRequest :: (Transaction r a
+makeSingleRequest :: ( Transaction r a
                      , Show r
                      , DefaultServiceConfiguration (ServiceConfiguration r NormalQuery)
                      ) 
-                  => r -> IO a
+                  => r -> IO (Attempt a)
 makeSingleRequest r = do
-    fromAttempt =<< getResult <$> (withManager (\m -> makeDefaultRequest m r))
+    getResult <$> (withManager (\m -> makeDefaultRequest m r))
 
 -- | Executes the given iterated request using the default configuration and a fresh 
 --   connection manager. Extracts the enclosed response body and returns it 
 --   within the IO monad.
 --
---   The result is wrapped in an 'Attempt'.
---
-makeSingleRequestAll :: (IteratedTransaction r a
+makeSingleRequestAll :: ( IteratedTransaction r a
                         , Show r
                         , DefaultServiceConfiguration (ServiceConfiguration r NormalQuery)
                         ) 
-                     => r -> IO a
+                     => r -> IO (Attempt a)
 makeSingleRequestAll r = do
-    fromAttempt =<< getResult <$> (withManager (\m -> makeDefaultRequestAll m r))
+    getResult <$> (withManager (\m -> makeDefaultRequestAll m r))
 
 -- | Given a Changeid returns the change info status for the corresponding 
 --   request.
 --
-getChangeStatus :: ChangeId -> IO ChangeInfoStatus
+getChangeStatus :: ChangeId -> IO (Attempt ChangeInfoStatus)
 getChangeStatus changeId = 
-    ciStatus . gcrChangeInfo <$> (makeSingleRequest $ getChange changeId)
+    fmap (ciStatus . gcrChangeInfo) <$> (makeSingleRequest $ getChange changeId)
 
 -- | Extracts the ChangeId from a response using the given function to extract
 --   the ChangeInfo from the response.
@@ -116,25 +117,25 @@ getChangeResourceRecordSetsResponseChangeId response = getChangeId crrsrChangeIn
 
 -- | Get all hosted zones of the user.
 --
-getAllZones :: IO HostedZones
-getAllZones = lhzrHostedZones <$> makeSingleRequestAll listHostedZones
+getAllZones :: IO (Attempt HostedZones)
+getAllZones = fmap lhzrHostedZones <$> makeSingleRequestAll listHostedZones
 
 -- | Get a hosted zone by its 'HostedZoneId'.
 --
-getZoneById :: HostedZoneId -> IO HostedZone
-getZoneById hzid = ghzrHostedZone <$> makeSingleRequest (getHostedZone hzid)
+getZoneById :: HostedZoneId -> IO (Attempt HostedZone)
+getZoneById hzid = fmap ghzrHostedZone <$> makeSingleRequest (getHostedZone hzid)
 
 -- | Get a hosted zone by its domain name.
 --   
 --   Results in an error if no hosted zone exists for the given domain name.
 --
-getZoneByName :: Domain -> IO HostedZone
-getZoneByName z = fromJust . find ((z==) . hzName) <$> getAllZones
+getZoneByName :: Domain -> IO (Attempt HostedZone)
+getZoneByName z = fmap (fromJust . find ((z==) . hzName)) <$> getAllZones
 
 -- | Returns the hosted zone id of the hosted zone for the given domain.
 --
-getZoneIdByName :: Domain -> IO HostedZoneId
-getZoneIdByName hzName = hzId <$> getZoneByName hzName
+getZoneIdByName :: Domain -> IO (Attempt HostedZoneId)
+getZoneIdByName hzName = fmap hzId <$> getZoneByName hzName
 
 -- -------------------------------------------------------------------------- --
 -- Resource Records Sets
@@ -150,40 +151,42 @@ simpleResourceRecordSet domain rtype ttl value =
 --
 --   Note the 'zName' is the domain name of the hosted zone itself.
 --
-getResourceRecordSetsByHostedZoneName :: Domain -> IO ResourceRecordSets
+getResourceRecordSetsByHostedZoneName :: Domain -> IO (Attempt ResourceRecordSets)
 getResourceRecordSetsByHostedZoneName zName = do
-    hzid <- getZoneIdByName zName
-    lrrsrResourceRecordSets <$> makeSingleRequestAll (listResourceRecordSets hzid)
+    attemptHzid <- getZoneIdByName zName
+    case attemptHzid of
+        Success hzid -> fmap lrrsrResourceRecordSets <$> makeSingleRequestAll (listResourceRecordSets hzid)
+        Failure e -> return $ Failure e
 
 -- | Lists all resource record sets in the hosted zone with the given hosted 
 --   zone id.
 --
-getResourceRecordSets :: HostedZoneId -> IO ResourceRecordSets
+getResourceRecordSets :: HostedZoneId -> IO (Attempt ResourceRecordSets)
 getResourceRecordSets hzid = 
-    lrrsrResourceRecordSets <$> makeSingleRequestAll (listResourceRecordSets hzid)
+    fmap lrrsrResourceRecordSets <$> makeSingleRequestAll (listResourceRecordSets hzid)
 
 -- | Lists all resource record sets in the given hosted zone for the given 
 --   domain.
 --
-getResourceRecordSetsByDomain :: HostedZoneId -> Domain -> IO ResourceRecordSets
+getResourceRecordSetsByDomain :: HostedZoneId -> Domain -> IO (Attempt ResourceRecordSets)
 getResourceRecordSetsByDomain hzid domain = do
     let req = (listResourceRecordSets hzid) { lrrsName = Just domain }
-    lrrsrResourceRecordSets <$> makeSingleRequestAll req
+    fmap lrrsrResourceRecordSets <$> makeSingleRequestAll req
 
 -- | Returns all resource records sets in the hosted zone with the given hosted
 --   zone id for the given DNS record type.
 --
-getResourceRecordSetsByType :: HostedZoneId -> RecordType -> IO ResourceRecordSets
+getResourceRecordSetsByType :: HostedZoneId -> RecordType -> IO (Attempt ResourceRecordSets)
 getResourceRecordSetsByType hzid dnsRecordType = 
-    filter ((== dnsRecordType) . rrsType) <$> getResourceRecordSets hzid
+    fmap (filter ((== dnsRecordType) . rrsType)) <$> getResourceRecordSets hzid
 
 -- | Returns the resource record set of the given type for the given domain in 
 --   the given hosted zone.
 --
-getResourceRecords :: HostedZoneId -> Domain -> RecordType -> IO (Maybe ResourceRecordSet)
+getResourceRecords :: HostedZoneId -> Domain -> RecordType -> IO (Attempt (Maybe ResourceRecordSet))
 getResourceRecords cid domain rtype = do
     let req = ListResourceRecordSets cid (Just domain) (Just rtype) Nothing (Just 1)
-    listToMaybe . lrrsrResourceRecordSets <$> (makeSingleRequest $ req)
+    fmap (listToMaybe . lrrsrResourceRecordSets) <$> (makeSingleRequest $ req)
 
 -- | Updates the resouce records of the given type for the given domain in the 
 --   given hosted zone using the given mapping function.
@@ -196,15 +199,15 @@ modifyRecords :: HostedZoneId
               -> Domain 
               -> RecordType 
               -> ([ResourceRecord] -> [ResourceRecord]) 
-              -> IO (Maybe (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse))
-modifyRecords cid domain rtype f = runMaybeT $ do
+              -> IO (Attempt (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse))
+modifyRecords cid domain rtype f = runAttemptT $ do
     -- Fixme fail more gracefully
-    Just rrs <- liftIO $ getResourceRecords cid domain rtype
+    Just (rrs:: ResourceRecordSet) <- AttemptT . liftIO $ getResourceRecords cid domain rtype
     let rrs' = rrs { rrsRecords = f (rrsRecords rrs) }
     
     -- Handle errors gracefully. What if we fail in the middle?
-    r1 <- liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
-    r2 <- liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rrs')]
+    (r1 :: ChangeResourceRecordSetsResponse) <- AttemptT . liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)] :: AttemptT IO (ChangeResourceRecordSetsResponse)
+    r2 <- AttemptT . liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rrs')]
     return (r1, r2)
 
 -- | Updates the A record for the given domain in the given zone to the given 
@@ -213,13 +216,57 @@ modifyRecords cid domain rtype f = runMaybeT $ do
 setARecord :: HostedZoneId -- ^ Zone ID
            -> Domain       -- ^ Domain
            -> Int          -- ^ TTL for the record
-           -> Text         -- ^ The new value for the A record, an IPv4 address
-           -> IO [ChangeResourceRecordSetsResponse]
-setARecord cid domain ttl ip = runListT $ do
-       maybeRrs <- liftIO $ getResourceRecords cid domain A
-       case maybeRrs of
-           Just rrs -> liftIO $ makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
+           -> IPv4         -- ^ The new value for the A record, an IPv4 address
+           -> IO (Attempt [ChangeResourceRecordSetsResponse])
+setARecord cid domain ttl ip = runAttemptT $ do
+       maybeRrs <- AttemptT . liftIO $ getResourceRecords cid domain A
+       runListT $ case maybeRrs of
+           Just rrs -> lift $ AttemptT . liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
            Nothing -> mzero
         `mplus` do
-            let rr = simpleResourceRecordSet domain A ttl ip
-            liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
+            let rr = simpleResourceRecordSet domain A ttl (pack . show $ ip)
+            lift $ AttemptT . liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
+
+{-
+retry :: (MonadIO m) => Int -> Int -> m (Attempt a) -> m (Attempt a)
+retry pause 1 req = do
+    r <- req
+    case r of
+    --    Failure x -> error "Failed after retry"
+        _ -> return r
+retry pause num req | num < 0   = error $ "Illegal argument to retry. Expected positive Int, got " ++ (show num)
+                    | otherwise = do
+    --liftIO $ print $ "retry: " ++ show num
+    r <- req
+    case r of
+        Failure x -> (liftIO . threadDelay $ (pause * 1000000)) >> retry pause (num-1) req
+        _         -> return r
+-}
+
+retry :: (MonadIO m, MonadPlus m) => Int -> Int -> m a -> m a
+retry _ 1 req = req
+retry pause num req | num < 0   = error $ "Illegal argument to retry. Expected positive Int, got " ++ (show num)
+                    | otherwise = req `mplus` (wait >> retry pause (num-1) req)
+    where
+    wait = liftIO . threadDelay $ (pause * 1000000)
+
+
+-- | Updates the A record for the given domain in the given zone to the given 
+--   IP address (encoded as Text).
+--
+setARecordRetry :: HostedZoneId -- ^ Zone ID
+           -> Domain       -- ^ Domain
+           -> Int          -- ^ TTL for the record
+           -> IPv4         -- ^ The new value for the A record, an IPv4 address
+           -> IO (Attempt [ChangeResourceRecordSetsResponse])
+setARecordRetry cid domain ttl ip = runAttemptT $ do
+       maybeRrs <- r . AttemptT . liftIO $ getResourceRecords cid domain A
+       runListT $ case maybeRrs of
+           Just rrs -> lift . r . AttemptT . liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
+           Nothing -> mzero
+        `mplus` do
+            let rr = simpleResourceRecordSet domain A ttl (pack . show $ ip)
+            lift . r . AttemptT . liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
+
+    where
+    r = retry 1 4

From 88527cf80f0a34d78b95aa4c92d41cf66b46b616 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Tue, 24 Jul 2012 12:41:57 -0700
Subject: [PATCH 44/55] Add AlephCloud copyright to Route53 DynDNS example

---
 Examples/Route53/AttemptT.hs | 4 ++++
 Examples/Route53/DynDNS.hs   | 6 +++++-
 2 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/Examples/Route53/AttemptT.hs b/Examples/Route53/AttemptT.hs
index 8eb1fcbc..38b7261f 100644
--- a/Examples/Route53/AttemptT.hs
+++ b/Examples/Route53/AttemptT.hs
@@ -1,3 +1,7 @@
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 {-# LANGUAGE DeriveDataTypeable #-}
 
 module AttemptT 
diff --git a/Examples/Route53/DynDNS.hs b/Examples/Route53/DynDNS.hs
index 4f5ec30b..9cc6bd04 100644
--- a/Examples/Route53/DynDNS.hs
+++ b/Examples/Route53/DynDNS.hs
@@ -1,3 +1,7 @@
+-- ------------------------------------------------------ --
+-- Copyright © 2012 AlephCloud Systems, Inc.
+-- ------------------------------------------------------ --
+
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 
@@ -49,7 +53,7 @@ dyndnsargs = DynDnsArgs
            }
            &= verbosity
            &= program "DynDNS"
-           &= summary "DynDNS v0.1, (C) AlephCloud System, Inc. 2012"
+           &= summary "DynDNS 0.1, © 2012 AlephCloud System, Inc."
            &= help "Regulary check and set the A record of the DNS name local machine to the effective public IP address"
            &= details [ "Uses AWS Route53 as DNS server backend."
                       , "An Route53 account is need with a configured hosted zone."

From 2e62ce9819a8927e99aafc35415251c441a49207 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Tue, 24 Jul 2012 15:48:25 -0700
Subject: [PATCH 45/55] Examples.Route53: allow to choose AWS key on the
 command line

---
 Examples/Route53/DynDNS.hs |  51 +++++++++++---
 Examples/Route53/Utils.hs  | 137 +++++++++++++++++--------------------
 2 files changed, 104 insertions(+), 84 deletions(-)

diff --git a/Examples/Route53/DynDNS.hs b/Examples/Route53/DynDNS.hs
index 9cc6bd04..fbd06eba 100644
--- a/Examples/Route53/DynDNS.hs
+++ b/Examples/Route53/DynDNS.hs
@@ -23,13 +23,16 @@ import Control.Monad.IO.Class (liftIO)
 
 import Network.DNS (lookup, makeResolvSeed, defaultResolvConf, withResolver, TYPE(A), RDATA(RD_A))
 
+import qualified Aws as Aws
 import Aws.Route53 (Domain(..), ChangeResourceRecordSetsResponse)
+
 import Utils hiding (retry)
 import qualified Utils (retry)
 import AttemptT
 
 import System.Console.CmdArgs
 
+
 -- -------------------------------------------------------------------------- --
 -- Command Line Arguments and Configuration
 --
@@ -40,16 +43,20 @@ data DynDnsArgs = DynDnsArgs
                 , sleep :: Int
                 , retry :: Int
                 , retry_sleep :: Int
+                , aws_keys_file :: FilePath
+                , aws_key :: String
                 } deriving (Show, Data, Typeable)
 
 dyndnsargs :: DynDnsArgs
 dyndnsargs = DynDnsArgs
-           { ttl = 60 &= help "The time to live header for the A record of the subdomain" &= typ "SECONDS"
-           , sleep = 60 &= help "The time to sleep after each check and possible reset of the A record of the subdomain" &= typ "SECONDS"
-           , retry = 4 &= help "The number of times network requests are retried" &= typ "INTEGER"
-           , retry_sleep = 1 &= help "The time to wait between two retries" &= typ "SECONDS"
-           , hosted_zone = def &= argPos 0 &= typ "HostedZone" -- &= help "The domain of the Route53 hosted zone" &= typ "ABSOLUTE DNSNAME"
-           , subdomain = def &= argPos 1 &= typ "SubDomain" -- &= help "The subdomain (relative to hosted zone domain)" &= typ "RELATIVE DNSNAME"
+           { ttl = 60 &= help "Value of the time to live header for the A record of the subdomain (default: 60)" &= typ "SECONDS"
+           , sleep = 60 &= help "Time to sleep after each check and possible reset of the A record of the subdomain (default: 60)" &= typ "SECONDS"
+           , retry = 4 &= help "Number of times network requests are retried (default: 4)" &= typ "INTEGER"
+           , retry_sleep = 1 &= help "Time to wait between two retries (defaul: 1)" &= typ "SECONDS"
+           , aws_keys_file = def &= help "File with the AWS access keys (default: ~/.aws-keys)" &= typFile
+           , aws_key = def &= help "Aws key to use (default: default)" &= typ "STRING"
+           , hosted_zone = def &= argPos 0 &= typ "HostedZone"
+           , subdomain = def &= argPos 1 &= typ "SubDomain"
            }
            &= verbosity
            &= program "DynDNS"
@@ -71,6 +78,7 @@ data Config = Config
             , confSleep :: Int
             , confRetry :: Int
             , confRetrySleep :: Int
+            , confAws :: Aws.Configuration
             }
 
 logError :: String -> IO ()
@@ -143,17 +151,43 @@ check conf _ = do
 
 setip :: Config -> IPv4 -> IO (Attempt [ChangeResourceRecordSetsResponse])
 setip conf ip = runAttemptT $ do
-    zid <- ret . AttemptT . liftIO $ getZoneIdByName (confHostedZone conf)
-    ret . AttemptT . liftIO $ setARecordRetry zid (confDomain conf) (confTtl conf) ip
+    zid <- ret . AttemptT . liftIO $ getZoneIdByName awsconf (confHostedZone conf)
+    ret . AttemptT . liftIO $ setARecordRetry awsconf zid (confDomain conf) (confTtl conf) ip
     where
     ret = Utils.retry (confRetrySleep conf) (confRetry conf)
+    awsconf = confAws conf
 
 -- -------------------------------------------------------------------------- --
 -- Main
 --
+
+awsConfiguration :: DynDnsArgs -> IO Aws.Configuration
+awsConfiguration a = do
+    maybeCreds <- awsCredentials (aws_keys_file a) (aws_key a)
+    creds <- case maybeCreds of
+        Nothing -> error "Failed to load AWS Credentials."
+        Just x  -> return x
+    verb <- getVerbosity
+    return $ Aws.Configuration
+           { Aws.timeInfo    = Aws.Timestamp
+           , Aws.credentials = creds
+           , Aws.logger      = awsLogger verb
+           }
+    where
+    awsLogger Quiet  = Aws.defaultLog Aws.Error
+    awsLogger Normal = Aws.defaultLog Aws.Warning
+    awsLogger Loud   = Aws.defaultLog Aws.Debug
+
+    awsCredentials file key | file == def && key == def = Aws.loadCredentialsDefault
+                            | key == def                = Aws.loadCredentialsFromFile file Aws.credentialsDefaultKey
+                            | file == def               = do f <- Aws.credentialsDefaultFile
+                                                             Aws.loadCredentialsFromEnvOrFile f (pack key)
+                            | otherwise                 = Aws.loadCredentialsFromFile file (pack key)
+
 main :: IO ()
 main = do
     a <- cmdArgs dyndnsargs
+    awsConf <- awsConfiguration a
 
     let conf = Config
              { confHostedZone = Domain . pack . hosted_zone $ a
@@ -162,6 +196,7 @@ main = do
              , confSleep = sleep a
              , confRetry = retry a
              , confRetrySleep = retry_sleep a
+             , confAws = awsConf
              }
 
     let dom        = dText (confDomain conf)
diff --git a/Examples/Route53/Utils.hs b/Examples/Route53/Utils.hs
index 821a36a4..3726ffe6 100644
--- a/Examples/Route53/Utils.hs
+++ b/Examples/Route53/Utils.hs
@@ -25,8 +25,8 @@ import Network.HTTP.Conduit      (Manager, withManager)
 import Data.IP                   (IPv4)
 
 import Aws                       (aws, Response(..), Transaction, DefaultServiceConfiguration, 
-                                  ServiceConfiguration, defServiceConfig, baseConfiguration,
-                                  ResponseMetadata, awsIteratedAll)
+                                  ServiceConfiguration, defServiceConfig, ResponseMetadata, 
+                                  awsIteratedAll, Configuration)
 import Aws.Core                  (NormalQuery, IteratedTransaction)
 import Aws.Route53
 
@@ -48,9 +48,8 @@ makeDefaultRequest :: ( Transaction r a
                       , MonadIO m
                       , DefaultServiceConfiguration (ServiceConfiguration r NormalQuery)
                       ) 
-                   => Manager -> r -> m (Response (ResponseMetadata a) a)
-makeDefaultRequest manager request = do
-    cfg <- baseConfiguration
+                   => Configuration -> Manager -> r -> m (Response (ResponseMetadata a) a)
+makeDefaultRequest cfg manager request = do
     let scfg = defServiceConfig
     aws cfg scfg manager request
 
@@ -62,9 +61,8 @@ makeDefaultRequestAll :: ( IteratedTransaction r a
                          , MonadIO m
                          , DefaultServiceConfiguration (ServiceConfiguration r NormalQuery)
                          ) 
-                      => Manager -> r -> m (Response [ResponseMetadata a] a)
-makeDefaultRequestAll manager request = do
-    cfg <- baseConfiguration
+                      => Configuration -> Manager -> r -> m (Response [ResponseMetadata a] a)
+makeDefaultRequestAll cfg manager request = do
     let scfg = defServiceConfig
     awsIteratedAll cfg scfg manager request
 
@@ -76,9 +74,9 @@ makeSingleRequest :: ( Transaction r a
                      , Show r
                      , DefaultServiceConfiguration (ServiceConfiguration r NormalQuery)
                      ) 
-                  => r -> IO (Attempt a)
-makeSingleRequest r = do
-    getResult <$> (withManager (\m -> makeDefaultRequest m r))
+                  => Configuration -> r -> IO (Attempt a)
+makeSingleRequest cfg r = do
+    getResult <$> (withManager (\m -> makeDefaultRequest cfg m r))
 
 -- | Executes the given iterated request using the default configuration and a fresh 
 --   connection manager. Extracts the enclosed response body and returns it 
@@ -88,16 +86,16 @@ makeSingleRequestAll :: ( IteratedTransaction r a
                         , Show r
                         , DefaultServiceConfiguration (ServiceConfiguration r NormalQuery)
                         ) 
-                     => r -> IO (Attempt a)
-makeSingleRequestAll r = do
-    getResult <$> (withManager (\m -> makeDefaultRequestAll m r))
+                     => Configuration -> r -> IO (Attempt a)
+makeSingleRequestAll cfg r = do
+    getResult <$> (withManager (\m -> makeDefaultRequestAll cfg m r))
 
 -- | Given a Changeid returns the change info status for the corresponding 
 --   request.
 --
-getChangeStatus :: ChangeId -> IO (Attempt ChangeInfoStatus)
-getChangeStatus changeId = 
-    fmap (ciStatus . gcrChangeInfo) <$> (makeSingleRequest $ getChange changeId)
+getChangeStatus :: Configuration -> ChangeId -> IO (Attempt ChangeInfoStatus)
+getChangeStatus cfg changeId = 
+    fmap (ciStatus . gcrChangeInfo) <$> (makeSingleRequest cfg $ getChange changeId)
 
 -- | Extracts the ChangeId from a response using the given function to extract
 --   the ChangeInfo from the response.
@@ -117,25 +115,25 @@ getChangeResourceRecordSetsResponseChangeId response = getChangeId crrsrChangeIn
 
 -- | Get all hosted zones of the user.
 --
-getAllZones :: IO (Attempt HostedZones)
-getAllZones = fmap lhzrHostedZones <$> makeSingleRequestAll listHostedZones
+getAllZones :: Configuration -> IO (Attempt HostedZones)
+getAllZones cfg = fmap lhzrHostedZones <$> makeSingleRequestAll cfg listHostedZones
 
 -- | Get a hosted zone by its 'HostedZoneId'.
 --
-getZoneById :: HostedZoneId -> IO (Attempt HostedZone)
-getZoneById hzid = fmap ghzrHostedZone <$> makeSingleRequest (getHostedZone hzid)
+getZoneById :: Configuration -> HostedZoneId -> IO (Attempt HostedZone)
+getZoneById cfg hzid = fmap ghzrHostedZone <$> makeSingleRequest cfg (getHostedZone hzid)
 
 -- | Get a hosted zone by its domain name.
 --   
 --   Results in an error if no hosted zone exists for the given domain name.
 --
-getZoneByName :: Domain -> IO (Attempt HostedZone)
-getZoneByName z = fmap (fromJust . find ((z==) . hzName)) <$> getAllZones
+getZoneByName :: Configuration -> Domain -> IO (Attempt HostedZone)
+getZoneByName cfg z = fmap (fromJust . find ((z==) . hzName)) <$> getAllZones cfg
 
 -- | Returns the hosted zone id of the hosted zone for the given domain.
 --
-getZoneIdByName :: Domain -> IO (Attempt HostedZoneId)
-getZoneIdByName hzName = fmap hzId <$> getZoneByName hzName
+getZoneIdByName :: Configuration -> Domain -> IO (Attempt HostedZoneId)
+getZoneIdByName cfg hzName = fmap hzId <$> getZoneByName cfg hzName
 
 -- -------------------------------------------------------------------------- --
 -- Resource Records Sets
@@ -151,42 +149,42 @@ simpleResourceRecordSet domain rtype ttl value =
 --
 --   Note the 'zName' is the domain name of the hosted zone itself.
 --
-getResourceRecordSetsByHostedZoneName :: Domain -> IO (Attempt ResourceRecordSets)
-getResourceRecordSetsByHostedZoneName zName = do
-    attemptHzid <- getZoneIdByName zName
+getResourceRecordSetsByHostedZoneName :: Configuration -> Domain -> IO (Attempt ResourceRecordSets)
+getResourceRecordSetsByHostedZoneName cfg zName = do
+    attemptHzid <- getZoneIdByName cfg zName
     case attemptHzid of
-        Success hzid -> fmap lrrsrResourceRecordSets <$> makeSingleRequestAll (listResourceRecordSets hzid)
+        Success hzid -> fmap lrrsrResourceRecordSets <$> makeSingleRequestAll cfg (listResourceRecordSets hzid)
         Failure e -> return $ Failure e
 
 -- | Lists all resource record sets in the hosted zone with the given hosted 
 --   zone id.
 --
-getResourceRecordSets :: HostedZoneId -> IO (Attempt ResourceRecordSets)
-getResourceRecordSets hzid = 
-    fmap lrrsrResourceRecordSets <$> makeSingleRequestAll (listResourceRecordSets hzid)
+getResourceRecordSets :: Configuration -> HostedZoneId -> IO (Attempt ResourceRecordSets)
+getResourceRecordSets cfg hzid = 
+    fmap lrrsrResourceRecordSets <$> makeSingleRequestAll cfg (listResourceRecordSets hzid)
 
 -- | Lists all resource record sets in the given hosted zone for the given 
 --   domain.
 --
-getResourceRecordSetsByDomain :: HostedZoneId -> Domain -> IO (Attempt ResourceRecordSets)
-getResourceRecordSetsByDomain hzid domain = do
+getResourceRecordSetsByDomain :: Configuration -> HostedZoneId -> Domain -> IO (Attempt ResourceRecordSets)
+getResourceRecordSetsByDomain cfg hzid domain = do
     let req = (listResourceRecordSets hzid) { lrrsName = Just domain }
-    fmap lrrsrResourceRecordSets <$> makeSingleRequestAll req
+    fmap lrrsrResourceRecordSets <$> makeSingleRequestAll cfg req
 
 -- | Returns all resource records sets in the hosted zone with the given hosted
 --   zone id for the given DNS record type.
 --
-getResourceRecordSetsByType :: HostedZoneId -> RecordType -> IO (Attempt ResourceRecordSets)
-getResourceRecordSetsByType hzid dnsRecordType = 
-    fmap (filter ((== dnsRecordType) . rrsType)) <$> getResourceRecordSets hzid
+getResourceRecordSetsByType :: Configuration -> HostedZoneId -> RecordType -> IO (Attempt ResourceRecordSets)
+getResourceRecordSetsByType cfg hzid dnsRecordType = 
+    fmap (filter ((== dnsRecordType) . rrsType)) <$> getResourceRecordSets cfg hzid
 
 -- | Returns the resource record set of the given type for the given domain in 
 --   the given hosted zone.
 --
-getResourceRecords :: HostedZoneId -> Domain -> RecordType -> IO (Attempt (Maybe ResourceRecordSet))
-getResourceRecords cid domain rtype = do
+getResourceRecords :: Configuration -> HostedZoneId -> Domain -> RecordType -> IO (Attempt (Maybe ResourceRecordSet))
+getResourceRecords cfg cid domain rtype = do
     let req = ListResourceRecordSets cid (Just domain) (Just rtype) Nothing (Just 1)
-    fmap (listToMaybe . lrrsrResourceRecordSets) <$> (makeSingleRequest $ req)
+    fmap (listToMaybe . lrrsrResourceRecordSets) <$> (makeSingleRequest cfg $ req)
 
 -- | Updates the resouce records of the given type for the given domain in the 
 --   given hosted zone using the given mapping function.
@@ -195,53 +193,39 @@ getResourceRecords cid domain rtype = do
 --   Aws.Route53 module. In a production environment one would reuse the same 
 --   connection manager and configuration for all involved requests.
 --
-modifyRecords :: HostedZoneId 
+modifyRecords :: Configuration
+              -> HostedZoneId 
               -> Domain 
               -> RecordType 
               -> ([ResourceRecord] -> [ResourceRecord]) 
               -> IO (Attempt (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse))
-modifyRecords cid domain rtype f = runAttemptT $ do
+modifyRecords cfg cid domain rtype f = runAttemptT $ do
     -- Fixme fail more gracefully
-    Just (rrs:: ResourceRecordSet) <- AttemptT . liftIO $ getResourceRecords cid domain rtype
+    Just (rrs:: ResourceRecordSet) <- AttemptT . liftIO $ getResourceRecords cfg cid domain rtype
     let rrs' = rrs { rrsRecords = f (rrsRecords rrs) }
     
     -- Handle errors gracefully. What if we fail in the middle?
-    (r1 :: ChangeResourceRecordSetsResponse) <- AttemptT . liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)] :: AttemptT IO (ChangeResourceRecordSetsResponse)
-    r2 <- AttemptT . liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rrs')]
+    (r1 :: ChangeResourceRecordSetsResponse) <- AttemptT . liftIO . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)] :: AttemptT IO (ChangeResourceRecordSetsResponse)
+    r2 <- AttemptT . liftIO . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(CREATE, rrs')]
     return (r1, r2)
 
 -- | Updates the A record for the given domain in the given zone to the given 
 --   IP address (encoded as Text).
 --
-setARecord :: HostedZoneId -- ^ Zone ID
+setARecord :: Configuration
+           -> HostedZoneId -- ^ Zone ID
            -> Domain       -- ^ Domain
            -> Int          -- ^ TTL for the record
            -> IPv4         -- ^ The new value for the A record, an IPv4 address
            -> IO (Attempt [ChangeResourceRecordSetsResponse])
-setARecord cid domain ttl ip = runAttemptT $ do
-       maybeRrs <- AttemptT . liftIO $ getResourceRecords cid domain A
+setARecord cfg cid domain ttl ip = runAttemptT $ do
+       maybeRrs <- AttemptT . liftIO $ getResourceRecords cfg cid domain A
        runListT $ case maybeRrs of
-           Just rrs -> lift $ AttemptT . liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
+           Just rrs -> lift $ AttemptT . liftIO . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
            Nothing -> mzero
         `mplus` do
             let rr = simpleResourceRecordSet domain A ttl (pack . show $ ip)
-            lift $ AttemptT . liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
-
-{-
-retry :: (MonadIO m) => Int -> Int -> m (Attempt a) -> m (Attempt a)
-retry pause 1 req = do
-    r <- req
-    case r of
-    --    Failure x -> error "Failed after retry"
-        _ -> return r
-retry pause num req | num < 0   = error $ "Illegal argument to retry. Expected positive Int, got " ++ (show num)
-                    | otherwise = do
-    --liftIO $ print $ "retry: " ++ show num
-    r <- req
-    case r of
-        Failure x -> (liftIO . threadDelay $ (pause * 1000000)) >> retry pause (num-1) req
-        _         -> return r
--}
+            lift $ AttemptT . liftIO . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
 
 retry :: (MonadIO m, MonadPlus m) => Int -> Int -> m a -> m a
 retry _ 1 req = req
@@ -254,19 +238,20 @@ retry pause num req | num < 0   = error $ "Illegal argument to retry. Expected p
 -- | Updates the A record for the given domain in the given zone to the given 
 --   IP address (encoded as Text).
 --
-setARecordRetry :: HostedZoneId -- ^ Zone ID
-           -> Domain       -- ^ Domain
-           -> Int          -- ^ TTL for the record
-           -> IPv4         -- ^ The new value for the A record, an IPv4 address
-           -> IO (Attempt [ChangeResourceRecordSetsResponse])
-setARecordRetry cid domain ttl ip = runAttemptT $ do
-       maybeRrs <- r . AttemptT . liftIO $ getResourceRecords cid domain A
+setARecordRetry :: Configuration
+                -> HostedZoneId -- ^ Zone ID
+                -> Domain       -- ^ Domain
+                -> Int          -- ^ TTL for the record
+                -> IPv4         -- ^ The new value for the A record, an IPv4 address
+                -> IO (Attempt [ChangeResourceRecordSetsResponse])
+setARecordRetry cfg cid domain ttl ip = runAttemptT $ do
+       maybeRrs <- r . AttemptT . liftIO $ getResourceRecords cfg cid domain A
        runListT $ case maybeRrs of
-           Just rrs -> lift . r . AttemptT . liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
+           Just rrs -> lift . r . AttemptT . liftIO . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
            Nothing -> mzero
         `mplus` do
             let rr = simpleResourceRecordSet domain A ttl (pack . show $ ip)
-            lift . r . AttemptT . liftIO . makeSingleRequest $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
+            lift . r . AttemptT . liftIO . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
 
     where
     r = retry 1 4

From ecbff2e6a3d74040e00b11eabb0425fb426c7d68 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Wed, 25 Jul 2012 13:01:01 -0700
Subject: [PATCH 46/55] Examples.Route53: Add log-file argument to DynDNS.

---
 Examples/Route53/DynDNS.hs | 126 ++++++++++++++++++++++++-------------
 1 file changed, 82 insertions(+), 44 deletions(-)

diff --git a/Examples/Route53/DynDNS.hs b/Examples/Route53/DynDNS.hs
index fbd06eba..276365e1 100644
--- a/Examples/Route53/DynDNS.hs
+++ b/Examples/Route53/DynDNS.hs
@@ -9,14 +9,20 @@ module Main where
 
 import Prelude hiding (lookup)
 
-import System.IO (hPutStrLn, stderr)
+import System.IO (stderr, Handle, withFile, BufferMode(LineBuffering), IOMode(AppendMode), hSetBuffering)
+import System.Locale (defaultTimeLocale)
 
 import Network.HTTP.Conduit (simpleHttp)
 import qualified Data.ByteString.Lazy.Char8 as B8 (unpack)
-import Data.Text (unpack, pack, append)
+import Data.Text (Text, pack, append)
+import Data.Text.IO (hPutStrLn)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Attempt
+import Data.Monoid ((<>))
 import Data.IP (IPv4)
+import Data.Time.Clock (getCurrentTime)
+import Data.Time.Format (formatTime)
+import Control.Monad (when)
 import Control.Applicative ((<$>))
 import Control.Concurrent (threadDelay)
 import Control.Monad.IO.Class (liftIO)
@@ -24,6 +30,7 @@ import Control.Monad.IO.Class (liftIO)
 import Network.DNS (lookup, makeResolvSeed, defaultResolvConf, withResolver, TYPE(A), RDATA(RD_A))
 
 import qualified Aws as Aws
+import Aws (LogLevel(..), Logger)
 import Aws.Route53 (Domain(..), ChangeResourceRecordSetsResponse)
 
 import Utils hiding (retry)
@@ -43,6 +50,7 @@ data DynDnsArgs = DynDnsArgs
                 , sleep :: Int
                 , retry :: Int
                 , retry_sleep :: Int
+                , log_file :: FilePath
                 , aws_keys_file :: FilePath
                 , aws_key :: String
                 } deriving (Show, Data, Typeable)
@@ -55,6 +63,7 @@ dyndnsargs = DynDnsArgs
            , retry_sleep = 1 &= help "Time to wait between two retries (defaul: 1)" &= typ "SECONDS"
            , aws_keys_file = def &= help "File with the AWS access keys (default: ~/.aws-keys)" &= typFile
            , aws_key = def &= help "Aws key to use (default: default)" &= typ "STRING"
+           , log_file = def &= help "File with where the logs will be written to (default: stderr)" &= typFile
            , hosted_zone = def &= argPos 0 &= typ "HostedZone"
            , subdomain = def &= argPos 1 &= typ "SubDomain"
            }
@@ -79,16 +88,30 @@ data Config = Config
             , confRetry :: Int
             , confRetrySleep :: Int
             , confAws :: Aws.Configuration
+            , confLog :: Logger
             }
 
-logError :: String -> IO ()
-logError = hPutStrLn stderr
+-- We reuse the simple logging approach from the Aws package.
+-- It is not very efficient but for this application we do not need
+-- to worry about performance
+getLogger :: Handle -> LogLevel -> Logger
+getLogger h minlevel level msg = do 
+    when (level >= minlevel) $ do 
+        time <- formatTime defaultTimeLocale "%F %X" <$> getCurrentTime
+        let m = pack time <> " - " <> pack (show level) <> ": " <> msg
+        hPutStrLn h m
 
-logNormal :: String -> IO ()
-logNormal = whenNormal . putStrLn
+logDebug :: Config -> Text -> IO ()
+logDebug conf msg = (confLog conf) Debug msg
 
-logVerbose :: String -> IO ()
-logVerbose = whenLoud . putStrLn
+logInfo :: Config -> Text -> IO ()
+logInfo conf msg = (confLog conf) Info msg
+
+logWarning :: Config -> Text -> IO ()
+logWarning conf msg = (confLog conf) Warning msg
+
+logError :: Config -> Text -> IO ()
+logError conf msg = (confLog conf) Error msg
 
 -- -------------------------------------------------------------------------- --
 -- Utils
@@ -105,7 +128,7 @@ dnsip conf = do
         case result of
             Just ips -> return . map (\(RD_A ip) -> ip) $ ips
             Nothing -> do
-                logError $ "WARNING: DNS lookup for " ++ unpack dom ++ " without result."
+                logWarning conf $ "DNS lookup for " <> dom <> " without result."
                 return []
 
     where
@@ -117,12 +140,12 @@ check :: Config -> [IPv4] -> IO ()
 
 check conf [ip] = do
     rip <- realip
-    logVerbose $ "Current public visible IP of the local machine is " ++ show rip ++ "."
+    logDebug conf $ "Current public visible IP of the local machine is " <> pack (show rip) <> "."
     
     ip' <- if ip == rip 
         then return [ip]
         else do
-            logNormal $ "INFO: real IPv4 address does not match the DNS IPv4 address."
+            logInfo conf $ "Real IPv4 address does not match the DNS IPv4 address."
             sip <- setip conf rip
             case sip of
                 Failure _ -> return [ip]
@@ -131,18 +154,18 @@ check conf [ip] = do
     check conf ip'
 
 check conf _ = do
-    logVerbose $ "No valid single IPv4 address (A record) in DNS." 
+    logDebug conf $ "No valid single IPv4 address (A record) in DNS." 
     
     rip <- realip
-    logVerbose $ "Current public visible IP of the local machine is " ++ show rip ++ "."
+    logDebug conf $ "Current public visible IP of the local machine is " <> pack (show rip) <> "."
     
     sip <- setip conf rip
     ip' <- case sip of
         Failure _ -> do
-            logError $ "WARNING: Failed to update ip address for " ++ unpack dom ++ " to " ++ show rip ++ "."
+            logWarning conf $ "Failed to update ip address for " <> dom <> " to " <> pack (show rip) <> "."
             return []
         Success _ -> do
-            logNormal $ "INFO: Successfully updated ip address for " ++ unpack dom ++ " to " ++ show rip ++ "."
+            logInfo conf $ "Successfully updated ip address for " <> dom <> " to " <> pack (show rip) <> "."
             return [rip]
     threadDelay $ (confSleep conf) * 1000000
     check conf ip'
@@ -161,23 +184,19 @@ setip conf ip = runAttemptT $ do
 -- Main
 --
 
-awsConfiguration :: DynDnsArgs -> IO Aws.Configuration
-awsConfiguration a = do
+awsConfiguration :: DynDnsArgs -> Logger -> IO Aws.Configuration
+awsConfiguration a logger = do
     maybeCreds <- awsCredentials (aws_keys_file a) (aws_key a)
     creds <- case maybeCreds of
-        Nothing -> error "Failed to load AWS Credentials."
+        Nothing -> do logger Error $ "Failed to load AWS Credentials."
+                      error "FATAL ERROR: Failed to load AWS Credentials."
         Just x  -> return x
-    verb <- getVerbosity
     return $ Aws.Configuration
            { Aws.timeInfo    = Aws.Timestamp
            , Aws.credentials = creds
-           , Aws.logger      = awsLogger verb
+           , Aws.logger      = logger
            }
     where
-    awsLogger Quiet  = Aws.defaultLog Aws.Error
-    awsLogger Normal = Aws.defaultLog Aws.Warning
-    awsLogger Loud   = Aws.defaultLog Aws.Debug
-
     awsCredentials file key | file == def && key == def = Aws.loadCredentialsDefault
                             | key == def                = Aws.loadCredentialsFromFile file Aws.credentialsDefaultKey
                             | file == def               = do f <- Aws.credentialsDefaultFile
@@ -187,24 +206,43 @@ awsConfiguration a = do
 main :: IO ()
 main = do
     a <- cmdArgs dyndnsargs
-    awsConf <- awsConfiguration a
-
-    let conf = Config
-             { confHostedZone = Domain . pack . hosted_zone $ a
-             , confDomain = Domain $ (pack (subdomain a)) `append` "." `append` (pack (hosted_zone a))
-             , confTtl = ttl a
-             , confSleep = sleep a
-             , confRetry = retry a
-             , confRetrySleep = retry_sleep a
-             , confAws = awsConf
-             }
-
-    let dom        = dText (confDomain conf)
-        hostedzone = dText (confHostedZone conf)
-
-    logNormal $ "Start DynDNS client for domain " ++ unpack dom ++ " in hosted zone " ++ unpack hostedzone ++ "."
-    dip <- dnsip conf
-
-    logNormal $ "Current IPv4 address (A record) in DNS is " ++ show dip ++ "." 
-    check conf dip
+    
+
+    let execWithLogfile logfile = do
+        hSetBuffering logfile LineBuffering
+
+        verb <- getVerbosity
+        let loglevel = case verb of
+                Quiet  -> Error
+                Normal -> Warning
+                Loud   -> Aws.Debug
+
+        let logger = getLogger logfile loglevel
+        logger Info $ "Startup DynDNS"
+
+        awsConf <- awsConfiguration a logger
+
+        let conf = Config
+                 { confHostedZone = Domain . pack . hosted_zone $ a
+                 , confDomain = Domain $ (pack (subdomain a)) `append` "." `append` (pack (hosted_zone a))
+                 , confTtl = ttl a
+                 , confSleep = sleep a
+                 , confRetry = retry a
+                 , confRetrySleep = retry_sleep a
+                 , confAws = awsConf
+                 , confLog = logger
+                 }
+
+        let dom        = dText (confDomain conf)
+            hostedzone = dText (confHostedZone conf)
+
+        logInfo conf $ "Start DynDNS client for domain " <> dom <> " in hosted zone " <> hostedzone <> "."
+        dip <- dnsip conf
+
+        logInfo conf $ "Current IPv4 address (A record) in DNS is " <> pack (show dip) <> "." 
+        check conf dip
+
+    if log_file a /= def
+       then withFile (log_file a) AppendMode execWithLogfile
+       else execWithLogfile stderr
 

From 9c14e7751559756ef44deb6d2cd8b5a75d05af6d Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sat, 28 Jul 2012 15:24:26 -0700
Subject: [PATCH 47/55] Examples.Route53: Rename DynDNS into r53-dyndns.

--HG--
rename : Examples/Route53/DynDNS.hs => Examples/Route53/R53DynDNS.hs
---
 Examples/Route53/{DynDNS.hs => R53DynDNS.hs} | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)
 rename Examples/Route53/{DynDNS.hs => R53DynDNS.hs} (97%)

diff --git a/Examples/Route53/DynDNS.hs b/Examples/Route53/R53DynDNS.hs
similarity index 97%
rename from Examples/Route53/DynDNS.hs
rename to Examples/Route53/R53DynDNS.hs
index 276365e1..43e36820 100644
--- a/Examples/Route53/DynDNS.hs
+++ b/Examples/Route53/R53DynDNS.hs
@@ -39,7 +39,6 @@ import AttemptT
 
 import System.Console.CmdArgs
 
-
 -- -------------------------------------------------------------------------- --
 -- Command Line Arguments and Configuration
 --
@@ -68,8 +67,8 @@ dyndnsargs = DynDnsArgs
            , subdomain = def &= argPos 1 &= typ "SubDomain"
            }
            &= verbosity
-           &= program "DynDNS"
-           &= summary "DynDNS 0.1, © 2012 AlephCloud System, Inc."
+           &= program "r53-dyndns"
+           &= summary "r53-dyndns 0.1, © 2012 AlephCloud System, Inc."
            &= help "Regulary check and set the A record of the DNS name local machine to the effective public IP address"
            &= details [ "Uses AWS Route53 as DNS server backend."
                       , "An Route53 account is need with a configured hosted zone."
@@ -218,7 +217,7 @@ main = do
                 Loud   -> Aws.Debug
 
         let logger = getLogger logfile loglevel
-        logger Info $ "Startup DynDNS"
+        logger Info $ "Startup r53-dyndns"
 
         awsConf <- awsConfiguration a logger
 
@@ -236,7 +235,7 @@ main = do
         let dom        = dText (confDomain conf)
             hostedzone = dText (confHostedZone conf)
 
-        logInfo conf $ "Start DynDNS client for domain " <> dom <> " in hosted zone " <> hostedzone <> "."
+        logInfo conf $ "Start r53-dyndns client for domain " <> dom <> " in hosted zone " <> hostedzone <> "."
         dip <- dnsip conf
 
         logInfo conf $ "Current IPv4 address (A record) in DNS is " <> pack (show dip) <> "." 

From 731969d1bbf75331873381876d67d45cbcfe2032 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sat, 28 Jul 2012 15:48:43 -0700
Subject: [PATCH 48/55] Examples.Route53: cabalize r53-dyndns.

--HG--
rename : Examples/Route53/R53DynDNS.hs => Examples/Route53/r53-dyndns.hs
---
 Examples/Route53/LICENSE                      | 30 ++++++++++++
 Examples/Route53/README.md                    | 32 ++++++++++++
 Examples/Route53/r53-dyndns.cabal             | 49 +++++++++++++++++++
 .../Route53/{R53DynDNS.hs => r53-dyndns.hs}   |  0
 4 files changed, 111 insertions(+)
 create mode 100644 Examples/Route53/LICENSE
 create mode 100644 Examples/Route53/README.md
 create mode 100644 Examples/Route53/r53-dyndns.cabal
 rename Examples/Route53/{R53DynDNS.hs => r53-dyndns.hs} (100%)

diff --git a/Examples/Route53/LICENSE b/Examples/Route53/LICENSE
new file mode 100644
index 00000000..f0e5fca1
--- /dev/null
+++ b/Examples/Route53/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2012, AlephCloud Systems, Inc.
+
+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 Aristid Breitkreuz 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.
diff --git a/Examples/Route53/README.md b/Examples/Route53/README.md
new file mode 100644
index 00000000..f30457c6
--- /dev/null
+++ b/Examples/Route53/README.md
@@ -0,0 +1,32 @@
+r53-dyndns - AWS Route53 Usage Example
+======================================
+
+The program r53-dyndns is simple dynamic DNS client that uses a AWS Route53
+hosted zone as backend DNS Server. It monitors the publically visible IP
+address of the local machine (through http://api.externalip.net/ip/) and
+maintains the correspodings A record in an AWS Route53 hosted zone to point
+that IP.
+
+Beside of being useful, the purpose of this program is to demonstrate the usage
+of the Haskell AWS Route53 API.
+
+INSTALLATION
+============
+
+```bash
+cabal configure
+cabal build
+cabal install
+```
+
+USAGE
+=====
+
+For usage information type `r53-dyndns --help`.
+
+RUNNING AS A SERVICE
+====================
+
+Edit the file `contrib/r53-dyndns.conf` according to your needs and copy to
+`/etc/init/r53-dyndns.conf`.
+
diff --git a/Examples/Route53/r53-dyndns.cabal b/Examples/Route53/r53-dyndns.cabal
new file mode 100644
index 00000000..bf65a73e
--- /dev/null
+++ b/Examples/Route53/r53-dyndns.cabal
@@ -0,0 +1,49 @@
+Name:                r53-dyndns
+Version:             0.1
+Synopsis:            A dynamic DNS Client for AWS Route53.
+
+Description:         
+    A dynamic DNS client that uses a AWS Route53 Hosted Zone as DNS Server.
+
+Homepage:            https://github.com/alephcloud/aws
+License:             BSD3
+License-file:        LICENSE
+Author:              Lars Kuhtz
+Maintainer:          lars@alephcloud.com
+Copyright:           Copyright (c) 2012 AlephCloud, Inc.
+Category:            Network
+Build-type:          Simple
+Cabal-version:       >=1.8
+
+Executable r53-dyndns
+  
+  Main-is:            r53-dyndns.hs
+  
+  Build-depends:
+    base,
+    transformers                 >= 0.2.2.0,
+    bytestring                   >= 0.9.1.10,
+    dns                          >= 0.3.3,
+    cmdargs                      >= 0.9.5,
+    text                         >= 0.11.2.0,
+    time                         >= 1.4,
+    attempt                      >= 0.4.0,
+    iproute                      >= 1.2.6,
+    http-conduit                 >= 1.5.0.3,
+    old-locale                   >= 1.0.0.4,
+    aws                          >= 0.7
+
+  Other-modules:
+    AttemptT
+    Utils
+  
+  ghc-options: -Wall -O2
+
+source-repository head
+  type:     git
+  location: https://github.com/alephcloud/aws.git 
+
+source-repository this
+  type:     git
+  location: https://github.com/alephcloud/aws.git
+  tag:      tip
diff --git a/Examples/Route53/R53DynDNS.hs b/Examples/Route53/r53-dyndns.hs
similarity index 100%
rename from Examples/Route53/R53DynDNS.hs
rename to Examples/Route53/r53-dyndns.hs

From 53d73f2640e2ae4c93490788f40ad9d82f5fdc9c Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sat, 28 Jul 2012 16:07:07 -0700
Subject: [PATCH 49/55] Examples.Route53: Add missing upstart script for
 r53-dyndns.

---
 Examples/Route53/README.md               |  4 +--
 Examples/Route53/contrib/r53-dyndns.conf | 32 ++++++++++++++++++++++++
 2 files changed, 34 insertions(+), 2 deletions(-)
 create mode 100644 Examples/Route53/contrib/r53-dyndns.conf

diff --git a/Examples/Route53/README.md b/Examples/Route53/README.md
index f30457c6..ecf253c3 100644
--- a/Examples/Route53/README.md
+++ b/Examples/Route53/README.md
@@ -27,6 +27,6 @@ For usage information type `r53-dyndns --help`.
 RUNNING AS A SERVICE
 ====================
 
-Edit the file `contrib/r53-dyndns.conf` according to your needs and copy to
-`/etc/init/r53-dyndns.conf`.
+On recent Ubuntu distributions edit the file `contrib/r53-dyndns.conf`
+according to your needs and copy to `/etc/init/r53-dyndns.conf`.
 
diff --git a/Examples/Route53/contrib/r53-dyndns.conf b/Examples/Route53/contrib/r53-dyndns.conf
new file mode 100644
index 00000000..3ab475ab
--- /dev/null
+++ b/Examples/Route53/contrib/r53-dyndns.conf
@@ -0,0 +1,32 @@
+description "r53-dyndns"
+
+start on runlevel [2345]
+stop on runlevel [06]
+
+script
+
+  # The user and the group of the service daemon process. You may
+  # need to create a new system account or use 'root". Using 'root' 
+  is not discouraged in a production setting.
+  USER="dyndns"
+  GROUP="dyndns"
+
+  # This MUST be an absolute domain name, i.e. it MUST end with a dot
+  export HOSTEDZONE="example.com."
+
+  # This is the subdomain name of the local machine relative to the
+  # hosted zone name.
+  SUBDOMAIN="www"
+
+  # Alternatively, the AWS credentials may be defined using environment variables
+  export AWSKEY="default"
+  export AWSKEYSFILE="/etc/aws-keys"
+  
+  export LOGFILE="/var/log/r53-dyndns.log"
+
+  if [ -f /etc/default/r53-dyndns ]; then . /etc/default/dyndns; fi
+  exec start-stop-daemon --start --quiet --chuid $USER:$GROUP --chdir /tmp --umask 027 \
+    --exec r53-dyndns -- "$HOSTEDZONE" "$SUBDOMAIN" --aws-key="$AWSKEY" --aws-keys-file="$AWSKEYSFILE" --log-file="LOGFILE"; 
+end script
+
+

From ca59ed2e056e8bdc1c7705d8b1387be370aebedb Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Sat, 28 Jul 2012 17:15:55 -0700
Subject: [PATCH 50/55] Examples.Route53: Fix r53-dyndns startup script.

---
 Examples/Route53/contrib/r53-dyndns.conf | 28 +++++++++++++++---------
 1 file changed, 18 insertions(+), 10 deletions(-)

diff --git a/Examples/Route53/contrib/r53-dyndns.conf b/Examples/Route53/contrib/r53-dyndns.conf
index 3ab475ab..e9687de8 100644
--- a/Examples/Route53/contrib/r53-dyndns.conf
+++ b/Examples/Route53/contrib/r53-dyndns.conf
@@ -5,28 +5,36 @@ stop on runlevel [06]
 
 script
 
+  DYNDNSPROG="/usr/local/bin/r53-dyndns"
+
   # The user and the group of the service daemon process. You may
   # need to create a new system account or use 'root". Using 'root' 
-  is not discouraged in a production setting.
-  USER="dyndns"
-  GROUP="dyndns"
+  # is not discouraged in a production setting.
+  DYNDNSUSER="dyndns"
+  DYNDNSGROUP="dyndns"
 
   # This MUST be an absolute domain name, i.e. it MUST end with a dot
-  export HOSTEDZONE="example.com."
+  HOSTEDZONE="example.com."
 
   # This is the subdomain name of the local machine relative to the
   # hosted zone name.
   SUBDOMAIN="www"
 
   # Alternatively, the AWS credentials may be defined using environment variables
-  export AWSKEY="default"
-  export AWSKEYSFILE="/etc/aws-keys"
+  AWSKEY="default"
+  AWSKEYSFILE="/etc/aws-keys"
   
-  export LOGFILE="/var/log/r53-dyndns.log"
+  LOGFILE="/var/log/r53-dyndns.log"
+
+  if [ ! -f "$LOGFILE" ] ; then
+    touch "$LOGFILE"
+    chown $DYNDNSUSER:$DYNDNSGROUP "$LOGFILE"
+    chmod u+w "$LOGFILE"
+  fi
 
-  if [ -f /etc/default/r53-dyndns ]; then . /etc/default/dyndns; fi
-  exec start-stop-daemon --start --quiet --chuid $USER:$GROUP --chdir /tmp --umask 027 \
-    --exec r53-dyndns -- "$HOSTEDZONE" "$SUBDOMAIN" --aws-key="$AWSKEY" --aws-keys-file="$AWSKEYSFILE" --log-file="LOGFILE"; 
+  if [ -f /etc/default/r53-dyndns ]; then . /etc/default/r53-dyndns; fi
+  exec start-stop-daemon --start --quiet --chuid $DYNDNSUSER:$DYNDNSGROUP --chdir /tmp --umask 027 \
+    --exec "$DYNDNSPROG" -- "$HOSTEDZONE" "$SUBDOMAIN" --aws-key="$AWSKEY" --aws-keys-file="$AWSKEYSFILE" --log-file="$LOGFILE"; 
 end script
 
 

From 8178a17b918969ea278b945714b878765108bfcc Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Mon, 30 Jul 2012 15:41:39 -0700
Subject: [PATCH 51/55] Examples.Route53: make subdomain arg of r53-dyndns
 optional

---
 Examples/Route53/contrib/r53-dyndns.conf | 12 +++++++++---
 Examples/Route53/r53-dyndns.hs           | 21 +++++++++++----------
 2 files changed, 20 insertions(+), 13 deletions(-)

diff --git a/Examples/Route53/contrib/r53-dyndns.conf b/Examples/Route53/contrib/r53-dyndns.conf
index e9687de8..8474e426 100644
--- a/Examples/Route53/contrib/r53-dyndns.conf
+++ b/Examples/Route53/contrib/r53-dyndns.conf
@@ -17,8 +17,9 @@ script
   HOSTEDZONE="example.com."
 
   # This is the subdomain name of the local machine relative to the
-  # hosted zone name.
-  SUBDOMAIN="www"
+  # hosted zone name. Leave comment out or leaf black if you want to set
+  # the A record of the domain of the hosted zone itself.
+  # SUBDOMAIN="www"
 
   # Alternatively, the AWS credentials may be defined using environment variables
   AWSKEY="default"
@@ -32,9 +33,14 @@ script
     chmod u+w "$LOGFILE"
   fi
 
+  SUBARG=""
+  if [ -n "$SUBDOMAIN" ] ; then
+      SUBDARG="--subdomain=$SUBDOMAIN"
+  fi
+
   if [ -f /etc/default/r53-dyndns ]; then . /etc/default/r53-dyndns; fi
   exec start-stop-daemon --start --quiet --chuid $DYNDNSUSER:$DYNDNSGROUP --chdir /tmp --umask 027 \
-    --exec "$DYNDNSPROG" -- "$HOSTEDZONE" "$SUBDOMAIN" --aws-key="$AWSKEY" --aws-keys-file="$AWSKEYSFILE" --log-file="$LOGFILE"; 
+    --exec "$DYNDNSPROG" -- "$HOSTEDZONE" $SUBDARG --aws-key="$AWSKEY" --aws-keys-file="$AWSKEYSFILE" --log-file="$LOGFILE"; 
 end script
 
 
diff --git a/Examples/Route53/r53-dyndns.hs b/Examples/Route53/r53-dyndns.hs
index 43e36820..cca6ba1d 100644
--- a/Examples/Route53/r53-dyndns.hs
+++ b/Examples/Route53/r53-dyndns.hs
@@ -4,6 +4,7 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DoAndIfThenElse #-}
 
 module Main where
 
@@ -14,7 +15,7 @@ import System.Locale (defaultTimeLocale)
 
 import Network.HTTP.Conduit (simpleHttp)
 import qualified Data.ByteString.Lazy.Char8 as B8 (unpack)
-import Data.Text (Text, pack, append)
+import Data.Text (Text, pack)
 import Data.Text.IO (hPutStrLn)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Attempt
@@ -63,20 +64,16 @@ dyndnsargs = DynDnsArgs
            , aws_keys_file = def &= help "File with the AWS access keys (default: ~/.aws-keys)" &= typFile
            , aws_key = def &= help "Aws key to use (default: default)" &= typ "STRING"
            , log_file = def &= help "File with where the logs will be written to (default: stderr)" &= typFile
-           , hosted_zone = def &= argPos 0 &= typ "HostedZone"
-           , subdomain = def &= argPos 1 &= typ "SubDomain"
+           , subdomain = def &= help "If present the A record for the subdomain is updated" &= typ "RELATIVE_DOMAIN"
+           , hosted_zone = def &= argPos 0 &= typ "HOSTED_ZONE"
            }
            &= verbosity
            &= program "r53-dyndns"
            &= summary "r53-dyndns 0.1, © 2012 AlephCloud System, Inc."
            &= help "Regulary check and set the A record of the DNS name local machine to the effective public IP address"
-           &= details [ "Uses AWS Route53 as DNS server backend."
-                      , "An Route53 account is need with a configured hosted zone."
-                      , "The subdomain must be choosen for the hosted zone."
-                      , "The Haskell AWS package must be configured with the default access key in place."
+           &= details [ "This dynamic DNS client sses AWS Route53 as DNS server backend. An Route53 account is need with a configured hosted zone. If a subdomain is provided it must be choosen for the hosted zone. The Haskell AWS package must be configured with the default access key in place."
                       , ""
-                      , "You must provide the domain of the hosted zone as absolute DNS name (ends with a dot)"
-                      , "and the subdomain relative to the hosted zone domain."
+                      , "You must provide the domain of the hosted zone as absolute DNS name (ends with a dot) and the subdomain relative to the hosted zone domain."
                       ]
 
 data Config = Config
@@ -221,9 +218,13 @@ main = do
 
         awsConf <- awsConfiguration a logger
 
+        let domain = if subdomain a /= def 
+            then Domain $ pack (subdomain a) <> "." <> pack (hosted_zone a)
+            else  Domain $ pack (hosted_zone a)
+
         let conf = Config
                  { confHostedZone = Domain . pack . hosted_zone $ a
-                 , confDomain = Domain $ (pack (subdomain a)) `append` "." `append` (pack (hosted_zone a))
+                 , confDomain = domain
                  , confTtl = ttl a
                  , confSleep = sleep a
                  , confRetry = retry a

From 3933df0f319f74be34b46fa6b8d6e30905ce13a9 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Mon, 30 Jul 2012 16:11:22 -0700
Subject: [PATCH 52/55] Examples.Route53: fix typo in r53-dyndns startup script

---
 Examples/Route53/contrib/r53-dyndns.conf | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Examples/Route53/contrib/r53-dyndns.conf b/Examples/Route53/contrib/r53-dyndns.conf
index 8474e426..fc59eac9 100644
--- a/Examples/Route53/contrib/r53-dyndns.conf
+++ b/Examples/Route53/contrib/r53-dyndns.conf
@@ -33,7 +33,7 @@ script
     chmod u+w "$LOGFILE"
   fi
 
-  SUBARG=""
+  SUBDARG=""
   if [ -n "$SUBDOMAIN" ] ; then
       SUBDARG="--subdomain=$SUBDOMAIN"
   fi

From be4d821f1dc85e8f5fb3dd094c4bdb47eed2f203 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Wed, 8 Aug 2012 21:45:29 -0700
Subject: [PATCH 53/55] Examples.Route53: fix r53-dyndns to not deleted the
 wrong DNS records.

The fix includes porting all functions that returned IO (Attempt a) to
return MonadIO m => AttemptT m a.
---
 Examples/Route53/AttemptT.hs   |  15 ++++
 Examples/Route53/Utils.hs      | 150 ++++++++++++++++-----------------
 Examples/Route53/r53-dyndns.hs |  79 +++++++++++------
 3 files changed, 140 insertions(+), 104 deletions(-)

diff --git a/Examples/Route53/AttemptT.hs b/Examples/Route53/AttemptT.hs
index 38b7261f..7746fff8 100644
--- a/Examples/Route53/AttemptT.hs
+++ b/Examples/Route53/AttemptT.hs
@@ -3,10 +3,15 @@
 -- ------------------------------------------------------ --
 
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 module AttemptT 
 ( AttemptT(..)
 , mapAttemptT
+, failAttempt
+, succeedAttempt
+, listToAttemptT
 ) where
 
 import Data.Typeable
@@ -69,3 +74,13 @@ instance MonadTrans AttemptT where
 instance (MonadIO m) => MonadIO (AttemptT m) where
     liftIO = lift . liftIO
 
+failAttempt :: (Monad m, Exception e) => e -> AttemptT m a
+failAttempt = AttemptT . return . Failure
+
+succeedAttempt :: (Monad m) => a -> AttemptT m a
+succeedAttempt = return
+
+listToAttemptT :: (Monad m) => [a] -> AttemptT m a
+listToAttemptT [] = failAttempt $ FailException "empty result list"
+listToAttemptT (h:_) = succeedAttempt h
+
diff --git a/Examples/Route53/Utils.hs b/Examples/Route53/Utils.hs
index 3726ffe6..a9f682bb 100644
--- a/Examples/Route53/Utils.hs
+++ b/Examples/Route53/Utils.hs
@@ -11,11 +11,11 @@ module Utils where
 
 import Data.Text                 (Text, pack)
 import Data.List                 (find)
-import Data.Maybe                (fromJust, listToMaybe)
+import Data.Maybe                (fromJust) 
 import Data.Attempt              (Attempt(..))
 
-import Control.Monad             (MonadPlus, mzero, mplus)
-import Control.Applicative       ((<$>))
+import Control.Monad             (MonadPlus, mplus)
+import Control.Applicative       (Applicative, (<$>))
 import Control.Monad.IO.Class    (MonadIO, liftIO)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.List  (runListT)
@@ -73,10 +73,11 @@ makeDefaultRequestAll cfg manager request = do
 makeSingleRequest :: ( Transaction r a
                      , Show r
                      , DefaultServiceConfiguration (ServiceConfiguration r NormalQuery)
+                     , MonadIO m
                      ) 
-                  => Configuration -> r -> IO (Attempt a)
+                  => Configuration -> r -> AttemptT m a
 makeSingleRequest cfg r = do
-    getResult <$> (withManager (\m -> makeDefaultRequest cfg m r))
+     AttemptT . liftIO $ getResult <$> withManager (\m -> makeDefaultRequest cfg m r)
 
 -- | Executes the given iterated request using the default configuration and a fresh 
 --   connection manager. Extracts the enclosed response body and returns it 
@@ -85,17 +86,18 @@ makeSingleRequest cfg r = do
 makeSingleRequestAll :: ( IteratedTransaction r a
                         , Show r
                         , DefaultServiceConfiguration (ServiceConfiguration r NormalQuery)
+                        , MonadIO m
                         ) 
-                     => Configuration -> r -> IO (Attempt a)
+                     => Configuration -> r -> AttemptT m a
 makeSingleRequestAll cfg r = do
-    getResult <$> (withManager (\m -> makeDefaultRequestAll cfg m r))
+    AttemptT . liftIO $ getResult <$> withManager (\m -> makeDefaultRequestAll cfg m r)
 
 -- | Given a Changeid returns the change info status for the corresponding 
 --   request.
 --
-getChangeStatus :: Configuration -> ChangeId -> IO (Attempt ChangeInfoStatus)
+getChangeStatus :: (MonadIO m, Applicative m) => Configuration -> ChangeId -> AttemptT m ChangeInfoStatus
 getChangeStatus cfg changeId = 
-    fmap (ciStatus . gcrChangeInfo) <$> (makeSingleRequest cfg $ getChange changeId)
+    ciStatus . gcrChangeInfo <$> (makeSingleRequest cfg $ getChange changeId)
 
 -- | Extracts the ChangeId from a response using the given function to extract
 --   the ChangeInfo from the response.
@@ -115,25 +117,25 @@ getChangeResourceRecordSetsResponseChangeId response = getChangeId crrsrChangeIn
 
 -- | Get all hosted zones of the user.
 --
-getAllZones :: Configuration -> IO (Attempt HostedZones)
-getAllZones cfg = fmap lhzrHostedZones <$> makeSingleRequestAll cfg listHostedZones
+getAllZones :: (MonadIO m, Applicative m) => Configuration -> AttemptT m HostedZones
+getAllZones cfg = lhzrHostedZones <$> makeSingleRequestAll cfg listHostedZones
 
 -- | Get a hosted zone by its 'HostedZoneId'.
 --
-getZoneById :: Configuration -> HostedZoneId -> IO (Attempt HostedZone)
-getZoneById cfg hzid = fmap ghzrHostedZone <$> makeSingleRequest cfg (getHostedZone hzid)
+getZoneById :: (MonadIO m, Applicative m) => Configuration -> HostedZoneId -> AttemptT m HostedZone
+getZoneById cfg hzid = ghzrHostedZone <$> makeSingleRequest cfg (getHostedZone hzid)
 
 -- | Get a hosted zone by its domain name.
 --   
 --   Results in an error if no hosted zone exists for the given domain name.
 --
-getZoneByName :: Configuration -> Domain -> IO (Attempt HostedZone)
-getZoneByName cfg z = fmap (fromJust . find ((z==) . hzName)) <$> getAllZones cfg
+getZoneByName :: (MonadIO m, Applicative m) => Configuration -> Domain -> AttemptT m HostedZone
+getZoneByName cfg z = fromJust . find ((z==) . hzName) <$> getAllZones cfg
 
 -- | Returns the hosted zone id of the hosted zone for the given domain.
 --
-getZoneIdByName :: Configuration -> Domain -> IO (Attempt HostedZoneId)
-getZoneIdByName cfg hzName = fmap hzId <$> getZoneByName cfg hzName
+getZoneIdByName :: (MonadIO m, Applicative m) => Configuration -> Domain -> AttemptT m HostedZoneId
+getZoneIdByName cfg hzName = hzId <$> getZoneByName cfg hzName
 
 -- -------------------------------------------------------------------------- --
 -- Resource Records Sets
@@ -149,42 +151,39 @@ simpleResourceRecordSet domain rtype ttl value =
 --
 --   Note the 'zName' is the domain name of the hosted zone itself.
 --
-getResourceRecordSetsByHostedZoneName :: Configuration -> Domain -> IO (Attempt ResourceRecordSets)
+getResourceRecordSetsByHostedZoneName :: (MonadIO m, Applicative m) => Configuration -> Domain -> AttemptT m ResourceRecordSets
 getResourceRecordSetsByHostedZoneName cfg zName = do
-    attemptHzid <- getZoneIdByName cfg zName
-    case attemptHzid of
-        Success hzid -> fmap lrrsrResourceRecordSets <$> makeSingleRequestAll cfg (listResourceRecordSets hzid)
-        Failure e -> return $ Failure e
+    hzid <- getZoneIdByName cfg zName
+    lrrsrResourceRecordSets <$> makeSingleRequestAll cfg (listResourceRecordSets hzid)
 
 -- | Lists all resource record sets in the hosted zone with the given hosted 
 --   zone id.
 --
-getResourceRecordSets :: Configuration -> HostedZoneId -> IO (Attempt ResourceRecordSets)
+getResourceRecordSets :: (MonadIO m, Applicative m) => Configuration -> HostedZoneId -> AttemptT m ResourceRecordSets
 getResourceRecordSets cfg hzid = 
-    fmap lrrsrResourceRecordSets <$> makeSingleRequestAll cfg (listResourceRecordSets hzid)
+    lrrsrResourceRecordSets <$> makeSingleRequestAll cfg (listResourceRecordSets hzid)
 
 -- | Lists all resource record sets in the given hosted zone for the given 
 --   domain.
 --
-getResourceRecordSetsByDomain :: Configuration -> HostedZoneId -> Domain -> IO (Attempt ResourceRecordSets)
+getResourceRecordSetsByDomain :: (MonadIO m, Applicative m) => Configuration -> HostedZoneId -> Domain -> AttemptT m ResourceRecordSets
 getResourceRecordSetsByDomain cfg hzid domain = do
-    let req = (listResourceRecordSets hzid) { lrrsName = Just domain }
-    fmap lrrsrResourceRecordSets <$> makeSingleRequestAll cfg req
+    filter ((== domain) . rrsName) <$> getResourceRecordSets cfg hzid
 
 -- | Returns all resource records sets in the hosted zone with the given hosted
 --   zone id for the given DNS record type.
 --
-getResourceRecordSetsByType :: Configuration -> HostedZoneId -> RecordType -> IO (Attempt ResourceRecordSets)
+getResourceRecordSetsByType :: (MonadIO m, Applicative m) => Configuration -> HostedZoneId -> RecordType -> AttemptT m ResourceRecordSets
 getResourceRecordSetsByType cfg hzid dnsRecordType = 
-    fmap (filter ((== dnsRecordType) . rrsType)) <$> getResourceRecordSets cfg hzid
+    filter ((== dnsRecordType) . rrsType) <$> getResourceRecordSets cfg hzid
 
--- | Returns the resource record set of the given type for the given domain in 
---   the given hosted zone.
+-- | Returns all resource records sets in the hosted zone with the given hosted
+--   zone id for the given domain and the given DNS record type.
 --
-getResourceRecords :: Configuration -> HostedZoneId -> Domain -> RecordType -> IO (Attempt (Maybe ResourceRecordSet))
-getResourceRecords cfg cid domain rtype = do
-    let req = ListResourceRecordSets cid (Just domain) (Just rtype) Nothing (Just 1)
-    fmap (listToMaybe . lrrsrResourceRecordSets) <$> (makeSingleRequest cfg $ req)
+getResourceRecordSetsByDomainAndType :: (MonadIO m, Applicative m) => Configuration -> HostedZoneId -> Domain -> RecordType -> AttemptT m ResourceRecordSets
+getResourceRecordSetsByDomainAndType cfg hzid domain dnsRecordType =
+    let f ResourceRecordSet{..} = (rrsType == dnsRecordType) && (rrsName == domain)
+    in  filter f <$> getResourceRecordSets cfg hzid
 
 -- | Updates the resouce records of the given type for the given domain in the 
 --   given hosted zone using the given mapping function.
@@ -193,40 +192,21 @@ getResourceRecords cfg cid domain rtype = do
 --   Aws.Route53 module. In a production environment one would reuse the same 
 --   connection manager and configuration for all involved requests.
 --
-modifyRecords :: Configuration
+modifyRecords :: (MonadIO m, Applicative m)
+              =>Configuration
               -> HostedZoneId 
               -> Domain 
               -> RecordType 
               -> ([ResourceRecord] -> [ResourceRecord]) 
-              -> IO (Attempt (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse))
-modifyRecords cfg cid domain rtype f = runAttemptT $ do
-    -- Fixme fail more gracefully
-    Just (rrs:: ResourceRecordSet) <- AttemptT . liftIO $ getResourceRecords cfg cid domain rtype
+              -> AttemptT m (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse)
+modifyRecords cfg cid domain rtype f = do
+    rrs <- listToAttemptT =<< getResourceRecordSetsByDomainAndType cfg cid domain rtype
     let rrs' = rrs { rrsRecords = f (rrsRecords rrs) }
-    
-    -- Handle errors gracefully. What if we fail in the middle?
-    (r1 :: ChangeResourceRecordSetsResponse) <- AttemptT . liftIO . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)] :: AttemptT IO (ChangeResourceRecordSetsResponse)
-    r2 <- AttemptT . liftIO . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(CREATE, rrs')]
+    -- FIXME: what if we fail in the second call? Should we try to rollback?
+    r1 <- makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)] 
+    r2 <- makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(CREATE, rrs')]
     return (r1, r2)
 
--- | Updates the A record for the given domain in the given zone to the given 
---   IP address (encoded as Text).
---
-setARecord :: Configuration
-           -> HostedZoneId -- ^ Zone ID
-           -> Domain       -- ^ Domain
-           -> Int          -- ^ TTL for the record
-           -> IPv4         -- ^ The new value for the A record, an IPv4 address
-           -> IO (Attempt [ChangeResourceRecordSetsResponse])
-setARecord cfg cid domain ttl ip = runAttemptT $ do
-       maybeRrs <- AttemptT . liftIO $ getResourceRecords cfg cid domain A
-       runListT $ case maybeRrs of
-           Just rrs -> lift $ AttemptT . liftIO . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
-           Nothing -> mzero
-        `mplus` do
-            let rr = simpleResourceRecordSet domain A ttl (pack . show $ ip)
-            lift $ AttemptT . liftIO . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
-
 retry :: (MonadIO m, MonadPlus m) => Int -> Int -> m a -> m a
 retry _ 1 req = req
 retry pause num req | num < 0   = error $ "Illegal argument to retry. Expected positive Int, got " ++ (show num)
@@ -238,20 +218,34 @@ retry pause num req | num < 0   = error $ "Illegal argument to retry. Expected p
 -- | Updates the A record for the given domain in the given zone to the given 
 --   IP address (encoded as Text).
 --
-setARecordRetry :: Configuration
-                -> HostedZoneId -- ^ Zone ID
-                -> Domain       -- ^ Domain
-                -> Int          -- ^ TTL for the record
-                -> IPv4         -- ^ The new value for the A record, an IPv4 address
-                -> IO (Attempt [ChangeResourceRecordSetsResponse])
-setARecordRetry cfg cid domain ttl ip = runAttemptT $ do
-       maybeRrs <- r . AttemptT . liftIO $ getResourceRecords cfg cid domain A
-       runListT $ case maybeRrs of
-           Just rrs -> lift . r . AttemptT . liftIO . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
-           Nothing -> mzero
-        `mplus` do
-            let rr = simpleResourceRecordSet domain A ttl (pack . show $ ip)
-            lift . r . AttemptT . liftIO . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
-
+setARecordRetry :: (MonadIO m, Applicative m)
+                => Int           -- ^ pause between retries (in seconds)
+                -> Int           -- ^ number of retried attempts
+                -> Configuration -- ^ Configuration
+                -> HostedZoneId  -- ^ Zone ID
+                -> Domain        -- ^ Domain
+                -> Int           -- ^ TTL for the record
+                -> IPv4          -- ^ The new value for the A record, an IPv4 address
+                -> AttemptT m [ChangeResourceRecordSetsResponse]
+setARecordRetry pause num cfg cid domain ttl ip = runListT $ lift del `mplus` lift ins
     where
-    r = retry 1 4
+    del = do
+        rrs <- listToAttemptT =<< (ret $ getResourceRecordSetsByDomainAndType cfg cid domain A)
+        ret . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
+    ins = do
+        let rr = simpleResourceRecordSet domain A ttl (pack . show $ ip)
+        ret . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
+    ret = retry pause num
+
+-- | Updates the A record for the given domain in the given zone to the given 
+--   IP address (encoded as Text).
+--
+setARecord :: (MonadIO m, Applicative m)
+           => Configuration
+           -> HostedZoneId -- ^ Zone ID
+           -> Domain       -- ^ Domain
+           -> Int          -- ^ TTL for the record
+           -> IPv4         -- ^ The new value for the A record, an IPv4 address
+           -> AttemptT m [ChangeResourceRecordSetsResponse]
+setARecord cfg cid domain ttl ip = setARecordRetry 0 1 cfg cid domain ttl ip
+
diff --git a/Examples/Route53/r53-dyndns.hs b/Examples/Route53/r53-dyndns.hs
index cca6ba1d..d2bf97dc 100644
--- a/Examples/Route53/r53-dyndns.hs
+++ b/Examples/Route53/r53-dyndns.hs
@@ -15,7 +15,7 @@ import System.Locale (defaultTimeLocale)
 
 import Network.HTTP.Conduit (simpleHttp)
 import qualified Data.ByteString.Lazy.Char8 as B8 (unpack)
-import Data.Text (Text, pack)
+import Data.Text (Text, pack, unpack)
 import Data.Text.IO (hPutStrLn)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Attempt
@@ -27,6 +27,7 @@ import Control.Monad (when)
 import Control.Applicative ((<$>))
 import Control.Concurrent (threadDelay)
 import Control.Monad.IO.Class (liftIO)
+import Control.Exception (finally)
 
 import Network.DNS (lookup, makeResolvSeed, defaultResolvConf, withResolver, TYPE(A), RDATA(RD_A))
 
@@ -138,14 +139,20 @@ check conf [ip] = do
     rip <- realip
     logDebug conf $ "Current public visible IP of the local machine is " <> pack (show rip) <> "."
     
+    let dom = dText (confDomain conf)
+    
     ip' <- if ip == rip 
         then return [ip]
         else do
             logInfo conf $ "Real IPv4 address does not match the DNS IPv4 address."
-            sip <- setip conf rip
+            sip <- runAttemptT $ setip conf rip
             case sip of
-                Failure _ -> return [ip]
-                Success _ -> return [rip]
+                Failure _ -> do
+                    logWarning conf $ "Failed to update ip address for " <> dom <> " to " <> pack (show rip) <> "."
+                    return []
+                Success _ -> do
+                    logInfo conf $ "Successfully updated ip address for " <> dom <> " to " <> pack (show rip) <> "."
+                    return [rip]
     threadDelay $ (confSleep conf) * 1000000
     check conf ip'
 
@@ -155,7 +162,9 @@ check conf _ = do
     rip <- realip
     logDebug conf $ "Current public visible IP of the local machine is " <> pack (show rip) <> "."
     
-    sip <- setip conf rip
+    let dom = dText (confDomain conf)
+    
+    sip <- runAttemptT $ setip conf rip
     ip' <- case sip of
         Failure _ -> do
             logWarning conf $ "Failed to update ip address for " <> dom <> " to " <> pack (show rip) <> "."
@@ -165,16 +174,16 @@ check conf _ = do
             return [rip]
     threadDelay $ (confSleep conf) * 1000000
     check conf ip'
-    where
-    dom = dText (confDomain conf)
 
-setip :: Config -> IPv4 -> IO (Attempt [ChangeResourceRecordSetsResponse])
-setip conf ip = runAttemptT $ do
-    zid <- ret . AttemptT . liftIO $ getZoneIdByName awsconf (confHostedZone conf)
-    ret . AttemptT . liftIO $ setARecordRetry awsconf zid (confDomain conf) (confTtl conf) ip
-    where
-    ret = Utils.retry (confRetrySleep conf) (confRetry conf)
-    awsconf = confAws conf
+setip :: Config -> IPv4 -> AttemptT IO [ChangeResourceRecordSetsResponse]
+setip conf ip = do
+    let pause = confRetrySleep conf
+        rnum = confRetry conf
+        ret = Utils.retry pause rnum
+        awsconf = confAws conf
+    liftIO $ logInfo conf $ "Attempt to set ip address to " <> pack (show ip) <> "."
+    zid <- ret $ getZoneIdByName awsconf (confHostedZone conf)
+    setARecordRetry pause rnum awsconf zid (confDomain conf) (confTtl conf) ip
 
 -- -------------------------------------------------------------------------- --
 -- Main
@@ -200,27 +209,41 @@ awsConfiguration a logger = do
                             | otherwise                 = Aws.loadCredentialsFromFile file (pack key)
 
 main :: IO ()
-main = do
+main = do 
     a <- cmdArgs dyndnsargs
-    
 
     let execWithLogfile logfile = do
         hSetBuffering logfile LineBuffering
 
         verb <- getVerbosity
+
+        -- Initialize the boot logger:
+        let bootLoglevel = case verb of
+                Quiet  -> Error
+                _      -> Aws.Debug
+
+        let bootLogger = getLogger logfile bootLoglevel
+        bootLogger Info "=== Start r53-dyndns ==="
+        
+        -- Initialize the service logger:
         let loglevel = case verb of
                 Quiet  -> Error
                 Normal -> Warning
                 Loud   -> Aws.Debug
 
         let logger = getLogger logfile loglevel
-        logger Info $ "Startup r53-dyndns"
 
-        awsConf <- awsConfiguration a logger
+        -- Configure the service
+        when (let d = (hosted_zone a) in null d || last d /= '.') $ do
+            let err = "The domain name of a AWS Route53 must end with a DOT. Please provide a valid ABSOLUTE DNS domain name as hosted zone name."
+            logger Error err
+            error $ "FATAL ERROR: " <> (unpack err)
+
+        let domain
+                | (subdomain a /= def) = Domain $ pack (subdomain a) <> "." <> pack (hosted_zone a)
+                | otherwise            = Domain $ pack (hosted_zone a)
 
-        let domain = if subdomain a /= def 
-            then Domain $ pack (subdomain a) <> "." <> pack (hosted_zone a)
-            else  Domain $ pack (hosted_zone a)
+        awsConf <- awsConfiguration a logger
 
         let conf = Config
                  { confHostedZone = Domain . pack . hosted_zone $ a
@@ -236,13 +259,17 @@ main = do
         let dom        = dText (confDomain conf)
             hostedzone = dText (confHostedZone conf)
 
+        -- Run the daemon
         logInfo conf $ "Start r53-dyndns client for domain " <> dom <> " in hosted zone " <> hostedzone <> "."
-        dip <- dnsip conf
-
-        logInfo conf $ "Current IPv4 address (A record) in DNS is " <> pack (show dip) <> "." 
-        check conf dip
-
+        daemon conf `finally` bootLogger Info "=== Exit r53-dyndns ==="
+    
     if log_file a /= def
        then withFile (log_file a) AppendMode execWithLogfile
        else execWithLogfile stderr
 
+daemon :: Config -> IO ()
+daemon conf = do
+        dip <- dnsip conf
+        logInfo conf $ "Current IPv4 address (A record) in DNS is " <> pack (show dip) <> "." 
+        check conf dip
+

From 29ccfba7270588b23cf3eaa5780ab58607e184f1 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Thu, 9 Aug 2012 01:25:10 -0700
Subject: [PATCH 54/55] Examples.Route53: more bug fixes and cleanup for
 r53-dyndns.

---
 Examples/Route53/AttemptT.hs   | 15 ++++--
 Examples/Route53/Utils.hs      | 28 ++++++-----
 Examples/Route53/r53-dyndns.hs | 90 +++++++++++++++++++++-------------
 3 files changed, 82 insertions(+), 51 deletions(-)

diff --git a/Examples/Route53/AttemptT.hs b/Examples/Route53/AttemptT.hs
index 7746fff8..b9ae0add 100644
--- a/Examples/Route53/AttemptT.hs
+++ b/Examples/Route53/AttemptT.hs
@@ -5,13 +5,18 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE Rank2Types #-}
 
+-- -------------------------------------------------------------------------- --
+-- | AttemptT - a lazy monad transformer for the 'Attempt' Monad.
+--
 module AttemptT 
 ( AttemptT(..)
 , mapAttemptT
 , failAttempt
 , succeedAttempt
 , listToAttemptT
+, handleFailure
 ) where
 
 import Data.Typeable
@@ -24,9 +29,6 @@ import Control.Monad
 
 import Control.Exception
 
--- -------------------------------------------------------------------------- --
--- AttemptT
-
 newtype AttemptT m a = AttemptT { runAttemptT :: m (Attempt a) }
 
 mapAttemptT :: (m (Attempt a) -> n (Attempt b)) -> AttemptT m a -> AttemptT n b
@@ -84,3 +86,10 @@ listToAttemptT :: (Monad m) => [a] -> AttemptT m a
 listToAttemptT [] = failAttempt $ FailException "empty result list"
 listToAttemptT (h:_) = succeedAttempt h
 
+handleFailure :: (Monad m) => (forall e . Exception e => e -> m b) -> AttemptT m b -> AttemptT m b
+handleFailure f n = AttemptT $ do 
+    a <- runAttemptT n
+    case a of
+        Failure e -> f e >>= return . Success
+        Success s -> return (Success s)
+
diff --git a/Examples/Route53/Utils.hs b/Examples/Route53/Utils.hs
index a9f682bb..2abc857c 100644
--- a/Examples/Route53/Utils.hs
+++ b/Examples/Route53/Utils.hs
@@ -9,16 +9,15 @@
 
 module Utils where
 
-import Data.Text                 (Text, pack)
+import Data.Text                 (Text, pack, unpack)
 import Data.List                 (find)
-import Data.Maybe                (fromJust) 
 import Data.Attempt              (Attempt(..))
 
 import Control.Monad             (MonadPlus, mplus)
 import Control.Applicative       (Applicative, (<$>))
 import Control.Monad.IO.Class    (MonadIO, liftIO)
 import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.List  (runListT)
+import Control.Monad.Trans.List  (runListT, ListT(..))
 import Control.Concurrent        (threadDelay)
 
 import Network.HTTP.Conduit      (Manager, withManager)
@@ -130,7 +129,10 @@ getZoneById cfg hzid = ghzrHostedZone <$> makeSingleRequest cfg (getHostedZone h
 --   Results in an error if no hosted zone exists for the given domain name.
 --
 getZoneByName :: (MonadIO m, Applicative m) => Configuration -> Domain -> AttemptT m HostedZone
-getZoneByName cfg z = fromJust . find ((z==) . hzName) <$> getAllZones cfg
+getZoneByName cfg z = maybe (fail err) return =<< (find ((z==) . hzName) <$> getAllZones cfg)
+    where
+    err = "Hosted zone not found: " ++ unpack (dText z)
+
 
 -- | Returns the hosted zone id of the hosted zone for the given domain.
 --
@@ -198,13 +200,13 @@ modifyRecords :: (MonadIO m, Applicative m)
               -> Domain 
               -> RecordType 
               -> ([ResourceRecord] -> [ResourceRecord]) 
-              -> AttemptT m (ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse)
-modifyRecords cfg cid domain rtype f = do
-    rrs <- listToAttemptT =<< getResourceRecordSetsByDomainAndType cfg cid domain rtype
+              -> AttemptT m [(ChangeResourceRecordSetsResponse, ChangeResourceRecordSetsResponse)]
+modifyRecords cfg cid domain rtype f = runListT $ do
+    rrs <- ListT $ getResourceRecordSetsByDomainAndType cfg cid domain rtype
     let rrs' = rrs { rrsRecords = f (rrsRecords rrs) }
     -- FIXME: what if we fail in the second call? Should we try to rollback?
-    r1 <- makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)] 
-    r2 <- makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(CREATE, rrs')]
+    r1 <- lift . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)] 
+    r2 <- lift . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(CREATE, rrs')]
     return (r1, r2)
 
 retry :: (MonadIO m, MonadPlus m) => Int -> Int -> m a -> m a
@@ -227,14 +229,14 @@ setARecordRetry :: (MonadIO m, Applicative m)
                 -> Int           -- ^ TTL for the record
                 -> IPv4          -- ^ The new value for the A record, an IPv4 address
                 -> AttemptT m [ChangeResourceRecordSetsResponse]
-setARecordRetry pause num cfg cid domain ttl ip = runListT $ lift del `mplus` lift ins
+setARecordRetry pause num cfg cid domain ttl ip = runListT $ del `mplus` ins
     where
     del = do
-        rrs <- listToAttemptT =<< (ret $ getResourceRecordSetsByDomainAndType cfg cid domain A)
-        ret . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
+        rrs <- ListT . ret $ getResourceRecordSetsByDomainAndType cfg cid domain A
+        lift . ret . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(DELETE, rrs)]
     ins = do
         let rr = simpleResourceRecordSet domain A ttl (pack . show $ ip)
-        ret . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
+        lift . ret . makeSingleRequest cfg $ ChangeResourceRecordSets cid Nothing [(CREATE, rr)]
     ret = retry pause num
 
 -- | Updates the A record for the given domain in the given zone to the given 
diff --git a/Examples/Route53/r53-dyndns.hs b/Examples/Route53/r53-dyndns.hs
index d2bf97dc..bc1f627c 100644
--- a/Examples/Route53/r53-dyndns.hs
+++ b/Examples/Route53/r53-dyndns.hs
@@ -88,6 +88,29 @@ data Config = Config
             , confLog :: Logger
             }
 
+awsConfiguration :: DynDnsArgs -> Logger -> IO Aws.Configuration
+awsConfiguration a logger = do
+    maybeCreds <- awsCredentials (aws_keys_file a) (aws_key a)
+    creds <- case maybeCreds of
+        Nothing -> do logger Error $ "Failed to load AWS Credentials."
+                      error "FATAL ERROR: Failed to load AWS Credentials."
+        Just x  -> return x
+    return $ Aws.Configuration
+           { Aws.timeInfo    = Aws.Timestamp
+           , Aws.credentials = creds
+           , Aws.logger      = logger
+           }
+    where
+    awsCredentials file key | file == def && key == def = Aws.loadCredentialsDefault
+                            | key == def                = Aws.loadCredentialsFromFile file Aws.credentialsDefaultKey
+                            | file == def               = do f <- Aws.credentialsDefaultFile
+                                                             Aws.loadCredentialsFromEnvOrFile f (pack key)
+                            | otherwise                 = Aws.loadCredentialsFromFile file (pack key)
+
+-- -------------------------------------------------------------------------- --
+-- Logger
+--
+
 -- We reuse the simple logging approach from the Aws package.
 -- It is not very efficient but for this application we do not need
 -- to worry about performance
@@ -111,12 +134,23 @@ logError :: Config -> Text -> IO ()
 logError conf msg = (confLog conf) Error msg
 
 -- -------------------------------------------------------------------------- --
--- Utils
+-- The r53-dyndns main loop
+--
+
+-- | The domain process retrieves the current IPv4 address for the given domain from
+--   the domain name system and passes that IPv4 address to the 'check' function which
+--   run the main loop.
 --
+daemon :: Config -> IO ()
+daemon conf = do
+    dip <- dnsip conf
+    logInfo conf $ "Current IPv4 address (A record) in DNS is " <> pack (show dip) <> "." 
+    check conf dip
+
 realip :: IO IPv4
 realip = read . B8.unpack <$> simpleHttp  "http://api.externalip.net/ip/"
 
--- TODO Retry depneding on the error. Do not retry on startup.
+-- TODO Retry should depend on the type of the error. Do not retry on startup.
 dnsip :: Config -> IO [IPv4]
 dnsip conf = do
     rs <- makeResolvSeed defaultResolvConf
@@ -147,8 +181,8 @@ check conf [ip] = do
             logInfo conf $ "Real IPv4 address does not match the DNS IPv4 address."
             sip <- runAttemptT $ setip conf rip
             case sip of
-                Failure _ -> do
-                    logWarning conf $ "Failed to update ip address for " <> dom <> " to " <> pack (show rip) <> "."
+                Failure e -> do
+                    logWarning conf $ "Failed to update ip address for " <> dom <> " to " <> pack (show rip) <> ": " <> pack (show e)
                     return []
                 Success _ -> do
                     logInfo conf $ "Successfully updated ip address for " <> dom <> " to " <> pack (show rip) <> "."
@@ -166,8 +200,8 @@ check conf _ = do
     
     sip <- runAttemptT $ setip conf rip
     ip' <- case sip of
-        Failure _ -> do
-            logWarning conf $ "Failed to update ip address for " <> dom <> " to " <> pack (show rip) <> "."
+        Failure e -> do
+            logWarning conf $ "Failed to update ip address for " <> dom <> " to " <> pack (show rip) <> ": " <> pack (show e)
             return []
         Success _ -> do
             logInfo conf $ "Successfully updated ip address for " <> dom <> " to " <> pack (show rip) <> "."
@@ -177,37 +211,29 @@ check conf _ = do
 
 setip :: Config -> IPv4 -> AttemptT IO [ChangeResourceRecordSetsResponse]
 setip conf ip = do
+    liftIO $ logDebug conf $ "Attempt to set ip address to " <> pack (show ip) <> "."
     let pause = confRetrySleep conf
         rnum = confRetry conf
         ret = Utils.retry pause rnum
         awsconf = confAws conf
-    liftIO $ logInfo conf $ "Attempt to set ip address to " <> pack (show ip) <> "."
     zid <- ret $ getZoneIdByName awsconf (confHostedZone conf)
-    setARecordRetry pause rnum awsconf zid (confDomain conf) (confTtl conf) ip
+    liftIO $ logDebug conf $ "Route53 hosted zone: " <> pack (show zid) <> "."
+    response <- setARecordRetry pause rnum awsconf zid (confDomain conf) (confTtl conf) ip
+    return response
 
 -- -------------------------------------------------------------------------- --
 -- Main
 --
 
-awsConfiguration :: DynDnsArgs -> Logger -> IO Aws.Configuration
-awsConfiguration a logger = do
-    maybeCreds <- awsCredentials (aws_keys_file a) (aws_key a)
-    creds <- case maybeCreds of
-        Nothing -> do logger Error $ "Failed to load AWS Credentials."
-                      error "FATAL ERROR: Failed to load AWS Credentials."
-        Just x  -> return x
-    return $ Aws.Configuration
-           { Aws.timeInfo    = Aws.Timestamp
-           , Aws.credentials = creds
-           , Aws.logger      = logger
-           }
-    where
-    awsCredentials file key | file == def && key == def = Aws.loadCredentialsDefault
-                            | key == def                = Aws.loadCredentialsFromFile file Aws.credentialsDefaultKey
-                            | file == def               = do f <- Aws.credentialsDefaultFile
-                                                             Aws.loadCredentialsFromEnvOrFile f (pack key)
-                            | otherwise                 = Aws.loadCredentialsFromFile file (pack key)
-
+-- | The main function 
+--
+--   * parses command line arguments,
+--   * initializes devices for loggin and sets up the logging functions,
+--   * configures the service, and
+--   * runs the daemon.
+--   
+--   For help call the main program with '--help".
+--
 main :: IO ()
 main = do 
     a <- cmdArgs dyndnsargs
@@ -223,7 +249,7 @@ main = do
                 _      -> Aws.Debug
 
         let bootLogger = getLogger logfile bootLoglevel
-        bootLogger Info "=== Start r53-dyndns ==="
+        bootLogger Info "\n=== Start r53-dyndns ==="
         
         -- Initialize the service logger:
         let loglevel = case verb of
@@ -261,15 +287,9 @@ main = do
 
         -- Run the daemon
         logInfo conf $ "Start r53-dyndns client for domain " <> dom <> " in hosted zone " <> hostedzone <> "."
-        daemon conf `finally` bootLogger Info "=== Exit r53-dyndns ==="
+        daemon conf `finally` bootLogger Info "\n=== Exit r53-dyndns ==="
     
     if log_file a /= def
        then withFile (log_file a) AppendMode execWithLogfile
        else execWithLogfile stderr
 
-daemon :: Config -> IO ()
-daemon conf = do
-        dip <- dnsip conf
-        logInfo conf $ "Current IPv4 address (A record) in DNS is " <> pack (show dip) <> "." 
-        check conf dip
-

From 9325a69d7e8625a15d92bceb83750a94935c7f66 Mon Sep 17 00:00:00 2001
From: Lars Kuhtz <lars@kuhtz.eu>
Date: Thu, 9 Aug 2012 01:25:39 -0700
Subject: [PATCH 55/55] Examples.Route53: add TOCO section to README.md

---
 Examples/Route53/README.md | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/Examples/Route53/README.md b/Examples/Route53/README.md
index ecf253c3..1d6b209e 100644
--- a/Examples/Route53/README.md
+++ b/Examples/Route53/README.md
@@ -30,3 +30,12 @@ RUNNING AS A SERVICE
 On recent Ubuntu distributions edit the file `contrib/r53-dyndns.conf`
 according to your needs and copy to `/etc/init/r53-dyndns.conf`.
 
+TODO
+====
+
+*   Add support for setting static IP addresses
+*   More generally, support different ways to determine the IPv4 address.
+*   Better error handling: retry or abort depending on the type of the error.
+*   Make the DNS server for the initial lookup configurable.
+*   Add option looking up the A record in the hosted zone itself.
+