diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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) diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -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. diff --git a/docs/API.md b/docs/API.md --- a/docs/API.md +++ b/docs/API.md @@ -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" ``` + + +### 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!" +``` + ### bucketExists :: Bucket -> Minio Bool diff --git a/examples/BucketExists.hs b/examples/BucketExists.hs --- a/examples/BucketExists.hs +++ b/examples/BucketExists.hs @@ -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 diff --git a/examples/CopyObject.hs b/examples/CopyObject.hs --- a/examples/CopyObject.hs +++ b/examples/CopyObject.hs @@ -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 diff --git a/examples/FileUploader.hs b/examples/FileUploader.hs --- a/examples/FileUploader.hs +++ b/examples/FileUploader.hs @@ -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) diff --git a/examples/GetConfig.hs b/examples/GetConfig.hs --- a/examples/GetConfig.hs +++ b/examples/GetConfig.hs @@ -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. diff --git a/examples/GetObject.hs b/examples/GetObject.hs --- a/examples/GetObject.hs +++ b/examples/GetObject.hs @@ -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 diff --git a/examples/HeadObject.hs b/examples/HeadObject.hs --- a/examples/HeadObject.hs +++ b/examples/HeadObject.hs @@ -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 diff --git a/examples/Heal.hs b/examples/Heal.hs --- a/examples/Heal.hs +++ b/examples/Heal.hs @@ -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. diff --git a/examples/ListBuckets.hs b/examples/ListBuckets.hs --- a/examples/ListBuckets.hs +++ b/examples/ListBuckets.hs @@ -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 diff --git a/examples/ListIncompleteUploads.hs b/examples/ListIncompleteUploads.hs --- a/examples/ListIncompleteUploads.hs +++ b/examples/ListIncompleteUploads.hs @@ -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" diff --git a/examples/ListObjects.hs b/examples/ListObjects.hs --- a/examples/ListObjects.hs +++ b/examples/ListObjects.hs @@ -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}] -} diff --git a/examples/MakeBucket.hs b/examples/MakeBucket.hs --- a/examples/MakeBucket.hs +++ b/examples/MakeBucket.hs @@ -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 diff --git a/examples/PresignedGetObject.hs b/examples/PresignedGetObject.hs --- a/examples/PresignedGetObject.hs +++ b/examples/PresignedGetObject.hs @@ -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 diff --git a/examples/PresignedPostPolicy.hs b/examples/PresignedPostPolicy.hs --- a/examples/PresignedPostPolicy.hs +++ b/examples/PresignedPostPolicy.hs @@ -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 diff --git a/examples/PresignedPutObject.hs b/examples/PresignedPutObject.hs --- a/examples/PresignedPutObject.hs +++ b/examples/PresignedPutObject.hs @@ -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 diff --git a/examples/PutObject.hs b/examples/PutObject.hs --- a/examples/PutObject.hs +++ b/examples/PutObject.hs @@ -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 diff --git a/examples/RemoveBucket.hs b/examples/RemoveBucket.hs --- a/examples/RemoveBucket.hs +++ b/examples/RemoveBucket.hs @@ -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 diff --git a/examples/RemoveIncompleteUpload.hs b/examples/RemoveIncompleteUpload.hs --- a/examples/RemoveIncompleteUpload.hs +++ b/examples/RemoveIncompleteUpload.hs @@ -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 diff --git a/examples/RemoveObject.hs b/examples/RemoveObject.hs --- a/examples/RemoveObject.hs +++ b/examples/RemoveObject.hs @@ -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. diff --git a/examples/SelectObject.hs b/examples/SelectObject.hs new file mode 100644 --- /dev/null +++ b/examples/SelectObject.hs @@ -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 diff --git a/examples/ServerInfo.hs b/examples/ServerInfo.hs --- a/examples/ServerInfo.hs +++ b/examples/ServerInfo.hs @@ -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. diff --git a/examples/ServiceSendRestart.hs b/examples/ServiceSendRestart.hs --- a/examples/ServiceSendRestart.hs +++ b/examples/ServiceSendRestart.hs @@ -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. diff --git a/examples/ServiceSendStop.hs b/examples/ServiceSendStop.hs --- a/examples/ServiceSendStop.hs +++ b/examples/ServiceSendStop.hs @@ -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. diff --git a/examples/ServiceStatus.hs b/examples/ServiceStatus.hs --- a/examples/ServiceStatus.hs +++ b/examples/ServiceStatus.hs @@ -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. diff --git a/examples/SetConfig.hs b/examples/SetConfig.hs --- a/examples/SetConfig.hs +++ b/examples/SetConfig.hs @@ -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. diff --git a/minio-hs.cabal b/minio-hs.cabal --- a/minio-hs.cabal +++ b/minio-hs.cabal @@ -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 diff --git a/src/Lib/Prelude.hs b/src/Lib/Prelude.hs --- a/src/Lib/Prelude.hs +++ b/src/Lib/Prelude.hs @@ -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. diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs --- a/src/Network/Minio.hs +++ b/src/Network/Minio.hs @@ -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 +-- +-- 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 diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs --- a/src/Network/Minio/API.hs +++ b/src/Network/Minio/API.hs @@ -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 diff --git a/src/Network/Minio/APICommon.hs b/src/Network/Minio/APICommon.hs --- a/src/Network/Minio/APICommon.hs +++ b/src/Network/Minio/APICommon.hs @@ -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. diff --git a/src/Network/Minio/AdminAPI.hs b/src/Network/Minio/AdminAPI.hs --- a/src/Network/Minio/AdminAPI.hs +++ b/src/Network/Minio/AdminAPI.hs @@ -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 diff --git a/src/Network/Minio/CopyObject.hs b/src/Network/Minio/CopyObject.hs --- a/src/Network/Minio/CopyObject.hs +++ b/src/Network/Minio/CopyObject.hs @@ -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 diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -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" --- | +-- | -- 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 diff --git a/src/Network/Minio/Data/ByteString.hs b/src/Network/Minio/Data/ByteString.hs --- a/src/Network/Minio/Data/ByteString.hs +++ b/src/Network/Minio/Data/ByteString.hs @@ -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. diff --git a/src/Network/Minio/Data/Crypto.hs b/src/Network/Minio/Data/Crypto.hs --- a/src/Network/Minio/Data/Crypto.hs +++ b/src/Network/Minio/Data/Crypto.hs @@ -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 diff --git a/src/Network/Minio/Data/Time.hs b/src/Network/Minio/Data/Time.hs --- a/src/Network/Minio/Data/Time.hs +++ b/src/Network/Minio/Data/Time.hs @@ -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. diff --git a/src/Network/Minio/Errors.hs b/src/Network/Minio/Errors.hs --- a/src/Network/Minio/Errors.hs +++ b/src/Network/Minio/Errors.hs @@ -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) diff --git a/src/Network/Minio/JsonParser.hs b/src/Network/Minio/JsonParser.hs --- a/src/Network/Minio/JsonParser.hs +++ b/src/Network/Minio/JsonParser.hs @@ -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. diff --git a/src/Network/Minio/ListOps.hs b/src/Network/Minio/ListOps.hs --- a/src/Network/Minio/ListOps.hs +++ b/src/Network/Minio/ListOps.hs @@ -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. diff --git a/src/Network/Minio/PresignedOperations.hs b/src/Network/Minio/PresignedOperations.hs --- a/src/Network/Minio/PresignedOperations.hs +++ b/src/Network/Minio/PresignedOperations.hs @@ -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 diff --git a/src/Network/Minio/PutObject.hs b/src/Network/Minio/PutObject.hs --- a/src/Network/Minio/PutObject.hs +++ b/src/Network/Minio/PutObject.hs @@ -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. diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -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 diff --git a/src/Network/Minio/SelectAPI.hs b/src/Network/Minio/SelectAPI.hs new file mode 100644 --- /dev/null +++ b/src/Network/Minio/SelectAPI.hs @@ -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 () diff --git a/src/Network/Minio/Sign/V4.hs b/src/Network/Minio/Sign/V4.hs --- a/src/Network/Minio/Sign/V4.hs +++ b/src/Network/Minio/Sign/V4.hs @@ -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. diff --git a/src/Network/Minio/Utils.hs b/src/Network/Minio/Utils.hs --- a/src/Network/Minio/Utils.hs +++ b/src/Network/Minio/Utils.hs @@ -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. diff --git a/src/Network/Minio/XmlGenerator.hs b/src/Network/Minio/XmlGenerator.hs --- a/src/Network/Minio/XmlGenerator.hs +++ b/src/Network/Minio/XmlGenerator.hs @@ -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]] diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs --- a/src/Network/Minio/XmlParser.hs +++ b/src/Network/Minio/XmlParser.hs @@ -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 diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -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. diff --git a/test/LiveServer.hs b/test/LiveServer.hs --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -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" diff --git a/test/Network/Minio/API/Test.hs b/test/Network/Minio/API/Test.hs --- a/test/Network/Minio/API/Test.hs +++ b/test/Network/Minio/API/Test.hs @@ -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 diff --git a/test/Network/Minio/JsonParser/Test.hs b/test/Network/Minio/JsonParser/Test.hs --- a/test/Network/Minio/JsonParser/Test.hs +++ b/test/Network/Minio/JsonParser/Test.hs @@ -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. diff --git a/test/Network/Minio/TestHelpers.hs b/test/Network/Minio/TestHelpers.hs --- a/test/Network/Minio/TestHelpers.hs +++ b/test/Network/Minio/TestHelpers.hs @@ -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. diff --git a/test/Network/Minio/Utils/Test.hs b/test/Network/Minio/Utils/Test.hs --- a/test/Network/Minio/Utils/Test.hs +++ b/test/Network/Minio/Utils/Test.hs @@ -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. diff --git a/test/Network/Minio/XmlGenerator/Test.hs b/test/Network/Minio/XmlGenerator/Test.hs --- a/test/Network/Minio/XmlGenerator/Test.hs +++ b/test/Network/Minio/XmlGenerator/Test.hs @@ -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|Select * from S3ObjectSQLGZIP" +IGNORE","ASNEEDED +",FALSE|] + ) + , ( setRequestProgressEnabled False $ + setInputCompressionType CompressionTypeGzip $ + selectRequest "Select * from S3Object" documentJsonInput + (outputJSONFromRecordDelimiter "\n") + , [r|Select * from S3ObjectSQLGZIPDOCUMENT +FALSE|] + ) + , ( setRequestProgressEnabled False $ + setInputCompressionType CompressionTypeNone $ + selectRequest "Select * from S3Object" defaultParquetInput + (outputCSVFromProps $ quoteFields QuoteFieldsAsNeeded + <> recordDelimiter "\n" + <> fieldDelimiter "," + <> quoteCharacter "\"" + <> quoteEscapeCharacter "\"") + , [r|Select * from S3ObjectSQLNONE"ASNEEDED +",FALSE|] + ) ] diff --git a/test/Network/Minio/XmlParser/Test.hs b/test/Network/Minio/XmlParser/Test.hs --- a/test/Network/Minio/XmlParser/Test.hs +++ b/test/Network/Minio/XmlParser/Test.hs @@ -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| + + 512 + 1024 + 1024 +|] , Progress 512 1024 1024) + , ([r| + + 512 + 1024 + 1024 +|], Progress 512 1024 1024) + ] + + forM_ cases $ \(xmldata, progress) -> do + result <- runExceptT $ parseSelectProgress xmldata + eitherValidationErr result (@?= progress) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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