aws 0.19 → 0.20
raw patch · 20 files changed
+140/−91 lines, 20 filesdep +semigroupsdep −conduit-combinatorsdep ~basedep ~conduitdep ~conduit-extra
Dependencies added: semigroups
Dependencies removed: conduit-combinators
Dependency ranges changed: base, conduit, conduit-extra, containers, exceptions, http-conduit, resourcet, time, xml-conduit
Files
- Aws/Aws.hs +2/−2
- Aws/Core.hs +6/−16
- Aws/DynamoDb/Core.hs +18/−10
- Aws/Iam/Core.hs +7/−3
- Aws/S3/Commands/GetObject.hs +3/−2
- Aws/S3/Core.hs +12/−9
- Aws/Ses/Core.hs +10/−4
- Aws/SimpleDb/Core.hs +5/−1
- Aws/Sqs/Core.hs +8/−3
- CHANGELOG.md +8/−0
- Examples/DynamoDb.hs +4/−3
- Examples/GetObject.hs +6/−4
- Examples/GetObjectGoogle.hs +6/−4
- Examples/GetObjectV4.hs +2/−2
- Examples/MultipartTransfer.hs +5/−5
- Examples/NukeBucket.hs +4/−2
- Examples/PutBucketNearLine.hs +4/−3
- README.md +6/−4
- aws.cabal +23/−13
- tests/S3/Main.hs +1/−1
Aws/Aws.hs view
@@ -35,8 +35,8 @@ import Aws.Core import Control.Applicative-import qualified Control.Exception.Lifted as E import Control.Monad+import qualified Control.Monad.Catch as E import Control.Monad.IO.Class import Control.Monad.Trans import Control.Monad.Trans.Resource@@ -91,7 +91,7 @@ baseConfiguration = liftIO $ do cr <- loadCredentialsDefault case cr of- Nothing -> E.throw $ NoCredentialsException "could not locate aws credentials"+ Nothing -> E.throwM $ NoCredentialsException "could not locate aws credentials" Just cr' -> return Configuration { timeInfo = Timestamp , credentials = cr'
Aws/Core.hs view
@@ -115,7 +115,7 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.UTF8 as BU import Data.Char-import Data.Conduit (($$+-))+import Data.Conduit ((.|)) import qualified Data.Conduit as C #if MIN_VERSION_http_conduit(2,2,0) import qualified Data.Conduit.Binary as CB@@ -195,7 +195,7 @@ tellMetadataRef r m = modifyIORef r (`mappend` m) -- | A full HTTP response parser. Takes HTTP status, response headers, and response body.-type HTTPResponseConsumer a = HTTP.Response (C.ResumableSource (ResourceT IO) ByteString)+type HTTPResponseConsumer a = HTTP.Response (C.ConduitM () ByteString (ResourceT IO) ()) -> ResourceT IO a -- | Class for types that AWS HTTP responses can be parsed into.@@ -217,7 +217,7 @@ instance ResponseConsumer r (HTTP.Response L.ByteString) where type ResponseMetadata (HTTP.Response L.ByteString) = () responseConsumer _ _ _ resp = do- bss <- HTTP.responseBody resp $$+- CL.consume+ bss <- C.runConduit $ HTTP.responseBody resp .| CL.consume return resp { HTTP.responseBody = L.fromChunks bss }@@ -875,23 +875,13 @@ instance E.Exception NoCredentialsException -- | A helper to throw an 'HTTP.StatusCodeException'.-throwStatusCodeException :: HTTP.Request- -> HTTP.Response (C.ResumableSource (ResourceT IO) ByteString)- -> ResourceT IO a-#if MIN_VERSION_http_conduit(2,2,0)+throwStatusCodeException :: MonadThrow m => HTTP.Request -> HTTP.Response (C.ConduitM () ByteString m ()) -> m a throwStatusCodeException req resp = do let resp' = fmap (const ()) resp -- only take first 10kB of error response- body <- HTTP.responseBody resp C.$$+- CB.take (10*1024)+ body <- C.runConduit $ HTTP.responseBody resp .| CB.take (10*1024) let sce = HTTP.StatusCodeException resp' (L.toStrict body) throwM $ HTTP.HttpExceptionRequest req sce-#else-throwStatusCodeException _req resp = do- let cookies = HTTP.responseCookieJar resp- headers = HTTP.responseHeaders resp- status = HTTP.responseStatus resp- throwM $ HTTP.StatusCodeException status headers cookies-#endif -- | A specific element (case-insensitive, ignoring namespace - sadly necessary), extracting only the textual contents. elContent :: T.Text -> Cursor -> [T.Text]@@ -939,7 +929,7 @@ -> IORef m -> HTTPResponseConsumer a xmlCursorConsumer parse metadataRef res- = do doc <- HTTP.responseBody res $$+- XML.sinkDoc XML.def+ = do doc <- C.runConduit $ HTTP.responseBody res .| XML.sinkDoc XML.def let cursor = Cu.fromDocument doc let Response metadata x = parse cursor liftIO $ tellMetadataRef metadataRef metadata
Aws/DynamoDb/Core.hs view
@@ -143,7 +143,8 @@ import Data.List import qualified Data.Map as M import Data.Maybe-import Data.Monoid+import Data.Monoid ()+import qualified Data.Semigroup as Sem import Data.Proxy import Data.Scientific import qualified Data.Serialize as Ser@@ -749,9 +750,12 @@ ", x-amz-id-2=" `mappend` fromMaybe "<none>" id2 +instance Sem.Semigroup DdbResponse where+ a <> b = DdbResponse (ddbrCrc a `mplus` ddbrCrc b) (ddbrMsgId a `mplus` ddbrMsgId b)+ instance Monoid DdbResponse where mempty = DdbResponse Nothing Nothing- mappend a b = DdbResponse (ddbrCrc a `mplus` ddbrCrc b) (ddbrMsgId a `mplus` ddbrMsgId b)+ mappend = (Sem.<>) data Region = Region {@@ -856,7 +860,7 @@ -- for some reason AWS doesn't want the x-amz-security-token in the canonical request amzHeaders = [ ("x-amz-date", sigTime)- , ("x-amz-target", dyApiVersion <> target)+ , ("x-amz-target", dyApiVersion Sem.<> target) ] canonicalHeaders = sortBy (compare `on` fst) $ amzHeaders ++@@ -895,7 +899,7 @@ ------------------------------------------------------------------------------- ddbResponseConsumer :: A.FromJSON a => IORef DdbResponse -> HTTPResponseConsumer a ddbResponseConsumer ref resp = do- val <- HTTP.responseBody resp $$+- sinkParser (A.json' <* AttoB.endOfInput)+ val <- runConduit $ HTTP.responseBody resp .| sinkParser (A.json' <* AttoB.endOfInput) case statusCode of 200 -> rSuccess val _ -> rError val@@ -1273,10 +1277,14 @@ in runParser a kf' ks {-# INLINE mplus #-} +instance Sem.Semigroup (Parser a) where+ (<>) = mplus+ {-# INLINE (<>) #-}+ instance Monoid (Parser a) where mempty = fail "mempty" {-# INLINE mempty #-}- mappend = mplus+ mappend = (Sem.<>) {-# INLINE mappend #-} apP :: Parser (a -> b) -> Parser a -> Parser b@@ -1330,8 +1338,8 @@ valErr :: forall a. Typeable a => Tagged a DValue -> String-valErr (Tagged dv) = "Can't convert DynamoDb value " <> show dv <>- " into type " <> (show (typeOf (undefined :: a)))+valErr (Tagged dv) = "Can't convert DynamoDb value " Sem.<> show dv Sem.<>+ " into type " Sem.<> (show (typeOf (undefined :: a))) -- | Convenience combinator for parsing fields from an 'Item' returned@@ -1345,7 +1353,7 @@ -> Parser a getAttr k m = do case M.lookup k m of- Nothing -> fail ("Key " <> T.unpack k <> " not found")+ Nothing -> fail ("Key " Sem.<> T.unpack k Sem.<> " not found") Just dv -> maybe (fail (valErr (Tagged dv :: Tagged a DValue))) return $ fromValue dv @@ -1373,9 +1381,9 @@ -> Parser a parseAttr k m = case M.lookup k m of- Nothing -> fail ("Key " <> T.unpack k <> " not found")+ Nothing -> fail ("Key " Sem.<> T.unpack k Sem.<> " not found") Just (DMap dv) -> either (fail "...") return $ fromItem dv- _ -> fail ("Key " <> T.unpack k <> " is not a map!")+ _ -> fail ("Key " Sem.<> T.unpack k Sem.<> " is not a map!") ------------------------------------------------------------------------------- -- | Parse an 'Item' into target type using the 'FromDynItem'
Aws/Iam/Core.hs view
@@ -28,7 +28,8 @@ import Data.IORef import Data.List (intersperse, sort) import Data.Maybe-import Data.Monoid+import Data.Monoid ()+import qualified Data.Semigroup as Sem import Data.Text (Text) import qualified Data.Text as Text import Data.Time@@ -58,11 +59,14 @@ deriving (Show, Typeable) instance Loggable IamMetadata where- toLogText (IamMetadata r) = "IAM: request ID=" <> fromMaybe "<none>" r+ toLogText (IamMetadata r) = "IAM: request ID=" Sem.<> fromMaybe "<none>" r +instance Sem.Semigroup IamMetadata where+ IamMetadata r1 <> IamMetadata r2 = IamMetadata (r1 `mplus` r2)+ instance Monoid IamMetadata where mempty = IamMetadata Nothing- IamMetadata r1 `mappend` IamMetadata r2 = IamMetadata (r1 `mplus` r2)+ mappend = (Sem.<>) data IamConfiguration qt = IamConfiguration {
Aws/S3/Commands/GetObject.hs view
@@ -11,6 +11,7 @@ import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as L import qualified Data.Conduit as C+import Data.Conduit ((.|)) import qualified Data.Conduit.List as CL import Data.Maybe import qualified Data.Text as T@@ -44,7 +45,7 @@ data GetObjectResponse = GetObjectResponse { gorMetadata :: ObjectMetadata,- gorResponse :: HTTP.Response (C.ResumableSource (ResourceT IO) B8.ByteString)+ gorResponse :: HTTP.Response (C.ConduitM () B8.ByteString (ResourceT IO) ()) } data GetObjectMemoryResponse@@ -96,7 +97,7 @@ instance AsMemoryResponse GetObjectResponse where type MemoryResponse GetObjectResponse = GetObjectMemoryResponse loadToMemory (GetObjectResponse om x) = do- bss <- HTTP.responseBody x C.$$+- CL.consume+ bss <- C.runConduit $ HTTP.responseBody x .| CL.consume return $ GetObjectMemoryResponse om x { HTTP.responseBody = L.fromChunks bss }
Aws/S3/Core.hs view
@@ -7,13 +7,14 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Resource (MonadThrow, throwM) import Data.Char (isAscii, isAlphaNum, toUpper, ord)-import Data.Conduit (($$+-))+import Data.Conduit ((.|)) import Data.Function import Data.Functor ((<$>)) import Data.IORef import Data.List import Data.Maybe import Data.Monoid+import qualified Data.Semigroup as Sem import Control.Applicative ((<|>)) import Data.Time import Data.Typeable@@ -164,9 +165,12 @@ } deriving (Show, Typeable) +instance Sem.Semigroup S3Metadata where+ S3Metadata a1 r1 <> S3Metadata a2 r2 = S3Metadata (a1 `mplus` a2) (r1 `mplus` r2)+ instance Monoid S3Metadata where mempty = S3Metadata Nothing Nothing- S3Metadata a1 r1 `mappend` S3Metadata a2 r2 = S3Metadata (a1 `mplus` a2) (r1 `mplus` r2)+ mappend = (Sem.<>) instance Loggable S3Metadata where toLogText (S3Metadata id2 rid) = "S3: request ID=" `mappend`@@ -231,7 +235,7 @@ | otherwise = x1 : merge (x2 : xs) merge xs = xs - urlEncodedS3QObject = HTTP.urlEncode False <$> s3QObject+ urlEncodedS3QObject = s3UriEncode False <$> s3QObject (host, path) = case s3RequestStyle of PathStyle -> ([Just s3Endpoint], [Just "/", fmap (`B8.snoc` '/') s3QBucket, urlEncodedS3QObject]) BucketStyle -> ([s3QBucket, Just s3Endpoint], [Just "/", urlEncodedS3QObject])@@ -337,7 +341,7 @@ , mconcat . catMaybes $ path -- path , s3RenderQuery False $ sort queryString -- query string ] ++- Map.foldMapWithKey (\a b -> [CI.foldedCase a <> ":" <> b]) canonicalHeaders +++ Map.foldMapWithKey (\a b -> [CI.foldedCase a Sem.<> ":" Sem.<> b]) canonicalHeaders ++ [ "" -- end headers , signedHeaders , amzHeaders Map.! hAmzContentSha256@@ -392,8 +396,8 @@ qmf = if qm then ("?":) else id renderItem :: HTTP.QueryItem -> B8.ByteString- renderItem (k, Just v) = s3UriEncode True k <> "=" <> s3UriEncode True v- renderItem (k, Nothing) = s3UriEncode True k <> "="+ renderItem (k, Just v) = s3UriEncode True k Sem.<> "=" Sem.<> s3UriEncode True v+ renderItem (k, Nothing) = s3UriEncode True k Sem.<> "=" -- | see: <http://docs.aws.amazon.com/general/latest/gr/rande.html#s3_region> s3ExtractRegion :: B.ByteString -> B.ByteString@@ -418,7 +422,6 @@ where inner' resp = do !res <- inner resp- C.closeResumableSource (HTTP.responseBody resp) return res s3BinaryResponseConsumer :: HTTPResponseConsumer a@@ -444,7 +447,7 @@ s3ErrorResponseConsumer :: HTTPResponseConsumer a s3ErrorResponseConsumer resp- = do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def+ = do doc <- C.runConduit $ HTTP.responseBody resp .| XML.sinkDoc XML.def let cursor = Cu.fromDocument doc liftIO $ case parseError cursor of Right err -> throwM err@@ -458,7 +461,7 @@ accessKeyId = listToMaybe $ root $/ elContent "AWSAccessKeyId" bucket = listToMaybe $ root $/ elContent "Bucket" endpointRaw = listToMaybe $ root $/ elContent "Endpoint"- endpoint = T.encodeUtf8 <$> (T.stripPrefix (fromMaybe "" bucket <> ".") =<< endpointRaw)+ endpoint = T.encodeUtf8 <$> (T.stripPrefix (fromMaybe "" bucket Sem.<> ".") =<< endpointRaw) stringToSign = do unprocessed <- listToMaybe $ root $/ elCont "StringToSignBytes" bytes <- mapM readHex2 $ words unprocessed return $ B.pack bytes
Aws/Ses/Core.hs view
@@ -33,6 +33,7 @@ import Data.IORef import Data.Maybe import Data.Monoid+import qualified Data.Semigroup as Sem import Data.Text (Text) import qualified Data.Text.Encoding as TE import Data.Typeable@@ -61,9 +62,12 @@ instance Loggable SesMetadata where toLogText (SesMetadata rid) = "SES: request ID=" `mappend` fromMaybe "<none>" rid +instance Sem.Semigroup SesMetadata where+ SesMetadata r1 <> SesMetadata r2 = SesMetadata (r1 `mplus` r2)+ instance Monoid SesMetadata where mempty = SesMetadata Nothing- SesMetadata r1 `mappend` SesMetadata r2 = SesMetadata (r1 `mplus` r2)+ mappend = (Sem.<>) data SesConfiguration qt = SesConfiguration {@@ -184,11 +188,13 @@ s = Blaze.fromByteString one = 1 :: Int -instance Monoid Destination where- mempty = Destination [] [] []- mappend (Destination a1 a2 a3) (Destination b1 b2 b3) =+instance Sem.Semigroup Destination where+ (Destination a1 a2 a3) <> (Destination b1 b2 b3) = Destination (a1 ++ b1) (a2 ++ b2) (a3 ++ b3) +instance Monoid Destination where+ mempty = Destination [] [] []+ mappend = (Sem.<>) -- | An e-mail address. type EmailAddress = Text
Aws/SimpleDb/Core.hs view
@@ -12,6 +12,7 @@ import Data.List import Data.Maybe import Data.Monoid+import qualified Data.Semigroup as Sem import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Typeable@@ -46,9 +47,12 @@ ", box usage=" `mappend` fromMaybe "<not available>" bu +instance Sem.Semigroup SdbMetadata where+ SdbMetadata r1 b1 <> SdbMetadata r2 b2 = SdbMetadata (r1 `mplus` r2) (b1 `mplus` b2)+ instance Monoid SdbMetadata where mempty = SdbMetadata Nothing Nothing- SdbMetadata r1 b1 `mappend` SdbMetadata r2 b2 = SdbMetadata (r1 `mplus` r2) (b1 `mplus` b2)+ mappend = (Sem.<>) data SdbConfiguration qt = SdbConfiguration {
Aws/Sqs/Core.hs view
@@ -11,11 +11,13 @@ import Control.Monad.Trans.Resource (MonadThrow, throwM) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC-import Data.Conduit (($$+-))+import qualified Data.Conduit+import Data.Conduit ((.|)) import Data.IORef import Data.List import Data.Maybe import Data.Monoid+import qualified Data.Semigroup as Sem import Data.Ord import qualified Data.Text as T import qualified Data.Text.Encoding as T@@ -64,9 +66,12 @@ ", x-amz-id-2=" `mappend` fromMaybe "<none>" id2 +instance Sem.Semigroup SqsMetadata where+ SqsMetadata a1 r1 <> SqsMetadata a2 r2 = SqsMetadata (a1 `mplus` a2) (r1 `mplus` r2)+ instance Monoid SqsMetadata where mempty = SqsMetadata Nothing Nothing- SqsMetadata a1 r1 `mappend` SqsMetadata a2 r2 = SqsMetadata (a1 `mplus` a2) (r1 `mplus` r2)+ mappend = (Sem.<>) data SqsAuthorization = SqsAuthorizationHeader @@ -248,7 +253,7 @@ sqsErrorResponseConsumer :: HTTPResponseConsumer a sqsErrorResponseConsumer resp- = do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def+ = do doc <- Data.Conduit.runConduit $ HTTP.responseBody resp .| XML.sinkDoc XML.def let cursor = Cu.fromDocument doc liftIO $ case parseError cursor of Right err -> throwM err
CHANGELOG.md view
@@ -1,3 +1,11 @@+0.20 series+-----------++- 0.20+ - Update to conduit 1.3 and http-conduit 2.3 (breaking API change+ due to removal of ResumableSource, which was used in public APIs)+ - S3: Fix to V2 string signing+ 0.19 series -----------
Examples/DynamoDb.hs view
@@ -11,12 +11,13 @@ import Control.Concurrent import Control.Monad import Control.Monad.Catch+import Control.Monad.Trans.Resource import Control.Applicative import Data.Conduit import Data.Maybe import qualified Data.Conduit.List as C import qualified Data.Text as T-import Network.HTTP.Conduit (withManager)+import Network.HTTP.Conduit (newManager, tlsManagerSettings) ------------------------------------------------------------------------------- createTableAndWait :: IO ()@@ -119,8 +120,8 @@ echo "Now paginating in increments of 5..." let q0 = (scan "devel-1") { sLimit = Just 5 } - xs <- withManager $ \mgr -> do- awsIteratedList cfg debugServiceConfig mgr q0 $$ C.consume+ mgr <- newManager tlsManagerSettings+ xs <- runResourceT $ awsIteratedList cfg debugServiceConfig mgr q0 $$ C.consume echo ("Pagination returned " ++ show (length xs) ++ " items")
Examples/GetObject.hs view
@@ -2,9 +2,10 @@ import qualified Aws import qualified Aws.S3 as S3-import Data.Conduit (($$+-))+import Control.Monad.Trans.Resource+import Data.Conduit ((.|), runConduit) import Data.Conduit.Binary (sinkFile)-import Network.HTTP.Conduit (withManager, responseBody)+import Network.HTTP.Conduit (newManager, tlsManagerSettings, responseBody) main :: IO () main = do@@ -13,11 +14,12 @@ let s3cfg = Aws.defServiceConfig :: S3.S3Configuration Aws.NormalQuery {- Set up a ResourceT region with an available HTTP manager. -}- withManager $ \mgr -> do+ mgr <- newManager tlsManagerSettings+ runResourceT $ do {- Create a request object with S3.getObject and run the request with pureAws. -} S3.GetObjectResponse { S3.gorResponse = rsp } <- Aws.pureAws cfg s3cfg mgr $ S3.getObject "haskell-aws" "cloud-remote.pdf" {- Save the response to a file. -}- responseBody rsp $$+- sinkFile "cloud-remote.pdf"+ runConduit $ responseBody rsp .| sinkFile "cloud-remote.pdf"
Examples/GetObjectGoogle.hs view
@@ -3,9 +3,10 @@ import qualified Aws import qualified Aws.Core as Aws import qualified Aws.S3 as S3-import Data.Conduit (($$+-))+import Control.Monad.Trans.Resource+import Data.Conduit ((.|), runConduit) import Data.Conduit.Binary (sinkFile)-import Network.HTTP.Conduit (withManager, responseBody)+import Network.HTTP.Conduit (newManager, tlsManagerSettings, responseBody) main :: IO () main = do@@ -13,7 +14,8 @@ let cfg = Aws.Configuration Aws.Timestamp creds (Aws.defaultLog Aws.Debug) Nothing let s3cfg = S3.s3 Aws.HTTP "storage.googleapis.com" False {- Set up a ResourceT region with an available HTTP manager. -}- withManager $ \mgr -> do+ mgr <- newManager tlsManagerSettings+ runResourceT $ do {- Create a request object with S3.getObject and run the request with pureAws. -} S3.GetObjectResponse { S3.gorResponse = rsp } <- Aws.pureAws cfg s3cfg mgr $@@ -21,4 +23,4 @@ S3.getObject "uspto-pair" "applications/05900016.zip" {- Save the response to a file. -}- responseBody rsp $$+- sinkFile "getobject-test.zip"+ runConduit $ responseBody rsp .| sinkFile "getobject-test.zip"
Examples/GetObjectV4.hs view
@@ -4,7 +4,7 @@ import qualified Aws.Core as Aws import qualified Aws.S3 as S3 import Control.Monad.Trans.Resource-import Data.Conduit (($$+-))+import Data.Conduit ((.|), runConduit) import Data.Conduit.Binary (sinkFile) import Network.HTTP.Conduit (newManager, tlsManagerSettings, responseBody) @@ -24,4 +24,4 @@ S3.getObject "haskell-aws" "cloud-remote.pdf" {- Save the response to a file. -}- responseBody rsp $$+- sinkFile "cloud-remote.pdf"+ runConduit $ responseBody rsp .| sinkFile "cloud-remote.pdf"
Examples/MultipartTransfer.hs view
@@ -7,10 +7,10 @@ import Aws.Aws (Configuration (..)) import qualified Aws.S3 as S3 import Control.Applicative ((<$>))-import Data.Conduit (unwrapResumable)+import Control.Monad.Trans.Resource import qualified Data.Text as T import Network.HTTP.Conduit (http, parseUrl, responseBody,- withManager)+ newManager, tlsManagerSettings) import System.Environment (getArgs) main :: IO ()@@ -27,9 +27,9 @@ case args of [sourceUrl,destBucket,destObj] -> do request <- parseUrl sourceUrl- withManager $ \mgr -> do- resumableSource <- responseBody <$> http request mgr- (source, _) <- unwrapResumable resumableSource+ mgr <- newManager tlsManagerSettings+ runResourceT $ do+ source <- responseBody <$> http request mgr let initiator b o = (S3.postInitiateMultipartUpload b o){S3.imuAcl = Just S3.AclPublicRead} S3.multipartUploadWithInitiator cfg{credentials = creds} s3cfg initiator mgr (T.pack destBucket) (T.pack destObj) source (10*1024*1024) _ -> do
Examples/NukeBucket.hs view
@@ -7,7 +7,8 @@ import Data.Text (pack) import Control.Monad ((<=<)) import Control.Monad.IO.Class (liftIO)-import Network.HTTP.Conduit (withManager, responseBody)+import Control.Monad.Trans.Resource+import Network.HTTP.Conduit (newManager, tlsManagerSettings, responseBody) import System.Environment (getArgs) main :: IO ()@@ -19,7 +20,8 @@ let s3cfg = Aws.defServiceConfig :: S3.S3Configuration Aws.NormalQuery {- Set up a ResourceT region with an available HTTP manager. -}- withManager $ \mgr -> do+ mgr <- newManager tlsManagerSettings+ runResourceT $ do let src = Aws.awsIteratedSource cfg s3cfg mgr (S3.getBucket bucket) let deleteObjects [] = return () deleteObjects os =
Examples/PutBucketNearLine.hs view
@@ -5,9 +5,9 @@ import qualified Aws import qualified Aws.Core as Aws import qualified Aws.S3 as S3-import Data.Conduit (($$+-)) import Data.Conduit.Binary (sinkFile)-import Network.HTTP.Conduit (withManager, RequestBody(..))+import Control.Monad.Trans.Resource+import Network.HTTP.Conduit (newManager, tlsManagerSettings, RequestBody(..)) import Control.Monad.IO.Class import Control.Concurrent import System.IO@@ -29,7 +29,8 @@ let s3cfg = S3.s3 Aws.HTTP "storage.googleapis.com" False {- Set up a ResourceT region with an available HTTP manager. -}- withManager $ \mgr -> do+ mgr <- newManager tlsManagerSettings+ runResourceT $ do {- Create a request object with S3.PutBucket and run the request with pureAws. -} rsp <- Aws.pureAws cfg s3cfg mgr $
README.md view
@@ -67,9 +67,10 @@ import qualified Aws import qualified Aws.S3 as S3-import Data.Conduit (($$+-))+import Control.Monad.Trans.Resource+import Data.Conduit ((.|), runConduit) import Data.Conduit.Binary (sinkFile)-import Network.HTTP.Conduit (withManager, responseBody)+import Network.HTTP.Conduit (newManager, tlsManagerSettings, responseBody) main :: IO () main = do@@ -78,14 +79,15 @@ let s3cfg = Aws.defServiceConfig :: S3.S3Configuration Aws.NormalQuery {- Set up a ResourceT region with an available HTTP manager. -}- withManager $ \mgr -> do+ mgr <- newManager tlsManagerSettings+ runResourceT $ do {- Create a request object with S3.getObject and run the request with pureAws. -} S3.GetObjectResponse { S3.gorResponse = rsp } <- Aws.pureAws cfg s3cfg mgr $ S3.getObject "haskell-aws" "cloud-remote.pdf" {- Save the response to a file. -}- responseBody rsp $$+- sinkFile "cloud-remote.pdf"+ runConduit $ responseBody rsp .| sinkFile "cloud-remote.pdf" ``` You can also find this example in the source distribution in the
aws.cabal view
@@ -1,5 +1,5 @@ Name: aws-Version: 0.19+Version: 0.20 Synopsis: Amazon Web Services (AWS) for Haskell Description: Bindings for Amazon Web Services (AWS), with the aim of supporting all AWS services. To see a high level overview of the library, see the README at <https://github.com/aristidb/aws/blob/master/README.md>. Homepage: http://github.com/aristidb/aws@@ -19,7 +19,7 @@ Source-repository this type: git location: https://github.com/aristidb/aws.git- tag: 0.19+ tag: 0.20 Source-repository head type: git@@ -123,22 +123,23 @@ bytestring >= 0.9 && < 0.11, case-insensitive >= 0.2 && < 1.3, cereal >= 0.3 && < 0.6,- conduit >= 1.1 && < 1.3,- conduit-extra >= 1.1 && < 1.3,+ conduit >= 1.3 && < 1.4,+ conduit-extra >= 1.3 && < 1.4, containers >= 0.4, cryptonite >= 0.11, data-default >= 0.5.3 && < 0.8, directory >= 1.0 && < 2.0, filepath >= 1.1 && < 1.5,- http-conduit >= 2.1 && < 2.4,+ http-conduit >= 2.3 && < 2.4, http-types >= 0.7 && < 1.0, lifted-base >= 0.1 && < 0.3, memory, monad-control >= 0.3,+ exceptions >= 0.8 && < 0.11, mtl == 2.*, network == 2.*, old-locale == 1.*,- resourcet >= 1.1 && < 1.2,+ resourcet >= 1.2 && < 1.3, safe >= 0.3 && < 0.4, scientific >= 0.3, tagged >= 0.7 && < 0.9,@@ -148,11 +149,14 @@ unordered-containers >= 0.2, utf8-string >= 0.3 && < 1.1, vector >= 0.10,- xml-conduit >= 1.2 && <2.0+ xml-conduit >= 1.8 && <2.0 if !impl(ghc >= 7.6) Build-depends: ghc-prim + if !impl(ghc >= 8.0)+ Build-depends: semigroups == 0.18.*+ GHC-Options: -Wall Default-Language: Haskell2010@@ -202,7 +206,8 @@ aws, http-conduit, conduit,- conduit-extra+ conduit-extra,+ resourcet Default-Language: Haskell2010 @@ -219,7 +224,8 @@ aws, http-conduit, conduit,- conduit-extra+ conduit-extra,+ resourcet Default-Language: Haskell2010 @@ -257,7 +263,8 @@ http-conduit, conduit, conduit-extra,- text+ text,+ resourcet Default-Language: Haskell2010 @@ -276,7 +283,8 @@ conduit, conduit-extra, text >=0.1,- transformers+ transformers,+ resourcet Default-Language: Haskell2010 @@ -295,7 +303,8 @@ conduit, conduit-extra, text >=0.1,- transformers+ transformers,+ resourcet Default-Language: Haskell2010 @@ -328,6 +337,7 @@ data-default, exceptions, http-conduit,+ resourcet, text, conduit @@ -430,7 +440,7 @@ QuickCheck >= 2.7, aeson >= 0.7, bytestring,- conduit-combinators,+ conduit, errors >= 2.0, lifted-base >= 0.2, monad-control >= 0.3,
tests/S3/Main.hs view
@@ -236,7 +236,7 @@ let Just vid = cmurVersionId resp bs <- runResourceT $ do gor <- pureAws cfg s3cfg mgr (getObject bucket k) { goVersionId = Just vid }- responseBody (gorResponse gor) $$+- sinkLazy+ sealConduitT (responseBody (gorResponse gor)) $$+- sinkLazy assertEqual "data do not match" testStr bs ]