aws 0.0.1 → 0.0.2
raw patch · 7 files changed
+100/−40 lines, 7 filesdep −wai
Dependencies removed: wai
Files
- Aws/S3/Error.hs +20/−3
- Aws/S3/Query.hs +4/−5
- Aws/S3/Response.hs +55/−9
- Aws/Signature.hs +8/−6
- Aws/SimpleDb/Error.hs +2/−1
- Aws/SimpleDb/Response.hs +9/−13
- aws.cabal +2/−3
Aws/S3/Error.hs view
@@ -8,9 +8,23 @@ 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 +type ErrorCode = String+ data S3Error- = S3XmlError { + = S3Error {+ s3StatusCode :: HTTP.Status+ , s3ErrorCode :: ErrorCode -- Error/Code+ , s3ErrorMessage :: String -- Error/Message+ , s3ErrorResource :: Maybe String -- Error/Resource+ , s3ErrorHostId :: Maybe String -- Error/HostId+ , s3ErrorAccessKeyId :: Maybe String -- Error/AWSAccessKeyId+ , s3ErrorStringToSign :: Maybe B.ByteString -- Error/StringToSignBytes (hexadecimal encoding)+ , s3ErrorMetadata :: Maybe S3Metadata+ }+ | S3XmlError { fromS3XmlError :: XmlError , s3XmlErrorMetadata :: Maybe S3Metadata }@@ -26,5 +40,8 @@ strMsg = fromXmlError . strMsg instance WithMetadata S3Error S3Metadata where- getMetadata = s3XmlErrorMetadata- setMetadata m a = a { s3XmlErrorMetadata = Just m }+ getMetadata S3Error { s3ErrorMetadata = m } = m+ getMetadata S3XmlError { s3XmlErrorMetadata = m } = m++ setMetadata m a@S3Error{} = a { s3ErrorMetadata = Just m }+ setMetadata m a@S3XmlError{} = a { s3XmlErrorMetadata = Just m }
Aws/S3/Query.hs view
@@ -14,11 +14,10 @@ import Data.Maybe import Data.Monoid import Data.Time-import qualified Blaze.ByteString.Builder as Blaze-import qualified Data.Ascii as A-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L-import qualified Network.HTTP.Types as HTTP+import qualified Data.Ascii as A+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Network.HTTP.Types as HTTP data S3Query = S3Query {
Aws/S3/Response.hs view
@@ -8,13 +8,17 @@ import Aws.S3.Metadata import Aws.Util import Control.Applicative-import Control.Exception+import Control.Monad.Compose.Class+import Data.Char import Data.Maybe-import qualified Data.Ascii as A-import qualified Data.ByteString as B-import qualified Data.Enumerator as En-import qualified Network.HTTP.Enumerator as HTTP-import qualified Network.HTTP.Types as HTTP+import Data.Word+import Text.XML.Monad+import qualified Data.Ascii as A+import qualified Data.ByteString as B+import qualified Data.Enumerator as En+import qualified Network.HTTP.Enumerator as HTTPE+import qualified Network.HTTP.Types as HTTP+import qualified Text.XML.Light as XL data S3Response a = S3Response {@@ -30,7 +34,9 @@ let amzId2 = headerString "x-amz-id-2" let requestId = headerString "x-amz-request-id" - specific <- tryError $ s3ResponseIteratee status headers+ specific <- tryError $ if status >= HTTP.status400+ then s3ErrorResponseIteratee status headers+ else s3ResponseIteratee status headers case specific of Left (err :: S3Error) -> En.throwError (setMetadata m err)@@ -41,8 +47,48 @@ , s3RequestId = requestId } +s3ErrorResponseIteratee :: HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a+s3ErrorResponseIteratee status headers = xmlResponseIteratee (e <<< parseXmlResponse) status headers+ where + e :: Xml S3Error XL.Element a+ e = do+ err <- e' <<< findElementNameUI "Error"+ raise err+ + e' = do+ code <- strContent <<< findElementNameUI "Code"+ message <- strContent <<< findElementNameUI "Message"+ resource <- tryMaybe $ strContent <<< findElementNameUI "Resource"+ hostId <- tryMaybe $ strContent <<< findElementNameUI "HostId"+ accessKeyId <- tryMaybe $ strContent <<< findElementNameUI "AWSAccessKeyId"+ stringToSignUnprocessed <- tryMaybe $ strContent <<< findElementNameUI "StringToSignBytes"+ let stringToSign = B.pack <$> (sequence . map readHex2 . words =<< stringToSignUnprocessed)+ + return S3Error { + s3StatusCode = status+ , s3ErrorCode = code+ , s3ErrorMessage = message+ , s3ErrorResource = resource+ , s3ErrorHostId = hostId+ , s3ErrorAccessKeyId = accessKeyId+ , s3ErrorStringToSign = stringToSign+ , s3ErrorMetadata = Nothing+ }++ readHex2 :: [Char] -> Maybe Word8+ readHex2 [c1,c2] = do+ n1 <- readHex1 c1+ n2 <- readHex1 c2+ return . fromIntegral $ n1 * 16 + n2+ readHex2 _ = Nothing+ + readHex1 c | c >= '0' && c <= '9' = Just $ ord c - ord '0'+ | c >= 'A' && c <= 'F' = Just $ ord c - ord 'A' + 10+ | c >= 'a' && c <= 'f' = Just $ ord c - ord 'a' + 10+ readHex1 _ = Nothing+ class S3ResponseIteratee a where s3ResponseIteratee :: HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a -instance S3ResponseIteratee HTTP.Response where- s3ResponseIteratee = HTTP.lbsIter+instance S3ResponseIteratee HTTPE.Response where+ s3ResponseIteratee = HTTPE.lbsIter
Aws/Signature.hs view
@@ -5,12 +5,13 @@ import Aws.Credentials import Aws.Query import Data.Time-import qualified Crypto.HMAC as HMAC-import qualified Crypto.Hash.SHA1 as SHA1-import qualified Crypto.Hash.SHA256 as SHA256-import qualified Data.ByteString as B-import qualified Data.ByteString.Base64 as Base64-import qualified Data.Serialize as Serialize+import qualified Crypto.Classes as Crypto+import qualified Crypto.HMAC as HMAC+import qualified Crypto.Hash.SHA1 as SHA1+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Data.ByteString as B+import qualified Data.ByteString.Base64 as Base64+import qualified Data.Serialize as Serialize data TimeInfo = Timestamp@@ -64,5 +65,6 @@ sig = case ah of HmacSHA1 -> computeSig (undefined :: SHA1.SHA1) HmacSHA256 -> computeSig (undefined :: SHA256.SHA256)+ computeSig :: Crypto.Hash c d => d -> B.ByteString computeSig t = Serialize.encode (HMAC.hmac' key input `asTypeOf` t) key = HMAC.MacKey (secretAccessKey cr)
Aws/SimpleDb/Error.hs view
@@ -8,12 +8,13 @@ import Data.Typeable import Text.XML.Monad import qualified Control.Exception as C+import qualified Network.HTTP.Types as HTTP type ErrorCode = String data SdbError = SdbError {- sdbStatusCode :: Int+ sdbStatusCode :: HTTP.Status , sdbErrorCode :: ErrorCode , sdbErrorMessage :: String , sdbErrorMetadata :: Maybe SdbMetadata
Aws/SimpleDb/Response.hs view
@@ -9,12 +9,10 @@ import Control.Applicative import Control.Arrow ((+++)) import Control.Monad.Compose.Class-import Control.Monad.Reader.Class import Data.Char import Text.XML.Monad import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.UTF8 as BU-import qualified Network.HTTP.Enumerator as HTTP import qualified Text.XML.Light as XL data SdbResponse a@@ -28,27 +26,25 @@ fmap f (SdbResponse a m) = SdbResponse (f a) m instance (SdbFromResponse a) => ResponseIteratee (SdbResponse a) where- responseIteratee = xmlResponseIteratee $ do- status <- asks HTTP.statusCode- fromXml status <<< parseXmlResponse- where fromXml :: SdbFromResponse a => Int -> Xml SdbError XL.Element (SdbResponse a)- fromXml status = do+ responseIteratee status headers = xmlResponseIteratee (fromXml <<< parseXmlResponse) status headers+ where fromXml :: SdbFromResponse a => Xml SdbError XL.Element (SdbResponse a)+ fromXml = do requestId' <- strContent <<< findElementNameUI "RequestID" boxUsage' <- tryMaybe $ strContent <<< findElementNameUI "BoxUsage" let metadata = SdbMetadata requestId' boxUsage'- innerTry <- try $ fromXmlInner status+ innerTry <- try $ fromXmlInner inner <- case innerTry of Left err -> raise $ setMetadata metadata err Right response -> return response return $ SdbResponse inner metadata- fromXmlInner :: SdbFromResponse a => Int -> Xml SdbError XL.Element a- fromXmlInner status = do+ fromXmlInner :: SdbFromResponse a => Xml SdbError XL.Element a+ fromXmlInner = do xmlError <- tryMaybe $ findElementNameUI "Error" case xmlError of- Just err -> mapply (fromError status) err+ Just err -> mapply fromError err Nothing -> sdbFromResponse- fromError :: Int -> Xml SdbError XL.Element a- fromError status = do+ fromError :: Xml SdbError XL.Element a+ fromError = do errCode <- strContent <<< findElementNameUI "Code" errMessage <- strContent <<< findElementNameUI "Message" raise $ SdbError status errCode errMessage Nothing
aws.cabal view
@@ -6,7 +6,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.0.1+Version: 0.0.2 -- A short (one-line) description of the package. Synopsis: Amazon Web Services (AWS) for Haskell@@ -33,7 +33,7 @@ -- A copyright notice. Copyright: Copyright (C) 2010 Aristid Breitkreuz -Category: Web+Category: Network, Web Build-type: Simple @@ -111,7 +111,6 @@ transformers >=0.2.2.0 && <0.3, transformers-compose ==0.1.*, utf8-string ==0.3.*,- wai >=0.3.1 && <0.4, xml ==1.3.*, xml-monad >=0.5 && <0.6