minio-hs 0.3.2 → 1.0.0

raw patch · 35 files changed

+2944/−447 lines, 35 filesdep +unliftiodep +unliftio-coredep −asyncdep −conduit-combinatorsdep −lifted-asyncPVP ok

version bump matches the API change (PVP)

Dependencies added: unliftio, unliftio-core

Dependencies removed: async, conduit-combinators, lifted-async, lifted-base, monad-control, transformers-base, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +77/−0
• CONTRIBUTING.md +8/−0
• README.md +113/−0
• docs/API.md +924/−0
• examples/BucketExists.hs +43/−0
• examples/CopyObject.hs +56/−0
• examples/FileUploader.hs +74/−0
• examples/GetObject.hs +45/−0
• examples/HeadObject.hs +43/−0
• examples/ListBuckets.hs +41/−0
• examples/ListIncompleteUploads.hs +54/−0
• examples/ListObjects.hs +50/−0
• examples/Makebucket.hs +40/−0
• examples/PresignedGetObject.hs +83/−0
• examples/PresignedPostPolicy.hs +84/−0
• examples/PresignedPutObject.hs +59/−0
• examples/PutObject.hs +53/−0
• examples/RemoveIncompleteUpload.hs +43/−0
• examples/RemoveObject.hs +36/−0
• examples/Removebucket.hs +38/−0
• minio-hs.cabal +27/−33
• src/Network/Minio.hs +71/−29
• src/Network/Minio/API.hs +4/−5
• src/Network/Minio/CopyObject.hs +93/−0
• src/Network/Minio/Data.hs +178/−101
• src/Network/Minio/Data/Crypto.hs +13/−12
• src/Network/Minio/ListOps.hs +13/−11
• src/Network/Minio/PutObject.hs +51/−126
• src/Network/Minio/S3API.hs +102/−24
• src/Network/Minio/Utils.hs +97/−41
• src/Network/Minio/XmlParser.hs +7/−3
• stack.yaml +66/−0
• test/LiveServer.hs +253/−60
• test/Network/Minio/XmlParser/Test.hs +3/−2
• test/Spec.hs +2/−0

@@ -0,0 +1,77 @@+Changelog+==========++## Version 1.0.0++This new release changes the following APIs to add new capabilities:++* Copy Object API now supports more options for source and destination (#73)+* get/put Object functions now support a wider set of options via a+  separate settings parameter (#71, #72)+* getBucketPolicy and setBucketPolicy APIs are added (#82)+* The library now uses UnliftIO (#83)++## Version 0.3.2++This release brings the following changes:++* Add `removeIncompleteUpload` API (#49)+* Add presigned operations APIs (#56)+* Add presigned Post Policy API (#58)+* Skip SHA256 checksum header for secure connections (#65)+* Remove resuming capability in PutObject (#67)+* Add ListObjectsV1 API support (#66)+* Add Bucket Notification APIs (#59)+* Reverse #54 - tests fix.++## Version 0.3.1++This is a bug-fix release:++* Fix concurrency bug in `limitedMapConcurrently` (#53)+* Fix tests related to listing incomplete uploads to accommodate Minio+  server's changed behaviour to not list incomplete uploads. Note that+  running these tests against AWS S3 are expected to fail. (#54)++## Version 0.3.0++This release includes a breaking change:++Users of the library need not call `runResourceT` explicitly after+calling `runMinio`. This is now done, within the `runMinio` call+making usage a bit simpler.++Other changes:++* Export ListUploadsResult and ListObjectsResult (#48)+  * Also take max-keys as an argument for listObjects and max-uploads+    for listIncompleteUploads.+* Add bucket and object name validation (#45)+* Add bucketExists and headBucket APIs (#42)++## Version 0.2.1++* Update dependencies, and switch to Stackage LTS 8.5++## Version 0.2.0++This is an interim release which brings some new features. However,+the library is not complete and APIs may change.++* Remove `listIncompleteParts` API and augment `listIncompleteUploads`+  API with information about aggregate size of parts uploaded.+* Refactors error types and simpler error throwing/handling behaviour.+* Add `removeObject` API to delete objects from the service.+* Rename `Network.Minio.getService` to `Network.Minio.listBuckets`.+* Add `docs/API.md` and examples directory with comprehensive+  documentation and examples of high-level APIs exported by the+  library.+* Rename types:+  * Rename PartInfo -> PartTuple+  * Rename ListPartInfo -> ObjectPartInfo+* Add a bucket region cache to avoid locating a bucket's region for+  every operation (mainly useful for AWS S3).+* Add new `copyObject` API to perform server side object copying.+* Rename `putObjectFromSource` API as `putObject`.+* Separate out tests into two suites, one with a live-server and the+  other without any external dependencies.

@@ -0,0 +1,8 @@+# Contributors Guide+* Fork minio-hs.+* Create your feature branch (`$ git checkout -b my-new-feature`).+* Hack, hack, hack...+* Commit your changes (`$ git commit -am 'Add some feature'`).+* Do test build (`$ stack test`).+* Push to the branch (`$ git push origin my-new-feature`).+* Create new Pull Request.

@@ -0,0 +1,113 @@+# Minio Client SDK for Haskell [![Build Status](https://travis-ci.org/minio/minio-hs.svg?branch=master)](https://travis-ci.org/minio/minio-hs)[![Hackage](https://img.shields.io/hackage/v/minio-hs.svg)](https://hackage.haskell.org/package/minio-hs)[![Slack](https://slack.minio.io/slack?type=svg)](https://slack.minio.io)++The Minio Haskell Client SDK provides simple APIs to access [Minio](https://minio.io) and Amazon S3 compatible object storage server.++## Minimum Requirements++- The Haskell [stack](https://docs.haskellstack.org/en/stable/README/)++## Installation++```sh+git clone https://github.com/minio/minio-hs.git++cd minio-hs/++stack install+```++Tests can be run with:++```sh++stack test++```++A section of the tests use the remote Minio Play server at+`https://play.minio.io:9000` by default. For library development,+using this remote server maybe slow. To run the tests against a+locally running Minio live server at `http://localhost:9000`, just set+the environment `MINIO_LOCAL` to any value (and unset it to switch+back to Play).++Documentation can be locally built with:++```sh++stack haddock++```++## Quick-Start Example - File Uploader++### FileUploader.hs+``` haskell+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs --package optparse-applicative --package filepath++{-# Language OverloadedStrings, ScopedTypeVariables #-}+import Network.Minio++import Control.Monad.Catch (catchIf)+import Control.Monad.IO.Class (liftIO)+import Data.Monoid ((<>))+import Data.Text (pack)+import Options.Applicative+import Prelude+import System.FilePath.Posix++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++-- optparse-applicative package based command-line parsing.+fileNameArgs :: Parser FilePath+fileNameArgs = strArgument+               (metavar "FILENAME"+                <> help "Name of file to upload to AWS S3 or a Minio server")++cmdParser = info+            (helper <*> fileNameArgs)+            (fullDesc+             <> progDesc "FileUploader"+             <> header+             "FileUploader - a simple file-uploader program using minio-hs")++ignoreMinioErr :: ServiceErr -> Minio ()+ignoreMinioErr = return . const ()+++main :: IO ()+main = do+  let bucket = "my-bucket"++  -- Parse command line argument, namely --filename.+  filepath <- execParser cmdParser+  let object = pack $ takeBaseName filepath++  res <- runMinio minioPlayCI $ do+    -- Make a bucket; catch bucket already exists exception if thrown.+    catchIf (== BucketAlreadyOwnedByYou) (makeBucket bucket Nothing) ignoreMinioErr++    -- Upload filepath to bucket; object is derived from filepath.+    fPutObject bucket object filepath++  case res of+    Left e -> putStrLn $ "file upload failed due to " ++ (show e)+    Right () -> putStrLn "file upload succeeded."+```++### Run FileUploader++``` sh+./FileUploader.hs "path/to/my/file"++```++## Contribute++[Contributors Guide](https://github.com/minio/minio-hs/blob/master/CONTRIBUTING.md)

