diff --git a/Aws.hs b/Aws.hs index 439541eb..a13c9666 100644 --- a/Aws.hs +++ b/Aws.hs @@ -10,6 +10,7 @@ module Aws , module Aws.Signature , module Aws.Transaction , module Aws.Util +, module Aws.Xml ) where @@ -23,3 +24,4 @@ import Aws.Response import Aws.Signature import Aws.Transaction import Aws.Util +import Aws.Xml diff --git a/Aws/S3/Commands/GetService.hs b/Aws/S3/Commands/GetService.hs index d153622b..79c2eebf 100644 --- a/Aws/S3/Commands/GetService.hs +++ b/Aws/S3/Commands/GetService.hs @@ -10,6 +10,7 @@ import Aws.S3.Query import Aws.S3.Response import Aws.Signature import Aws.Transaction +import Aws.Xml import Control.Monad import Data.Enumerator ((=$)) import Data.Maybe @@ -40,15 +41,15 @@ instance S3ResponseIteratee GetServiceResponse where where parse :: Cu.Cursor -> Either S3Error GetServiceResponse parse el = do - owner <- xmlForce "Missing Owner" <=< sequence $ el $/ Cu.laxElement "Owner" &| parseUserInfo + owner <- s3Force "Missing Owner" <=< sequence $ el $/ Cu.laxElement "Owner" &| parseUserInfo buckets <- sequence $ el $// Cu.laxElement "Bucket" &| parseBucket return GetServiceResponse { gsrOwner = owner, gsrBuckets = buckets } parseBucket :: Cu.Cursor -> Either S3Error BucketInfo parseBucket el = do - name <- xmlForce "Missing owner Name" $ el $/ Cu.laxElement "Name" &/ Cu.content &| T.unpack - creationDateString <- xmlForce "Missing owner CreationDate" $ el $/ Cu.laxElement "CreationDate" &/ Cu.content &| T.unpack - creationDate <- xmlForce "Invalid CreationDate" . maybeToList $ parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" creationDateString + name <- s3Force "Missing owner Name" $ el $/ elCont "Name" + creationDateString <- s3Force "Missing owner CreationDate" $ el $/ elCont "CreationDate" + creationDate <- s3Force "Invalid CreationDate" . maybeToList $ parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" creationDateString return BucketInfo { bucketName = name, bucketCreationDate = creationDate } instance SignQuery GetService where diff --git a/Aws/S3/Error.hs b/Aws/S3/Error.hs index e28c635d..f2922e8f 100644 --- a/Aws/S3/Error.hs +++ b/Aws/S3/Error.hs @@ -4,12 +4,11 @@ where import Aws.Metadata import Aws.S3.Metadata -import Control.Monad.Error.Class +import Aws.Xml import Data.Typeable -import Text.XML.Monad -import qualified Control.Exception as C -import qualified Data.ByteString as B -import qualified Network.HTTP.Types as HTTP +import qualified Control.Exception as C +import qualified Data.ByteString as B +import qualified Network.HTTP.Types as HTTP type ErrorCode = String @@ -39,6 +38,5 @@ instance WithMetadata S3Error S3Metadata where setMetadata m a@S3Error{} = a { s3ErrorMetadata = Just m } setMetadata m a@S3XmlError{} = a { s3XmlErrorMetadata = Just m } -xmlForce :: String -> [a] -> Either S3Error a -xmlForce msg [] = Left (S3XmlError msg Nothing) -xmlForce _ (x:_) = Right x +s3Force :: String -> [a] -> Either S3Error a +s3Force msg = force (S3XmlError msg Nothing) diff --git a/Aws/S3/Model.hs b/Aws/S3/Model.hs index 52b5dfd4..f3808cf6 100644 --- a/Aws/S3/Model.hs +++ b/Aws/S3/Model.hs @@ -3,6 +3,7 @@ module Aws.S3.Model where import Aws.S3.Error +import Aws.Xml import Data.Maybe import Data.Time import Text.XML.Enumerator.Cursor (($/), (&/), (&|)) @@ -19,8 +20,8 @@ data UserInfo deriving (Show) parseUserInfo :: Cu.Cursor -> Either S3Error UserInfo -parseUserInfo el = do id_ <- xmlForce "Missing user ID" $ el $/ Cu.laxElement "ID" &/ Cu.content &| T.unpack - displayName <- xmlForce "Missing user DisplayName" $ el $/ Cu.laxElement "DisplayName" &/ Cu.content &| T.unpack +parseUserInfo el = do id_ <- s3Force "Missing user ID" $ el $/ elCont "ID" + displayName <- s3Force "Missing user DisplayName" $ el $/ elCont "DisplayName" return UserInfo { userId = id_, userDisplayName = displayName } type Bucket = String diff --git a/Aws/S3/Response.hs b/Aws/S3/Response.hs index 3042260f..e79ae473 100644 --- a/Aws/S3/Response.hs +++ b/Aws/S3/Response.hs @@ -7,6 +7,7 @@ import Aws.Response import Aws.S3.Error import Aws.S3.Metadata import Aws.Util +import Aws.Xml import Control.Applicative import Control.Monad.Compose.Class import Data.Char @@ -59,8 +60,8 @@ s3ErrorResponseIteratee status headers = do doc <- XML.parseBytes XML.decodeEnti Right err -> En.throwError err where parseError :: Cu.Cursor -> Either S3Error S3Error - parseError root = do code <- xmlForce "Missing error Code" $ root $/ elCont "Code" - message <- xmlForce "Missing error Message" $ root $/ elCont "Message" + parseError root = do code <- s3Force "Missing error Code" $ root $/ elCont "Code" + message <- s3Force "Missing error Message" $ root $/ elCont "Message" let resource = listToMaybe $ root $/ elCont "Resource" hostId = listToMaybe $ root $/ elCont "HostId" accessKeyId = listToMaybe $ root $/ elCont "AWSAccessKeyId" @@ -77,9 +78,7 @@ s3ErrorResponseIteratee status headers = do doc <- XML.parseBytes XML.decodeEnti , s3ErrorStringToSign = stringToSign , s3ErrorMetadata = Nothing } - where elCont el = Cu.laxElement el &/ Cu.content &| T.unpack - - readHex2 :: [Char] -> Maybe Word8 + where readHex2 :: [Char] -> Maybe Word8 readHex2 [c1,c2] = do n1 <- readHex1 c1 n2 <- readHex1 c2 return . fromIntegral $ n1 * 16 + n2 diff --git a/Aws/Xml.hs b/Aws/Xml.hs new file mode 100644 index 00000000..ffcbfc3b --- /dev/null +++ b/Aws/Xml.hs @@ -0,0 +1,14 @@ +module Aws.Xml +where + +import Text.XML.Enumerator.Cursor +import qualified Data.Text as T +import qualified Text.XML.Enumerator.Parse as XML +import qualified Text.XML.Enumerator.Resolved as XML + +elCont :: T.Text -> Cursor -> [String] +elCont name = laxElement name &/ content &| T.unpack + +force :: e -> [a] -> Either e a +force e [] = Left e +force _ (x:_) = Right x diff --git a/aws.cabal b/aws.cabal index 2eb9462d..78ca3e87 100644 --- a/aws.cabal +++ b/aws.cabal @@ -86,7 +86,8 @@ Library Aws.SimpleDb.Query, Aws.SimpleDb.Response, Aws.Transaction, - Aws.Util + Aws.Util, + Aws.Xml -- Packages needed in order to build this package. Build-depends: