minio-hs 1.2.0 → 1.3.0

raw patch · 59 files changed

+1635/−553 lines, 59 filesdep +binarydep +digestdep +exceptionsdep ~basesetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: binary, digest, exceptions, raw-strings-qq, retry, unordered-containers

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−1
• README.md +8/−8
• Setup.hs +1/−1
• docs/API.md +79/−26
• examples/BucketExists.hs +2/−2
• examples/CopyObject.hs +2/−2
• examples/FileUploader.hs +3/−3
• examples/GetConfig.hs +1/−1
• examples/GetObject.hs +2/−2
• examples/HeadObject.hs +2/−2
• examples/Heal.hs +1/−1
• examples/ListBuckets.hs +2/−2
• examples/ListIncompleteUploads.hs +3/−3
• examples/ListObjects.hs +4/−4
• examples/MakeBucket.hs +2/−2
• examples/PresignedGetObject.hs +2/−2
• examples/PresignedPostPolicy.hs +2/−2
• examples/PresignedPutObject.hs +2/−2
• examples/PutObject.hs +2/−2
• examples/RemoveBucket.hs +2/−2
• examples/RemoveIncompleteUpload.hs +2/−2
• examples/RemoveObject.hs +1/−1
• examples/SelectObject.hs +50/−0
• examples/ServerInfo.hs +1/−1
• examples/ServiceSendRestart.hs +1/−1
• examples/ServiceSendStop.hs +1/−1
• examples/ServiceStatus.hs +1/−1
• examples/SetConfig.hs +1/−1
• minio-hs.cabal +29/−8
• src/Lib/Prelude.hs +1/−1
• src/Network/Minio.hs +28/−9
• src/Network/Minio/API.hs +38/−4
• src/Network/Minio/APICommon.hs +1/−1
• src/Network/Minio/AdminAPI.hs +4/−4
• src/Network/Minio/CopyObject.hs +2/−2
• src/Network/Minio/Data.hs +402/−39
• src/Network/Minio/Data/ByteString.hs +1/−1
• src/Network/Minio/Data/Crypto.hs +13/−2
• src/Network/Minio/Data/Time.hs +1/−1
• src/Network/Minio/Errors.hs +3/−1
• src/Network/Minio/JsonParser.hs +1/−1
• src/Network/Minio/ListOps.hs +1/−1
• src/Network/Minio/PresignedOperations.hs +10/−7
• src/Network/Minio/PutObject.hs +2/−2
• src/Network/Minio/S3API.hs +8/−3
• src/Network/Minio/SelectAPI.hs +302/−0
• src/Network/Minio/Sign/V4.hs +1/−1
• src/Network/Minio/Utils.hs +1/−1
• src/Network/Minio/XmlGenerator.hs +72/−9
• src/Network/Minio/XmlParser.hs +13/−1
• stack.yaml +1/−1
• test/LiveServer.hs +420/−363
• test/Network/Minio/API/Test.hs +4/−4
• test/Network/Minio/JsonParser/Test.hs +1/−1
• test/Network/Minio/TestHelpers.hs +1/−1
• test/Network/Minio/Utils/Test.hs +1/−1
• test/Network/Minio/XmlGenerator/Test.hs +47/−1
• test/Network/Minio/XmlParser/Test.hs +26/−3
• test/Spec.hs +9/−1

@@ -1,6 +1,16 @@ Changelog ========== +## Version 1.3.0++* Retry requests that timeout using full-jitter backoff (#119)+* Accept GetObjectOptions in statObject (#112)+* Add encryption options to GetObjectOptions and PutObjectOptions (#111)+* Add missing Haddock documentation (#110)+* Add support for S3Select API (#108)+* New travis with support for multiple GHCs (#106)+* Fix region setting in presigned url functions (#107)+ ## Version 1.2.0  * Export Provider and findFirst to look for credentials (#103)@@ -56,7 +66,7 @@ This is a bug-fix release:  * Fix concurrency bug in `limitedMapConcurrently` (#53)-* Fix tests related to listing incomplete uploads to accommodate Minio+* 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) 

@@ -1,6 +1,6 @@-# 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)+# 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.min.io/slack?type=svg)](https://slack.min.io) -The Minio Haskell Client SDK provides simple APIs to access [Minio](https://minio.io) and Amazon S3 compatible object storage server.+The MinIO Haskell Client SDK provides simple APIs to access [MinIO](https://min.io) and Amazon S3 compatible object storage server.  ## Minimum Requirements @@ -24,10 +24,10 @@  ``` -A section of the tests use the remote Minio Play server at-`https://play.minio.io:9000` by default. For library development,+A section of the tests use the remote MinIO Play server at+`https://play.min.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+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). @@ -47,7 +47,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs --package optparse-applicative --package filepath  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -76,7 +76,7 @@ import           Prelude  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo@@ -86,7 +86,7 @@ fileNameArgs :: Parser FilePath fileNameArgs = strArgument                (metavar "FILENAME"-                <> help "Name of file to upload to AWS S3 or a Minio server")+                <> help "Name of file to upload to AWS S3 or a MinIO server")  cmdParser = info             (helper <*> fileNameArgs)

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.

@@ -1,8 +1,8 @@-# Minio Haskell SDK API Reference+# MinIO Haskell SDK API Reference -## Initialize Minio Client object.+## Initialize MinIO Client object. -### Minio - for public Play server+### MinIO - for public Play server  ```haskell minioPlayCI :: ConnectInfo@@ -28,12 +28,12 @@ |[`listObjects`](#listObjects)|[`fPutObject`](#fPutObject)|| |[`listObjectsV1`](#listObjectsV1)|[`copyObject`](#copyObject)|| |[`listIncompleteUploads`](#listIncompleteUploads)|[`removeObject`](#removeObject)||-|[`bucketExists`](#bucketExists)|||+|[`bucketExists`](#bucketExists)|[`selectObjectContent`](#selectObjectContent)||  ## 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+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@@ -77,18 +77,18 @@ #### minioPlayCI :: ConnectInfo  This constructor provides connection and authentication information to-connect to the public Minio Play server at-`https://play.minio.io:9000/`.+connect to the public MinIO Play server at+`https://play.min.io:9000/`.  #### minioCI :: Text -> Int -> Bool -> ConnectInfo -Use to connect to a Minio server.+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 |+| `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? | @@ -112,7 +112,7 @@ ### The Minio Monad  This monad provides the required environment to perform requests-against a Minio or other S3 API compatible server. It uses the+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.@@ -264,8 +264,8 @@ import           Prelude  --- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- | The following example uses MinIO play server at+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo@@ -277,7 +277,7 @@     bucket = "test"    -- Performs a recursive listing of all objects under bucket "test"-  -- on play.minio.io.+  -- on play.min.io.   res <- runMinio minioPlayCI $     runConduit $ listObjects bucket Nothing True .| mapM_C (\v -> (liftIO $ print v))   print res@@ -325,8 +325,8 @@ import           Prelude  --- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- | The following example uses MinIO play server at+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo@@ -338,7 +338,7 @@     bucket = "test"    -- Performs a recursive listing of all objects under bucket "test"-  -- on play.minio.io.+  -- on play.min.io.   res <- runMinio minioPlayCI $     runConduit $ listObjectsV1 bucket Nothing True .| mapM_C (\v -> (liftIO $ print v))   print res@@ -383,8 +383,8 @@ import           Conduit import           Prelude --- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- | The following example uses MinIO play server at+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo@@ -396,7 +396,7 @@     bucket = "test"    -- Performs a recursive listing of incomplete uploads under bucket "test"-  -- on a local minio server.+  -- on a local MinIO server.   res <- runMinio minioPlayCI $     runConduit $ listIncompleteUploads bucket Nothing True .| mapM_C (\v -> (liftIO $ print v))   print res@@ -450,8 +450,8 @@  import           Prelude --- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- | The following example uses MinIO play server at+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo@@ -500,8 +500,8 @@  import           Prelude --- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- | The following example uses MinIO play server at+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo@@ -560,8 +560,8 @@ 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+-- | The following example uses MinIO play server at+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo@@ -742,6 +742,59 @@     Left _ -> putStrLn $ "Failed to remove " ++ show bucket ++ "/" ++ show object     Right _ -> putStrLn "Removed incomplete upload successfully" ```++<a name="selectObjectContent"></a>+### selectObjectContent :: Bucket -> Object -> SelectRequest -> Minio (ConduitT () EventMessage Minio ())+Removes an ongoing multipart upload of an object from the service++__Parameters__++In the expression `selectObjectContent bucketName objectName selReq`+the parameters are:++|Param   |Type   |Description   |+|:---|:---| :---|+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |+| `objectName` | _Object_ (alias for `Text`)  | Name of the object |+| `selReq` | _SelectRequest_   | Select request parameters  |++__SelectRequest record__++This record is created using `selectRequest`. Please refer to the Haddocks for further information.++__Return Value__++The return value can be used to read individual `EventMessage`s in the response. Please refer to the Haddocks for further information.++|Return type | Description |+|:---|:---|+| _Minio (C.conduitT () EventMessage Minio ())_ | A Conduit source of `EventMessage` values. |++__Example__++```haskell+{-# Language OverloadedStrings #-}+import Network.Minio++import qualified Conduit              as C++main :: IO ()+main = do+  let+    bucket = "mybucket"+    object = "myobject"++  res <- runMinio minioPlayCI $ do+    let sr = selectRequest "Select * from s3object"+             defaultCsvInput defaultCsvOutput+    res <- selectObjectContent bucket object sr+    C.runConduit $ res C..| getPayloadBytes C..| C.stdoutC++  case res of+    Left _ -> putStrLn "Failed!"+    Right _ -> putStrLn "Success!"+```+  <a name="BucketExists"></a> ### bucketExists :: Bucket -> Minio Bool

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -24,7 +24,7 @@ import Prelude  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -24,7 +24,7 @@ import           Prelude  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs --package optparse-applicative --package filepath  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -31,7 +31,7 @@ import           Prelude  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo@@ -41,7 +41,7 @@ fileNameArgs :: Parser FilePath fileNameArgs = strArgument                (metavar "FILENAME"-                <> help "Name of file to upload to AWS S3 or a Minio server")+                <> help "Name of file to upload to AWS S3 or a MinIO server")  cmdParser = info             (helper <*> fileNameArgs)

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -26,7 +26,7 @@ import           Prelude  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -24,7 +24,7 @@ import           Prelude  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -24,7 +24,7 @@ import           Prelude  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -24,7 +24,7 @@ import           Prelude  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo@@ -42,7 +42,7 @@   print res    {--    Following is the output of the above program on a local Minio server.+    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"

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -25,7 +25,7 @@   -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo@@ -37,12 +37,12 @@     bucket = "test"    -- Performs a recursive listing of all objects under bucket "test"-  -- on play.minio.io.+  -- on play.min.io.   res <- runMinio minioPlayCI $     runConduit $ listObjects bucket Nothing True .| mapM_C (\v -> (liftIO $ print v))   print res   {--    Following is the output of the above program on a local Minio server.+    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}]   -}

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -24,7 +24,7 @@ import           Prelude  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -27,7 +27,7 @@ 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+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -27,7 +27,7 @@ import qualified Data.Time             as Time  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -24,7 +24,7 @@ import           Data.CaseInsensitive  (original)  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -25,7 +25,7 @@ import           Prelude  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -24,7 +24,7 @@ import           Prelude  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -23,7 +23,7 @@ import           Prelude  -- | The following example uses minio's play server at--- https://play.minio.io:9000.  The endpoint and associated+-- https://play.min.io:9000.  The endpoint and associated -- credentials are provided via the libary constant, -- -- > minioPlayCI :: ConnectInfo

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.

@@ -0,0 +1,50 @@+#!/usr/bin/env stack+-- stack --resolver lts-13.1 runghc --package minio-hs++--+-- MinIO Haskell SDK, (C) 2019 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 Conduit              as C+import           Control.Monad        (when)+import qualified Data.ByteString.Lazy as LB++import           Prelude++main :: IO ()+main = do+    let bucket = "selectbucket"+        object = "1.csv"+        content = "Name,Place,Temperature\n"+               <> "James,San Jose,76\n"+               <> "Alicia,San Leandro,88\n"+               <> "Mark,San Carlos,90\n"++    res <- runMinio minioPlayCI $ do++        exists <- bucketExists bucket+        when (not exists) $+            makeBucket bucket Nothing++        C.liftIO $ putStrLn "Uploading csv object"+        putObject bucket object (C.sourceLazy content) Nothing defaultPutObjectOptions++        let sr = selectRequest "Select * from s3object" defaultCsvInput defaultCsvOutput+        res <- selectObjectContent bucket object sr+        C.runConduit $ res C..| getPayloadBytes C..| C.stdoutC+    print res

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.

@@ -2,7 +2,7 @@ -- stack --resolver lts-11.1 runghc --package minio-hs  ----- Minio Haskell SDK, (C) 2017, 2018 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.

@@ -1,15 +1,15 @@ name:                minio-hs-version:             1.2.0-synopsis:            A Minio Haskell Library for Amazon S3 compatible cloud+version:             1.3.0+synopsis:            A MinIO Haskell Library for Amazon S3 compatible cloud                      storage.-description:         The Minio Haskell client library provides simple APIs to-                     access Minio, Amazon S3 and other API compatible cloud+description:         The MinIO Haskell client library provides simple APIs to+                     access MinIO, Amazon S3 and other API compatible cloud                      storage servers. homepage:            https://github.com/minio/minio-hs#readme license:             Apache-2.0 license-file:        LICENSE-author:              Minio Dev Team-maintainer:          dev@minio.io+author:              MinIO Dev Team+maintainer:          dev@min.io category:            Network, AWS, Object Storage build-type:          Simple stability:           Experimental@@ -41,6 +41,7 @@                      , Network.Minio.ListOps                      , Network.Minio.PresignedOperations                      , Network.Minio.PutObject+                     , Network.Minio.SelectAPI                      , Network.Minio.Sign.V4                      , Network.Minio.Utils                      , Network.Minio.XmlGenerator@@ -50,6 +51,7 @@                      , protolude >= 0.2 && < 0.3                      , aeson >= 1.2                      , base64-bytestring >= 1.0+                     , binary >= 0.8.5.0                      , bytestring >= 0.10                      , case-insensitive >= 1.2                      , conduit >= 1.3@@ -57,19 +59,24 @@                      , containers >= 0.5                      , cryptonite >= 0.25                      , cryptonite-conduit >= 0.2+                     , digest >= 0.0.1                      , directory+                     , exceptions                      , filepath >= 1.4                      , http-client >= 0.5                      , http-conduit >= 2.3                      , http-types >= 0.12                      , ini                      , memory >= 0.14+                     , raw-strings-qq >= 1                      , resourcet >= 1.2+                     , retry                      , text >= 1.2                      , time >= 1.8                      , transformers >= 0.5                      , unliftio >= 0.2                      , unliftio-core >= 0.1+                     , unordered-containers >= 0.2                      , xml-conduit >= 1.8   default-language:    Haskell2010   default-extensions:  BangPatterns@@ -120,6 +127,7 @@                      , Network.Minio.PresignedOperations                      , Network.Minio.PutObject                      , Network.Minio.S3API+                     , Network.Minio.SelectAPI                      , Network.Minio.Sign.V4                      , Network.Minio.TestHelpers                      , Network.Minio.Utils@@ -131,11 +139,12 @@                      , Network.Minio.XmlParser.Test                      , Network.Minio.JsonParser                      , Network.Minio.JsonParser.Test-  build-depends:       base+  build-depends:       base >= 4.7 && < 5                      , minio-hs                      , protolude >= 0.1.6                      , aeson                      , base64-bytestring+                     , binary                      , bytestring                      , case-insensitive                      , conduit@@ -143,7 +152,9 @@                      , containers                      , cryptonite                      , cryptonite-conduit+                     , digest                      , directory+                     , exceptions                      , filepath                      , http-client                      , http-conduit@@ -151,7 +162,9 @@                      , ini                      , memory                      , QuickCheck+                     , raw-strings-qq >= 1                      , resourcet+                     , retry                      , tasty                      , tasty-hunit                      , tasty-quickcheck@@ -162,6 +175,7 @@                      , transformers                      , unliftio                      , unliftio-core+                     , unordered-containers                      , xml-conduit   if !flag(live-test)     buildable: False@@ -170,11 +184,12 @@   type:                exitcode-stdio-1.0   hs-source-dirs:      test, src   main-is:             Spec.hs-  build-depends:       base+  build-depends:       base >= 4.7 && < 5                      , minio-hs                      , protolude >= 0.1.6                      , aeson                      , base64-bytestring+                     , binary                      , bytestring                      , case-insensitive                      , conduit@@ -183,14 +198,18 @@                      , cryptonite                      , cryptonite-conduit                      , filepath+                     , digest                      , directory+                     , exceptions                      , http-client                      , http-conduit                      , http-types                      , ini                      , memory                      , QuickCheck+                     , raw-strings-qq >= 1                      , resourcet+                     , retry                      , tasty                      , tasty-hunit                      , tasty-quickcheck@@ -201,6 +220,7 @@                      , transformers                      , unliftio                      , unliftio-core+                     , unordered-containers                      , xml-conduit   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N   default-language:    Haskell2010@@ -230,6 +250,7 @@                      , Network.Minio.PresignedOperations                      , Network.Minio.PutObject                      , Network.Minio.S3API+                     , Network.Minio.SelectAPI                      , Network.Minio.Sign.V4                      , Network.Minio.TestHelpers                      , Network.Minio.Utils

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -14,7 +14,14 @@ -- limitations under the License. -- -+-- |+-- Module:      Network.Minio+-- Copyright:   (c) 2017-2019 MinIO Dev Team+-- License:     Apache 2.0+-- Maintainer:  MinIO Dev Team <dev@min.io>+--+-- Types and functions to access S3 compatible object storage servers+-- like MinIO.  module Network.Minio   (@@ -44,7 +51,7 @@    -- * Minio Monad   -----------------  -- | The Minio monad provides connection-reuse, bucket-location+  -- | The Minio Monad provides connection-reuse, bucket-location   -- caching, resource management and simpler error handling   -- functionality. All actions on object storage are performed within   -- this Monad.@@ -113,7 +120,6 @@    -- ** Conduit-based streaming operations   , putObject-  -- | Input data type represents PutObject options.   , PutObjectOptions   , defaultPutObjectOptions   , pooContentType@@ -124,9 +130,9 @@   , pooStorageClass   , pooUserMetadata   , pooNumThreads+  , pooSSE    , getObject-  -- | Input data type represents GetObject options.   , GetObjectOptions   , defaultGetObjectOptions   , gooRange@@ -134,6 +140,7 @@   , gooIfNoneMatch   , gooIfModifiedSince   , gooIfUnmodifiedSince+  , gooSSECKey    -- ** Server-side copying   , copyObject@@ -158,6 +165,16 @@   , removeObject   , removeIncompleteUpload +  -- ** Select Object Content with SQL+  , module Network.Minio.SelectAPI++  -- * Server-Size Encryption Helpers+  -----------------------------------+  , SSECKey+  , mkSSECKey+  , SSE(..)++   -- * Presigned Operations   -------------------------   , UrlExpiry@@ -192,7 +209,7 @@ ) where  {--This module exports the high-level Minio API for object storage.+This module exports the high-level MinIO API for object storage. -}  import qualified Data.Conduit             as C@@ -207,6 +224,7 @@ import           Network.Minio.ListOps import           Network.Minio.PutObject import           Network.Minio.S3API+import           Network.Minio.SelectAPI import           Network.Minio.Utils  -- | Lists buckets.@@ -255,9 +273,10 @@ getObject bucket object opts = snd <$> getObject' bucket object []                                (gooToHeaders opts) --- | Get an object's metadata from the object store.-statObject :: Bucket -> Object -> Minio ObjectInfo-statObject = headObject+-- | Get an object's metadata from the object store. It accepts the+-- same options as GetObject.+statObject :: Bucket -> Object -> GetObjectOptions -> Minio ObjectInfo+statObject b o opts = headObject b o $ gooToHeaders opts  -- | Creates a new bucket in the object store. The Region can be -- optionally specified. If not specified, it will use the region

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -28,6 +28,9 @@   , checkObjectNameValidity   ) where +import           Control.Retry             (fullJitterBackoff,+                                            limitRetriesByCumulativeDelay,+                                            retrying) import qualified Data.ByteString           as B import qualified Data.Char                 as C import qualified Data.Conduit              as C@@ -140,19 +143,50 @@         , NC.requestBody = getRequestBody (riPayload s3Req)         } ++retryAPIRequest :: Minio a -> Minio a+retryAPIRequest apiCall = do+  resE <- retrying retryPolicy (const shouldRetry) $+          const $ try apiCall+  either throwIO return resE+  where+    -- Retry using the full-jitter backoff method for up to 10 mins+    -- total+    retryPolicy = limitRetriesByCumulativeDelay tenMins+                  $ fullJitterBackoff oneMilliSecond++    oneMilliSecond = 1000 -- in microseconds+    tenMins = 10 * 60 * 1000000 -- in microseconds+    -- retry on connection related failure+    shouldRetry :: Either NC.HttpException a -> Minio Bool+    shouldRetry resE =+      case resE of+        -- API request returned successfully+        Right _ -> return False+        -- API request failed with a retryable exception+        Left httpExn@(NC.HttpExceptionRequest _ exn) ->+          case (exn :: NC.HttpExceptionContent) of+            NC.ResponseTimeout     -> return True+            NC.ConnectionTimeout   -> return True+            NC.ConnectionFailure _ -> return True+            -- We received an unexpected exception+            _                      -> throwIO httpExn+        -- We received an unexpected exception+        Left someOtherExn -> throwIO someOtherExn++ executeRequest :: S3ReqInfo -> Minio (Response LByteString) executeRequest ri = do   req <- buildRequest ri   mgr <- asks mcConnManager-  httpLbs req mgr-+  retryAPIRequest $ httpLbs req mgr  mkStreamRequest :: S3ReqInfo                 -> Minio (Response (C.ConduitM () ByteString Minio ())) mkStreamRequest ri = do   req <- buildRequest ri   mgr <- asks mcConnManager-  http req mgr+  retryAPIRequest $ http req mgr  -- Bucket name validity check according to AWS rules. isValidBucketName :: Bucket -> Bool

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2018 Minio, Inc.+-- MinIO Haskell SDK, (C) 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.

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2018 Minio, Inc.+-- MinIO Haskell SDK, (C) 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.@@ -15,9 +15,9 @@ --  module Network.Minio.AdminAPI-  ( -- * Minio Admin API+  ( -- * MinIO Admin API     ---------------------    -- | Provides Minio admin API and related types. It is in+    -- | Provides MinIO admin API and related types. It is in     -- experimental state.     DriveInfo(..)   , ErasureInfo(..)@@ -401,7 +401,7 @@         Right ss -> return ss         Left err -> throwIO $ MErrVJsonParse $ T.pack err --- | Send service restart or stop action to Minio server.+-- | Send service restart or stop action to MinIO server. serviceSendAction :: ServiceAction -> Minio () serviceSendAction action = do     let payload = PayloadBS $ LBS.toStrict $ A.encode action

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.@@ -34,7 +34,7 @@       sObject = srcObject srcInfo    -- get source object size with a head request-  oi <- headObject sBucket sObject+  oi <- headObject sBucket sObject []   let srcSize = oiSize oi    -- check that byte offsets are valid if specified in cps

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -14,6 +14,8 @@ -- limitations under the License. -- +{-# LANGUAGE CPP                        #-}+{-# LANGUAGE GADTs                      #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies               #-} module Network.Minio.Data where@@ -23,8 +25,11 @@ import           Control.Monad.IO.Unlift      (MonadUnliftIO, UnliftIO (..),                                                askUnliftIO, withUnliftIO) import           Control.Monad.Trans.Resource+import qualified Data.Aeson                   as A+import qualified Data.ByteArray               as BA import qualified Data.ByteString              as B import           Data.CaseInsensitive         (mk)+import qualified Data.HashMap.Strict          as H import qualified Data.Ini                     as Ini import qualified Data.Map                     as Map import           Data.String                  (IsString (..))@@ -45,6 +50,7 @@ import qualified UnliftIO                     as U  import           Lib.Prelude+import           Network.Minio.Data.Crypto  -- | max obj size is 5TiB maxObjectSize :: Int64@@ -83,9 +89,11 @@     , ("sa-east-1", "s3-sa-east-1.amazonaws.com")   ] --- | Connection Info data type. To create a 'ConnectInfo' value, use one--- of the provided smart constructors or override fields of the--- Default instance.+-- | Connection Info data type. To create a 'ConnectInfo' value,+-- enable the @OverloadedStrings@ language extension and use the+-- `IsString` instance to provide a URL, for example:+--+-- > let c :: ConnectInfo = "https://play.min.io:9000" data ConnectInfo = ConnectInfo {     connectHost               :: Text   , connectPort               :: Int@@ -109,6 +117,7 @@                         , connectAutoDiscoverRegion = True                         } +-- | Contains access key and secret key to access object storage. data Credentials = Credentials { cAccessKey :: Text                                , cSecretKey :: Text                                } deriving (Eq, Show)@@ -123,6 +132,7 @@ findFirst (f:fs) = do c <- f                       maybe (findFirst fs) (return . Just) c +-- | This Provider loads `Credentials` from @~\/.aws\/credentials@ fromAWSConfigFile :: Provider fromAWSConfigFile = do     credsE <- runExceptT $ do@@ -138,18 +148,25 @@         return $ Credentials akey skey     return $ hush credsE +-- | This Provider loads `Credentials` from @AWS_ACCESS_KEY_ID@ and+-- @AWS_SECRET_ACCESS_KEY@ environment variables. fromAWSEnv :: Provider fromAWSEnv = runMaybeT $ do         akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"         skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"         return $ Credentials (T.pack akey) (T.pack skey) +-- | This Provider loads `Credentials` from @MINIO_ACCESS_KEY@ and+-- @MINIO_SECRET_KEY@ environment variables. fromMinioEnv :: Provider fromMinioEnv = runMaybeT $ do     akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"     skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"     return $ Credentials (T.pack akey) (T.pack skey) +-- | setCredsFrom retrieves access credentials from the first+-- `Provider` form the given list that succeeds and sets it in the+-- `ConnectInfo`. setCredsFrom :: [Provider] -> ConnectInfo -> IO ConnectInfo setCredsFrom ps ci = do pMay <- findFirst ps                         maybe@@ -157,12 +174,14 @@                           (return . (flip setCreds ci))                           pMay +-- | setCreds sets the given `Credentials` in the `ConnectInfo`. setCreds :: Credentials -> ConnectInfo -> ConnectInfo setCreds (Credentials accessKey secretKey) connInfo =     connInfo { connectAccessKey = accessKey              , connectSecretKey = secretKey              } +-- | Set the S3 region parameter in the `ConnectInfo` setRegion :: Region -> ConnectInfo -> ConnectInfo setRegion r connInfo = connInfo { connectRegion = r                                 , connectAutoDiscoverRegion = False@@ -192,13 +211,13 @@ awsCI = "https://s3.amazonaws.com"  --- | <https://play.minio.io:9000 Minio Play Server>+-- | <https://play.min.io:9000 MinIO Play Server> -- ConnectInfo. Credentials are already filled in. minioPlayCI :: ConnectInfo minioPlayCI = let playCreds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"               in setCreds playCreds                  $ setRegion "us-east-1"-                 "https://play.minio.io:9000"+                 "https://play.min.io:9000"  -- | -- Represents a bucket in the object store@@ -216,9 +235,59 @@ -- | A type alias to represent an Entity-Tag returned by S3-compatible APIs. type ETag = Text --- |--- Data type represents various options specified for PutObject call.--- To specify PutObject options use the poo* accessors.+-- | Data type to represent an object encryption key. Create one using+-- the `mkSSECKey` function.+newtype SSECKey = SSECKey BA.ScrubbedBytes+                deriving (Eq, Show)++-- | Validates that the given ByteString is 32 bytes long and creates+-- an encryption key.+mkSSECKey :: MonadThrow m => ByteString -> m SSECKey+mkSSECKey keyBytes | B.length keyBytes /= 32 =+                         throwM MErrVInvalidEncryptionKeyLength+                   | otherwise =+                         return $ SSECKey $ BA.convert keyBytes++-- | Data type to represent Server-Side-Encryption settings+data SSE where+    -- | Specifies SSE S3 encryption - server manages encryption keys+    SSE :: SSE+    -- | Specifies that KMS service should be used. The first argument+    -- to the constructor is the Key Id to be used by the server (if+    -- not specified, the default KMS key id is used). The second+    -- argument is the optional KMS context that must have a+    -- `A.ToJSON` instance - please refer to the AWS S3 documentation+    -- for detailed information.+    SSEKMS :: A.ToJSON a => Maybe ByteString -> Maybe a -> SSE+    -- | Specifies server-side encryption with customer provided+    -- key. The argument is the encryption key to be used.+    SSEC :: SSECKey -> SSE++toPutObjectHeaders :: SSE -> [HT.Header]+toPutObjectHeaders sseArg =+    let sseHeader = "x-amz-server-side-encryption"+        sseKmsIdHeader = sseHeader <> "-aws-kms-key-id"+        sseKmsContextHeader = sseHeader <> "-context"+        ssecAlgo = sseHeader <> "-customer-algorithm"+        ssecKey = sseHeader <> "-customer-key"+        ssecKeyMD5 = ssecKey <> "-MD5"++    in case sseArg of+      SSE -> [(sseHeader, "AES256")]++      SSEKMS keyIdMay ctxMay ->+          [(sseHeader, "aws:kms")] +++          maybe [] (\k -> [(sseKmsIdHeader, k)]) keyIdMay +++          maybe [] (\k -> [(sseKmsContextHeader, toS $ A.encode k)]) ctxMay++      SSEC (SSECKey sb) ->+          [(ssecAlgo, "AES256"),+           (ssecKey, encodeToBase64 sb),+           (ssecKeyMD5, hashMD5ToBase64 sb)]++-- | Data type for options in PutObject call.  Start with the empty+-- `defaultPutObjectOptions` and use various the various poo*+-- accessors. data PutObjectOptions = PutObjectOptions {   -- | Set a standard MIME type describing the format of the object.     pooContentType        :: Maybe Text@@ -233,19 +302,21 @@   , pooCacheControl       :: Maybe Text   -- | Set to describe the language(s) intended for the audience.   , pooContentLanguage    :: Maybe Text-  -- | Set to 'STANDARD' or 'REDUCED_REDUNDANCY' depending on your-  -- performance needs, storage class is 'STANDARD' by default (i.e+  -- | Set to @STANDARD@ or @REDUCED_REDUNDANCY@ depending on your+  -- performance needs, storage class is @STANDARD@ by default (i.e   -- when Nothing is passed).   , pooStorageClass       :: Maybe Text   -- | Set user defined metadata to store with the object.   , pooUserMetadata       :: [(Text, Text)]   -- | Set number of worker threads used to upload an object.   , pooNumThreads         :: Maybe Word-  } deriving (Show, Eq)+  -- | Set object encryption parameters for the request.+  , pooSSE                :: Maybe SSE+  } --- Provide a default instance+-- | Provide default `PutObjectOptions`. defaultPutObjectOptions :: PutObjectOptions-defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing+defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing  addXAmzMetaPrefix :: Text -> Text addXAmzMetaPrefix s = do@@ -259,6 +330,7 @@ pooToHeaders :: PutObjectOptions -> [HT.Header] pooToHeaders poo = userMetadata                    ++ (catMaybes $ map tupToMaybe (zipWith (,) names values))+                   ++ maybe [] toPutObjectHeaders (pooSSE poo)   where     tupToMaybe (k, Just v)  = Just (k, v)     tupToMaybe (_, Nothing) = Nothing@@ -345,37 +417,56 @@   } deriving (Show, Eq)  -- | Represents information about an object.-data ObjectInfo = ObjectInfo {-    oiObject   :: Object-  , oiModTime  :: UTCTime-  , oiETag     :: ETag-  , oiSize     :: Int64-  , oiMetadata :: Map.Map Text Text+data ObjectInfo = ObjectInfo+  { oiObject   :: Object -- ^ Oject key+  , oiModTime  :: UTCTime -- ^ Mdification time of the object+  , oiETag     :: ETag -- ^ ETag of the object+  , oiSize     :: Int64 -- ^ Size of the object in bytes+  , oiMetadata :: Map.Map Text Text -- ^ A map of the metadata+                                    -- key-value pairs   } deriving (Show, Eq)  -- | 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+data SourceInfo = SourceInfo+  { srcBucket            :: Text -- ^ Bucket containing the source object+  , srcObject            :: Text -- ^ Source object key+  , srcRange             :: Maybe (Int64, Int64) -- ^ Source object+                                                 -- byte-range+                                                 -- (inclusive)+  , srcIfMatch           :: Maybe Text -- ^ ETag condition on source -+                                       -- object is copied only if the+                                       -- source object's ETag matches+                                       -- this value.+  , srcIfNoneMatch       :: Maybe Text -- ^ ETag not match condition+                                       -- on source - object is copied+                                       -- if ETag does not match this+                                       -- value.+  , srcIfModifiedSince   :: Maybe UTCTime -- ^ Copy source object only+                                          -- if the source has been+                                          -- modified since this time.+  , srcIfUnmodifiedSince :: Maybe UTCTime -- ^ Copy source object only+                                          -- if the source has been+                                          -- un-modified since this+                                          -- given time.   } deriving (Show, Eq) +-- | Provide a default for `SourceInfo` defaultSourceInfo :: SourceInfo defaultSourceInfo = SourceInfo "" "" Nothing Nothing Nothing Nothing Nothing  -- | Represents destination object in server-side copy object data DestinationInfo = DestinationInfo-                       { dstBucket :: Text-                       , dstObject :: Text+                       { dstBucket :: Text -- ^ Destination bucket+                       , dstObject :: Text -- ^ Destination object key                        } deriving (Show, Eq) +-- | Provide a default for `DestinationInfo` defaultDestinationInfo :: DestinationInfo defaultDestinationInfo = DestinationInfo "" "" +-- | Data type for options when getting an object from the+-- service. Start with the empty `defaultGetObjectOptions` and modify+-- it using the goo* functions. data GetObjectOptions = GetObjectOptions {     -- | Set object's data of given offset begin and end,     -- [ByteRangeFromTo 0 9] means first ten bytes of the source object.@@ -390,13 +481,18 @@   , gooIfUnmodifiedSince :: Maybe UTCTime     -- | Set object modified condition, GetObject modified since given time.   , gooIfModifiedSince   :: Maybe UTCTime-  } deriving (Show, Eq)+    -- | Specify SSE-C key+  , gooSSECKey           :: Maybe SSECKey+  } +-- | Provide default  `GetObjectOptions`. defaultGetObjectOptions :: GetObjectOptions-defaultGetObjectOptions = GetObjectOptions Nothing Nothing Nothing Nothing Nothing+defaultGetObjectOptions =+    GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing  gooToHeaders :: GetObjectOptions -> [HT.Header] gooToHeaders goo = rangeHdr ++ zip names values+                   ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)   where     names = ["If-Match",              "If-None-Match",@@ -449,24 +545,33 @@   _                                      -> Nothing  +-- | Filter data type - part of notification configuration data Filter = Filter   { fFilter :: FilterKey   } deriving (Show, Eq) +-- | defaultFilter is empty, used to create a notification+-- configuration. defaultFilter :: Filter defaultFilter = Filter defaultFilterKey +-- | FilterKey contains FilterRules, and is part of a Filter. data FilterKey = FilterKey   { fkKey :: FilterRules   } deriving (Show, Eq) +-- | defaultFilterKey is empty, used to create notification+-- configuration. defaultFilterKey :: FilterKey defaultFilterKey = FilterKey defaultFilterRules +-- | FilterRules represents a collection of `FilterRule`s. data FilterRules = FilterRules   { frFilterRules :: [FilterRule]   } deriving (Show, Eq) +-- | defaultFilterRules is empty, used to create notification+-- configuration. defaultFilterRules :: FilterRules defaultFilterRules = FilterRules [] @@ -477,14 +582,15 @@ --    > let suffixRule = FilterRule "suffix" ".jpg" --    > let prefixRule = FilterRule "prefix" "images/" ----- The `suffixRule` restricts the notification to be triggered only--- for objects having a suffix of ".jpg", and the `prefixRule`+-- The @suffixRule@ restricts the notification to be triggered only+-- for objects having a suffix of ".jpg", and the @prefixRule@ -- restricts it to objects having a prefix of "images/". data FilterRule = FilterRule   { frName  :: Text   , frValue :: Text   } deriving (Show, Eq) +-- | Arn is an alias of Text type Arn = Text  -- | A data-type representing the configuration for a particular@@ -508,9 +614,257 @@   , nCloudFunctionConfigurations :: [NotificationConfig]   } deriving (Eq, Show) +-- | The default notification configuration is empty. defaultNotification :: Notification defaultNotification = Notification [] [] [] ++--------------------------------------------------------------------------+-- Select API Related Types+--------------------------------------------------------------------------++-- | SelectRequest represents the Select API call. Use the+-- `selectRequest` function to create a value of this type.+data SelectRequest = SelectRequest+  { srExpression             :: Text+  , srExpressionType         :: ExpressionType+  , srInputSerialization     :: InputSerialization+  , srOutputSerialization    :: OutputSerialization+  , srRequestProgressEnabled :: Maybe Bool+  } deriving (Eq, Show)++data ExpressionType = SQL+                    deriving (Eq, Show)++-- | InputSerialization represents format information of the input+-- object being queried. Use one of the smart constructors such as+-- `defaultCsvInput` as a starting value, and add compression info+-- using `setInputCompressionType`+data InputSerialization = InputSerialization+  { isCompressionType :: Maybe CompressionType+  , isFormatInfo      :: InputFormatInfo+  } deriving (Eq, Show)++-- | Data type representing the compression setting in a Select+-- request.+data CompressionType = CompressionTypeNone+                     | CompressionTypeGzip+                     | CompressionTypeBzip2+                     deriving (Eq, Show)++-- | Data type representing input object format information in a+-- Select request.+data InputFormatInfo = InputFormatCSV CSVInputProp+                     | InputFormatJSON JSONInputProp+                     | InputFormatParquet+                     deriving (Eq, Show)++-- | defaultCsvInput returns InputSerialization with default CSV+-- format, and without any compression setting.+defaultCsvInput :: InputSerialization+defaultCsvInput = InputSerialization Nothing (InputFormatCSV defaultCSVProp)++-- | linesJsonInput returns InputSerialization with JSON line based+-- format with no compression setting.+linesJsonInput :: InputSerialization+linesJsonInput = InputSerialization Nothing+                 (InputFormatJSON $ JSONInputProp JSONTypeLines)++-- | documentJsonInput returns InputSerialization with JSON document+-- based format with no compression setting.+documentJsonInput :: InputSerialization+documentJsonInput = InputSerialization Nothing+                    (InputFormatJSON $ JSONInputProp JSONTypeDocument)++-- | defaultParquetInput returns InputSerialization with Parquet+-- format, and no compression setting.+defaultParquetInput :: InputSerialization+defaultParquetInput = InputSerialization Nothing InputFormatParquet++-- | setInputCompressionType sets the compression type for the input+-- of the SelectRequest+setInputCompressionType :: CompressionType -> SelectRequest+                        -> SelectRequest+setInputCompressionType c i =+    let is = srInputSerialization i+        is' = is { isCompressionType = Just c }+    in i { srInputSerialization = is' }++-- | defaultCsvOutput returns OutputSerialization with default CSV+-- format.+defaultCsvOutput :: OutputSerialization+defaultCsvOutput = OutputSerializationCSV defaultCSVProp++-- | defaultJsonInput returns OutputSerialization with default JSON+-- format.+defaultJsonOutput :: OutputSerialization+defaultJsonOutput = OutputSerializationJSON (JSONOutputProp Nothing)++-- | selectRequest is used to build a `SelectRequest`+-- value. @selectRequest query inputSer outputSer@ represents a+-- SelectRequest with the SQL query text given by @query@, the input+-- serialization settings (compression format and format information)+-- @inputSer@ and the output serialization settings @outputSer@.+selectRequest :: Text -> InputSerialization -> OutputSerialization+              -> SelectRequest+selectRequest sqlQuery inputSer outputSer =+    SelectRequest { srExpression = sqlQuery+                  , srExpressionType = SQL+                  , srInputSerialization = inputSer+                  , srOutputSerialization = outputSer+                  , srRequestProgressEnabled = Nothing+                  }++-- | setRequestProgressEnabled sets the flag for turning on progress+-- messages when the Select response is being streamed back to the+-- client.+setRequestProgressEnabled :: Bool -> SelectRequest -> SelectRequest+setRequestProgressEnabled enabled sr =+    sr { srRequestProgressEnabled = Just enabled }++type CSVInputProp = CSVProp++-- | CSVProp represents CSV format properties. It is built up using+-- the Monoid instance.+data CSVProp = CSVProp (H.HashMap Text Text)+             deriving (Eq, Show)++#if (__GLASGOW_HASKELL__ >= 804)+instance Semigroup CSVProp where+    (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)+#endif++instance Monoid CSVProp where+    mempty = CSVProp mempty+#if (__GLASGOW_HASKELL__ < 804)+    mappend (CSVProp a) (CSVProp b) = CSVProp (b <> a)+#endif++defaultCSVProp :: CSVProp+defaultCSVProp = mempty++-- | Specify the CSV record delimiter property.+recordDelimiter :: Text -> CSVProp+recordDelimiter = CSVProp . H.singleton "RecordDelimiter"++-- | Specify the CSV field delimiter property.+fieldDelimiter :: Text -> CSVProp+fieldDelimiter = CSVProp . H.singleton "FieldDelimiter"++-- | Specify the CSV quote character property.+quoteCharacter :: Text -> CSVProp+quoteCharacter = CSVProp . H.singleton "QuoteCharacter"++-- | Specify the CSV quote-escape character property.+quoteEscapeCharacter :: Text -> CSVProp+quoteEscapeCharacter = CSVProp . H.singleton "QuoteEscapeCharacter"++-- | FileHeaderInfo specifies information about column headers for CSV+-- format.+data FileHeaderInfo+    = FileHeaderNone -- ^ No column headers are present+    | FileHeaderUse -- ^ Headers are present and they should be used+    | FileHeaderIgnore -- ^ Header are present, but should be ignored+    deriving (Eq, Show)++-- | Specify the CSV file header info property.+fileHeaderInfo :: FileHeaderInfo -> CSVProp+fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toString+  where+    toString FileHeaderNone   = "NONE"+    toString FileHeaderUse    = "USE"+    toString FileHeaderIgnore = "IGNORE"++-- | Specify the CSV comment character property. Lines starting with+-- this character are ignored by the server.+commentCharacter :: Text -> CSVProp+commentCharacter = CSVProp . H.singleton "Comments"++-- | Allow quoted record delimiters inside a row using this property.+allowQuotedRecordDelimiter :: CSVProp+allowQuotedRecordDelimiter = CSVProp $ H.singleton "AllowQuotedRecordDelimiter" "TRUE"++-- | Set the CSV format properties in the InputSerialization.+setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization+setInputCSVProps p is = is { isFormatInfo = InputFormatCSV p }++-- | Set the CSV format properties in the OutputSerialization.+outputCSVFromProps :: CSVProp -> OutputSerialization+outputCSVFromProps p = OutputSerializationCSV p++data JSONInputProp = JSONInputProp { jsonipType :: JSONType }+                   deriving (Eq, Show)++data JSONType = JSONTypeDocument | JSONTypeLines+              deriving (Eq, Show)+++-- | OutputSerialization represents output serialization settings for+-- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as+-- a starting point.+data OutputSerialization = OutputSerializationJSON JSONOutputProp+                         | OutputSerializationCSV CSVOutputProp+                         deriving (Eq, Show)++type CSVOutputProp = CSVProp++-- | quoteFields is an output serialization parameter+quoteFields :: QuoteFields -> CSVProp+quoteFields q = CSVProp $ H.singleton "QuoteFields" $+  case q of+    QuoteFieldsAsNeeded -> "ASNEEDED"+    QuoteFieldsAlways   -> "ALWAYS"++-- | Represent the QuoteField setting.+data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways+                 deriving (Eq, Show)++data JSONOutputProp = JSONOutputProp { jsonopRecordDelimiter :: Maybe Text }+                    deriving (Eq, Show)++-- | Set the output record delimiter for JSON format+outputJSONFromRecordDelimiter :: Text -> OutputSerialization+outputJSONFromRecordDelimiter t =+    OutputSerializationJSON (JSONOutputProp $ Just t)++-- Response related types++-- | An EventMessage represents each kind of message received from the server.+data EventMessage = ProgressEventMessage { emProgress :: Progress }+                  | StatsEventMessage { emStats :: Stats }+                  | RequestLevelErrorMessage { emErrorCode    :: Text+                                             , emErrorMessage :: Text+                                             }+                  | RecordPayloadEventMessage { emPayloadBytes :: ByteString }+                  deriving (Eq, Show)++data MsgHeaderName = MessageType+                   | EventType+                   | ContentType+                   | ErrorCode+                   | ErrorMessage+                   deriving (Eq, Show)++msgHeaderValueType :: Word8+msgHeaderValueType = 7++type MessageHeader = (MsgHeaderName, Text)++-- | Represent the progress event returned in the Select response.+data Progress = Progress { pBytesScanned   :: Int64+                         , pBytesProcessed :: Int64+                         , pBytesReturned  :: Int64+                         }+              deriving (Eq, Show)++-- | Represent the stats event returned at the end of the Select+-- response.+type Stats = Progress++--------------------------------------------------------------------------+-- Select API Related Types End+--------------------------------------------------------------------------+ -- | Represents different kinds of payload that are used with S3 API -- requests. data Payload = PayloadBS ByteString@@ -530,8 +884,8 @@   , ariQueryParams :: Query   } -data S3ReqInfo = S3ReqInfo {-    riMethod        :: Method+data S3ReqInfo = S3ReqInfo+  { riMethod        :: Method   , riBucket        :: Maybe Bucket   , riObject        :: Maybe Object   , riQueryParams   :: Query@@ -558,6 +912,8 @@  type RegionMap = Map.Map Bucket Region +-- | The Minio Monad - all computations accessing object storage+-- happens in it. newtype Minio a = Minio {   unMinio :: ReaderT MinioConn (ResourceT IO) a   }@@ -575,7 +931,8 @@                 withUnliftIO $ \u ->                 return (UnliftIO (unliftIO u . flip runReaderT r . unMinio)) --- | MinioConn holds connection info and a connection pool+-- | MinioConn holds connection info and a connection pool to allow+-- for efficient resource re-use. data MinioConn = MinioConn   { mcConnInfo    :: ConnectInfo   , mcConnManager :: NC.Manager@@ -593,7 +950,9 @@                                     "http://s3.amazonaws.com/doc/2006-03-01/"  -- | Takes connection information and returns a connection object to--- be passed to 'runMinio'+-- be passed to 'runMinio'. The returned value can be kept in the+-- application environment and passed to `runMinioWith` whenever+-- object storage is accessed. connect :: ConnectInfo -> IO MinioConn connect ci = do   let settings | connectIsSecure ci = NC.tlsManagerSettings@@ -601,7 +960,9 @@   mgr <- NC.newManager settings   mkMinioConn ci mgr -+-- | Run the computation accessing object storage using the given+-- `MinioConn`. This reuses connections, but otherwise it is similar+-- to `runMinio`. runMinioWith :: MinioConn -> Minio a -> IO (Either MinioErr a) runMinioWith conn m = runResourceT . flip runReaderT conn . unMinio $     fmap Right m `U.catches`@@ -616,6 +977,8 @@     handlerFE = return . Left . MErrIO     handlerValidation = return . Left . MErrValidation +-- | Given `ConnectInfo` and a HTTP connection manager, create a+-- `MinioConn`. mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn mkMinioConn ci mgr = do     rMapMVar <- M.newMVar Map.empty

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.@@ -20,12 +20,15 @@   , hashSHA256FromSource    , hashMD5+  , hashMD5ToBase64   , hashMD5FromSource    , hmacSHA256   , hmacSHA256RawBS   , digestToBS   , digestToBase16++  , encodeToBase64   ) where  import           Crypto.Hash             (Digest, MD5 (..), SHA256 (..),@@ -33,7 +36,7 @@ import           Crypto.Hash.Conduit     (sinkHash) import           Crypto.MAC.HMAC         (HMAC, hmac) import           Data.ByteArray          (ByteArrayAccess, convert)-import           Data.ByteArray.Encoding (Base (Base16), convertToBase)+import           Data.ByteArray.Encoding (Base (Base16, Base64), convertToBase) import qualified Data.Conduit            as C  import           Lib.Prelude@@ -50,6 +53,7 @@     sinkSHA256Hash :: Monad m => C.ConduitM ByteString Void m (Digest SHA256)     sinkSHA256Hash = sinkHash +-- Returns MD5 hash hex encoded. hashMD5 :: ByteString -> ByteString hashMD5 = digestToBase16 . hashWith MD5 @@ -73,3 +77,10 @@  digestToBase16 :: ByteArrayAccess a => a -> ByteString digestToBase16 = convertToBase Base16++-- Returns MD5 hash base 64 encoded.+hashMD5ToBase64 :: ByteArrayAccess a => a -> ByteString+hashMD5ToBase64 = convertToBase Base64 . hashWith MD5++encodeToBase64 :: ByteArrayAccess a => a -> ByteString+encodeToBase64 = convertToBase Base64

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -41,6 +41,7 @@            | MErrVJsonParse Text            | MErrVInvalidHealPath            | MErrVMissingCredentials+           | MErrVInvalidEncryptionKeyLength   deriving (Show, Eq)  instance Exception MErrV@@ -51,6 +52,7 @@                 | NoSuchBucket                 | InvalidBucketName                 | NoSuchKey+                | SelectErr Text Text                 | ServiceErr Text Text   deriving (Show, Eq) 

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2018 Minio, Inc.+-- MinIO Haskell SDK, (C) 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.

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.@@ -107,9 +107,10 @@ -- object REST API AWS S3 documentation. presignedPutObjectUrl :: Bucket -> Object -> UrlExpiry -> HT.RequestHeaders                       -> Minio ByteString-presignedPutObjectUrl bucket object expirySeconds extraHeaders =+presignedPutObjectUrl bucket object expirySeconds extraHeaders = do+  region <- asks (Just . connectRegion . mcConnInfo)   makePresignedUrl expirySeconds HT.methodPut-  (Just bucket) (Just object) Nothing [] extraHeaders+      (Just bucket) (Just object) region [] extraHeaders  -- | Generate a URL with authentication signature to GET (download) an -- object. All extra query parameters and headers passed here will be@@ -122,9 +123,10 @@ -- to the GET object REST API AWS S3 documentation. presignedGetObjectUrl :: Bucket -> Object -> UrlExpiry -> HT.Query                       -> HT.RequestHeaders -> Minio ByteString-presignedGetObjectUrl bucket object expirySeconds extraQuery extraHeaders =+presignedGetObjectUrl bucket object expirySeconds extraQuery extraHeaders = do+  region <- asks (Just . connectRegion . mcConnInfo)   makePresignedUrl expirySeconds HT.methodGet-  (Just bucket) (Just object) Nothing extraQuery extraHeaders+      (Just bucket) (Just object) region extraQuery extraHeaders  -- | Generate a URL with authentication signature to make a HEAD -- request on an object. This is used to fetch metadata about an@@ -135,9 +137,10 @@ -- object REST API AWS S3 documentation. presignedHeadObjectUrl :: Bucket -> Object -> UrlExpiry                        -> HT.RequestHeaders -> Minio ByteString-presignedHeadObjectUrl bucket object expirySeconds extraHeaders =+presignedHeadObjectUrl bucket object expirySeconds extraHeaders = do+  region <- asks (Just . connectRegion . mcConnInfo)   makePresignedUrl expirySeconds HT.methodHead-  (Just bucket) (Just object) Nothing [] extraHeaders+      (Just bucket) (Just object) region [] extraHeaders  -- | Represents individual conditions in a Post Policy document. data PostPolicyCondition = PPCStartsWith Text Text

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.@@ -47,7 +47,7 @@ -- -- 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.+-- stream ends or the object reaches `maxObjectSize` size. data ObjectData m   = ODFile FilePath (Maybe Int64) -- ^ Takes filepath and optional                                   -- size.

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -145,6 +145,10 @@ maxSinglePutObjectSizeBytes :: Int64 maxSinglePutObjectSizeBytes = 5 * 1024 * 1024 * 1024 +-- | PUT an object into the service. This function performs a single+-- PUT object call and uses a strict ByteString as the object+-- data. `putObjectSingle` is preferable as the object data will not+-- be resident in memory. putObjectSingle' :: Bucket -> Object -> [HT.Header] -> ByteString -> Minio ETag putObjectSingle' bucket object headers bs = do   let size = fromIntegral (BS.length bs)@@ -400,11 +404,12 @@       ]  -- | Get metadata of an object.-headObject :: Bucket -> Object -> Minio ObjectInfo-headObject bucket object = do+headObject :: Bucket -> Object -> [HT.Header] -> Minio ObjectInfo+headObject bucket object reqHeaders = do   resp <- executeRequest $ defaultS3ReqInfo { riMethod = HT.methodHead                                , riBucket = Just bucket                                , riObject = Just object+                               , riHeaders = reqHeaders                                }    let

@@ -0,0 +1,302 @@+--+-- MinIO Haskell SDK, (C) 2017-2019 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.SelectAPI+  (++  -- | The `selectObjectContent` allows querying CSV, JSON or Parquet+  -- format objects in AWS S3 and in MinIO using SQL Select+  -- statements. This allows significant reduction of data transfer+  -- from object storage for computation-intensive tasks, as relevant+  -- data is filtered close to the storage.++    selectObjectContent++  , SelectRequest+  , selectRequest++  -- *** Input Serialization+  -------------------------++  , InputSerialization+  , defaultCsvInput+  , linesJsonInput+  , documentJsonInput+  , defaultParquetInput+  , setInputCSVProps++  , CompressionType(..)+  , setInputCompressionType++  -- *** CSV Format details+  ------------------------+  -- | CSV format options such as delimiters and quote characters are+  -- specified using using the functions below. Options are combined+  -- monoidally.++  , CSVProp+  , recordDelimiter+  , fieldDelimiter+  , quoteCharacter+  , quoteEscapeCharacter+  , commentCharacter+  , allowQuotedRecordDelimiter+  , FileHeaderInfo(..)+  , fileHeaderInfo+  , QuoteFields(..)+  , quoteFields++  -- *** Output Serialization+  -------------------------++  , OutputSerialization+  , defaultCsvOutput+  , defaultJsonOutput+  , outputCSVFromProps+  , outputJSONFromRecordDelimiter++  -- *** Progress messages+  ------------------------++  , setRequestProgressEnabled++  -- *** Interpreting Select output+  --------------------------------------------+  -- | The conduit returned by `selectObjectContent` returns values of+  -- the `EventMessage` data type. This returns the query output+  -- messages formatted according to the chosen output serialization,+  -- interleaved with progress messages (if enabled by+  -- `setRequestProgressEnabled`), and at the end a statistics+  -- message.+  --+  -- If the application is interested in only the payload, then+  -- `getPayloadBytes` can be used. For example to simply print the+  -- payload to stdout:+  --+  -- > resultConduit <- selectObjectContent bucket object mySelectRequest+  -- > runConduit $ resultConduit .| getPayloadBytes .| stdoutC+  --+  -- Note that runConduit, the connect operator (.|) and stdoutC are+  -- all from the "conduit" package.++  , getPayloadBytes+  , EventMessage(..)+  , Progress(..)+  , Stats+  ) where++import           Conduit                    ((.|))+import qualified Conduit                    as C+import qualified Data.Binary                as Bin+import qualified Data.ByteString            as B+import qualified Data.ByteString.Lazy       as LB+import           Data.Digest.CRC32          (crc32, crc32Update)+import qualified Network.HTTP.Conduit       as NC+import qualified Network.HTTP.Types         as HT+import           UnliftIO                   (MonadUnliftIO)++import           Lib.Prelude++import           Network.Minio.API+import           Network.Minio.Data+import           Network.Minio.Errors+import           Network.Minio.Utils+import           Network.Minio.XmlGenerator+import           Network.Minio.XmlParser++data EventStreamException = ESEPreludeCRCFailed+                          | ESEMessageCRCFailed+                          | ESEUnexpectedEndOfStream+                          | ESEDecodeFail [Char]+                          | ESEInvalidHeaderType+                          | ESEInvalidHeaderValueType+                          | ESEInvalidMessageType+    deriving (Eq, Show)++instance Exception EventStreamException++-- chunkSize in bytes is 32KiB+chunkSize :: Int+chunkSize = 32 * 1024++parseBinary :: Bin.Binary a => ByteString -> IO a+parseBinary b = do+    case Bin.decodeOrFail $ LB.fromStrict b of+      Left (_, _, msg) -> throwIO $ ESEDecodeFail msg+      Right (_, _, r)  -> return r++bytesToHeaderName :: Text -> IO MsgHeaderName+bytesToHeaderName t = case t of+  ":message-type"  -> return MessageType+  ":event-type"    -> return EventType+  ":content-type"  -> return ContentType+  ":error-code"    -> return ErrorCode+  ":error-message" -> return ErrorMessage+  _                -> throwIO ESEInvalidHeaderType++parseHeaders :: MonadUnliftIO m+             => Word32 -> C.ConduitM ByteString a m [MessageHeader]+parseHeaders 0 = return []+parseHeaders hdrLen = do+    bs1 <- readNBytes 1+    n :: Word8 <- liftIO $ parseBinary bs1++    headerKeyBytes <- readNBytes $ fromIntegral n+    let headerKey = decodeUtf8Lenient headerKeyBytes+    headerName <- liftIO $ bytesToHeaderName headerKey++    bs2 <- readNBytes 1+    headerValueType :: Word8 <- liftIO $ parseBinary bs2+    when (headerValueType /= 7) $ throwIO ESEInvalidHeaderValueType++    bs3 <- readNBytes 2+    vLen :: Word16 <- liftIO $ parseBinary bs3+    headerValueBytes <- readNBytes $ fromIntegral vLen+    let headerValue = decodeUtf8Lenient headerValueBytes+        m = (headerName, headerValue)+        k = 1 + fromIntegral n + 1 + 2 + fromIntegral vLen++    ms <- parseHeaders (hdrLen - k)+    return (m:ms)++-- readNBytes returns N bytes read from the string and throws an+-- exception if N bytes are not present on the stream.+readNBytes :: MonadUnliftIO m => Int -> C.ConduitM ByteString a m ByteString+readNBytes n = do+    b <- LB.toStrict <$> (C.takeCE n .| C.sinkLazy)+    if B.length b /= n+        then throwIO ESEUnexpectedEndOfStream+        else return b++crcCheck :: MonadUnliftIO m+         => C.ConduitM ByteString ByteString m ()+crcCheck = do+    b <- readNBytes 12+    n :: Word32 <- liftIO $ parseBinary $ B.take 4 b+    preludeCRC :: Word32 <- liftIO $ parseBinary $ B.drop 8 b+    when (crc32 (B.take 8 b) /= preludeCRC) $+        throwIO ESEPreludeCRCFailed++    -- we do not yield the checksum+    C.yield $ B.take 8 b++    -- 12 bytes have been read off the current message. Now read the+    -- next (n-12)-4 bytes and accumulate the checksum, and yield it.+    let startCrc = crc32 b+    finalCrc <- accumulateYield (fromIntegral n-16) startCrc++    bs <- readNBytes 4+    expectedCrc :: Word32 <- liftIO $ parseBinary bs++    when (finalCrc /= expectedCrc) $+        throwIO ESEMessageCRCFailed++    -- we unconditionally recurse - downstream figures out when to+    -- quit reading the stream+    crcCheck+  where+    accumulateYield n checkSum = do+        let toRead = min n chunkSize+        b <- readNBytes toRead+        let c' = crc32Update checkSum b+            n' = n - B.length b+        C.yield b+        if n' > 0+            then accumulateYield n' c'+            else return c'++handleMessage :: MonadUnliftIO m => C.ConduitT ByteString EventMessage m ()+handleMessage = do+    b1 <- readNBytes 4+    msgLen :: Word32 <- liftIO $ parseBinary b1++    b2 <- readNBytes 4+    hdrLen :: Word32 <- liftIO $ parseBinary b2++    hs <- parseHeaders hdrLen++    let payloadLen = msgLen - hdrLen - 16+        getHdrVal h = fmap snd . headMay . filter ((h ==) . fst)+        eventHdrValue = getHdrVal EventType hs+        msgHdrValue = getHdrVal MessageType hs+        errCode = getHdrVal ErrorCode hs+        errMsg = getHdrVal ErrorMessage hs++    case msgHdrValue of+      Just "event" -> do+          case eventHdrValue of+            Just "Records" -> passThrough $ fromIntegral payloadLen+            Just "Cont" -> return ()+            Just "Progress" -> do+                bs <- readNBytes $ fromIntegral payloadLen+                progress <- parseSelectProgress bs+                C.yield $ ProgressEventMessage progress+            Just "Stats" -> do+                bs <- readNBytes $ fromIntegral payloadLen+                stats <- parseSelectProgress bs+                C.yield $ StatsEventMessage stats+            Just "End" -> return ()+            _ -> throwIO ESEInvalidMessageType+          when (eventHdrValue /= Just "End") handleMessage++      Just "error" -> do+          let reqMsgMay = RequestLevelErrorMessage <$> errCode <*> errMsg+          maybe (throwIO ESEInvalidMessageType) C.yield reqMsgMay++      _ -> throwIO ESEInvalidMessageType++  where+    passThrough 0 = return ()+    passThrough n = do+        let c = min n chunkSize+        b <- readNBytes c+        C.yield $ RecordPayloadEventMessage b+        passThrough $ n - B.length b+++selectProtoConduit :: MonadUnliftIO m+                   => C.ConduitT ByteString EventMessage m ()+selectProtoConduit = crcCheck .| handleMessage++-- | selectObjectContent calls the SelectRequest on the given+-- object. It returns a Conduit of event messages that can be consumed+-- by the client.+selectObjectContent :: Bucket -> Object -> SelectRequest+                    -> Minio (C.ConduitT () EventMessage Minio ())+selectObjectContent b o r = do+    let reqInfo = defaultS3ReqInfo { riMethod = HT.methodPost+                                   , riBucket = Just b+                                   , riObject = Just o+                                   , riPayload = PayloadBS $ mkSelectRequest r+                                   , riNeedsLocation = False+                                   , riQueryParams = [("select", Nothing), ("select-type", Just "2")]+                                   }+    --print $ mkSelectRequest r+    resp <- mkStreamRequest reqInfo+    return $ NC.responseBody resp .| selectProtoConduit++-- | A helper conduit that returns only the record payload bytes.+getPayloadBytes :: MonadIO m => C.ConduitT EventMessage ByteString m ()+getPayloadBytes = do+    evM <- C.await+    case evM of+      Just v -> do+          case v of+            RecordPayloadEventMessage b  -> C.yield b+            RequestLevelErrorMessage c m -> liftIO $ throwIO $ SelectErr c m+            _                            -> return ()+          getPayloadBytes+      Nothing -> return ()

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.@@ -18,11 +18,12 @@   ( mkCreateBucketConfig   , mkCompleteMultipartUploadRequest   , mkPutNotificationRequest+  , mkSelectRequest   ) where   import qualified Data.ByteString.Lazy as LBS-import qualified Data.Map             as M+import qualified Data.HashMap.Strict  as H import qualified Data.Text            as T import           Text.XML @@ -35,7 +36,7 @@ mkCreateBucketConfig :: Text -> Region -> ByteString mkCreateBucketConfig ns location = LBS.toStrict $ renderLBS def bucketConfig   where-      s3Element n = Element (s3Name ns n) M.empty+      s3Element n = Element (s3Name ns n) mempty       root = s3Element "CreateBucketConfiguration"         [ NodeElement $ s3Element "LocationConstraint"           [ NodeContent location]@@ -47,12 +48,12 @@ mkCompleteMultipartUploadRequest partInfo =   LBS.toStrict $ renderLBS def cmur   where-    root = Element "CompleteMultipartUpload" M.empty $+    root = Element "CompleteMultipartUpload" mempty $            map (NodeElement . mkPart) partInfo-    mkPart (n, etag) = Element "Part" M.empty-                               [ NodeElement $ Element "PartNumber" M.empty+    mkPart (n, etag) = Element "Part" mempty+                               [ NodeElement $ Element "PartNumber" mempty                                  [NodeContent $ T.pack $ show n]-                               , NodeElement $ Element "ETag" M.empty+                               , NodeElement $ Element "ETag" mempty                                  [NodeContent etag]                                ]     cmur = Document (Prologue [] Nothing []) root []@@ -67,9 +68,9 @@   Document (Prologue [] Nothing []) (xmlNode node) []   where     xmlNode :: XNode -> Element-    xmlNode (XNode name nodes)   = Element (s3Name ns name) M.empty $+    xmlNode (XNode name nodes)   = Element (s3Name ns name) mempty $                                    map (NodeElement . xmlNode) nodes-    xmlNode (XLeaf name content) = Element (s3Name ns name) M.empty+    xmlNode (XLeaf name content) = Element (s3Name ns name) mempty                                    [NodeContent content]  class ToXNode a where@@ -100,3 +101,65 @@  mkPutNotificationRequest :: Text -> Notification -> ByteString mkPutNotificationRequest ns = toXML ns . toXNode++mkSelectRequest :: SelectRequest -> ByteString+mkSelectRequest r = LBS.toStrict $ renderLBS def sr+  where+    sr = Document (Prologue [] Nothing []) root []+    root = Element "SelectRequest" mempty $+           [ NodeElement (Element "Expression" mempty+                          [NodeContent $ srExpression r])+           , NodeElement (Element "ExpressionType" mempty+                          [NodeContent $ show $ srExpressionType r])+           , NodeElement (Element "InputSerialization" mempty $+                          inputSerializationNodes $ srInputSerialization r)+           , NodeElement (Element "OutputSerialization" mempty $+                          outputSerializationNodes $ srOutputSerialization r)+           ] ++ maybe [] reqProgElem (srRequestProgressEnabled r)+    reqProgElem enabled = [NodeElement+                           (Element "RequestProgress" mempty+                             [NodeElement+                              (Element "Enabled" mempty+                                [NodeContent+                                 (if enabled then "TRUE" else "FALSE")]+                              )+                             ]+                           )+                          ]+    inputSerializationNodes is = comprTypeNode (isCompressionType is) +++                                 [NodeElement $ formatNode (isFormatInfo is)]+    comprTypeNode (Just c) = [NodeElement $ Element "CompressionType" mempty+                              [NodeContent $ case c of+                                  CompressionTypeNone  -> "NONE"+                                  CompressionTypeGzip  -> "GZIP"+                                  CompressionTypeBzip2 -> "BZIP2"+                              ]+                             ]+    comprTypeNode Nothing = []++    kvElement (k, v) = Element (Name k Nothing Nothing) mempty [NodeContent v]+    formatNode (InputFormatCSV (CSVProp h)) =+      Element "CSV" mempty+      (map NodeElement $ map kvElement $ H.toList h)+    formatNode (InputFormatJSON p) =+      Element "JSON" mempty+      [NodeElement+        (Element "Type" mempty+          [NodeContent $ case jsonipType p of+              JSONTypeDocument -> "DOCUMENT"+              JSONTypeLines    -> "LINES"+          ]+        )+      ]+    formatNode InputFormatParquet = Element "Parquet" mempty []++    outputSerializationNodes (OutputSerializationJSON j) =+      [NodeElement (Element "JSON" mempty $+                     rdElem $ jsonopRecordDelimiter j)]+    outputSerializationNodes (OutputSerializationCSV (CSVProp h)) =+      [NodeElement $ Element "CSV" mempty+       (map NodeElement $ map kvElement $ H.toList h)]++    rdElem Nothing = []+    rdElem (Just t) = [NodeElement $ Element "RecordDelimiter" mempty+                        [NodeContent t]]

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.@@ -26,8 +26,10 @@   , parseListPartsResponse   , parseErrResponse   , parseNotification+  , parseSelectProgress   ) where +import qualified Data.ByteString.Lazy as LB import           Data.List            (zip3, zip4, zip5) import qualified Data.Map             as Map import qualified Data.Text            as T@@ -261,3 +263,13 @@                   s3Elem ns "FilterRule" &| getFilterRule ns       return $ NotificationConfig id arn events         (Filter $ FilterKey $ FilterRules rules)++parseSelectProgress :: MonadIO m => ByteString -> m Progress+parseSelectProgress xmldata = do+    r <- parseRoot $ LB.fromStrict xmldata+    let bScanned = T.concat $ r $/ element "BytesScanned" &/ content+        bProcessed = T.concat $ r $/element "BytesProcessed" &/ content+        bReturned = T.concat $ r $/element "BytesReturned" &/ content+    Progress <$> parseDecimal bScanned+             <*> parseDecimal bProcessed+             <*> parseDecimal bReturned

@@ -15,7 +15,7 @@ # resolver: #  name: custom-snapshot #  location: "./custom-snapshot.yaml"-resolver: lts-11.1+resolver: lts-13.1  # User packages to be built. # Various formats can be used as shown in the example below.

@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -96,6 +96,123 @@     deleteBucket b   isRight ret @? ("Functional test " ++ t ++ " failed => " ++ show ret) +liveServerUnitTests :: TestTree+liveServerUnitTests = testGroup "Unit tests against a live server"+  [ basicTests+  , listingTest+  , highLevelListingTest+  , lowLevelMultipartTest+  , putObjectSizeTest+  , putObjectNoSizeTest+  , multipartTest+  , putObjectContentTypeTest+  , putObjectContentLanguageTest+  , putObjectStorageClassTest+  , copyObjectTests+  , presignedUrlFunTest+  , presignedPostPolicyFunTest+  , bucketPolicyFunTest+  , getNPutSSECTest+  ]++basicTests :: TestTree+basicTests = funTestWithBucket "Basic tests" $+  \step bucket -> do+    step "getService works and contains the test bucket."+    buckets <- getService+    unless (length (filter (== bucket) $ map biName buckets) == 1) $+      liftIO $+      assertFailure ("The bucket " ++ show bucket +++                     " was expected to exist.")++    step "makeBucket again to check if BucketAlreadyOwnedByYou exception is raised."+    mbE <- try $ makeBucket bucket Nothing+    case mbE of+      Left exn -> liftIO $ exn @?= BucketAlreadyOwnedByYou+      _        -> return ()++    step "makeBucket with an invalid bucket name and check for appropriate exception."+    invalidMBE <- try $ makeBucket "invalidBucketName" Nothing+    case invalidMBE of+      Left exn -> liftIO $ exn @?= MErrVInvalidBucketName "invalidBucketName"+      _        -> return ()++    step "getLocation works"+    region <- getLocation bucket+    liftIO $ region == "us-east-1" @? ("Got unexpected region => " ++ show region)++    step "singlepart putObject works"+    fPutObject bucket "lsb-release" "/etc/lsb-release" defaultPutObjectOptions++    step "fPutObject onto a non-existent bucket and check for NoSuchBucket exception"+    fpE <- try $ fPutObject "nosuchbucket" "lsb-release" "/etc/lsb-release" defaultPutObjectOptions+    case fpE of+      Left exn -> liftIO $ exn @?= NoSuchBucket+      _        -> return ()++    outFile <- mkRandFile 0+    step "simple fGetObject works"+    fGetObject bucket "lsb-release" outFile defaultGetObjectOptions++    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 <- try $ fGetObject bucket "lsb-release" outFile defaultGetObjectOptions {+      gooIfUnmodifiedSince = (Just unmodifiedTime)+      }+    case resE 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 matching etag, check for exception"+    resE1 <- try $ fGetObject bucket "lsb-release" outFile defaultGetObjectOptions {+      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 <- try $ fGetObject bucket "lsb-release" outFile defaultGetObjectOptions {+      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 defaultGetObjectOptions {+      gooRange = (Just $ HT.ByteRangeFrom 1)+      }++    step "fGetObject a non-existent object and check for NoSuchKey exception"+    resE3 <- try $ fGetObject bucket "noSuchKey" outFile defaultGetObjectOptions+    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.")++    step "abort a new multipart upload works"+    abortMultipartUpload bucket "newmpupload" uid++    step "delete object works"+    deleteObject bucket "lsb-release"++    step "statObject test"+    let object = "sample"+    step "create an object"+    inputFile <- mkRandFile 0+    fPutObject bucket object inputFile defaultPutObjectOptions++    step "get metadata of the object"+    res <- statObject bucket object defaultGetObjectOptions+    liftIO $ (oiSize res) @?= 0++    step "delete object"+    deleteObject bucket object+ lowLevelMultipartTest :: TestTree lowLevelMultipartTest = funTestWithBucket "Low-level Multipart Test" $     \step bucket -> do@@ -299,367 +416,6 @@       liftIO $ (length $ lprParts listPartsResult) @?= 10       abortMultipartUpload bucket object uid --liveServerUnitTests :: TestTree-liveServerUnitTests = testGroup "Unit tests against a live server"-  [ basicTests-  , listingTest-  , highLevelListingTest-  , lowLevelMultipartTest-  , putObjectSizeTest-  , putObjectNoSizeTest-  , funTestWithBucket "Multipart Tests" $-    \step bucket -> do-      step "Prepare for putObjectInternal with non-seekable file, with size."-      step "Upload multipart file."-      let mb80 = 80 * 1024 * 1024-          obj = "mpart"--      void $ putObjectInternal bucket obj defaultPutObjectOptions $ ODFile "/dev/zero" (Just mb80)--      step "Retrieve and verify file size"-      destFile <- mkRandFile 0-      fGetObject bucket obj destFile defaultGetObjectOptions-      gotSize <- withNewHandle destFile getFileSize-      liftIO $ gotSize == Right (Just mb80) @?-        "Wrong file size of put file after getting"--      step "Cleanup actions"-      removeObject bucket obj--      step "cleanup"-      removeObject bucket "big"--      step "Prepare for removeIncompleteUpload"-      -- low-level multipart operation tests.-      let object = "newmpupload"-          kb5 = 5 * 1024--      step "create new multipart upload"-      uid <- newMultipartUpload bucket object []-      liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id."--      randFile <- mkRandFile kb5--      step "upload 2 parts"-      forM_ [1,2] $ \partNum -> do-        h <- liftIO $ SIO.openBinaryFile randFile SIO.ReadMode-        void $ putObjectPart bucket object uid partNum [] $ PayloadH h 0 kb5--      step "remove ongoing upload"-      removeIncompleteUpload bucket object-      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 defaultPutObjectOptions {-        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 defaultPutObjectOptions {-        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 defaultPutObjectOptions {-        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 defaultPutObjectOptions {-        pooStorageClass = Just "STANDARD"-        }--      fPutObject bucket object' inputFile' defaultPutObjectOptions {-        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 <- try $ fPutObject bucket object'' inputFile'' defaultPutObjectOptions {-        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"-          objCopy = "xxxCopy"-          size1 = 100 :: Int64--      step "create server object to copy"-      inputFile <- mkRandFile size1-      fPutObject bucket object inputFile defaultPutObjectOptions--      step "copy object"-      let srcInfo = defaultSourceInfo { srcBucket = bucket, srcObject = object}-      (etag, modTime) <- copyObjectSingle bucket objCopy srcInfo []--      -- retrieve obj info to check-      oi <- headObject bucket objCopy-      let t = oiModTime oi-      let e = oiETag oi-      let s = oiSize oi--      let isMTimeDiffOk = abs (diffUTCTime modTime t) < 1.0--      liftIO $ (s == size1 && e == etag && isMTimeDiffOk) @?-        "Copied object did not match expected."--      step "cleanup actions"-      removeObject bucket object-      removeObject bucket objCopy--      step "copyObjectPart basic tests"-      let srcObj = "XXX"-          copyObj = "XXXCopy"--      step "Prepare"-      let mb15 = 15 * 1024 * 1024-          mb5 = 5 * 1024 * 1024-      randFile <- mkRandFile mb15-      fPutObject bucket srcObj randFile defaultPutObjectOptions--      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 srcInfo' = defaultSourceInfo { srcBucket = bucket, srcObject = srcObj }-          dstInfo' = defaultDestinationInfo { dstBucket = bucket, dstObject = copyObj }-      parts <- forM [1..3] $ \p -> do-        (etag', _) <- copyObjectPart dstInfo' srcInfo'{-          srcRange = Just $ (,) ((p-1)*mb5) ((p-1)*mb5 + (mb5 - 1))-          } uid (fromIntegral p) []-        return (fromIntegral p, etag')--      step "complete multipart"-      void $ completeMultipartUpload bucket copyObj uid parts--      step "verify copied object size"-      oi' <- headObject bucket copyObj-      let s' = oiSize oi'--      liftIO $ (s' == mb15) @? "Size failed to match"--      step "Cleanup actions"-      removeObject bucket srcObj-      removeObject bucket copyObj--      step "copyObject basic tests"-      let srcs = ["XXX", "XXXL"]-          copyObjs = ["XXXCopy", "XXXLCopy"]-          sizes = map (* (1024 * 1024)) [15, 65]--      step "Prepare"-      forM_ (zip srcs sizes) $ \(src, size) -> do-        inputFile' <- mkRandFile size-        fPutObject bucket src inputFile' defaultPutObjectOptions--      step "make small and large object copy"-      forM_ (zip copyObjs srcs) $ \(cp, src) ->-        copyObject defaultDestinationInfo {dstBucket = bucket, dstObject = cp} defaultSourceInfo {srcBucket = bucket, srcObject = src}--      step "verify uploaded objects"-      uploadedSizes <- fmap oiSize <$> forM copyObjs (headObject bucket)--      liftIO $ (sizes == uploadedSizes) @? "Uploaded obj sizes failed to match"--      forM_ (srcs ++ copyObjs) (removeObject bucket)--      step "copyObject with offset test "-      let src = "XXX"-          size = 15 * 1024 * 1024--      step "Prepare"-      inputFile' <- mkRandFile size-      fPutObject bucket src inputFile' defaultPutObjectOptions--      step "copy last 10MiB of object"-      copyObject defaultDestinationInfo { dstBucket = bucket, dstObject = copyObj } defaultSourceInfo {-          srcBucket = bucket-        , srcObject = src-        , srcRange = Just $ (,) (5 * 1024 * 1024) (size - 1)-        }--      step "verify uploaded object"-      cSize <- oiSize <$> headObject bucket copyObj--      liftIO $ (cSize == 10 * 1024 * 1024) @? "Uploaded obj size mismatched!"--      forM_ [src, copyObj] (removeObject bucket)--  , presignedUrlFunTest-  , presignedPostPolicyFunTest-  , bucketPolicyFunTest-  ]--basicTests :: TestTree-basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do-      step "getService works and contains the test bucket."-      buckets <- getService-      unless (length (filter (== bucket) $ map biName buckets) == 1) $-        liftIO $-        assertFailure ("The bucket " ++ show bucket ++-                       " was expected to exist.")--      step "makeBucket again to check if BucketAlreadyOwnedByYou exception is raised."-      mbE <- try $ makeBucket bucket Nothing-      case mbE of-        Left exn -> liftIO $ exn @?= BucketAlreadyOwnedByYou-        _        -> return ()--      step "makeBucket with an invalid bucket name and check for appropriate exception."-      invalidMBE <- try $ makeBucket "invalidBucketName" Nothing-      case invalidMBE of-        Left exn -> liftIO $ exn @?= MErrVInvalidBucketName "invalidBucketName"-        _ -> return ()--      step "getLocation works"-      region <- getLocation bucket-      liftIO $ region == "us-east-1" @? ("Got unexpected region => " ++ show region)--      step "singlepart putObject works"-      fPutObject bucket "lsb-release" "/etc/lsb-release" defaultPutObjectOptions--      step "fPutObject onto a non-existent bucket and check for NoSuchBucket exception"-      fpE <- try $ fPutObject "nosuchbucket" "lsb-release" "/etc/lsb-release" defaultPutObjectOptions-      case fpE of-        Left exn -> liftIO $ exn @?= NoSuchBucket-        _        -> return ()--      outFile <- mkRandFile 0-      step "simple fGetObject works"-      fGetObject bucket "lsb-release" outFile defaultGetObjectOptions--      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 <- try $ fGetObject bucket "lsb-release" outFile defaultGetObjectOptions {-        gooIfUnmodifiedSince = (Just unmodifiedTime)-        }-      case resE 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 matching etag, check for exception"-      resE1 <- try $ fGetObject bucket "lsb-release" outFile defaultGetObjectOptions {-        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 <- try $ fGetObject bucket "lsb-release" outFile defaultGetObjectOptions {-        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 defaultGetObjectOptions {-        gooRange = (Just $ HT.ByteRangeFrom 1)-        }--      step "fGetObject a non-existent object and check for NoSuchKey exception"-      resE3 <- try $ fGetObject bucket "noSuchKey" outFile defaultGetObjectOptions-      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.")--      step "abort a new multipart upload works"-      abortMultipartUpload bucket "newmpupload" uid--      step "delete object works"-      deleteObject bucket "lsb-release"--      step "statObject test"-      let object = "sample"-      step "create an object"-      inputFile <- mkRandFile 0-      fPutObject bucket object inputFile defaultPutObjectOptions--      step "get metadata of the object"-      res <- statObject bucket object-      liftIO $ (oiSize res) @?= 0--      step "delete object"-      deleteObject bucket object- presignedUrlFunTest :: TestTree presignedUrlFunTest = funTestWithBucket "presigned Url tests" $   \step bucket -> do@@ -695,7 +451,7 @@       "presigned put and get got mismatched data"      step "PUT object presigned - presignedPutObjectURL"-    putUrl2 <- presignedPutObjectUrl bucket obj2 3600 []+    putUrl2 <- presignedPutObjectUrl bucket obj2 604800 []      let size2 = 1200     testFile <- mkRandFile size2@@ -834,3 +590,304 @@      step "delete bucket policy"     setBucketPolicy bucket T.empty++multipartTest :: TestTree+multipartTest = funTestWithBucket "Multipart Tests" $+  \step bucket -> do+    step "Prepare for putObjectInternal with non-seekable file, with size."+    step "Upload multipart file."+    let mb80 = 80 * 1024 * 1024+        obj = "mpart"++    void $ putObjectInternal bucket obj defaultPutObjectOptions $ ODFile "/dev/zero" (Just mb80)++    step "Retrieve and verify file size"+    destFile <- mkRandFile 0+    fGetObject bucket obj destFile defaultGetObjectOptions+    gotSize <- withNewHandle destFile getFileSize+    liftIO $ gotSize == Right (Just mb80) @?+      "Wrong file size of put file after getting"++    step "Cleanup actions"+    removeObject bucket obj++    step "cleanup"+    removeObject bucket "big"++    step "Prepare for removeIncompleteUpload"+    -- low-level multipart operation tests.+    let object = "newmpupload"+        kb5 = 5 * 1024++    step "create new multipart upload"+    uid <- newMultipartUpload bucket object []+    liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id."++    randFile <- mkRandFile kb5++    step "upload 2 parts"+    forM_ [1,2] $ \partNum -> do+      h <- liftIO $ SIO.openBinaryFile randFile SIO.ReadMode+      void $ putObjectPart bucket object uid partNum [] $ PayloadH h 0 kb5++    step "remove ongoing upload"+    removeIncompleteUpload bucket object+    uploads <- C.runConduit $ listIncompleteUploads bucket (Just object) False+               C..| sinkList+    liftIO $ (null uploads) @? "removeIncompleteUploads didn't complete successfully"++putObjectContentTypeTest :: TestTree+putObjectContentTypeTest = 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 defaultPutObjectOptions {+      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 defaultPutObjectOptions {+      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++putObjectContentLanguageTest :: TestTree+putObjectContentLanguageTest = 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 defaultPutObjectOptions {+      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++putObjectStorageClassTest :: TestTree+putObjectStorageClassTest = 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 defaultPutObjectOptions {+      pooStorageClass = Just "STANDARD"+      }++    fPutObject bucket object' inputFile' defaultPutObjectOptions {+      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 <- try $ fPutObject bucket object'' inputFile'' defaultPutObjectOptions {+      pooStorageClass = Just "INVALID_STORAGE_CLASS"+      }+    case fpE of+      Left exn -> liftIO $ exn @?= ServiceErr "InvalidStorageClass" "Invalid storage class."+      _        -> return ()++    step "Cleanup actions"++    removeObject bucket object'++copyObjectTests :: TestTree+copyObjectTests = funTestWithBucket "copyObject related tests" $+  \step bucket -> do+    step "copyObjectSingle basic tests"+    let object = "xxx"+        objCopy = "xxxCopy"+        size1 = 100 :: Int64++    step "create server object to copy"+    inputFile <- mkRandFile size1+    fPutObject bucket object inputFile defaultPutObjectOptions++    step "copy object"+    let srcInfo = defaultSourceInfo { srcBucket = bucket, srcObject = object}+    (etag, modTime) <- copyObjectSingle bucket objCopy srcInfo []++    -- retrieve obj info to check+    oi <- headObject bucket objCopy []+    let t = oiModTime oi+    let e = oiETag oi+    let s = oiSize oi++    let isMTimeDiffOk = abs (diffUTCTime modTime t) < 1.0++    liftIO $ (s == size1 && e == etag && isMTimeDiffOk) @?+      "Copied object did not match expected."++    step "cleanup actions"+    removeObject bucket object+    removeObject bucket objCopy++    step "copyObjectPart basic tests"+    let srcObj = "XXX"+        copyObj = "XXXCopy"++    step "Prepare"+    let mb15 = 15 * 1024 * 1024+        mb5 = 5 * 1024 * 1024+    randFile <- mkRandFile mb15+    fPutObject bucket srcObj randFile defaultPutObjectOptions++    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 srcInfo' = defaultSourceInfo { srcBucket = bucket, srcObject = srcObj }+        dstInfo' = defaultDestinationInfo { dstBucket = bucket, dstObject = copyObj }+    parts <- forM [1..3] $ \p -> do+      (etag', _) <- copyObjectPart dstInfo' srcInfo'{+        srcRange = Just $ (,) ((p-1)*mb5) ((p-1)*mb5 + (mb5 - 1))+        } uid (fromIntegral p) []+      return (fromIntegral p, etag')++    step "complete multipart"+    void $ completeMultipartUpload bucket copyObj uid parts++    step "verify copied object size"+    oi' <- headObject bucket copyObj []+    let s' = oiSize oi'++    liftIO $ (s' == mb15) @? "Size failed to match"++    step "Cleanup actions"+    removeObject bucket srcObj+    removeObject bucket copyObj++    step "copyObject basic tests"+    let srcs = ["XXX", "XXXL"]+        copyObjs = ["XXXCopy", "XXXLCopy"]+        sizes = map (* (1024 * 1024)) [15, 65]++    step "Prepare"+    forM_ (zip srcs sizes) $ \(src, size) -> do+      inputFile' <- mkRandFile size+      fPutObject bucket src inputFile' defaultPutObjectOptions++    step "make small and large object copy"+    forM_ (zip copyObjs srcs) $ \(cp, src) ->+      copyObject defaultDestinationInfo {dstBucket = bucket, dstObject = cp} defaultSourceInfo {srcBucket = bucket, srcObject = src}++    step "verify uploaded objects"+    uploadedSizes <- fmap oiSize <$> forM copyObjs (\o -> headObject bucket o [])++    liftIO $ (sizes == uploadedSizes) @? "Uploaded obj sizes failed to match"++    forM_ (srcs ++ copyObjs) (removeObject bucket)++    step "copyObject with offset test "+    let src = "XXX"+        size = 15 * 1024 * 1024++    step "Prepare"+    inputFile' <- mkRandFile size+    fPutObject bucket src inputFile' defaultPutObjectOptions++    step "copy last 10MiB of object"+    copyObject defaultDestinationInfo { dstBucket = bucket, dstObject = copyObj } defaultSourceInfo {+        srcBucket = bucket+      , srcObject = src+      , srcRange = Just $ (,) (5 * 1024 * 1024) (size - 1)+      }++    step "verify uploaded object"+    cSize <- oiSize <$> headObject bucket copyObj []++    liftIO $ (cSize == 10 * 1024 * 1024) @? "Uploaded obj size mismatched!"++    forM_ [src, copyObj] (removeObject bucket)++getNPutSSECTest :: TestTree+getNPutSSECTest =+    funTestWithBucket "Get and Put SSE-C Test" $ \step bucket -> do+       -- Skip this test if the server is not using TLS as encryption is+       -- disabled anyway.+       isTLSConn <- asks (connectIsSecure . mcConnInfo)+       if isTLSConn+           then do step "Make an encryption key"+                   key <- case mkSSECKey $ BS.pack [0..31] of+                            Nothing -> liftIO $ assertFailure "This should not happen"+                            Just k  -> return k++                   let mb1 = 1024*1024+                       obj = "1"+                   step "Upload an object using the encryption key"+                   rFile <- mkRandFile mb1+                   let putOpts = defaultPutObjectOptions { pooSSE = Just $ SSEC key }+                   fPutObject bucket obj rFile putOpts++                   step "Stat object without key - should fail"+                   headRes <- try $ statObject bucket obj defaultGetObjectOptions+                   case headRes of+                     Right _ -> liftIO $ assertFailure "Cannot perform head object on encrypted object without specifying key"+                     Left ex@(NC.HttpExceptionRequest _ (NC.StatusCodeException rsp _))+                         | NC.responseStatus rsp == HT.status400 -> return ()+                         | otherwise -> liftIO $ assertFailure $ "Unexpected err: " ++ show ex+                     Left ex -> liftIO $ assertFailure $ "Unexpected err: " ++ show ex++                   step "Get file and check length"+                   dstFile <- mkRandFile 0+                   let getOpts = defaultGetObjectOptions { gooSSECKey = Just key }+                   fGetObject bucket obj dstFile getOpts++                   gotSize <- withNewHandle dstFile getFileSize+                   liftIO $ gotSize == Right (Just mb1) @?+                       "Wrong file size of object when getting"++                   step "Cleanup"+                   deleteObject bucket obj++           else step "Skipping encryption test as server is not using TLS"

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -56,7 +56,7 @@   ]  parseServerInfoJSONTest :: TestTree-parseServerInfoJSONTest = testGroup "Parse Minio Admin API ServerInfo JSON test" $+parseServerInfoJSONTest = testGroup "Parse MinIO Admin API ServerInfo JSON test" $   map (\(tName, tDesc, tfn, tVal) -> testCase tName $ assertBool tDesc $         tfn (eitherDecode tVal :: Either [Char] [ServerInfo])) testCases   where@@ -71,7 +71,7 @@     invalidJSON = "[{\"error\":\"\",\"addr\":\"192.168.1.218:9000\",\"data\":{\"storage\":{\"Used\":83084,\"Backend\":{\"Type\":42,\"OnlineDisks\":4,\"OfflineDisks\":0,\"StandardSCData\":2,\"StandardSCParity\":2,\"RRSCData\":2,\"RRSCParity\":2,\"Sets\":[[{\"uuid\":\"16ec6f2c-9197-4787-904a-36bb2c2683f8\",\"endpoint\":\"/tmp/1\",\"state\":\"ok\"},{\"uuid\":\"4052e086-ef99-4aa5-ae2b-8e27559432f6\",\"endpoint\":\"/tmp/2\",\"state\":\"ok\"},{\"uuid\":\"d0639950-ddd3-45b0-93ca-fd86f5d79f72\",\"endpoint\":\"/tmp/3\",\"state\":\"ok\"},{\"uuid\":\"30ec68c0-37e1-4592-82c1-26b143c0ac10\",\"endpoint\":\"/tmp/4\",\"state\":\"ok\"}]]}},\"network\":{\"transferred\":404,\"received\":0},\"http\":{\"totalHEADs\":{\"count\":0,\"avgDuration\":\"0s\"},\"successHEADs\":{\"count\":0,\"avgDuration\":\"0s\"},\"totalGETs\":{\"count\":0,\"avgDuration\":\"0s\"},\"successGETs\":{\"count\":0,\"avgDuration\":\"0s\"},\"totalPUTs\":{\"count\":0,\"avgDuration\":\"0s\"},\"successPUTs\":{\"count\":0,\"avgDuration\":\"0s\"},\"totalPOSTs\":{\"count\":0,\"avgDuration\":\"0s\"},\"successPOSTs\":{\"count\":0,\"avgDuration\":\"0s\"},\"totalDELETEs\":{\"count\":0,\"avgDuration\":\"0s\"},\"successDELETEs\":{\"count\":0,\"avgDuration\":\"0s\"}},\"server\":{\"uptime\":2738903073,\"version\":\"DEVELOPMENT.GOGET\",\"commitID\":\"DEVELOPMENT.GOGET\",\"region\":\"\",\"sqsARN\":[]}}}]"  parseHealStatusTest :: TestTree-parseHealStatusTest = testGroup "Parse Minio Admin API HealStatus JSON test" $+parseHealStatusTest = testGroup "Parse MinIO Admin API HealStatus JSON test" $   map (\(tName, tDesc, tfn, tVal) -> testCase tName $ assertBool tDesc $         tfn (eitherDecode tVal :: Either [Char] HealStatus)) testCases @@ -88,7 +88,7 @@     invalidItemType = "{\"Summary\":\"finished\",\"StartTime\":\"2018-06-05T08:09:47.644465513Z\",\"NumDisks\":4,\"Settings\":{\"recursive\":false,\"dryRun\":false},\"Items\":[{\"resultId\":1,\"type\":\"hello\",\"bucket\":\"\",\"object\":\"\",\"detail\":\"disk-format\",\"diskCount\":4,\"setCount\":1,\"before\":{\"drives\":[{\"uuid\":\"c3487166-b8a4-481a-b1e7-fb9b249e2500\",\"endpoint\":\"/tmp/1\",\"state\":\"ok\"},{\"uuid\":\"55a6e787-184f-4e4c-bf09-03dcada658a9\",\"endpoint\":\"/tmp/2\",\"state\":\"ok\"},{\"uuid\":\"f035d8c3-fca1-4407-b89c-38c2bcf4a641\",\"endpoint\":\"/tmp/3\",\"state\":\"ok\"},{\"uuid\":\"4f8b79d3-db90-4c1d-87c2-35a28b0d9a13\",\"endpoint\":\"/tmp/4\",\"state\":\"ok\"}]},\"after\":{\"drives\":[{\"uuid\":\"c3487166-b8a4-481a-b1e7-fb9b249e2500\",\"endpoint\":\"/tmp/1\",\"state\":\"ok\"},{\"uuid\":\"55a6e787-184f-4e4c-bf09-03dcada658a9\",\"endpoint\":\"/tmp/2\",\"state\":\"ok\"},{\"uuid\":\"f035d8c3-fca1-4407-b89c-38c2bcf4a641\",\"endpoint\":\"/tmp/3\",\"state\":\"ok\"},{\"uuid\":\"4f8b79d3-db90-4c1d-87c2-35a28b0d9a13\",\"endpoint\":\"/tmp/4\",\"state\":\"ok\"}]},\"objectSize\":0}]}"  parseHealStartRespTest :: TestTree-parseHealStartRespTest = testGroup "Parse Minio Admin API HealStartResp JSON test" $+parseHealStartRespTest = testGroup "Parse MinIO Admin API HealStartResp JSON test" $   map (\(tName, tDesc, tfn, tVal) -> testCase tName $ assertBool tDesc $         tfn (eitherDecode tVal :: Either [Char] HealStartResp)) testCases 

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2018 Minio, Inc.+-- MinIO Haskell SDK, (C) 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.

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2018 Minio, Inc.+-- MinIO Haskell SDK, (C) 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.

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.@@ -14,12 +14,14 @@ -- limitations under the License. -- +{-# LANGUAGE QuasiQuotes #-} module Network.Minio.XmlGenerator.Test   ( xmlGeneratorTests   ) where  import           Test.Tasty import           Test.Tasty.HUnit+import           Text.RawString.QQ          (r)  import           Lib.Prelude @@ -33,6 +35,7 @@   [ testCase "Test mkCreateBucketConfig" testMkCreateBucketConfig   , testCase "Test mkCompleteMultipartUploadRequest" testMkCompleteMultipartUploadRequest   , testCase "Test mkPutNotificationRequest" testMkPutNotificationRequest+  , testCase "Test mkSelectRequest" testMkSelectRequest   ]  testMkCreateBucketConfig :: Assertion@@ -94,4 +97,47 @@                 "ObjectCreatedEvents" "arn:aws:lambda:us-west-2:35667example:function:CreateThumbnail"                 [ObjectCreated] defaultFilter               ]+            ]++testMkSelectRequest :: Assertion+testMkSelectRequest = mapM_ assertFn cases+  where+    assertFn (a, b) = assertEqual "selectRequest XML should match: " b $ mkSelectRequest a+    cases = [ ( SelectRequest "Select * from S3Object" SQL+                (InputSerialization (Just CompressionTypeGzip)+                 (InputFormatCSV $ fileHeaderInfo FileHeaderIgnore+                                <> recordDelimiter "\n"+                                <> fieldDelimiter ","+                                <> quoteCharacter "\""+                                <> quoteEscapeCharacter "\""+                 ))+                (OutputSerializationCSV $ quoteFields QuoteFieldsAsNeeded+                                       <> recordDelimiter "\n"+                                       <> fieldDelimiter ","+                                       <> quoteCharacter "\""+                                       <> quoteEscapeCharacter "\""+                )+                (Just False)+              , [r|<?xml version="1.0" encoding="UTF-8"?><SelectRequest><Expression>Select * from S3Object</Expression><ExpressionType>SQL</ExpressionType><InputSerialization><CompressionType>GZIP</CompressionType><CSV><QuoteCharacter>&#34;</QuoteCharacter><RecordDelimiter>+</RecordDelimiter><FileHeaderInfo>IGNORE</FileHeaderInfo><QuoteEscapeCharacter>&#34;</QuoteEscapeCharacter><FieldDelimiter>,</FieldDelimiter></CSV></InputSerialization><OutputSerialization><CSV><QuoteCharacter>&#34;</QuoteCharacter><QuoteFields>ASNEEDED</QuoteFields><RecordDelimiter>+</RecordDelimiter><QuoteEscapeCharacter>&#34;</QuoteEscapeCharacter><FieldDelimiter>,</FieldDelimiter></CSV></OutputSerialization><RequestProgress><Enabled>FALSE</Enabled></RequestProgress></SelectRequest>|]+              )+            , ( setRequestProgressEnabled False $+                setInputCompressionType CompressionTypeGzip $+                selectRequest "Select * from S3Object" documentJsonInput+                (outputJSONFromRecordDelimiter "\n")+              , [r|<?xml version="1.0" encoding="UTF-8"?><SelectRequest><Expression>Select * from S3Object</Expression><ExpressionType>SQL</ExpressionType><InputSerialization><CompressionType>GZIP</CompressionType><JSON><Type>DOCUMENT</Type></JSON></InputSerialization><OutputSerialization><JSON><RecordDelimiter>+</RecordDelimiter></JSON></OutputSerialization><RequestProgress><Enabled>FALSE</Enabled></RequestProgress></SelectRequest>|]+              )+            , ( setRequestProgressEnabled False $+                setInputCompressionType CompressionTypeNone $+                selectRequest "Select * from S3Object" defaultParquetInput+                (outputCSVFromProps $ quoteFields QuoteFieldsAsNeeded+                                   <> recordDelimiter "\n"+                                   <> fieldDelimiter ","+                                   <> quoteCharacter "\""+                                   <> quoteEscapeCharacter "\"")+              , [r|<?xml version="1.0" encoding="UTF-8"?><SelectRequest><Expression>Select * from S3Object</Expression><ExpressionType>SQL</ExpressionType><InputSerialization><CompressionType>NONE</CompressionType><Parquet/></InputSerialization><OutputSerialization><CSV><QuoteCharacter>&#34;</QuoteCharacter><QuoteFields>ASNEEDED</QuoteFields><RecordDelimiter>+</RecordDelimiter><QuoteEscapeCharacter>&#34;</QuoteEscapeCharacter><FieldDelimiter>,</FieldDelimiter></CSV></OutputSerialization><RequestProgress><Enabled>FALSE</Enabled></RequestProgress></SelectRequest>|]+              )             ]

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017 Minio, Inc.+-- 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.@@ -14,15 +14,16 @@ -- limitations under the License. -- +{-# LANGUAGE QuasiQuotes #-} module Network.Minio.XmlParser.Test-  (-    xmlParserTests+  ( xmlParserTests   ) where  import qualified Data.Map                  as Map import           Data.Time                 (fromGregorian) import           Test.Tasty import           Test.Tasty.HUnit+import           Text.RawString.QQ         (r) import           UnliftIO                  (MonadUnliftIO)  import           Lib.Prelude@@ -43,6 +44,7 @@   , testCase "Test parseListPartsResponse" testParseListPartsResponse   , testCase "Test parseCopyObjectResponse" testParseCopyObjectResponse   , testCase "Test parseNotification" testParseNotification+  , testCase "Test parseSelectProgress" testParseSelectProgress   ]  tryValidationErr :: (MonadUnliftIO m) => m a -> m (Either MErrV a)@@ -356,3 +358,24 @@   forM_ cases $ \(xmldata, val) -> do     result <- runExceptT $ runTestNS $ parseNotification xmldata     eitherValidationErr result (@?= val)++-- | Tests parsing of both progress and stats+testParseSelectProgress :: Assertion+testParseSelectProgress = do+    let cases = [ ([r|<?xml version="1.0" encoding="UTF-8"?>+<Progress>+     <BytesScanned>512</BytesScanned>+     <BytesProcessed>1024</BytesProcessed>+     <BytesReturned>1024</BytesReturned>+</Progress>|] , Progress 512 1024 1024)+                , ([r|<?xml version="1.0" encoding="UTF-8"?>+<Stats>+     <BytesScanned>512</BytesScanned>+     <BytesProcessed>1024</BytesProcessed>+     <BytesReturned>1024</BytesReturned>+</Stats>|], Progress 512 1024 1024)+                ]++    forM_ cases $ \(xmldata, progress) -> do+        result <- runExceptT $ parseSelectProgress xmldata+        eitherValidationErr result (@?= progress)

@@ -1,5 +1,5 @@ ----- Minio Haskell SDK, (C) 2017, 2018 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.@@ -17,6 +17,7 @@ import           Test.Tasty import           Test.Tasty.QuickCheck           as QC +import qualified Data.ByteString                 as B import qualified Data.List                       as L  import           Lib.Prelude@@ -111,6 +112,13 @@        in start < 0 || start > end ||          (isLastPartOk && isFirstPartOk && isPartSizesOk && isContParts)++  , QC.testProperty "mkSSECKey:" $+    \w8s -> let bs = B.pack w8s+                r = mkSSECKey bs+            in case r of+                Just _  -> B.length bs == 32+                Nothing -> B.length bs /= 32   ]  unitTests :: TestTree