@@ -0,0 +1,924 @@+# Minio Haskell SDK API Reference++## Initialize Minio Client object.++### Minio - for public Play server++```haskell+minioPlayCI :: ConnectInfo+minioPlayCI++```++### AWS S3++```haskell+awsCI :: ConnectInfo+awsCI { connectAccesskey = "your-access-key"+      , connectSecretkey = "your-secret-key"+      }++```++|Bucket operations|Object Operations|Presigned Operations|+|:---|:---|:---|+|[`listBuckets`](#listBuckets) |[`getObject`](#getObject)|[`presignedGetObjectUrl`](#presignedGetObjectUrl)|+|[`makeBucket`](#makeBucket)|[`putObject`](#putObject)|[`presignedPutObjectUrl`](#presignedPutObjectUrl)|+|[`removeBucket`](#removeBucket)|[`fGetObject`](#fGetObject)|[`presignedPostPolicy`](#presignedPostPolicy)|+|[`listObjects`](#listObjects)|[`fPutObject`](#fPutObject)||+|[`listObjectsV1`](#listObjectsV1)|[`copyObject`](#copyObject)||+|[`listIncompleteUploads`](#listIncompleteUploads)|[`removeObject`](#removeObject)||+|[`bucketExists`](#bucketExists)|||++## 1. Connecting and running operations on the storage service++The Haskell Minio SDK provides high-level functionality to perform+operations on a Minio server or any AWS S3-like API compatible storage+service.++### The `ConnectInfo` type++The `ConnectInfo` record-type contains connection information for a+particular server. It is recommended to construct the `ConnectInfo`+value using one of the several smart constructors provided by the+library, documented in the following subsections.++The library automatically discovers the region of a bucket by+default. This is especially useful with AWS, where buckets may be in+different regions. When performing an upload, download or other+operation, the library requests the service for the location of a+bucket and caches it for subsequent requests.++#### awsCI :: ConnectInfo++`awsCI` is a value that provides connection information for AWS+S3. Credentials can be supplied by overriding a couple of fields like+so:++``` haskell+awsConn = awsCI {+    connectAccessKey = "my-AWS-access-key"+  , connectSecretKey = "my-AWS-secret-key"+  }+```++#### awsWithRegionCI :: Region -> Bool -> ConnectInfo++This constructor allows to specify the initial region and a Boolean to+enable/disable the automatic region discovery behaviour.++The parameters in the expression `awsWithRegion region autoDiscover` are:++|Parameter|Type|Description|+|:---|:---|:---|+| `region` | _Region_ (alias for `Text`) | The region to connect to by default for all requests. |+| `autoDiscover` | _Bool_ | If `True`, region discovery will be enabled. If `False`, discovery is disabled, and all requests go the given region only.|++#### minioPlayCI :: ConnectInfo++This constructor provides connection and authentication information to+connect to the public Minio Play server at+`https://play.minio.io:9000/`.++#### minioCI :: Text -> Int -> Bool -> ConnectInfo++Use to connect to a Minio server.++The parameters in the expression `minioCI host port isSecure` are:++|Parameter|Type|Description|+|:---|:---|:---|+| `host` | _Text_ | Hostname of the Minio or other S3-API compatible server |+| `port` | _Int_ | Port number to connect to|+| `isSecure` | _Bool_ | Does the server use HTTPS? |++#### The ConnectInfo fields and Default instance++The following table shows the fields in the `ConnectInfo` record-type:++| Field | Type | Description |+|:---|:---|:---|+| `connectHost` | _Text_ | Host name of the server. Defaults to `localhost`. |+| `connectPort` | _Int_ | Port number on which the server listens. Defaults to `9000`. |+| `connectAccessKey` | _Text_ | Access key to use in authentication. Defaults to `minio`. |+| `connectSecretkey` | _Text_ | Secret key to use in authentication. Defaults to `minio123`. |+| `connectIsSecure` | _Bool_ | Specifies if the server used TLS. Defaults to `False` |+| `connectRegion` | _Region_ (alias for `Text`) | Specifies the region to use. Defaults to 'us-east-1' |+| `connectAutoDiscoverRegion` | _Bool_ | Specifies if the library should automatically discover the region of a bucket. Defaults to `True`|++The `def` value of type `ConnectInfo` has all the above default+values.++### The Minio Monad++This monad provides the required environment to perform requests+against a Minio or other S3 API compatible server. It uses the+connection information from the `ConnectInfo` value provided to it. It+performs connection pooling, bucket location caching, error handling+and resource clean-up actions.++The `runMinio` function performs the provided action in the `Minio`+monad and returns a `IO (Either MinioErr a)` value:++``` haskell+{-# Language OverloadedStrings #-}++import Network.Minio++main :: IO ()+main = do+  result <- runMinio def $ do+    buckets <- listBuckets+    return $ length buckets++  case result of+    Left e -> putStrLn $ "Failed operation with error: " ++ show e+    Right n -> putStrLn $ show n ++ " bucket(s) found."+```++The above performs a `listBuckets` operation and returns the number of+buckets in the server. If there were any errors, they will be returned+as values of type `MinioErr` as a `Left` value.++## 2. Bucket operations++<a name="listBuckets"></a>+### listBuckets :: Minio [BucketInfo]+Lists buckets.++__Return Value__++|Return type   |Description   |+|:---|:---|+| _Minio [BucketInfo]_| List of buckets |+++__BucketInfo record type__++|Field   |Type   |Description   |+|:---|:---| :---|+| `biName` | _Bucket_ (alias of `Text`) | Name of the bucket |+| `biCreationDate` | _UTCTime_ | Creation time of the bucket |+++<a name="makeBucket"></a>+### makeBucket :: Bucket -> Maybe Region -> Minio ()++Create a new bucket. If the region is not specified, the region+specified by `ConnectInfo` is used.++__Parameters__++In the expression `makeBucket bucketName region` the arguments are:++| Param  | Type  | Description  |+|---|---|---|+|`bucketName`  | _Bucket_ (alias for `Text`) | Name of the bucket |+| `region`  |  _Maybe Region_ | Region where the bucket is to be created. If not specified, default to the region in `ConnectInfo`.|++__Example__++``` haskell+{-# Language OverloadedStrings #-}++main :: IO ()+main = do+    res <- runMinio minioPlayCI $ do+        makeBucket bucketName (Just "us-east-1")++    case res of+        Left err -> putStrLn $ "Failed to make bucket: " ++ (show res)+        Right _ -> putStrLn $ "makeBucket successful."++```++<a name="removeBucket"></a>+### removeBucket :: Bucket -> Minio ()++Remove a bucket. The bucket must be empty or an error will be thrown.++__Parameters__++In the expression `removeBucket bucketName` the arguments are:++| Param  | Type  | Description  |+|---|---|---|+|`bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+++__Example__+++``` haskell+{-# Language OverloadedStrings #-}++main :: IO ()+main = do+    res <- runMinio minioPlayCI $ do+        removeBucket "mybucket"++    case res of+        Left err -> putStrLn $ "Failed to remove bucket: " ++ (show res)+        Right _ -> putStrLn $ "removeBucket successful."++```+++<a name="listObjects"></a>+### listObjects :: Bucket -> Maybe Text -> Bool -> C.Producer Minio ObjectInfo++List objects in the given bucket, implements version 2 of AWS S3 API.++__Parameters__++In the expression `listObjects bucketName prefix recursive` the+arguments are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+| `prefix` | _Maybe Text_  | Optional prefix that listed objects should have |+| `recursive`  | _Bool_  |`True` indicates recursive style listing and `False` indicates directory style listing delimited by '/'.  |++__Return Value__++|Return type   |Description   |+|:---|:---|+| _C.Producer Minio ObjectInfo_  | A Conduit Producer of `ObjectInfo` values corresponding to each object. |++__ObjectInfo record type__++|Field   |Type   |Description   |+|:---|:---| :---|+|`oiObject`  | _Object_ (alias for `Text`) | Name of object |+|`oiModTime` | _UTCTime_ | Last modified time of the object |+|`oiETag` | _ETag_ (alias for `Text`) | ETag of the object |+|`oiSize` | _Int64_ | Size of the object in bytes  |++__Example__++``` haskell+{-# Language OverloadedStrings #-}++import Data.Conduit (($$))+import Conduit.Combinators (sinkList)++main :: IO ()+main = do+  let+    bucket = "test"++  -- Performs a recursive listing of all objects under bucket "test"+  -- on play.minio.io.+  res <- runMinio minioPlayCI $ do+    listObjects bucket Nothing True $$ sinkList+  print res++```++<a name="listObjectsV1"></a>+### listObjectsV1 :: Bucket -> Maybe Text -> Bool -> C.Producer Minio ObjectInfo++List objects in the given bucket, implements version 1 of AWS S3 API. This API+is provided for legacy S3 compatible object storage endpoints.++__Parameters__++In the expression `listObjectsV1 bucketName prefix recursive` the+arguments are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+| `prefix` | _Maybe Text_  | Optional prefix that listed objects should have |+| `recursive`  | _Bool_  |`True` indicates recursive style listing and `False` indicates directory style listing delimited by '/'.  |++__Return Value__++|Return type   |Description   |+|:---|:---|+| _C.Producer Minio ObjectInfo_  | A Conduit Producer of `ObjectInfo` values corresponding to each object. |++__ObjectInfo record type__++|Field   |Type   |Description   |+|:---|:---| :---|+|`oiObject`  | _Object_ (alias for `Text`) | Name of object |+|`oiModTime` | _UTCTime_ | Last modified time of the object |+|`oiETag` | _ETag_ (alias for `Text`) | ETag of the object |+|`oiSize` | _Int64_ | Size of the object in bytes  |++__Example__++``` haskell+{-# Language OverloadedStrings #-}++import Data.Conduit (($$))+import Conduit.Combinators (sinkList)++main :: IO ()+main = do+  let+    bucket = "test"++  -- Performs a recursive listing of all objects under bucket "test"+  -- on play.minio.io.+  res <- runMinio minioPlayCI $ do+    listObjectsV1 bucket Nothing True $$ sinkList+  print res++```++<a name="listIncompleteUploads"></a>+### listIncompleteUploads :: Bucket -> Maybe Prefix -> Bool -> C.Producer Minio UploadInfo++List incompletely uploaded objects.++__Parameters__++In the expression `listIncompleteUploads bucketName prefix recursive`+the parameters are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+| `prefix` | _Maybe Text_  | Optional prefix that listed objects should have. |+| `recursive`  | _Bool_  |`True` indicates recursive style listing and `Talse` indicates directory style listing delimited by '/'.  |++__Return Value__++|Return type   |Description   |+|:---|:---|+| _C.Producer Minio UploadInfo_  | A Conduit Producer of `UploadInfo` values corresponding to each incomplete multipart upload |++__UploadInfo record type__++|Field   |Type   |Description   |+|:---|:---| :---|+|`uiKey`  | _Object_  |Name of incompletely uploaded object |+|`uiUploadId` | _String_ |Upload ID of incompletely uploaded object |+|`uiSize` | _Int64_ |Size of incompletely uploaded object |++__Example__++```haskell+{-# Language OverloadedStrings #-}++import Data.Conduit (($$))+import Conduit.Combinators (sinkList)++main :: IO ()+main = do+  let+    bucket = "test"++  -- Performs a recursive listing of all incompletely uploaded objects+  -- under bucket "test" on play.minio.io.+  res <- runMinio minioPlayCI $ do+    listIncompleteUploads bucket Nothing True $$ sinkList+  print res++```++## 3. Object operations++<a name="getObject"></a>+### getObject :: Bucket -> Object -> Minio (C.ResumableSource Minio ByteString)++Get an object from the service.++__Parameters__++In the expression `getObject bucketName objectName` the parameters+are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+| `objectName` | _Object_ (alias for `Text`)  | Name of the object |++__Return Value__++The return value can be incrementally read to process the contents of+the object.+|Return type   |Description   |+|:---|:---|+| _C.ResumableSource Minio ByteString_  | A Conduit ResumableSource of `ByteString` values. |++__Example__++```haskell+{-# Language OverloadedStrings #-}++import Network.Minio+import Data.Conduit (($$+-))+import Data.Conduit.Binary (sinkLbs)+import qualified Data.ByteString.Lazy as LB++main :: IO ()+main = do+  let+    bucket = "mybucket"+    object = "myobject"++  -- Lists the parts in an incompletely uploaded object identified by+  -- bucket, object and upload ID.+  res <- runMinio minioPlayCI $ do+           source <- getObject bucket object+           source $$+- sinkLbs++  -- the following the prints the contents of the object.+  putStrLn $ either+    (("Failed to getObject: " ++) . show)+    (("Read an object of length: " ++) . show . LB.length)+    res+```++<a name="putObject"></a>+### putObject :: Bucket -> Object -> C.Producer Minio ByteString -> Maybe Int64 -> Minio ()+Uploads an object to a bucket in the service, from the given input+byte stream of optionally supplied length++__Parameters__++In the expression `putObject bucketName objectName inputSrc` the parameters+are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+| `objectName` | _Object_ (alias for `Text`)  | Name of the object |+| `inputSrc` | _C.Producer Minio ByteString_ | A Conduit Producer of `ByteString` values |++__Example__++```haskell+{-# Language OverloadedStrings #-}+import Network.Minio+import qualified Data.Conduit.Combinators as CC++main :: IO ()+main = do+  let+    bucket = "mybucket"+    object = "myobject"+    kb15 = 15 * 1024++  res <- runMinio minioPlayCI $ do+           putObject bucket object (CC.repeat "a") (Just kb15)++  case res of+    Left e -> putStrLn $ "Failed to putObject " ++ show bucket ++ "/" ++ show object+    Right _ -> putStrLn "PutObject was successful"+```++<a name="fGetObject"></a>+### fGetObject :: Bucket -> Object -> FilePath -> GetObjectOptions -> Minio ()+Downloads an object from a bucket in the service, to the given file++__Parameters__++In the expression `fGetObject bucketName objectName inputFile` the parameters+are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+| `objectName` | _Object_ (alias for `Text`)  | Name of the object |+| `inputFile` | _FilePath_ | Path to the file to be uploaded |+| `opts`      | _GetObjectOptions_ | Options for GET requests specifying additional options like If-Match, Range |+++__GetObjectOptions record type__++|Field   |Type   |Description   |+|:---|:---| :---|+| `gooRange` | `Maybe ByteRanges` | Represents the byte range of object. E.g ByteRangeFromTo 0 9 represents first ten bytes of the object|+| `gooIfMatch` | `Maybe ETag` (alias for `Text`) | (Optional) ETag of object should match |+| `gooIfNoneMatch` | `Maybe ETag` (alias for `Text`) | (Optional) ETag of object shouldn't match |+| `gooIfUnmodifiedSince` | `Maybe UTCTime` | (Optional) Time since object wasn't modified |+| `gooIfModifiedSince` | `Maybe UTCTime` | (Optional) Time since object was modified |++``` haskell++{-# Language OverloadedStrings #-}+import Network.Minio++import Data.Conduit (($$+-))+import Data.Conduit.Binary (sinkLbs)+import Prelude++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++main :: IO ()+main = do+  let+      bucket = "my-bucket"+      object = "my-object"+      localFile = "/etc/lsb-release"++  res <- runMinio minioPlayCI $ do+    src <- fGetObject bucket object localFile def+    (src $$+- sinkLbs)++  case res of+    Left e -> putStrLn $ "fGetObject failed." ++ (show e)+    Right _ -> putStrLn "fGetObject succeeded."+```++<a name="fPutObject"></a>+### fPutObject :: Bucket -> Object -> FilePath -> Minio ()+Uploads an object to a bucket in the service, from the given file++__Parameters__++In the expression `fPutObject bucketName objectName inputFile` the parameters+are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+| `objectName` | _Object_ (alias for `Text`)  | Name of the object |+| `inputFile` | _FilePath_ | Path to the file to be uploaded |++__Example__++```haskell+{-# Language OverloadedStrings #-}+import Network.Minio+import qualified Data.Conduit.Combinators as CC++main :: IO ()+main = do+  let+    bucket = "mybucket"+    object = "myobject"+    localFile = "/etc/lsb-release"++  res <- runMinio minioPlayCI $ do+           fPutObject bucket object localFile++  case res of+    Left e -> putStrLn $ "Failed to fPutObject " ++ show bucket ++ "/" ++ show object+    Right _ -> putStrLn "fPutObject was successful"+```++<a name="copyObject"></a>+### copyObject :: DestinationInfo -> SourceInfo -> Minio ()+Copies content of an object from the service to another++__Parameters__++In the expression `copyObject dstInfo srcInfo` the parameters+are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `dstInfo` | _DestinationInfo_ | A value representing properties of the destination object |+| `srcInfo` | _SourceInfo_ | A value representing properties of the source object |+++__SourceInfo record type__++|Field   |Type   |Description   |+|:---|:---| :---|+| `srcBucket` | `Bucket` | Name of source bucket |+| `srcObject` | `Object` | Name of source object |+| `srcRange` | `Maybe (Int64, Int64)` | (Optional) Represents the byte range of source object. (0, 9) represents first ten bytes of source object|+| `srcIfMatch` | `Maybe Text` | (Optional) ETag source object should match |+| `srcIfNoneMatch` | `Maybe Text` | (Optional) ETag source object shouldn't match |+| `srcIfUnmodifiedSince` | `Maybe UTCTime` | (Optional) Time since source object wasn't modified |+| `srcIfModifiedSince` | `Maybe UTCTime` | (Optional) Time since source object was modified |++__Destination record type__++|Field   |Type   |Description   |+|:---|:---| :---|+| `dstBucket` | `Bucket` | Name of destination bucket in server-side copyObject |+| `dstObject` | `Object` | Name of destination object in server-side copyObject |++__Example__++```haskell+{-# Language OverloadedStrings #-}+import Network.Minio++main :: IO ()+main = do+  let+    bucket = "mybucket"+    object = "myobject"+    objectCopy = "obj-copy"++  res <- runMinio minioPlayCI $ do+           copyObject def { dstBucket = bucket, dstObject = objectCopy } def { srcBucket = bucket, srcObject = object }++  case res of+    Left e -> putStrLn $ "Failed to copyObject " ++ show bucket ++ show "/" ++ show object+    Right _ -> putStrLn "copyObject was successful"+```++<a name="removeObject"></a>+### removeObject :: Bucket -> Object -> Minio ()+Removes an object from the service++__Parameters__++In the expression `removeObject bucketName objectName` the parameters+are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+| `objectName` | _Object_ (alias for `Text`)  | Name of the object |++__Example__++```haskell+{-# Language OverloadedStrings #-}+import Network.Minio++main :: IO ()+main = do+  let+    bucket = "mybucket"+    object = "myobject"++  res <- runMinio minioPlayCI $ do+           removeObject bucket object++  case res of+    Left e -> putStrLn $ "Failed to remove " ++ show bucket ++ "/" ++ show object+    Right _ -> putStrLn "Removed object successfully"+```++<a name="removeIncompleteUpload"></a>+### removeIncompleteUpload :: Bucket -> Object -> Minio ()+Removes an ongoing multipart upload of an object from the service++__Parameters__++In the expression `removeIncompleteUpload bucketName objectName` the parameters+are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+| `objectName` | _Object_ (alias for `Text`)  | Name of the object |++__Example__++```haskell+{-# Language OverloadedStrings #-}+import Network.Minio++main :: IO ()+main = do+  let+    bucket = "mybucket"+    object = "myobject"++  res <- runMinio minioPlayCI $+           removeIncompleteUpload bucket object++  case res of+    Left _ -> putStrLn $ "Failed to remove " ++ show bucket ++ "/" ++ show object+    Right _ -> putStrLn "Removed incomplete upload successfully"+```++<a name="BucketExists"></a>+### bucketExists :: Bucket -> Minio Bool+Checks if a bucket exists.++__Parameters__++In the expression `bucketExists bucketName` the parameters are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+++## 4. Presigned operations++<a name="presignedGetObjectUrl"></a>+### presignedGetObjectUrl :: Bucket -> Object -> UrlExpiry -> Query -> RequestHeaders -> Minio ByteString++Generate a URL with authentication signature to GET (download) an+object. All extra query parameters and headers passed here will be+signed and are required when the generated URL is used. Query+parameters could be used to change the response headers sent by the+server. Headers can be used to set Etag match conditions among others.++For a list of possible request parameters and headers, please refer+to the GET object REST API AWS S3 documentation.++__Parameters__++In the expression `presignedGetObjectUrl bucketName objectName expiry queryParams headers`+the parameters are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+| `objectName` | _Object_ (alias for `Text`)  | Name of the object |+| `expiry` | _UrlExpiry_ (alias for `Int`) | Url expiry time in seconds |+| `queryParams` | _Query_ (from package `http-types:Network.HTTP.Types`) | Query parameters to add to the URL |+| `headers` | _RequestHeaders_ (from package `http-types:Network.HTTP.Types` | Request headers that would be used with the URL |++__Return Value__++Returns the generated URL - it will include authentication+information.++|Return type   |Description   |+|:---|:---|+| _ByteString_  | Generated presigned URL |++__Example__++```haskell+{-# Language OverloadedStrings #-}++import Network.Minio+import qualified Data.ByteString.Char8 as B++main :: IO ()+main = do+  let+    bucket = "mybucket"+    object = "myobject"++  res <- runMinio minioPlayCI $ do+           -- Set a 7 day expiry for the URL+           presignedGetObjectUrl bucket object (7*24*3600) [] []++  -- Print the URL on success.+  putStrLn $ either+    (("Failed to generate URL: " ++) . show)+    B.unpack+    res+```++<a name="presignedPutObjectUrl"></a>+### presignedPutObjectUrl :: Bucket -> Object -> UrlExpiry -> RequestHeaders -> Minio ByteString++Generate a URL with authentication signature to PUT (upload) an+object. Any extra headers if passed, are signed, and so they are+required when the URL is used to upload data. This could be used, for+example, to set user-metadata on the object.++For a list of possible headers to pass, please refer to the PUT object+REST API AWS S3 documentation.++__Parameters__++In the expression `presignedPutObjectUrl bucketName objectName expiry headers`+the parameters are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+| `objectName` | _Object_ (alias for `Text`)  | Name of the object |+| `expiry` | _UrlExpiry_ (alias for `Int`) | Url expiry time in seconds |+| `headers` | _RequestHeaders_ (from package `http-types:Network.HTTP.Types` | Request headers that would be used with the URL |++__Return Value__++Returns the generated URL - it will include authentication+information.++|Return type   |Description   |+|:---|:---|+| _ByteString_  | Generated presigned URL |++__Example__++```haskell+{-# Language OverloadedStrings #-}++import Network.Minio+import qualified Data.ByteString.Char8 as B++main :: IO ()+main = do+  let+    bucket = "mybucket"+    object = "myobject"++  res <- runMinio minioPlayCI $ do+           -- Set a 7 day expiry for the URL+           presignedPutObjectUrl bucket object (7*24*3600) [] []++  -- Print the URL on success.+  putStrLn $ either+    (("Failed to generate URL: " ++) . show)+    B.unpack+    res+```++<a name="presignedPostPolicy"></a>+### presignedPostPolicy :: PostPolicy -> Minio (ByteString, Map.Map Text ByteString)++Generate a presigned URL and POST policy to upload files via a POST+request. This is intended for browser uploads and generates form data+that should be submitted in the request.++The `PostPolicy` argument is created using the `newPostPolicy` function:++#### newPostPolicy :: UTCTime -> [PostPolicyCondition] -> Either PostPolicyError PostPolicy++In the expression `newPostPolicy expirationTime conditions` the parameters are:++|Param | Type| Description |+|:---|:---|:---|+| `expirationTime` | _UTCTime_ (from package `time:Data.Time.UTCTime`) | The expiration time for the policy |+| `conditions` | _[PostPolicyConditions]_ | List of conditions to be added to the policy |++The policy conditions are created using various helper functions -+please refer to the Haddocks for details.++Since conditions are validated by `newPostPolicy` it returns an+`Either` value.++__Return Value__++`presignedPostPolicy` returns a 2-tuple - the generated URL and a map+containing the form-data that should be submitted with the request.++__Example__++```haskell+{-# Language OverloadedStrings #-}++import Network.Minio++import qualified Data.ByteString       as B+import qualified Data.ByteString.Char8 as Char8+import qualified Data.Map.Strict       as Map+import qualified Data.Text.Encoding    as Enc+import qualified Data.Time             as Time++main :: IO ()+main = do+  now <- Time.getCurrentTime+  let+    bucket = "mybucket"+    object = "myobject"++    -- set an expiration time of 10 days+    expireTime = Time.addUTCTime (3600 * 24 * 10) now++    -- create a policy with expiration time and conditions - since the+    -- conditions are validated, newPostPolicy returns an Either value+    policyE = newPostPolicy expireTime+              [ -- set the object name condition+                ppCondKey "photos/my-object"+                -- set the bucket name condition+              , ppCondBucket "my-bucket"+                -- set the size range of object as 1B to 10MiB+              , ppCondContentLengthRange 1 (10*1024*1024)+                -- set content type as jpg image+              , ppCondContentType "image/jpeg"+                -- on success set the server response code to 200+              , ppCondSuccessActionStatus 200+              ]++  case policyE of+    Left err -> putStrLn $ show err+    Right policy -> do+      res <- runMinio minioPlayCI $ do+        (url, formData) <- presignedPostPolicy policy++        -- a curl command is output to demonstrate using the generated+        -- URL and form-data+        let+          formFn (k, v) = B.concat ["-F ", Enc.encodeUtf8 k, "=",+                                    "'", v, "'"]+          formOptions = B.intercalate " " $ map formFn $ Map.toList formData+++        return $ B.intercalate " " $+          ["curl", formOptions, "-F file=@/tmp/photo.jpg", url]++      case res of+        Left e -> putStrLn $ "post-policy error: " ++ (show e)+        Right cmd -> do+          putStrLn $ "Put a photo at /tmp/photo.jpg and run command:\n"++          -- print the generated curl command+          Char8.putStrLn cmd+```++<!-- ## 5. Bucket policy/notification operations -->++<!-- TODO -->++<!-- ## 6. Explore Further -->++<!-- TODO -->

@@ -0,0 +1,43 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++{-# Language OverloadedStrings #-}+import Network.Minio++import Control.Monad.IO.Class (liftIO)+import Prelude++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++main :: IO ()+main = do+  let bucket = "missingbucket"++  res1 <- runMinio minioPlayCI $ do+    foundBucket <- bucketExists bucket+    liftIO $ putStrLn $ "Does " ++ show bucket ++ " exist? - " ++ show foundBucket++  case res1 of+    Left e -> putStrLn $ "bucketExists failed." ++ show e+    Right () -> return ()

@@ -0,0 +1,56 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++{-# LANGUAGE OverloadedStrings #-}+import           Network.Minio++import           Control.Monad.Catch (catchIf)+import           Prelude++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++ignoreMinioErr :: ServiceErr -> Minio ()+ignoreMinioErr = return . const ()++main :: IO ()+main = do+  let+      bucket = "test"+      object = "obj"+      objectCopy = "obj-copy"+      localFile = "/etc/lsb-release"++  res1 <- runMinio minioPlayCI $ do+    -- 1. Make a bucket; Catch BucketAlreadyOwnedByYou exception.+    catchIf (== BucketAlreadyOwnedByYou) (makeBucket bucket Nothing) ignoreMinioErr++    -- 2. Upload a file to bucket/object.+    fPutObject bucket object localFile++    -- 3. Copy bucket/object to bucket/objectCopy.+    copyObject def {dstBucket = bucket, dstObject = objectCopy} def { srcBucket = bucket , srcObject = object }++  case res1 of+    Left e   -> putStrLn $ "copyObject failed." ++ show e+    Right () -> putStrLn "copyObject succeeded."

@@ -0,0 +1,74 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs --package optparse-applicative --package filepath++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--+++{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+import           Network.Minio++import           Control.Monad.Catch    (catchIf)+import           Control.Monad.IO.Class (liftIO)+import           Data.Monoid            ((<>))+import           Data.Text              (pack)+import           Options.Applicative+import           Prelude+import           System.FilePath.Posix++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++-- optparse-applicative package based command-line parsing.+fileNameArgs :: Parser FilePath+fileNameArgs = strArgument+               (metavar "FILENAME"+                <> help "Name of file to upload to AWS S3 or a Minio server")++cmdParser = info+            (helper <*> fileNameArgs)+            (fullDesc+             <> progDesc "FileUploader"+             <> header+             "FileUploader - a simple file-uploader program using minio-hs")++ignoreMinioErr :: ServiceErr -> Minio ()+ignoreMinioErr = return . const ()+++main :: IO ()+main = do+  let bucket = "my-bucket"++  -- Parse command line argument+  filepath <- execParser cmdParser+  let object = pack $ takeBaseName filepath++  res <- runMinio minioPlayCI $ do+    -- Make a bucket; catch bucket already exists exception if thrown.+    catchIf (== BucketAlreadyOwnedByYou) (makeBucket bucket Nothing) ignoreMinioErr++    -- Upload filepath to bucket; object is derived from filepath.+    fPutObject bucket object filepath++  case res of+    Left e   -> putStrLn $ "file upload failed due to " ++ (show e)+    Right () -> putStrLn "file upload succeeded."

@@ -0,0 +1,45 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++{-# LANGUAGE OverloadedStrings #-}+import           Network.Minio++import           Data.Conduit        (($$+-))+import           Data.Conduit.Binary (sinkLbs)+import           Prelude++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++main :: IO ()+main = do+  let+      bucket = "my-bucket"+      object = "my-object"+  res <- runMinio minioPlayCI $ do+    src <- getObject bucket object+    (src $$+- sinkLbs)++  case res of+    Left e  -> putStrLn $ "getObject failed." ++ (show e)+    Right _ -> putStrLn "getObject succeeded."

@@ -0,0 +1,43 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++{-# LANGUAGE OverloadedStrings #-}+import           Network.Minio+import           Network.Minio.S3API++import           Prelude++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++main :: IO ()+main = do+  let+      bucket = "test"+      object = "passwd"+  res <- runMinio minioPlayCI $+    headObject bucket object++  case res of+    Left e        -> putStrLn $ "headObject failed." ++ show e+    Right objInfo -> putStrLn $ "headObject succeeded." ++ show objInfo

@@ -0,0 +1,41 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++{-# LANGUAGE OverloadedStrings #-}+import           Network.Minio++import           Control.Monad.IO.Class (liftIO)+import           Prelude++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++-- This example list buckets that belongs to the user and returns+-- region of the first bucket returned.+main :: IO ()+main = do+  firstRegionE <- runMinio minioPlayCI $ do+    buckets <- listBuckets+    liftIO $ print $ "Top 5 buckets: " ++ show (take 5 buckets)+    getLocation $ biName $ head buckets+  print firstRegionE

@@ -0,0 +1,54 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++{-# LANGUAGE OverloadedStrings #-}+import           Network.Minio++import           Data.Conduit             (($$))+import           Data.Conduit.Combinators (sinkList)+import           Prelude++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++main :: IO ()+main = do+  let+    bucket = "test"++  -- Performs a recursive listing of incomplete uploads under bucket "test"+  -- on a local minio server.+  res <- runMinio minioPlayCI $+    listIncompleteUploads bucket Nothing True $$ sinkList+  print res++  {-+    Following is the output of the above program on a local Minio server.++    Right [UploadInfo { uiKey = "go1.6.2.linux-amd64.tar.gz"+                      , uiUploadId = "063eb592-bdd7-4a0c-be48-34fb3ceb63e2"+                      , uiInitTime = 2017-03-01 10:16:25.698 UTC+                      , uiSize = 17731794+                      }+          ]+  -}

@@ -0,0 +1,50 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++{-# LANGUAGE OverloadedStrings #-}+import           Network.Minio++import qualified Data.Conduit             as C+import qualified Data.Conduit.Combinators as CC+import           Prelude+++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++main :: IO ()+main = do+  let+    bucket = "test"++  -- Performs a recursive listing of all objects under bucket "test"+  -- on play.minio.io.+  res <- runMinio minioPlayCI $+    listObjects bucket Nothing True C.$$ CC.sinkList+  print res++  {-+    Following is the output of the above program on a local Minio server.++    Right [ObjectInfo {oiObject = "ADVANCED.png", oiModTime = 2017-02-10 05:33:24.816 UTC, oiETag = "\"a69f3af6bbb06fe1d42ac910ec30482f\"", oiSize = 94026},ObjectInfo {oiObject = "obj", oiModTime = 2017-02-10 08:49:26.777 UTC, oiETag = "\"715a872a253a3596652c1490081b4b6a-1\"", oiSize = 15728640}]+  -}

@@ -0,0 +1,40 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--+++{-# LANGUAGE OverloadedStrings #-}+import           Network.Minio++import           Prelude++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++main :: IO ()+main = do+  let+      bucket = "my-bucket"+  res <- runMinio minioPlayCI $+    -- N B the region provided for makeBucket is optional.+    makeBucket bucket (Just "us-east-1")+  print res

@@ -0,0 +1,83 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++{-# LANGUAGE OverloadedStrings #-}+import           Network.Minio++import           Control.Monad.IO.Class   (liftIO)+import qualified Data.ByteString.Char8    as B+import           Data.CaseInsensitive     (original)+import qualified Data.Conduit.Combinators as CC+import qualified Data.Text.Encoding       as E++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++main :: IO ()+main = do+  let+    bucket = "my-bucket"+    object = "my-object"+    kb15 = 15*1024++    -- Set query parameter to modify content disposition response+    -- header+    queryParam = [("response-content-disposition",+                   Just "attachment; filename=\"your-filename.txt\"")]++  res <- runMinio minioPlayCI $ do+    liftIO $ B.putStrLn "Upload a file that we will fetch with a presigned URL..."+    putObject bucket object (CC.repeat "a") (Just kb15) def+    liftIO $ putStrLn $ "Done. Object created at: my-bucket/my-object"++    -- Extract Etag of uploaded object+    oi <- statObject bucket object+    let etag = oiETag oi++    -- Set header to add an if-match constraint - this makes sure+    -- the fetching fails if the object is changed on the server+    let headers = [("If-Match", E.encodeUtf8 etag)]++    -- Generate a URL with 7 days expiry time - note that the headers+    -- used above must be added to the request with the signed URL+    -- generated.+    url <- presignedGetObjectUrl "my-bucket" "my-object" (7*24*3600)+           queryParam headers++    return (headers, etag, url)++  case res of+    Left e -> putStrLn $ "presignedPutObject URL failed." ++ show e+    Right (headers, etag, url) -> do++      -- We generate a curl command to demonstrate usage of the signed+      -- URL.+      let+        hdrOpt (k, v) = B.concat ["-H '", original k, ": ", v, "'"]+        curlCmd = B.intercalate " " $+                  ["curl --fail"] ++ map hdrOpt headers +++                  ["-o /tmp/myfile", B.concat ["'", url, "'"]]++      putStrLn $ "The following curl command would use the presigned " +++        "URL to fetch the object and write it to \"/tmp/myfile\":"+      B.putStrLn curlCmd

@@ -0,0 +1,84 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++{-# LANGUAGE OverloadedStrings #-}+import           Network.Minio++import qualified Data.ByteString       as B+import qualified Data.ByteString.Char8 as Char8+import qualified Data.Map.Strict       as Map+import qualified Data.Text.Encoding    as Enc+import qualified Data.Time             as Time++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++main :: IO ()+main = do+  now <- Time.getCurrentTime+  let+    bucket = "my-bucket"+    object = "my-object"++    -- set an expiration time of 10 days+    expireTime = Time.addUTCTime (3600 * 24 * 10) now++    -- create a policy with expiration time and conditions - since the+    -- conditions are validated, newPostPolicy returns an Either value+    policyE = newPostPolicy expireTime+              [ -- set the object name condition+                ppCondKey "photos/my-object"+                -- set the bucket name condition+              , ppCondBucket "my-bucket"+                -- set the size range of object as 1B to 10MiB+              , ppCondContentLengthRange 1 (10*1024*1024)+                -- set content type as jpg image+              , ppCondContentType "image/jpeg"+                -- on success set the server response code to 200+              , ppCondSuccessActionStatus 200+              ]++  case policyE of+    Left err -> putStrLn $ show err+    Right policy -> do+      res <- runMinio minioPlayCI $ do+        (url, formData) <- presignedPostPolicy policy++        -- a curl command is output to demonstrate using the generated+        -- URL and form-data+        let+          formFn (k, v) = B.concat ["-F ", Enc.encodeUtf8 k, "=",+                                    "'", v, "'"]+          formOptions = B.intercalate " " $ map formFn $ Map.toList formData+++        return $ B.intercalate " " $+          ["curl", formOptions, "-F file=@/tmp/photo.jpg", url]++      case res of+        Left e -> putStrLn $ "post-policy error: " ++ (show e)+        Right cmd -> do+          putStrLn $ "Put a photo at /tmp/photo.jpg and run command:\n"++          -- print the generated curl command+          Char8.putStrLn cmd

@@ -0,0 +1,59 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++{-# LANGUAGE OverloadedStrings #-}+import           Network.Minio++import qualified Data.ByteString.Char8 as B+import           Data.CaseInsensitive  (original)++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++main :: IO ()+main = do+  let+    -- Use headers to set user-metadata - note that this header will+    -- need to be set when the URL is used to make an upload.+    headers = [("x-amz-meta-url-creator",+                "minio-hs-presigned-put-example")]+  res <- runMinio minioPlayCI $ do++    -- generate a URL with 7 days expiry time+    presignedPutObjectUrl "my-bucket" "my-object" (7*24*3600) headers++  case res of+    Left e -> putStrLn $ "presignedPutObject URL failed." ++ show e+    Right url -> do++      -- We generate a curl command to demonstrate usage of the signed+      -- URL.+      let+        hdrOpt (k, v) = B.concat ["-H '", original k, ": ", v, "'"]+        curlCmd = B.intercalate " " $+                  ["curl "] ++ map hdrOpt headers +++                  ["-T /tmp/myfile", B.concat ["'", url, "'"]]++      putStrLn $ "The following curl command would use the presigned " +++        "URL to upload the file at \"/tmp/myfile\":"+      B.putStrLn curlCmd

@@ -0,0 +1,53 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++{-# LANGUAGE OverloadedStrings #-}+import           Network.Minio++import qualified Data.Conduit.Combinators as CC++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++main :: IO ()+main = do+  let+      bucket = "test"+      object = "obj"+      localFile = "/etc/lsb-release"+      kb15 = 15 * 1024++  -- Eg 1. Upload a stream of repeating "a" using putObject with default options.+  res1 <- runMinio minioPlayCI $+    putObject bucket object (CC.repeat "a") (Just kb15) def+  case res1 of+    Left e   -> putStrLn $ "putObject failed." ++ show e+    Right () -> putStrLn "putObject succeeded."+++  -- Eg 2. Upload a file using fPutObject with default options.+  res2 <- runMinio minioPlayCI $+    fPutObject bucket object localFile def+  case res2 of+    Left e   -> putStrLn $ "fPutObject failed." ++ show e+    Right () -> putStrLn "fPutObject succeeded."

@@ -0,0 +1,43 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++{-# LANGUAGE OverloadedStrings #-}+import           Network.Minio++import           Prelude++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++main :: IO ()+main = do+  let+    bucket = "mybucket"+    object = "myobject"++  res <- runMinio minioPlayCI $+           removeIncompleteUpload bucket object++  case res of+    Left _ -> putStrLn $ "Failed to remove " ++ show bucket ++ "/" ++ show object+    Right _ -> putStrLn "Removed incomplete upload successfully"

@@ -0,0 +1,36 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++{-# LANGUAGE OverloadedStrings #-}++import           Network.Minio+import           Prelude++main :: IO ()+main = do+  let+    bucket = "mybucket"+    object = "myobject"++  res <- runMinio minioPlayCI $+           removeObject bucket object++  case res of+    Left _ -> putStrLn $ "Failed to remove " ++ show bucket ++ "/" ++ show object+    Right _ -> putStrLn "Removed object successfully"

@@ -0,0 +1,38 @@+#!/usr/bin/env stack+-- stack --resolver lts-9.1 runghc --package minio-hs++--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--+++{-# LANGUAGE OverloadedStrings #-}+import           Network.Minio++import           Prelude++-- | The following example uses minio's play server at+-- https://play.minio.io:9000.  The endpoint and associated+-- credentials are provided via the libary constant,+--+-- > minioPlayCI :: ConnectInfo+--++main :: IO ()+main = do+  let+      bucket = "my-bucket"+  res <- runMinio minioPlayCI $ removeBucket bucket+  print res

@@ -1,5 +1,5 @@ name:                minio-hs-version:             0.3.2+version:             1.0.0 synopsis:            A Minio Haskell Library for Amazon S3 compatible cloud                      storage. description:         The Minio Haskell client library provides simple APIs to@@ -8,12 +8,19 @@ homepage:            https://github.com/minio/minio-hs#readme license:             Apache-2.0 license-file:        LICENSE-author:              Aditya Manthramurthy, Krishnan Parthasarathi+author:              Minio Dev Team maintainer:          dev@minio.io category:            Network, AWS, Object Storage build-type:          Simple stability:           Experimental--- extra-source-files:+extra-source-files:+                   CHANGELOG.md+                   CONTRIBUTING.md+                   docs/API.md+                   examples/*.hs+                   README.md+                   stack.yaml+ cabal-version:       >=1.10  library@@ -27,6 +34,7 @@                      , Network.Minio.Data.ByteString                      , Network.Minio.Data.Crypto                      , Network.Minio.Data.Time+                     , Network.Minio.CopyObject                      , Network.Minio.Errors                      , Network.Minio.ListOps                      , Network.Minio.PresignedOperations@@ -38,12 +46,10 @@   build-depends:       base >= 4.7 && < 5                      , protolude >= 0.1.6                      , aeson-                     , async                      , base64-bytestring                      , bytestring                      , case-insensitive                      , conduit-                     , conduit-combinators                      , conduit-extra                      , containers                      , cryptonite@@ -54,22 +60,19 @@                      , http-client                      , http-conduit                      , http-types-                     , lifted-async-                     , lifted-base                      , memory-                     , monad-control                      , resourcet                      , text                      , text-format                      , time                      , transformers-                     , transformers-base-                     , vector+                     , unliftio+                     , unliftio-core                      , xml-conduit   default-language:    Haskell2010-  default-extensions:  FlexibleContexts+  default-extensions:  BangPatterns+                     , FlexibleContexts                      , FlexibleInstances-                     , BangPatterns                      , MultiParamTypeClasses                      , MultiWayIf                      , NoImplicitPrelude@@ -92,17 +95,18 @@   default-extensions:  BangPatterns                      , FlexibleContexts                      , FlexibleInstances-                     , OverloadedStrings-                     , NoImplicitPrelude                      , MultiParamTypeClasses                      , MultiWayIf-                     , ScopedTypeVariables+                     , NoImplicitPrelude+                     , OverloadedStrings                      , RankNTypes+                     , ScopedTypeVariables                      , TupleSections                      , TypeFamilies   other-modules:       Lib.Prelude                      , Network.Minio                      , Network.Minio.API+                     , Network.Minio.CopyObject                      , Network.Minio.Data                      , Network.Minio.Data.ByteString                      , Network.Minio.Data.Crypto@@ -124,12 +128,10 @@                      , minio-hs                      , protolude >= 0.1.6                      , aeson-                     , async                      , base64-bytestring                      , bytestring                      , case-insensitive                      , conduit-                     , conduit-combinators                      , conduit-extra                      , containers                      , cryptonite@@ -141,10 +143,7 @@                      , http-client                      , http-conduit                      , http-types-                     , lifted-async-                     , lifted-base                      , memory-                     , monad-control                      , QuickCheck                      , resourcet                      , tasty@@ -156,8 +155,8 @@                      , text-format                      , time                      , transformers-                     , transformers-base-                     , vector+                     , unliftio+                     , unliftio-core                      , xml-conduit   if !flag(live-test)     buildable: False@@ -170,12 +169,10 @@                      , minio-hs                      , protolude >= 0.1.6                      , aeson-                     , async                      , base64-bytestring                      , bytestring                      , case-insensitive                      , conduit-                     , conduit-combinators                      , conduit-extra                      , containers                      , cryptonite@@ -183,14 +180,10 @@                      , data-default                      , directory                      , exceptions-                     , filepath                      , http-client                      , http-conduit                      , http-types-                     , lifted-async-                     , lifted-base                      , memory-                     , monad-control                      , QuickCheck                      , resourcet                      , tasty@@ -202,20 +195,20 @@                      , text-format                      , time                      , transformers-                     , transformers-base-                     , vector+                     , unliftio+                     , unliftio-core                      , xml-conduit   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N   default-language:    Haskell2010   default-extensions:  BangPatterns                      , FlexibleContexts                      , FlexibleInstances-                     , OverloadedStrings-                     , NoImplicitPrelude                      , MultiParamTypeClasses                      , MultiWayIf-                     , ScopedTypeVariables+                     , NoImplicitPrelude+                     , OverloadedStrings                      , RankNTypes+                     , ScopedTypeVariables                      , TupleSections                      , TypeFamilies   other-modules:       Lib.Prelude@@ -225,6 +218,7 @@                      , Network.Minio.Data.ByteString                      , Network.Minio.Data.Crypto                      , Network.Minio.Data.Time+                     , Network.Minio.CopyObject                      , Network.Minio.Errors                      , Network.Minio.ListOps                      , Network.Minio.PresignedOperations

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- Minio Haskell SDK, (C) 2017, 2018 Minio, Inc. -- -- Licensed under the Apache License, Version 2.0 (the "License"); -- you may not use this file except in compliance with the License.@@ -55,16 +55,25 @@   -- ** Listing   , BucketInfo(..)   , listBuckets-  , ObjectInfo(..)++  -- ** Object info type represents object metadata information.+  , ObjectInfo+  , oiObject+  , oiModTime+  , oiETag+  , oiSize+  , oiMetadata+   , listObjects   , listObjectsV1+   , UploadId   , UploadInfo(..)   , listIncompleteUploads   , ObjectPartInfo(..)   , listIncompleteParts -  -- ** Notifications+  -- ** Bucket Notifications   , Notification(..)   , NotificationConfig(..)   , Arn@@ -79,7 +88,6 @@    -- * Object Operations   -----------------------   , Object    -- ** File operations@@ -88,11 +96,39 @@    -- ** Conduit-based streaming operations   , putObject+  -- | Input data type represents PutObject options.+  , PutObjectOptions+  , pooContentType+  , pooContentEncoding+  , pooContentDisposition+  , pooContentLanguage+  , pooCacheControl+  , pooStorageClass+  , pooUserMetadata+  , pooNumThreads+   , getObject+  -- | Input data type represents GetObject options.+  , GetObjectOptions+  , gooRange+  , gooIfMatch+  , gooIfNoneMatch+  , gooIfModifiedSince+  , gooIfUnmodifiedSince    -- ** Server-side copying-  , CopyPartSource(..)   , copyObject+  , SourceInfo+  , srcBucket+  , srcObject+  , srcRange+  , srcIfMatch+  , srcIfNoneMatch+  , srcIfModifiedSince+  , srcIfUnmodifiedSince+  , DestinationInfo+  , dstBucket+  , dstObject    -- ** Querying   , statObject@@ -142,15 +178,16 @@ import qualified Data.Conduit.Binary      as CB import qualified Data.Conduit.Combinators as CC import           Data.Default             (def)-import qualified Data.Map                 as Map  import           Lib.Prelude +import           Network.Minio.CopyObject import           Network.Minio.Data import           Network.Minio.Errors import           Network.Minio.ListOps import           Network.Minio.PutObject import           Network.Minio.S3API+import           Network.Minio.Utils  -- | Lists buckets. listBuckets :: Minio [BucketInfo]@@ -159,39 +196,44 @@ -- | Fetch the object and write it to the given file safely. The -- object is first written to a temporary file in the same directory -- and then moved to the given path.-fGetObject :: Bucket -> Object -> FilePath -> Minio ()-fGetObject bucket object fp = do-  src <- getObject bucket object-  src C.$$+- CB.sinkFileCautious fp+fGetObject :: Bucket -> Object -> FilePath -> GetObjectOptions -> Minio ()+fGetObject bucket object fp opts = do+  src <- getObject bucket object opts+  C.connect src $ CB.sinkFileCautious fp  -- | Upload the given file to the given object.-fPutObject :: Bucket -> Object -> FilePath -> Minio ()-fPutObject bucket object f = void $ putObjectInternal bucket object $-                             ODFile f Nothing+fPutObject :: Bucket -> Object -> FilePath+           -> PutObjectOptions -> Minio ()+fPutObject bucket object f opts =+  void $ putObjectInternal bucket object opts $ ODFile f Nothing  -- | Put an object from a conduit source. The size can be provided if -- known; this helps the library select optimal part sizes to perform -- a multipart upload. If not specified, it is assumed that the object -- can be potentially 5TiB and selects multipart sizes appropriately.-putObject :: Bucket -> Object -> C.Producer Minio ByteString-          -> Maybe Int64 -> Minio ()-putObject bucket object src sizeMay =-  void $ putObjectInternal bucket object $ ODStream src sizeMay+putObject :: Bucket -> Object -> C.ConduitM () ByteString Minio ()+          -> Maybe Int64 -> PutObjectOptions -> Minio ()+putObject bucket object src sizeMay opts =+  void $ putObjectInternal bucket object opts $ ODStream src sizeMay --- | Perform a server-side copy operation to create an object with the--- given bucket and object name from the source specification in--- CopyPartSource. This function performs a multipart copy operation--- if the new object is to be greater than 5GiB in size.-copyObject :: Bucket -> Object -> CopyPartSource -> Minio ()-copyObject bucket object cps = void $ copyObjectInternal bucket object cps+-- | Perform a server-side copy operation to create an object based on+-- the destination specification in DestinationInfo from the source+-- specification in SourceInfo. This function performs a multipart+-- copy operation if the new object is to be greater than 5GiB in+-- size.+copyObject :: DestinationInfo -> SourceInfo -> Minio ()+copyObject dstInfo srcInfo = void $ copyObjectInternal (dstBucket dstInfo)+                             (dstObject dstInfo) srcInfo  -- | Remove an object from the object store. removeObject :: Bucket -> Object -> Minio () removeObject = deleteObject  -- | Get an object from the object store as a resumable source (conduit).-getObject :: Bucket -> Object -> Minio (C.ResumableSource Minio ByteString)-getObject bucket object = snd <$> getObject' bucket object [] []+getObject :: Bucket -> Object -> GetObjectOptions+          -> Minio (C.ConduitM () ByteString Minio ())+getObject bucket object opts = snd <$> getObject' bucket object []+                               (gooToHeaders opts)  -- | Get an object's metadata from the object store. statObject :: Bucket -> Object -> Minio ObjectInfo@@ -205,21 +247,21 @@ makeBucket bucket regionMay = do   region <- maybe (asks $ connectRegion . mcConnInfo) return regionMay   putBucket bucket region-  modify (Map.insert bucket region)+  addToRegionCache bucket region  -- | Removes a bucket from the object store. removeBucket :: Bucket -> Minio () removeBucket bucket = do   deleteBucket bucket-  modify (Map.delete bucket)+  deleteFromRegionCache bucket  -- | Query the object store if a given bucket is present. bucketExists :: Bucket -> Minio Bool bucketExists = headBucket - -- | Removes an ongoing multipart upload of an object. removeIncompleteUpload :: Bucket -> Object -> Minio () removeIncompleteUpload bucket object = do-  uploads <- listIncompleteUploads bucket (Just object) False C.$$ CC.sinkList+  uploads <- C.runConduit $ listIncompleteUploads bucket (Just object) False+             C..| CC.sinkList   mapM_ (abortMultipartUpload bucket object) (uiUploadId <$> uploads)

@@ -15,8 +15,7 @@ --  module Network.Minio.API-  (-    connect+  ( connect   , RequestInfo(..)   , runMinio   , executeRequest@@ -86,10 +85,10 @@ discoverRegion :: RequestInfo -> Minio (Maybe Region) discoverRegion ri = runMaybeT $ do   bucket <- MaybeT $ return $ riBucket ri-  regionMay <- gets (Map.lookup bucket)+  regionMay <- lift $ lookupRegionCache bucket   maybe (do             l <- lift $ getLocation bucket-            modify $ Map.insert bucket l+            lift $ addToRegionCache bucket l             return l         ) return regionMay @@ -161,7 +160,7 @@   mkStreamRequest :: RequestInfo-                -> Minio (Response (C.ResumableSource Minio ByteString))+                -> Minio (Response (C.ConduitM () ByteString Minio ())) mkStreamRequest ri = do   req <- buildRequest ri   mgr <- asks mcConnManager

@@ -0,0 +1,93 @@+--+-- Minio Haskell SDK, (C) 2017 Minio, Inc.+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++module Network.Minio.CopyObject where++import           Data.Default         (def)+import qualified Data.List            as List++import           Lib.Prelude++import           Network.Minio.Data+import           Network.Minio.Errors+import           Network.Minio.S3API+import           Network.Minio.Utils+++-- | Copy an object using single or multipart copy strategy.+copyObjectInternal :: Bucket -> Object -> SourceInfo+                   -> Minio ETag+copyObjectInternal b' o srcInfo = do+  let sBucket = srcBucket srcInfo+      sObject = srcObject srcInfo++  -- get source object size with a head request+  oi <- headObject sBucket sObject+  let srcSize = oiSize oi++  -- check that byte offsets are valid if specified in cps+  let rangeMay = srcRange srcInfo+      range = maybe (0, srcSize) identity rangeMay+      startOffset = fst range+      endOffset = snd range++  when (isJust rangeMay &&+        or [startOffset < 0, endOffset < startOffset,+            endOffset >= fromIntegral srcSize]) $+    throwM $ MErrVInvalidSrcObjByteRange range++  -- 1. If sz > 64MiB (minPartSize) use multipart copy, OR+  -- 2. If startOffset /= 0 use multipart copy+  let destSize = (\(a, b) -> b - a + 1 ) $+                 maybe (0, srcSize - 1) identity rangeMay++  if destSize > minPartSize || (endOffset - startOffset + 1 /= srcSize)+    then multiPartCopyObject b' o srcInfo srcSize++    else fst <$> copyObjectSingle b' o srcInfo{srcRange = Nothing} []++-- | Given the input byte range of the source object, compute the+-- splits for a multipart copy object procedure. Minimum part size+-- used is minPartSize.+selectCopyRanges :: (Int64, Int64) -> [(PartNumber, (Int64, Int64))]+selectCopyRanges (st, end) = zip pns $+  map (\(x, y) -> (st + x, st + x + y - 1)) $ zip startOffsets partSizes+  where+    size = end - st + 1+    (pns, startOffsets, partSizes) = List.unzip3 $ selectPartSizes size++-- | Perform a multipart copy object action. Since we cannot verify+-- existing parts based on the source object, there is no resuming+-- copy action support.+multiPartCopyObject :: Bucket -> Object -> SourceInfo -> Int64+                    -> Minio ETag+multiPartCopyObject b o cps srcSize = do+  uid <- newMultipartUpload b o []++  let byteRange = maybe (0, fromIntegral $ srcSize - 1) identity $ srcRange cps+      partRanges = selectCopyRanges byteRange+      partSources = map (\(x, (start, end)) -> (x, cps {srcRange = Just (start, end) }))+                    partRanges+      dstInfo = def { dstBucket = b, dstObject = o}++  copiedParts <- limitedMapConcurrently 10+                 (\(pn, cps') -> do+                     (etag, _) <- copyObjectPart dstInfo cps' uid pn []+                     return (pn, etag)+                 )+                 partSources++  completeMultipartUpload b o uid copiedParts

@@ -14,31 +14,50 @@ -- limitations under the License. -- -{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies               #-} module Network.Minio.Data where -import           Control.Monad.Base-import qualified Control.Monad.Catch as MC-import           Control.Monad.Trans.Control+import           Control.Concurrent.MVar      (MVar)+import qualified Control.Concurrent.MVar      as M+import qualified Control.Monad.Catch          as MC+import           Control.Monad.IO.Unlift      (MonadUnliftIO, UnliftIO (..),+                                               askUnliftIO, withUnliftIO) import           Control.Monad.Trans.Resource -import qualified Data.ByteString as B-import           Data.Default (Default(..))-import qualified Data.Map as Map-import qualified Data.Text as T-import           Data.Time (formatTime, defaultTimeLocale)-import           Network.HTTP.Client (defaultManagerSettings)-import qualified Network.HTTP.Conduit as NC-import           Network.HTTP.Types (Method, Header, Query)-import qualified Network.HTTP.Types as HT+import qualified Data.ByteString              as B+import           Data.CaseInsensitive         (mk)+import           Data.Default                 (Default (..))+import qualified Data.Map                     as Map+import qualified Data.Text                    as T+import           Data.Time                    (defaultTimeLocale, formatTime)+import           Network.HTTP.Client          (defaultManagerSettings)+import qualified Network.HTTP.Conduit         as NC+import           Network.HTTP.Types           (ByteRange, Header, Method, Query,+                                               hRange)+import qualified Network.HTTP.Types           as HT import           Network.Minio.Errors import           Text.XML -import           GHC.Show (Show(..))+import           GHC.Show                     (Show (..))  import           Lib.Prelude +-- | max obj size is 5TiB+maxObjectSize :: Int64+maxObjectSize = 5 * 1024 * 1024 * oneMiB +-- | minimum size of parts used in multipart operations.+minPartSize :: Int64+minPartSize = 64 * oneMiB++oneMiB :: Int64+oneMiB = 1024 * 1024++-- | maximum number of parts that can be uploaded for a single object.+maxMultipartParts :: Int64+maxMultipartParts = 10000+ -- TODO: Add a type which provides typed constants for region.  this -- type should have a IsString instance to infer the appropriate -- constant.@@ -65,12 +84,12 @@ -- of the provided smart constructors or override fields of the -- Default instance. data ConnectInfo = ConnectInfo {-    connectHost :: Text-  , connectPort :: Int-  , connectAccessKey :: Text-  , connectSecretKey :: Text-  , connectIsSecure :: Bool-  , connectRegion :: Region+    connectHost               :: Text+  , connectPort               :: Int+  , connectAccessKey          :: Text+  , connectSecretKey          :: Text+  , connectIsSecure           :: Bool+  , connectRegion             :: Region   , connectAutoDiscoverRegion :: Bool   } deriving (Eq, Show) @@ -167,9 +186,57 @@ type ETag = Text  -- |+-- Data type represents various options specified for PutObject call.+-- To specify PutObject options use the poo* accessors.+data PutObjectOptions = PutObjectOptions {+    pooContentType        :: Maybe Text+  , pooContentEncoding    :: Maybe Text+  , pooContentDisposition :: Maybe Text+  , pooCacheControl       :: Maybe Text+  , pooContentLanguage    :: Maybe Text+  , pooStorageClass       :: Maybe Text+  , pooUserMetadata       :: [(Text, Text)]+  , pooNumThreads         :: Maybe Word+  } deriving (Show, Eq)++-- Provide a default instance+instance Default PutObjectOptions where+    def = PutObjectOptions def def def def def def [] def++addXAmzMetaPrefix :: Text -> Text+addXAmzMetaPrefix s = do+  if (T.isPrefixOf "x-amz-meta-" s)+    then s+    else T.concat ["x-amz-meta-", s]++mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]+mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ T.toLower x, encodeUtf8 y))++pooToHeaders :: PutObjectOptions -> [HT.Header]+pooToHeaders poo = userMetadata+                   ++ (catMaybes $ map tupToMaybe (zipWith (,) names values))+  where+    tupToMaybe (k, Just v)  = Just (k, v)+    tupToMaybe (_, Nothing) = Nothing++    userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo++    names = ["content-type",+             "content-encoding",+             "content-disposition",+             "content-language",+             "cache-control",+             "x-amz-storage-class"]+    values = map (fmap encodeUtf8 . (poo &))+             [pooContentType, pooContentEncoding,+              pooContentDisposition, pooContentLanguage,+              pooCacheControl, pooStorageClass]+++-- | -- BucketInfo returned for list buckets call data BucketInfo = BucketInfo {-    biName :: Bucket+    biName         :: Bucket   , biCreationDate :: UTCTime   } deriving (Show, Eq) @@ -185,103 +252,113 @@ -- | Represents result from a listing of object parts of an ongoing -- multipart upload. data ListPartsResult = ListPartsResult {-    lprHasMore :: Bool+    lprHasMore  :: Bool   , lprNextPart :: Maybe Int-  , lprParts :: [ObjectPartInfo]+  , lprParts    :: [ObjectPartInfo]  } deriving (Show, Eq) - -- | Represents information about an object part in an ongoing -- multipart upload. data ObjectPartInfo = ObjectPartInfo {-    opiNumber :: PartNumber-  , opiETag :: ETag-  , opiSize :: Int64+    opiNumber  :: PartNumber+  , opiETag    :: ETag+  , opiSize    :: Int64   , opiModTime :: UTCTime   } deriving (Show, Eq)  -- | Represents result from a listing of incomplete uploads to a -- bucket. data ListUploadsResult = ListUploadsResult {-    lurHasMore :: Bool-  , lurNextKey :: Maybe Text+    lurHasMore    :: Bool+  , lurNextKey    :: Maybe Text   , lurNextUpload :: Maybe Text-  , lurUploads :: [(Object, UploadId, UTCTime)]-  , lurCPrefixes :: [Text]+  , lurUploads    :: [(Object, UploadId, UTCTime)]+  , lurCPrefixes  :: [Text]   } deriving (Show, Eq)  -- | Represents information about a multipart upload. data UploadInfo = UploadInfo {-    uiKey :: Object+    uiKey      :: Object   , uiUploadId :: UploadId   , uiInitTime :: UTCTime-  , uiSize :: Int64+  , uiSize     :: Int64   } deriving (Show, Eq)  -- | Represents result from a listing of objects in a bucket. data ListObjectsResult = ListObjectsResult {-    lorHasMore :: Bool+    lorHasMore   :: Bool   , lorNextToken :: Maybe Text-  , lorObjects :: [ObjectInfo]+  , lorObjects   :: [ObjectInfo]   , lorCPrefixes :: [Text]   } deriving (Show, Eq)  -- | Represents result from a listing of objects version 1 in a bucket. data ListObjectsV1Result = ListObjectsV1Result {-    lorHasMore' :: Bool+    lorHasMore'   :: Bool   , lorNextMarker :: Maybe Text-  , lorObjects' :: [ObjectInfo]+  , lorObjects'   :: [ObjectInfo]   , lorCPrefixes' :: [Text]   } deriving (Show, Eq)  -- | Represents information about an object. data ObjectInfo = ObjectInfo {-    oiObject :: Object-  , oiModTime :: UTCTime-  , oiETag :: ETag-  , oiSize :: Int64+    oiObject   :: Object+  , oiModTime  :: UTCTime+  , oiETag     :: ETag+  , oiSize     :: Int64+  , oiMetadata :: Map.Map Text Text   } deriving (Show, Eq) -data CopyPartSource = CopyPartSource {-    -- | formatted like "\/sourceBucket\/sourceObject"-    cpSource :: Text-    -- | (0, 9) means first ten bytes of the source object-  , cpSourceRange :: Maybe (Int64, Int64)-  , cpSourceIfMatch :: Maybe Text-  , cpSourceIfNoneMatch :: Maybe Text-  , cpSourceIfUnmodifiedSince :: Maybe UTCTime-  , cpSourceIfModifiedSince :: Maybe UTCTime+-- | Represents source object in server-side copy object+data SourceInfo = SourceInfo {+    srcBucket            :: Text+  , srcObject            :: Text+  , srcRange             :: Maybe (Int64, Int64)+  , srcIfMatch           :: Maybe Text+  , srcIfNoneMatch       :: Maybe Text+  , srcIfModifiedSince   :: Maybe UTCTime+  , srcIfUnmodifiedSince :: Maybe UTCTime   } deriving (Show, Eq) -instance Default CopyPartSource where-  def = CopyPartSource "" def def def def def+instance Default SourceInfo where+  def = SourceInfo "" "" def def def def def -cpsToHeaders :: CopyPartSource -> [HT.Header]-cpsToHeaders cps = ("x-amz-copy-source", encodeUtf8 $ cpSource cps) :-                   rangeHdr ++ zip names values-  where-    names = ["x-amz-copy-source-if-match", "x-amz-copy-source-if-none-match",-             "x-amz-copy-source-if-unmodified-since",-             "x-amz-copy-source-if-modified-since"]-    values = mapMaybe (fmap encodeUtf8 . (cps &))-             [cpSourceIfMatch, cpSourceIfNoneMatch,-              fmap formatRFC1123 . cpSourceIfUnmodifiedSince,-              fmap formatRFC1123 . cpSourceIfModifiedSince]-    rangeHdr = ("x-amz-copy-source-range",)-             . HT.renderByteRanges-             . (:[])-             . uncurry HT.ByteRangeFromTo-           <$> map (both fromIntegral) (maybeToList $ cpSourceRange cps)+-- | Represents destination object in server-side copy object+data DestinationInfo = DestinationInfo {+  dstBucket   :: Text+  , dstObject :: Text+  } deriving (Show, Eq) --- | Extract the source bucket and source object name. TODO: validate--- the bucket and object name extracted.-cpsToObject :: CopyPartSource -> Maybe (Bucket, Object)-cpsToObject cps = do-  [_, bucket, object] <- Just splits-  return (bucket, object)+instance Default DestinationInfo where+  def = DestinationInfo "" ""++data GetObjectOptions = GetObjectOptions {+    -- | [ByteRangeFromTo 0 9] means first ten bytes of the source object.+    gooRange             :: Maybe ByteRange+  , gooIfMatch           :: Maybe ETag+  , gooIfNoneMatch       :: Maybe ETag+  , gooIfUnmodifiedSince :: Maybe UTCTime+  , gooIfModifiedSince   :: Maybe UTCTime+  } deriving (Show, Eq)++instance Default GetObjectOptions where+  def = GetObjectOptions def def def def def++gooToHeaders :: GetObjectOptions -> [HT.Header]+gooToHeaders goo = rangeHdr ++ zip names values   where-    splits = T.splitOn "/" $ cpSource cps+    names = ["If-Match",+             "If-None-Match",+             "If-Unmodified-Since",+             "If-Modified-Since"]+    values = mapMaybe (fmap encodeUtf8 . (goo &))+             [gooIfMatch, gooIfNoneMatch,+              fmap formatRFC1123 . gooIfUnmodifiedSince,+              fmap formatRFC1123 . gooIfModifiedSince]+    rangeHdr = maybe [] (\a -> [(hRange, HT.renderByteRanges [a])])+               $ gooRange goo + -- | A data-type for events that can occur in the object storage -- server. Reference: -- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types@@ -352,7 +429,7 @@ -- for objects having a suffix of ".jpg", and the `prefixRule` -- restricts it to objects having a prefix of "images/". data FilterRule = FilterRule-  { frName :: Text+  { frName  :: Text   , frValue :: Text   } deriving (Show, Eq) @@ -362,8 +439,8 @@ -- notification system. It could represent a Queue, Topic or Lambda -- Function configuration. data NotificationConfig = NotificationConfig-  { ncId :: Text-  , ncArn :: Arn+  { ncId     :: Text+  , ncArn    :: Arn   , ncEvents :: [Event]   , ncFilter :: Filter   } deriving (Show, Eq)@@ -374,8 +451,8 @@ -- described at -- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html> data Notification = Notification-  { nQueueConfigurations :: [NotificationConfig]-  , nTopicConfigurations :: [NotificationConfig]+  { nQueueConfigurations         :: [NotificationConfig]+  , nTopicConfigurations         :: [NotificationConfig]   , nCloudFunctionConfigurations :: [NotificationConfig]   } deriving (Eq, Show) @@ -393,14 +470,14 @@   def = PayloadBS ""  data RequestInfo = RequestInfo {-    riMethod :: Method-  , riBucket :: Maybe Bucket-  , riObject :: Maybe Object-  , riQueryParams :: Query-  , riHeaders :: [Header]-  , riPayload :: Payload-  , riPayloadHash :: Maybe ByteString-  , riRegion :: Maybe Region+    riMethod        :: Method+  , riBucket        :: Maybe Bucket+  , riObject        :: Maybe Object+  , riQueryParams   :: Query+  , riHeaders       :: [Header]+  , riPayload       :: Payload+  , riPayloadHash   :: Maybe ByteString+  , riRegion        :: Maybe Region   , riNeedsLocation :: Bool   } @@ -423,7 +500,7 @@ type RegionMap = Map.Map Bucket Region  newtype Minio a = Minio {-  unMinio :: ReaderT MinioConn (StateT RegionMap (ResourceT IO)) a+  unMinio :: ReaderT MinioConn (ResourceT IO) a   }   deriving (       Functor@@ -431,38 +508,38 @@     , Monad     , MonadIO     , MonadReader MinioConn-    , MonadState RegionMap     , MonadThrow     , MonadCatch-    , MonadBase IO     , MonadResource     ) -instance MonadBaseControl IO Minio where-  type StM Minio a = (a, RegionMap)-  liftBaseWith f = Minio $ liftBaseWith $ \q -> f (q . unMinio)-  restoreM = Minio . restoreM+instance MonadUnliftIO Minio where+  askUnliftIO = Minio $ ReaderT $ \r ->+                withUnliftIO $ \u ->+                return (UnliftIO (unliftIO u . flip runReaderT r . unMinio))  -- | MinioConn holds connection info and a connection pool-data MinioConn = MinioConn {-    mcConnInfo :: ConnectInfo+data MinioConn = MinioConn+  { mcConnInfo    :: ConnectInfo   , mcConnManager :: NC.Manager+  , mcRegionMap   :: MVar RegionMap   }  -- | Takes connection information and returns a connection object to -- be passed to 'runMinio' connect :: ConnectInfo -> IO MinioConn connect ci = do-  let settings = bool defaultManagerSettings NC.tlsManagerSettings $-        connectIsSecure ci+  let settings | connectIsSecure ci = NC.tlsManagerSettings+               | otherwise = defaultManagerSettings   mgr <- NC.newManager settings-  return $ MinioConn ci mgr+  rMapMVar <- M.newMVar Map.empty+  return $ MinioConn ci mgr rMapMVar  -- | Run the Minio action and return the result or an error. runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a) runMinio ci m = do   conn <- liftIO $ connect ci-  runResourceT . flip evalStateT Map.empty . flip runReaderT conn . unMinio $+  runResourceT . flip runReaderT conn . unMinio $     fmap Right m `MC.catches`     [ MC.Handler handlerServiceErr     , MC.Handler handlerHE

@@ -28,37 +28,38 @@   , digestToBase16   ) where -import           Crypto.Hash (SHA256(..), MD5(..), hashWith, Digest)-import           Crypto.Hash.Conduit (sinkHash)-import           Crypto.MAC.HMAC (hmac, HMAC)-import           Data.ByteArray (ByteArrayAccess, convert)-import           Data.ByteArray.Encoding (convertToBase, Base(Base16))-import qualified Data.Conduit as C+import           Crypto.Hash             (Digest, MD5 (..), SHA256 (..),+                                          hashWith)+import           Crypto.Hash.Conduit     (sinkHash)+import           Crypto.MAC.HMAC         (HMAC, hmac)+import           Data.ByteArray          (ByteArrayAccess, convert)+import           Data.ByteArray.Encoding (Base (Base16), convertToBase)+import qualified Data.Conduit            as C  import           Lib.Prelude  hashSHA256 :: ByteString -> ByteString hashSHA256 = digestToBase16 . hashWith SHA256 -hashSHA256FromSource :: Monad m => C.Producer m ByteString -> m ByteString+hashSHA256FromSource :: Monad m => C.ConduitM () ByteString m () -> m ByteString hashSHA256FromSource src = do-  digest <- src C.$$ sinkSHA256Hash+  digest <- C.connect src sinkSHA256Hash   return $ digestToBase16 digest   where     -- To help with type inference-    sinkSHA256Hash :: Monad m => C.Consumer ByteString m (Digest SHA256)+    sinkSHA256Hash :: Monad m => C.ConduitM ByteString Void m (Digest SHA256)     sinkSHA256Hash = sinkHash  hashMD5 :: ByteString -> ByteString hashMD5 = digestToBase16 . hashWith MD5 -hashMD5FromSource :: Monad m => C.Producer m ByteString -> m ByteString+hashMD5FromSource :: Monad m => C.ConduitM () ByteString m () -> m ByteString hashMD5FromSource src = do-  digest <- src C.$$ sinkMD5Hash+  digest <- C.connect src sinkMD5Hash   return $ digestToBase16 digest   where     -- To help with type inference-    sinkMD5Hash :: Monad m => C.Consumer ByteString m (Digest MD5)+    sinkMD5Hash :: Monad m => C.ConduitM ByteString Void m (Digest MD5)     sinkMD5Hash = sinkHash  hmacSHA256 :: ByteString -> ByteString -> HMAC SHA256

@@ -16,9 +16,9 @@  module Network.Minio.ListOps where -import qualified Data.Conduit as C+import qualified Data.Conduit             as C import qualified Data.Conduit.Combinators as CC-import qualified Data.Conduit.List as CL+import qualified Data.Conduit.List        as CL  import           Lib.Prelude @@ -27,10 +27,10 @@  -- | List objects in a bucket matching the given prefix. If recurse is -- set to True objects matching prefix are recursively listed.-listObjects :: Bucket -> Maybe Text -> Bool -> C.Producer Minio ObjectInfo+listObjects :: Bucket -> Maybe Text -> Bool -> C.ConduitM () ObjectInfo Minio () listObjects bucket prefix recurse = loop Nothing   where-    loop :: Maybe Text -> C.Producer Minio ObjectInfo+    loop :: Maybe Text -> C.ConduitM () ObjectInfo Minio ()     loop nextToken = do       let         delimiter = bool (Just "/") Nothing recurse@@ -42,10 +42,11 @@  -- | List objects in a bucket matching the given prefix. If recurse is -- set to True objects matching prefix are recursively listed.-listObjectsV1 :: Bucket -> Maybe Text -> Bool -> C.Producer Minio ObjectInfo+listObjectsV1 :: Bucket -> Maybe Text -> Bool+              -> C.ConduitM () ObjectInfo Minio () listObjectsV1 bucket prefix recurse = loop Nothing   where-    loop :: Maybe Text -> C.Producer Minio ObjectInfo+    loop :: Maybe Text -> C.ConduitM () ObjectInfo Minio ()     loop nextMarker = do       let         delimiter = bool (Just "/") Nothing recurse@@ -59,10 +60,10 @@ -- recurse is set to True incomplete uploads for the given prefix are -- recursively listed. listIncompleteUploads :: Bucket -> Maybe Text -> Bool-                      -> C.Producer Minio UploadInfo+                      -> C.ConduitM () UploadInfo Minio () listIncompleteUploads bucket prefix recurse = loop Nothing Nothing   where-    loop :: Maybe Text -> Maybe Text -> C.Producer Minio UploadInfo+    loop :: Maybe Text -> Maybe Text -> C.ConduitM () UploadInfo Minio ()     loop nextKeyMarker nextUploadIdMarker = do       let         delimiter = bool (Just "/") Nothing recurse@@ -71,7 +72,8 @@              nextKeyMarker nextUploadIdMarker Nothing        aggrSizes <- lift $ forM (lurUploads res) $ \(uKey, uId, _) -> do-            partInfos <- listIncompleteParts bucket uKey uId C.$$ CC.sinkList+            partInfos <- C.runConduit $ listIncompleteParts bucket uKey uId+                    C..| CC.sinkList             return $ foldl (\sizeSofar p -> opiSize p + sizeSofar) 0 partInfos        CL.sourceList $@@ -86,10 +88,10 @@ -- | List object parts of an ongoing multipart upload for given -- bucket, object and uploadId. listIncompleteParts :: Bucket -> Object -> UploadId-                    -> C.Producer Minio ObjectPartInfo+                    -> C.ConduitM () ObjectPartInfo Minio () listIncompleteParts bucket object uploadId = loop Nothing   where-    loop :: Maybe Text -> C.Producer Minio ObjectPartInfo+    loop :: Maybe Text -> C.ConduitM () ObjectPartInfo Minio ()     loop nextPartMarker = do       res <- lift $ listIncompleteParts' bucket object uploadId Nothing              nextPartMarker

@@ -19,17 +19,15 @@     putObjectInternal   , ObjectData(..)   , selectPartSizes-  , copyObjectInternal-  , selectCopyRanges-  , minPartSize   ) where  -import qualified Data.Conduit as C-import qualified Data.Conduit.Binary as CB+import qualified Data.ByteString.Lazy     as LBS+import qualified Data.Conduit             as C+import qualified Data.Conduit.Binary      as CB import qualified Data.Conduit.Combinators as CC-import qualified Data.Conduit.List as CL-import qualified Data.List as List+import qualified Data.Conduit.List        as CL+import qualified Data.List                as List  import           Lib.Prelude @@ -39,20 +37,6 @@ import           Network.Minio.Utils  --- | max obj size is 5TiB-maxObjectSize :: Int64-maxObjectSize = 5 * 1024 * 1024 * oneMiB---- | minimum size of parts used in multipart operations.-minPartSize :: Int64-minPartSize = 64 * oneMiB--oneMiB :: Int64-oneMiB = 1024 * 1024--maxMultipartParts :: Int64-maxMultipartParts = 10000- -- | A data-type to represent the source data for an object. A -- file-path or a producer-conduit may be provided. --@@ -63,15 +47,33 @@ -- For streams also, a size may be provided. This is useful to limit -- the input - if it is not provided, upload will continue until the -- stream ends or the object reaches `maxObjectsize` size.-data ObjectData m =-  ODFile FilePath (Maybe Int64) -- ^ Takes filepath and optional size.-  | ODStream (C.Producer m ByteString) (Maybe Int64) -- ^ Pass size in bytes as maybe if known.+data ObjectData m+  = ODFile FilePath (Maybe Int64) -- ^ Takes filepath and optional+                                  -- size.+  | ODStream (C.ConduitM () ByteString m ()) (Maybe Int64) -- ^ Pass+                                                           -- size+                                                           -- (bytes)+                                                           -- if+                                                           -- known.  -- | Put an object from ObjectData. This high-level API handles -- objects of all sizes, and even if the object size is unknown.-putObjectInternal :: Bucket -> Object -> ObjectData Minio -> Minio ETag-putObjectInternal b o (ODStream src sizeMay) = sequentialMultipartUpload b o sizeMay src-putObjectInternal b o (ODFile fp sizeMay) = do+putObjectInternal :: Bucket -> Object -> PutObjectOptions+                  -> ObjectData Minio -> Minio ETag+putObjectInternal b o opts (ODStream src sizeMay) = do+  case sizeMay of+    -- unable to get size, so assume non-seekable file and max-object size+    Nothing -> sequentialMultipartUpload b o opts (Just maxObjectSize) src++    -- got file size, so check for single/multipart upload+    Just size ->+      if | size <= 64 * oneMiB -> do+             bs <- C.runConduit $ src C..| CB.sinkLbs+             putObjectSingle' b o (pooToHeaders opts) $ LBS.toStrict bs+         | size > maxObjectSize -> throwM $ MErrVPutSizeExceeded size+         | otherwise -> sequentialMultipartUpload b o opts (Just size) src++putObjectInternal b o opts (ODFile fp sizeMay) = do   hResE <- withNewHandle fp $ \h ->     liftM2 (,) (isHandleSeekable h) (getFileSize h) @@ -83,45 +85,30 @@    case finalSizeMay of     -- unable to get size, so assume non-seekable file and max-object size-    Nothing -> sequentialMultipartUpload b o (Just maxObjectSize) $+    Nothing -> sequentialMultipartUpload b o opts (Just maxObjectSize) $                CB.sourceFile fp      -- got file size, so check for single/multipart upload     Just size ->       if | size <= 64 * oneMiB -> either throwM return =<<-           withNewHandle fp (\h -> putObjectSingle b o [] h 0 size)+           withNewHandle fp (\h -> putObjectSingle b o (pooToHeaders opts) h 0 size)          | size > maxObjectSize -> throwM $ MErrVPutSizeExceeded size-         | isSeekable -> parallelMultipartUpload b o fp size-         | otherwise -> sequentialMultipartUpload b o (Just size) $+         | isSeekable -> parallelMultipartUpload b o opts fp size+         | otherwise -> sequentialMultipartUpload b o opts (Just size) $                         CB.sourceFile fp --- | Select part sizes - the logic is that the minimum part-size will--- be 64MiB.-selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]-selectPartSizes size = uncurry (List.zip3 [1..]) $-                       List.unzip $ loop 0 size-  where-    ceil :: Double -> Int64-    ceil = ceiling-    partSize = max minPartSize (ceil $ fromIntegral size /-                               fromIntegral maxMultipartParts)--    m = fromIntegral partSize-    loop st sz-      | st > sz = []-      | st + m >= sz = [(st, sz - st)]-      | otherwise = (st, m) : loop (st + m) sz--parallelMultipartUpload :: Bucket -> Object -> FilePath -> Int64-                        -> Minio ETag-parallelMultipartUpload b o filePath size = do+parallelMultipartUpload :: Bucket -> Object -> PutObjectOptions+                        -> FilePath -> Int64 -> Minio ETag+parallelMultipartUpload b o opts filePath size = do   -- get a new upload id.-  uploadId <- newMultipartUpload b o []+  uploadId <- newMultipartUpload b o (pooToHeaders opts)    let partSizeInfo = selectPartSizes size -  -- perform upload with 10 threads-  uploadedPartsE <- limitedMapConcurrently 10+  let threads = fromMaybe 10 $ pooNumThreads opts++  -- perform upload with 'threads' threads+  uploadedPartsE <- limitedMapConcurrently (fromIntegral threads)                     (uploadPart uploadId) partSizeInfo    -- if there were any errors, rethrow exception.@@ -129,6 +116,7 @@    -- if we get here, all parts were successfully uploaded.   completeMultipartUpload b o uploadId $ rights uploadedPartsE+   where     uploadPart uploadId (partNum, offset, sz) =       withNewHandle filePath $ \h -> do@@ -136,20 +124,23 @@         putObjectPart b o uploadId partNum [] payload  -- | Upload multipart object from conduit source sequentially-sequentialMultipartUpload :: Bucket -> Object -> Maybe Int64-                          -> C.Producer Minio ByteString -> Minio ETag-sequentialMultipartUpload b o sizeMay src = do+sequentialMultipartUpload :: Bucket -> Object -> PutObjectOptions+                          -> Maybe Int64+                          -> C.ConduitM () ByteString Minio ()+                          -> Minio ETag+sequentialMultipartUpload b o opts sizeMay src = do   -- get a new upload id.-  uploadId <- newMultipartUpload b o []+  uploadId <- newMultipartUpload b o (pooToHeaders opts)    -- upload parts in loop   let partSizes = selectPartSizes $ maybe maxObjectSize identity sizeMay       (pnums, _, sizes) = List.unzip3 partSizes-  uploadedParts <- src+  uploadedParts <- C.runConduit+                 $ src               C..| chunkBSConduit sizes               C..| CL.map PayloadBS               C..| uploadPart' uploadId pnums-              C.$$ CC.sinkList+              C..| CC.sinkList    -- complete multipart upload   completeMultipartUpload b o uploadId uploadedParts@@ -163,69 +154,3 @@         Just payload -> do pinfo <- lift $ putObjectPart b o uid pn [] payload                            C.yield pinfo                            uploadPart' uid pns---- | Copy an object using single or multipart copy strategy.-copyObjectInternal :: Bucket -> Object -> CopyPartSource-                   -> Minio ETag-copyObjectInternal b' o cps = do-  -- validate and extract the src bucket and object-  (srcBucket, srcObject) <- maybe-    (throwM $ MErrVInvalidSrcObjSpec $ cpSource cps)-    return $ cpsToObject cps--  -- get source object size with a head request-  (ObjectInfo _ _ _ srcSize) <- headObject srcBucket srcObject--  -- check that byte offsets are valid if specified in cps-  when (isJust (cpSourceRange cps) &&-        or [fst range < 0, snd range < fst range,-            snd range >= fromIntegral srcSize]) $-    throwM $ MErrVInvalidSrcObjByteRange range--  -- 1. If sz > 64MiB (minPartSize) use multipart copy, OR-  -- 2. If startOffset /= 0 use multipart copy-  let destSize = (\(a, b) -> b - a + 1 ) $-                 maybe (0, srcSize - 1) identity $ cpSourceRange cps-      startOffset = maybe 0 fst $ cpSourceRange cps-      endOffset = maybe (srcSize - 1) snd $ cpSourceRange cps--  if destSize > minPartSize || (endOffset - startOffset + 1 /= srcSize)-    then multiPartCopyObject b' o cps srcSize--    else fst <$> copyObjectSingle b' o cps{cpSourceRange = Nothing} []--  where-    range = maybe (0, 0) identity $ cpSourceRange cps---- | Given the input byte range of the source object, compute the--- splits for a multipart copy object procedure. Minimum part size--- used is minPartSize.-selectCopyRanges :: (Int64, Int64) -> [(PartNumber, (Int64, Int64))]-selectCopyRanges (st, end) = zip pns $-  map (\(x, y) -> (st + x, st + x + y - 1)) $ zip startOffsets partSizes-  where-    size = end - st + 1-    (pns, startOffsets, partSizes) = List.unzip3 $ selectPartSizes size---- | Perform a multipart copy object action. Since we cannot verify--- existing parts based on the source object, there is no resuming--- copy action support.-multiPartCopyObject :: Bucket -> Object -> CopyPartSource -> Int64-                    -> Minio ETag-multiPartCopyObject b o cps srcSize = do-  uid <- newMultipartUpload b o []--  let byteRange = maybe (0, fromIntegral $ srcSize - 1) identity $-                  cpSourceRange cps-      partRanges = selectCopyRanges byteRange-      partSources = map (\(x, y) -> (x, cps {cpSourceRange = Just y}))-                    partRanges--  copiedParts <- limitedMapConcurrently 10-                 (\(pn, cps') -> do-                     (etag, _) <- copyObjectPart b o cps' uid pn []-                     return (pn, etag)-                 )-                 partSources--  completeMultipartUpload b o uid copiedParts

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- Minio Haskell SDK, (C) 2017, 2018 Minio, Inc. -- -- Licensed under the Apache License, Version 2.0 (the "License"); -- you may not use this file except in compliance with the License.@@ -42,6 +42,7 @@   ---------------------------------   , putBucket   , ETag+  , putObjectSingle'   , putObjectSingle   , copyObjectSingle @@ -51,7 +52,6 @@   , PartTuple   , Payload(..)   , PartNumber-  , CopyPartSource(..)   , newMultipartUpload   , putObjectPart   , copyObjectPart@@ -71,6 +71,10 @@   -----------------------------   , module Network.Minio.PresignedOperations +  -- ** Bucket Policies+  , getBucketPolicy+  , setBucketPolicy+   -- * Bucket Notifications   -------------------------   , Notification(..)@@ -86,24 +90,25 @@   , removeAllBucketNotification   ) where -import           Control.Monad.Catch (catches, Handler(..))-import qualified Data.Conduit as C-import           Data.Default (def)-import qualified Network.HTTP.Conduit as NC-import qualified Network.HTTP.Types as HT-import           Network.HTTP.Types.Status (status404)+import           Control.Monad.Catch               (Handler (..), catches)+import qualified Data.ByteString                   as BS+import qualified Data.Conduit                      as C+import           Data.Default                      (def)+import qualified Data.Text                         as T -import           Lib.Prelude hiding (catches)+import           Lib.Prelude                       hiding (catches)+import qualified Network.HTTP.Conduit              as NC+import qualified Network.HTTP.Types                as HT+import           Network.HTTP.Types.Status         (status404)  import           Network.Minio.API import           Network.Minio.Data import           Network.Minio.Errors+import           Network.Minio.PresignedOperations import           Network.Minio.Utils import           Network.Minio.XmlGenerator import           Network.Minio.XmlParser-import           Network.Minio.PresignedOperations - -- | Fetch all buckets from the service. getService :: Minio [BucketInfo] getService = do@@ -115,7 +120,7 @@ -- | GET an object from the service and return the response headers -- and a conduit source for the object content getObject' :: Bucket -> Object -> HT.Query -> [HT.Header]-           -> Minio ([HT.Header], C.ResumableSource Minio ByteString)+           -> Minio ([HT.Header], C.ConduitM () ByteString Minio ()) getObject' bucket object queryParams headers = do   resp <- mkStreamRequest reqInfo   return (NC.responseHeaders resp, NC.responseBody resp)@@ -140,6 +145,28 @@ maxSinglePutObjectSizeBytes :: Int64 maxSinglePutObjectSizeBytes = 5 * 1024 * 1024 * 1024 +putObjectSingle' :: Bucket -> Object -> [HT.Header] -> ByteString -> Minio ETag+putObjectSingle' bucket object headers bs = do+  let size = fromIntegral (BS.length bs)+  -- check length is within single PUT object size.+  when (size > maxSinglePutObjectSizeBytes) $+    throwM $ MErrVSinglePUTSizeExceeded size++  -- content-length header is automatically set by library.+  resp <- executeRequest $+          def { riMethod = HT.methodPut+              , riBucket = Just bucket+              , riObject = Just object+              , riHeaders = headers+              , riPayload = PayloadBS bs+              }++  let rheaders = NC.responseHeaders resp+      etag = getETagHeader rheaders+  maybe+    (throwM MErrVETagHeaderNotFound)+    return etag+ -- | PUT an object into the service. This function performs a single -- PUT object call, and so can only transfer objects upto 5GiB. putObjectSingle :: Bucket -> Object -> [HT.Header] -> Handle -> Int64@@ -252,17 +279,33 @@       , ("partNumber", Just $ show partNumber)       ] +srcInfoToHeaders :: SourceInfo -> [HT.Header]+srcInfoToHeaders srcInfo = ("x-amz-copy-source", encodeUtf8 $ format "/{}/{}" [srcBucket srcInfo, srcObject srcInfo]) :+                   rangeHdr ++ zip names values+  where+    names = ["x-amz-copy-source-if-match", "x-amz-copy-source-if-none-match",+             "x-amz-copy-source-if-unmodified-since",+             "x-amz-copy-source-if-modified-since"]+    values = mapMaybe (fmap encodeUtf8 . (srcInfo &))+             [srcIfMatch, srcIfNoneMatch,+              fmap formatRFC1123 . srcIfUnmodifiedSince,+              fmap formatRFC1123 . srcIfModifiedSince]+    rangeHdr = maybe [] (\a -> [("x-amz-copy-source-range", HT.renderByteRanges [a])])+               $ toByteRange <$> srcRange srcInfo+    toByteRange :: (Int64, Int64) -> HT.ByteRange+    toByteRange (x, y) = HT.ByteRangeFromTo (fromIntegral x) (fromIntegral y)+ -- | Performs server-side copy of an object or part of an object as an -- upload part of an ongoing multi-part upload.-copyObjectPart :: Bucket -> Object -> CopyPartSource -> UploadId+copyObjectPart :: DestinationInfo -> SourceInfo -> UploadId                -> PartNumber -> [HT.Header] -> Minio (ETag, UTCTime)-copyObjectPart bucket object cps uploadId partNumber headers = do+copyObjectPart dstInfo srcInfo uploadId partNumber headers = do   resp <- executeRequest $           def { riMethod = HT.methodPut-              , riBucket = Just bucket-              , riObject = Just object+              , riBucket = Just $ dstBucket dstInfo+              , riObject = Just $ dstObject dstInfo               , riQueryParams = mkOptionalParams params-              , riHeaders = headers ++ cpsToHeaders cps+              , riHeaders = headers ++ srcInfoToHeaders srcInfo               }    parseCopyObjectResponse $ NC.responseBody resp@@ -275,17 +318,17 @@ -- | Performs server-side copy of an object that is upto 5GiB in -- size. If the object is greater than 5GiB, this function throws the -- error returned by the server.-copyObjectSingle :: Bucket -> Object -> CopyPartSource -> [HT.Header]+copyObjectSingle :: Bucket -> Object -> SourceInfo -> [HT.Header]                  -> Minio (ETag, UTCTime)-copyObjectSingle bucket object cps headers = do-  -- validate that cpSourceRange is Nothing for this API.-  when (isJust $ cpSourceRange cps) $+copyObjectSingle bucket object srcInfo headers = do+  -- validate that srcRange is Nothing for this API.+  when (isJust $ srcRange srcInfo) $     throwM MErrVCopyObjSingleNoRangeAccepted   resp <- executeRequest $           def { riMethod = HT.methodPut               , riBucket = Just bucket               , riObject = Just object-              , riHeaders = headers ++ cpsToHeaders cps+              , riHeaders = headers ++ srcInfoToHeaders srcInfo               }   parseCopyObjectResponse $ NC.responseBody resp @@ -367,10 +410,10 @@     modTime = getLastModifiedHeader headers     etag = getETagHeader headers     size = getContentLength headers+    metadata = getMetadataMap headers    maybe (throwM MErrVInvalidObjectInfoResponse) return $-    ObjectInfo <$> Just object <*> modTime <*> etag <*> size-+    ObjectInfo <$> Just object <*> modTime <*> etag <*> size <*> Just metadata   -- | Query the object store if a given bucket exists.@@ -420,3 +463,38 @@ -- | Remove all notifications configured on a bucket. removeAllBucketNotification :: Bucket -> Minio () removeAllBucketNotification = flip putBucketNotification def++-- | Fetch the policy if any on a bucket.+getBucketPolicy :: Bucket -> Minio Text+getBucketPolicy bucket = do+  resp <- executeRequest $ def { riMethod = HT.methodGet+                               , riBucket = Just bucket+                               , riQueryParams = [("policy", Nothing)]+                               }+  return $ toS $ NC.responseBody resp++-- | Set a new policy on a bucket.+-- As a special condition if the policy is empty+-- then we treat it as policy DELETE operation.+setBucketPolicy :: Bucket -> Text -> Minio ()+setBucketPolicy bucket policy = do+  if T.null policy+    then deleteBucketPolicy bucket+    else putBucketPolicy bucket policy++-- | Save a new policy on a bucket.+putBucketPolicy :: Bucket -> Text -> Minio()+putBucketPolicy bucket policy = do+  void $ executeRequest $ def { riMethod = HT.methodPut+                              , riBucket = Just bucket+                              , riQueryParams = [("policy", Nothing)]+                              , riPayload = PayloadBS $ encodeUtf8 policy+                              }++-- | Delete any policy set on a bucket.+deleteBucketPolicy :: Bucket -> Minio()+deleteBucketPolicy bucket = do+  void $ executeRequest $ def { riMethod = HT.methodDelete+                              , riBucket = Just bucket+                              , riQueryParams = [("policy", Nothing)]+                              }

@@ -16,66 +16,71 @@  module Network.Minio.Utils where -import qualified Control.Concurrent.Async.Lifted as A-import qualified Control.Concurrent.QSem.Lifted as Q-import qualified Control.Exception.Lifted as ExL-import qualified Control.Monad.Catch as MC-import qualified Control.Monad.Trans.Resource as R--import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as LB-import qualified Data.Conduit as C-import qualified Data.Conduit.Binary as CB-import qualified Data.Text as T-import           Data.Text.Encoding.Error (lenientDecode)-import           Data.Text.Read (decimal)-import           Data.Time-import           Network.HTTP.Conduit (Response)-import qualified Network.HTTP.Conduit as NC-import qualified Network.HTTP.Types as HT-import qualified Network.HTTP.Types.Header as Hdr-import qualified System.IO as IO-import           Data.CaseInsensitive (mk)-+import qualified Control.Monad.Catch           as MC+import           Control.Monad.IO.Unlift       (MonadUnliftIO)+import qualified Control.Monad.Trans.Resource  as R+import qualified Data.ByteString               as B+import qualified Data.ByteString.Lazy          as LB+import           Data.CaseInsensitive          (mk, original)+import qualified Data.Conduit                  as C+import qualified Data.Conduit.Binary           as CB+import qualified Data.List                     as List+import qualified Data.Map                      as Map+import qualified Data.Text                     as T+import           Data.Text.Encoding.Error      (lenientDecode)+import           Data.Text.Read                (decimal)+import           Data.Time                     (defaultTimeLocale, parseTimeM,+                                                rfc822DateFormat)+import           Network.HTTP.Conduit          (Response)+import qualified Network.HTTP.Conduit          as NC+import qualified Network.HTTP.Types            as HT+import qualified Network.HTTP.Types.Header     as Hdr+import qualified System.IO                     as IO+import qualified UnliftIO.Async                as A+import qualified UnliftIO.Exception            as UEx+import qualified UnliftIO.MVar                 as UM+import qualified UnliftIO.STM                  as U  import           Lib.Prelude -import           Network.Minio.XmlParser (parseErrResponse)+import           Network.Minio.Data+import           Network.Minio.Data.ByteString+import           Network.Minio.XmlParser       (parseErrResponse) -allocateReadFile :: (R.MonadResource m, R.MonadResourceBase m, MonadCatch m)+allocateReadFile :: (MonadUnliftIO m, R.MonadResource m, MonadCatch m)                  => FilePath -> m (R.ReleaseKey, Handle) allocateReadFile fp = do   (rk, hdlE) <- R.allocate (openReadFile fp) cleanup   either (\(e :: IOException) -> throwM e) (return . (rk,)) hdlE   where-    openReadFile f = ExL.try $ IO.openBinaryFile f IO.ReadMode+    openReadFile f = UEx.try $ IO.openBinaryFile f IO.ReadMode     cleanup = either (const $ return ()) IO.hClose  -- | Queries the file size from the handle. Catches any file operation -- exceptions and returns Nothing instead.-getFileSize :: (R.MonadResourceBase m, R.MonadResource m)+getFileSize :: (MonadUnliftIO m, R.MonadResource m)             => Handle -> m (Maybe Int64) getFileSize h = do   resE <- liftIO $ try $ fromIntegral <$> IO.hFileSize h   case resE of     Left (_ :: IOException) -> return Nothing-    Right s -> return $ Just s+    Right s                 -> return $ Just s  -- | Queries if handle is seekable. Catches any file operation -- exceptions and return False instead.-isHandleSeekable :: (R.MonadResource m, R.MonadResourceBase m)+isHandleSeekable :: (R.MonadResource m, MonadUnliftIO m)                => Handle -> m Bool isHandleSeekable h = do   resE <- liftIO $ try $ IO.hIsSeekable h   case resE of     Left (_ :: IOException) -> return False-    Right v -> return v+    Right v                 -> return v  -- | Helper function that opens a handle to the filepath and performs -- the given action on it. Exceptions of type MError are caught and -- returned - both during file handle allocation and when the action -- is run.-withNewHandle :: (R.MonadResourceBase m, R.MonadResource m, MonadCatch m)+withNewHandle :: (MonadUnliftIO m, R.MonadResource m, MonadCatch m)               => FilePath -> (Handle -> m a) -> m (Either IOException a) withNewHandle fp fileAction = do   -- opening a handle can throw MError exception.@@ -98,6 +103,12 @@ getETagHeader :: [HT.Header] -> Maybe Text getETagHeader hs = decodeUtf8Lenient <$> lookupHeader Hdr.hETag hs +getMetadata :: [HT.Header] -> [(Text, Text)]+getMetadata = map ((\(x, y) -> (decodeUtf8Lenient $ original x, decodeUtf8Lenient $ stripBS y)))++getMetadataMap :: [HT.Header] -> Map Text Text+getMetadataMap hs = Map.fromList (getMetadata hs)+ getLastModifiedHeader :: [HT.Header] -> Maybe UTCTime getLastModifiedHeader hs = do   modTimebs <- decodeUtf8Lenient <$> lookupHeader Hdr.hLastModified hs@@ -139,16 +150,17 @@     contentTypeMay resp = lookupHeader Hdr.hContentType $                           NC.responseHeaders resp -http :: (R.MonadResourceBase m, R.MonadResource m)+http :: (MonadUnliftIO m, MonadThrow m, R.MonadResource m)      => NC.Request -> NC.Manager-     -> m (Response (C.ResumableSource m ByteString))+     -> m (Response (C.ConduitT () ByteString m ())) http req mgr = do   respE <- tryHttpEx $ NC.http req mgr   resp <- either throwM return respE   unless (isSuccessStatus $ NC.responseStatus resp) $     case contentTypeMay resp of       Just "application/xml" -> do-        respBody <- NC.responseBody resp C.$$+- CB.sinkLbs+        respBody <- C.connect (NC.responseBody resp) CB.sinkLbs+        --respBody <- C.unsealConduitT (NC.responseBody resp) C.$$+- CB.sinkLbs         sErr <- parseErrResponse respBody         throwM sErr @@ -160,24 +172,35 @@    return resp   where-    tryHttpEx :: (R.MonadResourceBase m) => m a+    tryHttpEx :: (MonadUnliftIO m) => m a               -> m (Either NC.HttpException a)-    tryHttpEx = ExL.try+    tryHttpEx = UEx.try     contentTypeMay resp = lookupHeader Hdr.hContentType $ NC.responseHeaders resp  -- Similar to mapConcurrently but limits the number of threads that -- can run using a quantity semaphore.-limitedMapConcurrently :: (MonadIO m, R.MonadBaseControl IO m)+limitedMapConcurrently :: MonadUnliftIO m                        => Int -> (t -> m a) -> [t] -> m [a]+limitedMapConcurrently 0 _ _ = return [] limitedMapConcurrently count act args = do-  qSem <- liftIO $ Q.newQSem count-  threads <- mapM (A.async . wThread qSem) args+  t' <- U.newTVarIO count+  threads <- mapM (A.async . wThread t') args   mapM A.wait threads   where-    -- grab 1 unit from semaphore, run action and release it-    wThread qs arg =-      ExL.bracket_ (Q.waitQSem qs) (Q.signalQSem qs) $ act arg+    wThread t arg =+      UEx.bracket_ (waitSem t) (signalSem t) $ act arg +    -- quantity semaphore implementation using TVar+    waitSem t = U.atomically $ do+      v <- U.readTVar t+      if v > 0+      then U.writeTVar t (v-1)+      else U.retrySTM++    signalSem t = U.atomically $ do+      v <- U.readTVar t+      U.writeTVar t (v+1)+ -- helper function to 'drop' empty optional parameter. mkQuery :: Text -> Maybe Text -> Maybe (Text, Text) mkQuery k mv = (k,) <$> mv@@ -188,7 +211,7 @@ mkOptionalParams params = HT.toQuery $ uncurry  mkQuery <$> params  chunkBSConduit :: (Monad m, Integral a)-               => [a] -> C.Conduit ByteString m ByteString+               => [a] -> C.ConduitM ByteString ByteString m () chunkBSConduit s = loop 0 [] s   where     loop _ _ [] = return ()@@ -203,3 +226,36 @@                            loop (fromIntegral $ B.length b) [b] sizes                    else loop (n + fromIntegral (B.length bs))                         (readChunks ++ [bs]) (size:sizes)++-- | Select part sizes - the logic is that the minimum part-size will+-- be 64MiB.+selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]+selectPartSizes size = uncurry (List.zip3 [1..]) $+                       List.unzip $ loop 0 size+  where+    ceil :: Double -> Int64+    ceil = ceiling+    partSize = max minPartSize (ceil $ fromIntegral size /+                               fromIntegral maxMultipartParts)++    m = fromIntegral partSize+    loop st sz+      | st > sz = []+      | st + m >= sz = [(st, sz - st)]+      | otherwise = (st, m) : loop (st + m) sz++lookupRegionCache :: Bucket -> Minio (Maybe Region)+lookupRegionCache b = do+    rMVar <- asks mcRegionMap+    rMap <- UM.readMVar rMVar+    return $ Map.lookup b rMap++addToRegionCache :: Bucket -> Region -> Minio ()+addToRegionCache b region = do+    rMVar <- asks mcRegionMap+    UM.modifyMVar_ rMVar $ return . Map.insert b region++deleteFromRegionCache :: Bucket -> Minio ()+deleteFromRegionCache b = do+    rMVar <- asks mcRegionMap+    UM.modifyMVar_ rMVar $ return . Map.delete b

@@ -29,8 +29,9 @@   ) where  import           Control.Monad.Trans.Resource-import           Data.List                    (zip3, zip4)+import           Data.List                    (zip3, zip4, zip5) import qualified Data.Text                    as T+import qualified Data.Map                     as Map import           Data.Text.Read               (decimal) import           Data.Time import           Text.XML@@ -50,6 +51,9 @@ uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e uncurry4 f (a, b, c, d) = f a b c d +uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f+uncurry5 f (a, b, c, d, e) = f a b c d e+ -- | Parse time strings from XML parseS3XMLTime :: (MonadThrow m) => Text -> m UTCTime parseS3XMLTime = either (throwM . MErrVXmlParse) return@@ -134,7 +138,7 @@   sizes <- parseDecimals sizeStr    let-    objects = map (uncurry4 ObjectInfo) $ zip4 keys modTimes etags sizes+    objects = map (uncurry5 ObjectInfo) $ zip5 keys modTimes etags sizes (repeat Map.empty)    return $ ListObjectsV1Result hasMore nextMarker objects prefixes @@ -161,7 +165,7 @@   sizes <- parseDecimals sizeStr    let-    objects = map (uncurry4 ObjectInfo) $ zip4 keys modTimes etags sizes+    objects = map (uncurry5 ObjectInfo) $ zip5 keys modTimes etags sizes (repeat Map.empty)    return $ ListObjectsResult hasMore nextToken objects prefixes 

@@ -0,0 +1,66 @@+# This file was automatically generated by 'stack init'+#+# Some commonly used options have been documented as comments in this file.+# For advanced use and comprehensive documentation of the format, please see:+# http://docs.haskellstack.org/en/stable/yaml_configuration/++# Resolver to choose a 'specific' stackage snapshot or a compiler version.+# A snapshot resolver dictates the compiler version and the set of packages+# to be used for project dependencies. For example:+#+# resolver: lts-3.5+# resolver: nightly-2015-09-21+# resolver: ghc-7.10.2+# resolver: ghcjs-0.1.0_ghc-7.10.2+# resolver:+#  name: custom-snapshot+#  location: "./custom-snapshot.yaml"+resolver: lts-11.1++# User packages to be built.+# Various formats can be used as shown in the example below.+#+# packages:+# - some-directory+# - https://example.com/foo/bar/baz-0.0.2.tar.gz+# - location:+#    git: https://github.com/commercialhaskell/stack.git+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a+#   extra-dep: true+#  subdirs:+#  - auto-update+#  - wai+#+# A package marked 'extra-dep: true' will only be built if demanded by a+# non-dependency (i.e. a user package), and its test suites and benchmarks+# will not be run. This is useful for tweaking upstream packages.+packages:+- '.'+# Dependency packages to be pulled from upstream that are not in the resolver+# (e.g., acme-missiles-0.3)+extra-deps: []++# Override default flag values for local packages and extra-deps+flags: {}++# Extra package databases containing global packages+extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true+#+# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: ">=1.1"+#+# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64+#+# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]+#+# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- Minio Haskell SDK, (C) 2017, 2018 Minio, Inc. -- -- Licensed under the Apache License, Version 2.0 (the "License"); -- you may not use this file except in compliance with the License.@@ -19,30 +19,29 @@ import           Test.Tasty.HUnit import           Test.Tasty.QuickCheck                 as QC -import           Lib.Prelude--import           System.Directory                      (getTemporaryDirectory)-import qualified System.IO                             as SIO- import qualified Control.Monad.Catch                   as MC import qualified Control.Monad.Trans.Resource          as R import qualified Data.ByteString                       as BS-import           Data.Conduit                          (yield, ($$))+import           Data.Conduit                          (yield) import qualified Data.Conduit                          as C import qualified Data.Conduit.Binary                   as CB import           Data.Conduit.Combinators              (sinkList) import           Data.Default                          (Default (..)) import qualified Data.Map.Strict                       as Map import qualified Data.Text                             as T+import           Data.Time                             (fromGregorian) import qualified Data.Time                             as Time import qualified Network.HTTP.Client.MultipartFormData as Form import qualified Network.HTTP.Conduit                  as NC import qualified Network.HTTP.Types                    as HT+import           System.Directory                      (getTemporaryDirectory) import           System.Environment                    (lookupEnv)+import qualified System.IO                             as SIO +import           Lib.Prelude+ import           Network.Minio import           Network.Minio.Data-import           Network.Minio.ListOps import           Network.Minio.PutObject import           Network.Minio.S3API import           Network.Minio.Utils@@ -54,11 +53,9 @@ tests = testGroup "Tests" [liveServerUnitTests]  -- conduit that generates random binary stream of given length-randomDataSrc :: MonadIO m => Int64 -> C.Producer m ByteString+randomDataSrc :: MonadIO m => Int64 -> C.ConduitM () ByteString m () randomDataSrc s' = genBS s'   where-    oneMiB = 1024*1024-     concatIt bs n = BS.concat $ replicate (fromIntegral q) bs ++                     [BS.take (fromIntegral r) bs]       where (q, r) = n `divMod` fromIntegral (BS.length bs)@@ -74,7 +71,7 @@ mkRandFile :: R.MonadResource m => Int64 -> m FilePath mkRandFile size = do   dir <- liftIO $ getTemporaryDirectory-  randomDataSrc size C.$$ CB.sinkTempFile dir "miniohstest.random"+  C.runConduit $ randomDataSrc size C..| CB.sinkTempFile dir "miniohstest.random"  funTestBucketPrefix :: Text funTestBucketPrefix = "miniohstest-"@@ -119,7 +116,7 @@        destFile <- mkRandFile 0       step  "Retrieve the created object and check size"-      fGetObject bucket object destFile+      fGetObject bucket object destFile def       gotSize <- withNewHandle destFile getFileSize       liftIO $ gotSize == Right (Just mb15) @?         "Wrong file size of put file after getting"@@ -127,6 +124,29 @@       step  "Cleanup actions"       removeObject bucket object +putObjectSizeTest :: TestTree+putObjectSizeTest = funTestWithBucket "PutObject of conduit source with size" $+  \step bucket -> do+      -- putObject test (conduit source, size specified)+      let obj = "msingle"+          mb1 = 1 * 1024 * 1024++      step "Prepare for putObject with from source with size."+      rFile <- mkRandFile mb1++      step "Upload single file."+      putObject bucket obj (CB.sourceFile rFile) (Just mb1) def++      step "Retrieve and verify file size"+      destFile <- mkRandFile 0+      fGetObject bucket obj destFile def+      gotSize <- withNewHandle destFile getFileSize+      liftIO $ gotSize == Right (Just mb1) @?+        "Wrong file size of put file after getting"++      step "Cleanup actions"+      deleteObject bucket obj+ putObjectNoSizeTest :: TestTree putObjectNoSizeTest = funTestWithBucket "PutObject of conduit source with no size" $   \step bucket -> do@@ -138,11 +158,11 @@       rFile <- mkRandFile mb70        step "Upload multipart file."-      putObject bucket obj (CB.sourceFile rFile) Nothing+      putObject bucket obj (CB.sourceFile rFile) Nothing def        step "Retrieve and verify file size"       destFile <- mkRandFile 0-      fGetObject bucket obj destFile+      fGetObject bucket obj destFile def       gotSize <- withNewHandle destFile getFileSize       liftIO $ gotSize == Right (Just mb70) @?         "Wrong file size of put file after getting"@@ -157,17 +177,21 @@       step "put 3 objects"       let expectedObjects = ["dir/o1", "dir/dir1/o2", "dir/dir2/o3"]       forM_ expectedObjects $-        \obj -> fPutObject bucket obj "/etc/lsb-release"+        \obj -> fPutObject bucket obj "/etc/lsb-release" def        step "High-level listing of objects"-      objects <- listObjects bucket Nothing True $$ sinkList+      objects <- C.runConduit $ listObjects bucket Nothing True C..| sinkList        liftIO $ assertEqual "Objects match failed!" (sort expectedObjects)         (map oiObject objects)        step "High-level listing of objects (version 1)"-      objects <- listObjectsV1 bucket Nothing True $$ sinkList+      objectsV1 <- C.runConduit $ listObjectsV1 bucket Nothing True C..|+                   sinkList +      liftIO $ assertEqual "Objects match failed!" (sort expectedObjects)+        (map oiObject objectsV1)+       step "Cleanup actions"       forM_ expectedObjects $         \obj -> removeObject bucket obj@@ -180,11 +204,10 @@         liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.")        step "High-level listing of incomplete multipart uploads"-      uploads <- listIncompleteUploads bucket Nothing True $$ sinkList-      -- Minio server behaviour changed to list no incomplete uploads,-      -- so the check below reflects this; this test is expected to-      -- fail on AWS S3.-      liftIO $ length uploads @?= 0+      uploads <- C.runConduit $+                 listIncompleteUploads bucket (Just "newmpupload") True C..|+                 sinkList+      liftIO $ length uploads @?= 10        step "cleanup"       forM_ uploads $ \(UploadInfo _ uid _ _) ->@@ -204,7 +227,8 @@         putObjectPart bucket object uid pnum [] $ PayloadH h 0 mb5        step "fetch list parts"-      incompleteParts <- listIncompleteParts bucket object uid $$ sinkList+      incompleteParts <- C.runConduit $ listIncompleteParts bucket object uid+                         C..| sinkList       liftIO $ length incompleteParts @?= 10        step "cleanup"@@ -217,7 +241,7 @@       let objects = (\s ->T.concat ["lsb-release", T.pack (show s)]) <$> [1..10::Int]        forM_ [1..10::Int] $ \s ->-        fPutObject bucket (T.concat ["lsb-release", T.pack (show s)]) "/etc/lsb-release"+        fPutObject bucket (T.concat ["lsb-release", T.pack (show s)]) "/etc/lsb-release" def        step "Simple list"       res <- listObjects' bucket Nothing Nothing Nothing Nothing@@ -226,14 +250,14 @@         (map oiObject $ lorObjects res)        step "Simple list version 1"-      res <- listObjectsV1' bucket Nothing Nothing Nothing Nothing+      resV1 <- listObjectsV1' bucket Nothing Nothing Nothing Nothing       let expected = sort $ map (T.concat .                           ("lsb-release":) .                           (\x -> [x]) .                           T.pack .                           show) [1..10::Int]       liftIO $ assertEqual "Objects match failed!" expected-        (map oiObject $ lorObjects' res)+        (map oiObject $ lorObjects' resV1)        step "Cleanup actions"       forM_ objects $ \obj -> deleteObject bucket obj@@ -246,12 +270,9 @@         liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.")        step "list incomplete multipart uploads"-      incompleteUploads <- listIncompleteUploads' bucket Nothing Nothing+      incompleteUploads <- listIncompleteUploads' bucket (Just "newmpupload") Nothing                            Nothing Nothing Nothing-      -- Minio server behaviour changed to list no incomplete uploads,-      -- so the check below reflects this; this test is expected to-      -- fail on AWS S3.-      liftIO $ (length $ lurUploads incompleteUploads) @?= 0+      liftIO $ (length $ lurUploads incompleteUploads) @?= 10        step "cleanup"       forM_ (lurUploads incompleteUploads) $@@ -282,6 +303,7 @@   , listingTest   , highLevelListingTest   , lowLevelMultipartTest+  , putObjectSizeTest   , putObjectNoSizeTest   , funTestWithBucket "Multipart Tests" $     \step bucket -> do@@ -290,11 +312,11 @@       let mb80 = 80 * 1024 * 1024           obj = "mpart" -      void $ putObjectInternal bucket obj $ ODFile "/dev/zero" (Just mb80)+      void $ putObjectInternal bucket obj def $ ODFile "/dev/zero" (Just mb80)        step "Retrieve and verify file size"       destFile <- mkRandFile 0-      fGetObject bucket obj destFile+      fGetObject bucket obj destFile def       gotSize <- withNewHandle destFile getFileSize       liftIO $ gotSize == Right (Just mb80) @?         "Wrong file size of put file after getting"@@ -323,10 +345,108 @@        step "remove ongoing upload"       removeIncompleteUpload bucket object-      uploads <- listIncompleteUploads bucket (Just object) False C.$$ sinkList+      uploads <- C.runConduit $ listIncompleteUploads bucket (Just object) False+                 C..| sinkList       liftIO $ (null uploads) @? "removeIncompleteUploads didn't complete successfully" +  , funTestWithBucket "putObject contentType tests" $ \step bucket -> do+      step "fPutObject content type test"+      let object = "xxx-content-type"+          size1 = 100 :: Int64 +      step "create server object with content-type"+      inputFile <- mkRandFile size1+      fPutObject bucket object inputFile def{+        pooContentType = Just "application/javascript"+        }++      -- retrieve obj info to check+      oi <- headObject bucket object+      let m = oiMetadata oi++      step "Validate content-type"+      liftIO $ assertEqual "Content-Type did not match" (Just "application/javascript") (Map.lookup "Content-Type" m)++      step "upload object with content-encoding set to identity"+      fPutObject bucket object inputFile def {+        pooContentEncoding = Just "identity"+        }++      oiCE <- headObject bucket object+      let m' = oiMetadata oiCE++      step "Validate content-encoding"+      liftIO $ assertEqual "Content-Encoding did not match" (Just "identity")+        (Map.lookup "Content-Encoding" m')++      step "Cleanup actions"++      removeObject bucket object++  , funTestWithBucket "putObject contentLanguage tests" $ \step bucket -> do+      step "fPutObject content language test"+      let object = "xxx-content-language"+          size1 = 100 :: Int64++      step "create server object with content-language"+      inputFile <- mkRandFile size1+      fPutObject bucket object inputFile def{+        pooContentLanguage = Just "en-US"+        }++      -- retrieve obj info to check+      oi <- headObject bucket object+      let m = oiMetadata oi++      step "Validate content-language"+      liftIO $ assertEqual "content-language did not match" (Just "en-US")+        (Map.lookup "Content-Language" m)+      step "Cleanup actions"++      removeObject bucket object++  , funTestWithBucket "putObject storageClass tests" $ \step bucket -> do+      step "fPutObject storage class test"+      let object = "xxx-storage-class-standard"+          object' = "xxx-storage-class-reduced"+          object'' = "xxx-storage-class-invalid"+          size1 = 100 :: Int64+          size0 = 0 :: Int64++      step "create server objects with storageClass"+      inputFile <- mkRandFile size1+      inputFile' <- mkRandFile size1+      inputFile'' <- mkRandFile size0++      fPutObject bucket object inputFile def{+        pooStorageClass = Just "STANDARD"+        }++      fPutObject bucket object' inputFile' def{+        pooStorageClass = Just "REDUCED_REDUNDANCY"+        }++      removeObject bucket object++      -- retrieve obj info to check+      oi' <- headObject bucket object'+      let m' = oiMetadata oi'++      step "Validate x-amz-storage-class rrs"+      liftIO $ assertEqual "storageClass did not match" (Just "REDUCED_REDUNDANCY")+        (Map.lookup "X-Amz-Storage-Class" m')++      fpE <- MC.try $ fPutObject bucket object'' inputFile'' def{+        pooStorageClass = Just "INVALID_STORAGE_CLASS"+        }+      case fpE of+        Left exn -> liftIO $ exn @?= ServiceErr "InvalidStorageClass" "Invalid storage class."+        _        -> return ()++      step "Cleanup actions"++      removeObject bucket object'+   , funTestWithBucket "copyObject related tests" $ \step bucket -> do       step "copyObjectSingle basic tests"       let object = "xxx"@@ -335,14 +455,17 @@        step "create server object to copy"       inputFile <- mkRandFile size1-      fPutObject bucket object inputFile+      fPutObject bucket object inputFile def        step "copy object"-      let cps = def { cpSource = format "/{}/{}" [bucket, object] }-      (etag, modTime) <- copyObjectSingle bucket objCopy cps []+      let srcInfo = def { srcBucket = bucket, srcObject = object}+      (etag, modTime) <- copyObjectSingle bucket objCopy srcInfo []        -- retrieve obj info to check-      ObjectInfo _ t e s <- headObject bucket objCopy+      oi <- headObject bucket objCopy+      let t = oiModTime oi+      let e = oiETag oi+      let s = oiSize oi        let isMTimeDiffOk = abs (diffUTCTime modTime t) < 1.0 @@ -361,17 +484,18 @@       let mb15 = 15 * 1024 * 1024           mb5 = 5 * 1024 * 1024       randFile <- mkRandFile mb15-      fPutObject bucket srcObj randFile+      fPutObject bucket srcObj randFile def        step "create new multipart upload"       uid <- newMultipartUpload bucket copyObj []       liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id."        step "put object parts 1-3"-      let cps' = def {cpSource = format "/{}/{}" [bucket, srcObj]}+      let srcInfo' = def { srcBucket = bucket, srcObject = srcObj }+          dstInfo' = def { dstBucket = bucket, dstObject = copyObj }       parts <- forM [1..3] $ \p -> do-        (etag', _) <- copyObjectPart bucket copyObj cps'{-          cpSourceRange = Just ((p-1)*mb5, (p-1)*mb5 + (mb5 - 1))+        (etag', _) <- copyObjectPart dstInfo' srcInfo'{+          srcRange = Just $ (,) ((p-1)*mb5) ((p-1)*mb5 + (mb5 - 1))           } uid (fromIntegral p) []         return (fromIntegral p, etag') @@ -379,7 +503,8 @@       void $ completeMultipartUpload bucket copyObj uid parts        step "verify copied object size"-      (ObjectInfo _ _ _ s') <- headObject bucket copyObj+      oi' <- headObject bucket copyObj+      let s' = oiSize oi'        liftIO $ (s' == mb15) @? "Size failed to match" @@ -393,12 +518,13 @@           sizes = map (* (1024 * 1024)) [15, 65]        step "Prepare"-      forM_ (zip srcs sizes) $ \(src, size) ->-        fPutObject bucket src =<< mkRandFile size+      forM_ (zip srcs sizes) $ \(src, size) -> do+        inputFile' <- mkRandFile size+        fPutObject bucket src inputFile' def        step "make small and large object copy"       forM_ (zip copyObjs srcs) $ \(cp, src) ->-        copyObject bucket cp def{cpSource = format "/{}/{}" [bucket, src]}+        copyObject def {dstBucket = bucket, dstObject = cp} def{srcBucket = bucket, srcObject = src}        step "verify uploaded objects"       uploadedSizes <- fmap oiSize <$> forM copyObjs (headObject bucket)@@ -412,12 +538,14 @@           size = 15 * 1024 * 1024        step "Prepare"-      fPutObject bucket src =<< mkRandFile size+      inputFile' <- mkRandFile size+      fPutObject bucket src inputFile' def        step "copy last 10MiB of object"-      copyObject bucket copyObj def{-          cpSource = format "/{}/{}" [bucket, src]-        , cpSourceRange = Just (5 * 1024 * 1024, size - 1)+      copyObject def { dstBucket = bucket, dstObject = copyObj } def{+          srcBucket = bucket+        , srcObject = src+        , srcRange = Just $ (,) (5 * 1024 * 1024) (size - 1)         }        step "verify uploaded object"@@ -429,6 +557,7 @@    , presignedUrlFunTest   , presignedPostPolicyFunTest+  , bucketPolicyFunTest   ]  basicTests :: TestTree@@ -457,25 +586,54 @@       liftIO $ region == "us-east-1" @? ("Got unexpected region => " ++ show region)        step "singlepart putObject works"-      fPutObject bucket "lsb-release" "/etc/lsb-release"+      fPutObject bucket "lsb-release" "/etc/lsb-release" def        step "fPutObject onto a non-existent bucket and check for NoSuchBucket exception"-      fpE <- MC.try $ fPutObject "nosuchbucket" "lsb-release" "/etc/lsb-release"+      fpE <- MC.try $ fPutObject "nosuchbucket" "lsb-release" "/etc/lsb-release" def       case fpE of         Left exn -> liftIO $ exn @?= NoSuchBucket         _        -> return ()        outFile <- mkRandFile 0       step "simple fGetObject works"-      fGetObject bucket "lsb-release" outFile+      fGetObject bucket "lsb-release" outFile def -      step "fGetObject a non-existent object and check for NoSuchKey exception"-      resE <- MC.try $ fGetObject bucket "noSuchKey" outFile+      let unmodifiedTime = UTCTime (fromGregorian 2010 11 26) 69857+      step "fGetObject an object which is modified now but requesting as un-modified in past, check for exception"+      resE <- MC.try $ fGetObject bucket "lsb-release" outFile def{+        gooIfUnmodifiedSince = (Just unmodifiedTime)+        }       case resE of-        Left exn -> liftIO $ exn @?= NoSuchKey+        Left exn -> liftIO $ exn @?= ServiceErr "PreconditionFailed" "At least one of the pre-conditions you specified did not hold"         _        -> return () +      step "fGetObject an object with no matching etag, check for exception"+      resE1 <- MC.try $ fGetObject bucket "lsb-release" outFile def{+        gooIfMatch = (Just "invalid-etag")+        }+      case resE1 of+        Left exn -> liftIO $ exn @?= ServiceErr "PreconditionFailed" "At least one of the pre-conditions you specified did not hold"+        _        -> return () +      step "fGetObject an object with no valid range, check for exception"+      resE2 <- MC.try $ fGetObject bucket "lsb-release" outFile def{+        gooRange = (Just $ HT.ByteRangeFromTo 100 200)+        }+      case resE2 of+          Left exn -> liftIO $ exn @?= ServiceErr "InvalidRange" "The requested range is not satisfiable"+          _        -> return ()++      step "fGetObject on object with a valid range"+      fGetObject bucket "lsb-release" outFile def{+        gooRange = (Just $ HT.ByteRangeFrom 1)+        }++      step "fGetObject a non-existent object and check for NoSuchKey exception"+      resE3 <- MC.try $ fGetObject bucket "noSuchKey" outFile def+      case resE3 of+        Left exn -> liftIO $ exn @?= NoSuchKey+        _        -> return ()+       step "create new multipart upload works"       uid <- newMultipartUpload bucket "newmpupload" []       liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.")@@ -490,7 +648,7 @@       let object = "sample"       step "create an object"       inputFile <- mkRandFile 0-      fPutObject bucket object inputFile+      fPutObject bucket object inputFile def        step "get metadata of the object"       res <- statObject bucket object@@ -529,7 +687,7 @@       "presigned GET failed"      -- read content from file to compare with response above-    bs <- CB.sourceFile inputFile $$ CB.sinkLbs+    bs <- C.runConduit $ CB.sourceFile inputFile C..| CB.sinkLbs     liftIO $ (bs == NC.responseBody getResp) @?       "presigned put and get got mismatched data" @@ -564,7 +722,7 @@       "presigned GET failed (presignedGetObjectUrl)"      -- read content from file to compare with response above-    bs2 <- CB.sourceFile testFile $$ CB.sinkLbs+    bs2 <- C.runConduit $ CB.sourceFile testFile C..| CB.sinkLbs     liftIO $ (bs2 == NC.responseBody getResp2) @?       "presigned put and get got mismatched data (presigned*Url)" @@ -624,3 +782,38 @@         req' <- Form.formDataBody parts' req         mgr <- NC.newManager NC.tlsManagerSettings         NC.httpLbs req' mgr++bucketPolicyFunTest :: TestTree+bucketPolicyFunTest = funTestWithBucket "Bucket Policy tests" $+  \step bucket -> do++    step "bucketPolicy basic test - no policy exception"+    resE <- MC.try $ getBucketPolicy bucket+    case resE of+      Left exn -> liftIO $ exn @?= ServiceErr "NoSuchBucketPolicy" "The bucket policy does not exist"+      _        -> return ()++    resE' <- MC.try $ setBucketPolicy bucket T.empty+    case resE' of+      Left exn -> liftIO $ exn @?= ServiceErr "NoSuchBucketPolicy" "The bucket policy does not exist"+      _        -> return ()++    let expectedPolicyJSON = "{\"Version\":\"2012-10-17\",\"Statement\":[{\"Action\":[\"s3:GetBucketLocation\",\"s3:ListBucket\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::testbucket\"],\"Sid\":\"\"},{\"Action\":[\"s3:GetObject\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::testbucket/*\"],\"Sid\":\"\"}]}"++    step "try a malformed policy, expect error"+    resE'' <- MC.try $ setBucketPolicy bucket expectedPolicyJSON+    case resE'' of+      Left exn -> liftIO $ exn @?= ServiceErr "MalformedPolicy" "Policy has invalid resource."+      _        -> return ()++    let expectedPolicyJSON' = "{\"Version\":\"2012-10-17\",\"Statement\":[{\"Action\":[\"s3:GetBucketLocation\",\"s3:ListBucket\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::" <> bucket <> "\"],\"Sid\":\"\"},{\"Action\":[\"s3:GetObject\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::" <> bucket <> "/*\"],\"Sid\":\"\"}]}"++    step "set bucket policy"+    setBucketPolicy bucket expectedPolicyJSON'++    step "verify if bucket policy was properly set"+    policyJSON <- getBucketPolicy bucket+    liftIO $ policyJSON @?= expectedPolicyJSON'++    step "delete bucket policy"+    setBucketPolicy bucket T.empty

@@ -21,6 +21,7 @@  import qualified Control.Monad.Catch     as MC import           Data.Time               (fromGregorian)+import qualified Data.Map                as Map import           Test.Tasty import           Test.Tasty.HUnit @@ -126,7 +127,7 @@               \</ListBucketResult>"      expectedListResult = ListObjectsResult True (Just "opaque") [object1] []-    object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234+    object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 Map.empty     modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12    parsedListObjectsResult <- tryValidationErr $ parseListObjectsResponse xmldata@@ -153,7 +154,7 @@               \</ListBucketResult>"      expectedListResult = ListObjectsV1Result True (Just "my-image1.jpg") [object1] []-    object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234+    object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 Map.empty     modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12    parsedListObjectsV1Result <- tryValidationErr $ parseListObjectsV1Response xmldata

@@ -22,6 +22,8 @@ import           Lib.Prelude  import           Network.Minio.API.Test+import           Network.Minio.CopyObject+import           Network.Minio.Data import           Network.Minio.PutObject import           Network.Minio.Utils.Test import           Network.Minio.XmlGenerator.Test