├── CNAME ├── .gitignore ├── CONTRIBUTING.md ├── examples ├── README.md ├── GetConfig.hs ├── ServerInfo.hs ├── ServiceStatus.hs ├── ServiceSendStop.hs ├── ServiceSendRestart.hs ├── Heal.hs ├── RemoveObject.hs ├── RemoveBucket.hs ├── MakeBucket.hs ├── HeadObject.hs ├── RemoveIncompleteUpload.hs ├── BucketExists.hs ├── ListBuckets.hs ├── GetObject.hs ├── SelectObject.hs ├── AssumeRole.hs ├── ListObjects.hs ├── ListIncompleteUploads.hs ├── PutObject.hs ├── CopyObject.hs ├── PresignedPutObject.hs ├── FileUploader.hs ├── SetConfig.hs ├── PresignedPostPolicy.hs └── PresignedGetObject.hs ├── stack.yaml.lock ├── test ├── Network │ └── Minio │ │ ├── TestHelpers.hs │ │ ├── Utils │ │ └── Test.hs │ │ ├── JsonParser │ │ └── Test.hs │ │ ├── XmlGenerator │ │ └── Test.hs │ │ └── API │ │ └── Test.hs ├── cert │ ├── public.crt │ └── private.key └── Spec.hs ├── src ├── Network │ ├── Minio │ │ ├── JsonParser.hs │ │ ├── Data │ │ │ ├── Time.hs │ │ │ ├── ByteString.hs │ │ │ └── Crypto.hs │ │ ├── XmlCommon.hs │ │ ├── Credentials.hs │ │ ├── APICommon.hs │ │ ├── Errors.hs │ │ ├── Credentials │ │ │ ├── Types.hs │ │ │ └── AssumeRole.hs │ │ ├── CopyObject.hs │ │ ├── ListOps.hs │ │ ├── PutObject.hs │ │ ├── XmlGenerator.hs │ │ ├── XmlParser.hs │ │ ├── SelectAPI.hs │ │ └── Utils.hs │ └── Minio.hs └── Lib │ └── Prelude.hs ├── stack.yaml ├── CHANGELOG.md ├── README.md ├── .github └── workflows │ └── ci.yml └── LICENSE /CNAME: -------------------------------------------------------------------------------- 1 | minio-hs.min.io -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-* 3 | cabal-dev 4 | *.o 5 | *.hi 6 | *.chi 7 | *.chs.h 8 | *.dyn_o 9 | *.dyn_hi 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | *.eventlog 18 | .stack-work/ 19 | cabal.project.local 20 | *~ -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributors Guide 2 | * Fork minio-hs. 3 | * Create your feature branch (`$ git checkout -b my-new-feature`). 4 | * Hack, hack, hack... 5 | * Commit your changes (`$ git commit -am 'Add some feature'`). 6 | * Do test build (`$ stack test`). 7 | * Push to the branch (`$ git push origin my-new-feature`). 8 | * Create new Pull Request. -------------------------------------------------------------------------------- /examples/README.md: -------------------------------------------------------------------------------- 1 | # Examples 2 | 3 | The examples in this directory illustrate usage of various APIs provided by this library. Each file is self-contained and can be run like a script directly. 4 | 5 | To build the examples, the build flag `examples` needs to be turned on: 6 | 7 | ```sh 8 | stack build --flag minio-hs:examples 9 | ``` 10 | 11 | Now to run and example script [BucketExists.hs](https://github.com/minio/minio-hs/blob/master/examples/BucketExists.hs): 12 | 13 | ```sh 14 | stack exec BucketExists 15 | ``` 16 | 17 | The CI system is configured to build these examples with every change, so they should be current. 18 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: crypton-connection-0.3.2@sha256:c7937edc25ab022bcf167703f2ec5ab73b62908e545bb587d2aa42b33cd6f6cc,1581 9 | pantry-tree: 10 | sha256: f986ad29b008cbe5732606e9cde1897191c486a2f1f169a4cb75fd915bce397c 11 | size: 394 12 | original: 13 | hackage: crypton-connection-0.3.2 14 | snapshots: 15 | - completed: 16 | sha256: e5cac927cf7ccbd52aa41476baa68b88c564ee6ddc3bc573dbf4210069287fe7 17 | size: 713340 18 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/19.yaml 19 | original: lts-22.19 20 | -------------------------------------------------------------------------------- /examples/GetConfig.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | 20 | import Network.Minio 21 | import Network.Minio.AdminAPI 22 | import Prelude 23 | 24 | main :: IO () 25 | main = do 26 | res <- 27 | runMinio 28 | minioPlayCI 29 | getConfig 30 | print res 31 | -------------------------------------------------------------------------------- /examples/ServerInfo.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | 20 | import Network.Minio 21 | import Network.Minio.AdminAPI 22 | import Prelude 23 | 24 | main :: IO () 25 | main = do 26 | res <- 27 | runMinio 28 | minioPlayCI 29 | getServerInfo 30 | print res 31 | -------------------------------------------------------------------------------- /examples/ServiceStatus.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | 20 | import Network.Minio 21 | import Network.Minio.AdminAPI 22 | import Prelude 23 | 24 | main :: IO () 25 | main = do 26 | res <- 27 | runMinio 28 | minioPlayCI 29 | serviceStatus 30 | print res 31 | -------------------------------------------------------------------------------- /examples/ServiceSendStop.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | 20 | import Network.Minio 21 | import Network.Minio.AdminAPI 22 | import Prelude 23 | 24 | main :: IO () 25 | main = do 26 | res <- 27 | runMinio minioPlayCI $ 28 | serviceSendAction ServiceActionStop 29 | print res 30 | -------------------------------------------------------------------------------- /examples/ServiceSendRestart.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | 20 | import Network.Minio 21 | import Network.Minio.AdminAPI 22 | import Prelude 23 | 24 | main :: IO () 25 | main = do 26 | res <- 27 | runMinio minioPlayCI $ 28 | serviceSendAction ServiceActionRestart 29 | print res 30 | -------------------------------------------------------------------------------- /test/Network/Minio/TestHelpers.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2018 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.TestHelpers 18 | ( runTestNS, 19 | ) 20 | where 21 | 22 | import Network.Minio.Data 23 | 24 | newtype TestNS = TestNS {testNamespace :: Text} 25 | 26 | instance HasSvcNamespace TestNS where 27 | getSvcNamespace = testNamespace 28 | 29 | runTestNS :: ReaderT TestNS m a -> m a 30 | runTestNS = 31 | flip runReaderT $ 32 | TestNS "http://s3.amazonaws.com/doc/2006-03-01/" 33 | -------------------------------------------------------------------------------- /test/cert/public.crt: -------------------------------------------------------------------------------- 1 | -----BEGIN CERTIFICATE----- 2 | MIIDCzCCAfOgAwIBAgIUaIUOMI78LCu+r1zl0mmFHK8n5/AwDQYJKoZIhvcNAQEL 3 | BQAwFDESMBAGA1UEAwwJbG9jYWxob3N0MCAXDTE5MTAyNDE5NTMxOVoYDzIxMTkw 4 | OTMwMTk1MzE5WjAUMRIwEAYDVQQDDAlsb2NhbGhvc3QwggEiMA0GCSqGSIb3DQEB 5 | AQUAA4IBDwAwggEKAoIBAQC3G9IiC+adjf0pi/2KYc+4dizeuzUFN7wraSdhiOMd 6 | QgCnu9Dc3t2YEsQhNdrARjOTyXd36KeM3TwIrPJ61dRGQSuN12l+mzngFJQjE0sy 7 | sZHUJOLQC3rVvIrHSQ57utPg8ifxt/SunlPYfhcUcq03onMGq44yOfE6mIhoe0Y9 8 | wcPQ3RjjNNS44bgmXiXwa+Do0h2hEn6/essq5KjHL8WW2vGg7G9edpYdxINA/A2f 9 | dLtr8BwPNrZhOx84eee2XcUNdBuTtUUxE+0L9yRqItqddriRxJFwOXb5OPW8xx2W 10 | GaV2a0wbE4gB2PTwwDvfo72mo9HXHZUHM1A84TD/RXMbAgMBAAGjUzBRMB0GA1Ud 11 | DgQWBBSEWXQ2JRD+OK7/KTmlD+OW16pGmzAfBgNVHSMEGDAWgBSEWXQ2JRD+OK7/ 12 | KTmlD+OW16pGmzAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBCwUAA4IBAQCF 13 | 0zYRaabB3X0jzGI9/Lr3Phrb90GvoL1DFLRuiOuTlDkz0vrm/HrZskwHCgMNrkCj 14 | OTD9Vpas4D1QZBbQbRzfnf3OOoG4bgmcCwLFZl3dy27yIDAhrmbUP++g9l1Jmy4v 15 | vBR/M4lt2scQ8LcZYEPqhEaE5EzFQEjtaxDcKdWDNKY9W1NUzSIABhF9eHiAUNdH 16 | AFNJlYeBlCHxcWIeqgon184Dqp/CsvKtz3z3Ni+rlwPM/zuJCFHh1VF+z++0LJjG 17 | roBCV0Tro4XyiEz9yp7Cb5kQYMaj1KL9TqBG0tZx0pmv7y+lXc4TT6DEllXz6USy 18 | rbIba9/uUet3BqeIMTqj 19 | -----END CERTIFICATE----- 20 | -------------------------------------------------------------------------------- /examples/Heal.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | 20 | import Network.Minio 21 | import Network.Minio.AdminAPI 22 | import Prelude 23 | 24 | main :: IO () 25 | main = do 26 | res <- runMinio minioPlayCI $ 27 | do 28 | hsr <- 29 | startHeal 30 | Nothing 31 | Nothing 32 | HealOpts 33 | { hoRecursive = True, 34 | hoDryRun = False 35 | } 36 | getHealStatus Nothing Nothing (hsrClientToken hsr) 37 | print res 38 | -------------------------------------------------------------------------------- /examples/RemoveObject.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import Network.Minio 22 | import Prelude 23 | 24 | main :: IO () 25 | main = do 26 | let bucket = "mybucket" 27 | object = "myobject" 28 | 29 | res <- 30 | runMinio minioPlayCI $ 31 | removeObject bucket object 32 | 33 | case res of 34 | Left _ -> putStrLn $ "Failed to remove " ++ show bucket ++ "/" ++ show object 35 | Right _ -> putStrLn "Removed object successfully" 36 | -------------------------------------------------------------------------------- /examples/RemoveBucket.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import Network.Minio 22 | import Prelude 23 | 24 | -- | The following example uses minio's play server at 25 | -- https://play.min.io. The endpoint and associated 26 | -- credentials are provided via the libary constant, 27 | -- 28 | -- > minioPlayCI :: ConnectInfo 29 | main :: IO () 30 | main = do 31 | let bucket = "my-bucket" 32 | res <- runMinio minioPlayCI $ removeBucket bucket 33 | print res 34 | -------------------------------------------------------------------------------- /examples/MakeBucket.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import Network.Minio 22 | import Prelude 23 | 24 | -- | The following example uses minio's play server at 25 | -- https://play.min.io. The endpoint and associated 26 | -- credentials are provided via the libary constant, 27 | -- 28 | -- > minioPlayCI :: ConnectInfo 29 | main :: IO () 30 | main = do 31 | let bucket = "my-bucket" 32 | res <- 33 | runMinio minioPlayCI $ 34 | -- N B the region provided for makeBucket is optional. 35 | makeBucket bucket (Just "us-east-1") 36 | print res 37 | -------------------------------------------------------------------------------- /examples/HeadObject.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import Network.Minio 22 | import Network.Minio.S3API 23 | import Prelude 24 | 25 | -- | The following example uses minio's play server at 26 | -- https://play.min.io. The endpoint and associated 27 | -- credentials are provided via the libary constant, 28 | -- 29 | -- > minioPlayCI :: ConnectInfo 30 | main :: IO () 31 | main = do 32 | let bucket = "test" 33 | object = "passwd" 34 | res <- 35 | runMinio minioPlayCI $ 36 | headObject bucket object [] 37 | 38 | case res of 39 | Left e -> putStrLn $ "headObject failed." ++ show e 40 | Right objInfo -> putStrLn $ "headObject succeeded." ++ show objInfo 41 | -------------------------------------------------------------------------------- /examples/RemoveIncompleteUpload.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import Network.Minio 22 | import Prelude 23 | 24 | -- | The following example uses minio's play server at 25 | -- https://play.min.io. The endpoint and associated 26 | -- credentials are provided via the libary constant, 27 | -- 28 | -- > minioPlayCI :: ConnectInfo 29 | main :: IO () 30 | main = do 31 | let bucket = "mybucket" 32 | object = "myobject" 33 | 34 | res <- 35 | runMinio minioPlayCI $ 36 | removeIncompleteUpload bucket object 37 | 38 | case res of 39 | Left _ -> putStrLn $ "Failed to remove " ++ show bucket ++ "/" ++ show object 40 | Right _ -> putStrLn "Removed incomplete upload successfully" 41 | -------------------------------------------------------------------------------- /examples/BucketExists.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import Control.Monad.IO.Class (liftIO) 22 | import Network.Minio 23 | import Prelude 24 | 25 | -- | The following example uses minio's play server at 26 | -- https://play.min.io. The endpoint and associated 27 | -- credentials are provided via the libary constant, 28 | -- 29 | -- > minioPlayCI :: ConnectInfo 30 | main :: IO () 31 | main = do 32 | let bucket = "missingbucket" 33 | 34 | res1 <- runMinio minioPlayCI $ do 35 | foundBucket <- bucketExists bucket 36 | liftIO $ putStrLn $ "Does " ++ show bucket ++ " exist? - " ++ show foundBucket 37 | 38 | case res1 of 39 | Left e -> putStrLn $ "bucketExists failed." ++ show e 40 | Right () -> return () 41 | -------------------------------------------------------------------------------- /examples/ListBuckets.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import Control.Monad.IO.Class (liftIO) 22 | import Network.Minio 23 | import Prelude 24 | 25 | -- | The following example uses minio's play server at 26 | -- https://play.min.io. The endpoint and associated 27 | -- credentials are provided via the libary constant, 28 | -- 29 | -- > minioPlayCI :: ConnectInfo 30 | 31 | -- This example list buckets that belongs to the user and returns 32 | -- region of the first bucket returned. 33 | main :: IO () 34 | main = do 35 | firstRegionE <- runMinio minioPlayCI $ do 36 | buckets <- listBuckets 37 | liftIO $ print $ "Top 5 buckets: " ++ show (take 5 buckets) 38 | getLocation $ biName $ head buckets 39 | print firstRegionE 40 | -------------------------------------------------------------------------------- /examples/GetObject.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import qualified Data.Conduit as C 22 | import qualified Data.Conduit.Binary as CB 23 | import Network.Minio 24 | import Prelude 25 | 26 | -- | The following example uses minio's play server at 27 | -- https://play.min.io. The endpoint and associated 28 | -- credentials are provided via the libary constant, 29 | -- 30 | -- > minioPlayCI :: ConnectInfo 31 | main :: IO () 32 | main = do 33 | let bucket = "my-bucket" 34 | object = "my-object" 35 | res <- runMinio minioPlayCI $ do 36 | src <- getObject bucket object defaultGetObjectOptions 37 | C.connect (gorObjectStream src) $ CB.sinkFileCautious "/tmp/my-object" 38 | 39 | case res of 40 | Left e -> putStrLn $ "getObject failed." ++ show e 41 | Right _ -> putStrLn "getObject succeeded." 42 | -------------------------------------------------------------------------------- /src/Network/Minio/JsonParser.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2018 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.JsonParser 18 | ( parseErrResponseJSON, 19 | ) 20 | where 21 | 22 | import Data.Aeson 23 | ( FromJSON, 24 | eitherDecode, 25 | parseJSON, 26 | withObject, 27 | (.:), 28 | ) 29 | import qualified Data.Text as T 30 | import Lib.Prelude 31 | import Network.Minio.Errors 32 | 33 | data AdminErrJSON = AdminErrJSON 34 | { aeCode :: Text, 35 | aeMessage :: Text 36 | } 37 | deriving stock (Eq, Show) 38 | 39 | instance FromJSON AdminErrJSON where 40 | parseJSON = withObject "AdminErrJSON" $ \v -> 41 | AdminErrJSON 42 | <$> v .: "Code" 43 | <*> v .: "Message" 44 | 45 | parseErrResponseJSON :: (MonadIO m) => LByteString -> m ServiceErr 46 | parseErrResponseJSON jsondata = 47 | case eitherDecode jsondata of 48 | Right aErr -> return $ toServiceErr (aeCode aErr) (aeMessage aErr) 49 | Left err -> throwIO $ MErrVJsonParse $ T.pack err 50 | -------------------------------------------------------------------------------- /test/Network/Minio/Utils/Test.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.Utils.Test 18 | ( limitedMapConcurrentlyTests, 19 | ) 20 | where 21 | 22 | import Network.Minio.Utils 23 | import Test.Tasty 24 | import Test.Tasty.HUnit 25 | 26 | limitedMapConcurrentlyTests :: TestTree 27 | limitedMapConcurrentlyTests = 28 | testGroup 29 | "limitedMapConcurrently Tests" 30 | [ testCase "Test with various thread counts" testLMC 31 | ] 32 | 33 | testLMC :: Assertion 34 | testLMC = do 35 | let maxNum = 50 36 | -- test with thread count of 1 to 2*maxNum 37 | forM_ [1 .. (2 * maxNum)] $ \threads -> do 38 | res <- limitedMapConcurrently threads compute [1 .. maxNum] 39 | sum res @?= overallResultCheck maxNum 40 | where 41 | -- simple function to run in each thread 42 | compute :: Int -> IO Int 43 | compute n = return $ sum [1 .. n] 44 | -- function to check overall result 45 | overallResultCheck n = sum $ map (\t -> (t * (t + 1)) `div` 2) [1 .. n] 46 | -------------------------------------------------------------------------------- /src/Lib/Prelude.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Lib.Prelude 18 | ( module Exports, 19 | both, 20 | showBS, 21 | toStrictBS, 22 | fromStrictBS, 23 | lastMay, 24 | ) 25 | where 26 | 27 | import Control.Monad.Trans.Maybe as Exports (MaybeT (..), runMaybeT) 28 | import qualified Data.ByteString.Lazy as LB 29 | import Data.Time as Exports 30 | ( UTCTime (..), 31 | diffUTCTime, 32 | ) 33 | import UnliftIO as Exports 34 | ( Handler, 35 | catch, 36 | catches, 37 | throwIO, 38 | try, 39 | ) 40 | 41 | -- | Apply a function on both elements of a pair 42 | both :: (a -> b) -> (a, a) -> (b, b) 43 | both f (a, b) = (f a, f b) 44 | 45 | showBS :: (Show a) => a -> ByteString 46 | showBS a = encodeUtf8 (show a :: Text) 47 | 48 | toStrictBS :: LByteString -> ByteString 49 | toStrictBS = LB.toStrict 50 | 51 | fromStrictBS :: ByteString -> LByteString 52 | fromStrictBS = LB.fromStrict 53 | 54 | lastMay :: [a] -> Maybe a 55 | lastMay a = last <$> nonEmpty a 56 | -------------------------------------------------------------------------------- /examples/SelectObject.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2019 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import qualified Conduit as C 22 | import Control.Monad (unless) 23 | import Network.Minio 24 | import Prelude 25 | 26 | main :: IO () 27 | main = do 28 | let bucket = "selectbucket" 29 | object = "1.csv" 30 | content = 31 | "Name,Place,Temperature\n" 32 | <> "James,San Jose,76\n" 33 | <> "Alicia,San Leandro,88\n" 34 | <> "Mark,San Carlos,90\n" 35 | 36 | res <- runMinio minioPlayCI $ do 37 | exists <- bucketExists bucket 38 | unless exists $ 39 | makeBucket bucket Nothing 40 | 41 | C.liftIO $ putStrLn "Uploading csv object" 42 | putObject bucket object (C.sourceLazy content) Nothing defaultPutObjectOptions 43 | 44 | let sr = selectRequest "Select * from s3object" defaultCsvInput defaultCsvOutput 45 | res <- selectObjectContent bucket object sr 46 | C.runConduit $ res C..| getPayloadBytes C..| C.stdoutC 47 | print res 48 | -------------------------------------------------------------------------------- /examples/AssumeRole.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2023 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | {-# LANGUAGE OverloadedStrings #-} 17 | 18 | import Control.Monad.IO.Class (liftIO) 19 | import Network.Minio 20 | import Prelude 21 | 22 | main :: IO () 23 | main = do 24 | -- Use play credentials for example. 25 | let assumeRole = 26 | STSAssumeRole 27 | ( CredentialValue 28 | "Q3AM3UQ867SPQQA43P2F" 29 | "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG" 30 | Nothing 31 | ) 32 | $ defaultSTSAssumeRoleOptions 33 | { saroLocation = Just "us-east-1", 34 | saroEndpoint = Just "https://play.min.io:9000" 35 | } 36 | 37 | -- Retrieve temporary credentials and print them. 38 | cv <- requestSTSCredential assumeRole 39 | print $ "Temporary credentials" ++ show (credentialValueText $ fst cv) 40 | print $ "Expiry" ++ show (snd cv) 41 | 42 | -- Configure 'ConnectInfo' to request temporary credentials on demand. 43 | ci <- setSTSCredential assumeRole "https://play.min.io" 44 | res <- runMinio ci $ do 45 | buckets <- listBuckets 46 | liftIO $ print $ "Top 5 buckets: " ++ show (take 5 buckets) 47 | print res 48 | -------------------------------------------------------------------------------- /test/cert/private.key: -------------------------------------------------------------------------------- 1 | -----BEGIN PRIVATE KEY----- 2 | MIIEvwIBADANBgkqhkiG9w0BAQEFAASCBKkwggSlAgEAAoIBAQC3G9IiC+adjf0p 3 | i/2KYc+4dizeuzUFN7wraSdhiOMdQgCnu9Dc3t2YEsQhNdrARjOTyXd36KeM3TwI 4 | rPJ61dRGQSuN12l+mzngFJQjE0sysZHUJOLQC3rVvIrHSQ57utPg8ifxt/SunlPY 5 | fhcUcq03onMGq44yOfE6mIhoe0Y9wcPQ3RjjNNS44bgmXiXwa+Do0h2hEn6/essq 6 | 5KjHL8WW2vGg7G9edpYdxINA/A2fdLtr8BwPNrZhOx84eee2XcUNdBuTtUUxE+0L 7 | 9yRqItqddriRxJFwOXb5OPW8xx2WGaV2a0wbE4gB2PTwwDvfo72mo9HXHZUHM1A8 8 | 4TD/RXMbAgMBAAECggEBAJ7r1oUWLyGvinn0tijUm6RNbMQjVvEgXoCO008jr3pF 9 | PqxVpgEMrOa/4tmwFBus0jcCNF4t3r2zhddBw3I5A/O1vEdvHnBz6NdDBQ8sP6fP 10 | 1fF50iEe1Y2MBibQkXFxxVMG2QRB1Gt5nuvXA9ELdqtCovK3EsMk5ukkWb/UvjH5 11 | 8hcmQsaSqvzFEF4wJSY2mkeGSGIJTphPhhuA22xbhaBMInQyhZu8EHsn0h6s/Wgy 12 | C4Cp2+4qZTKaaf6x3/ZjJ8CuKiSX+ZsJKjOEv8sqx7j/Y7QFOmJPewInKDhwazr/ 13 | xIK+N0KXPbUzeSEz6ZvExNDTxtR5ZlQP2UrRDg28yQECgYEA4Is1O2BvKVzNFOkj 14 | bTVz25a/bb0Xrcfgi0Y9rdfLzlNdItFjAkxLTVRSW2Hv9ICl0RDDAG+wTlktXRdh 15 | rfvDjwG2CvLQo1VEdMWTTkKVg03SwMEy2hFiWV69lENFGSaY8Y6unZDbia5HQinA 16 | EgSS4sCojS+a2jtzG5FVVHJDKlkCgYEA0MKhMhD4SUhr2y1idPBrmLxuW5mVozuW 17 | 8bYaBeSzmfS0BRsN4fP9JGODPBPDdNbfGfGC9ezWLgD/lmCgjIEyBOq8EmqWSsiS 18 | Kihds1+Z7hXtbzGsFGAFJJTIh7blBCsK5QFuyuih2UG0fL9z6K/dy+UUJkzrYqph 19 | vSfKixyM8pMCgYEAmUPLsNyw4325aeV8TeWnUCJERaZFDFQa21W1cfyS2yEhuEtN 20 | llr3JzBACqn9vFk3VU1onNqfb8sE4L696KCpKeqUFEMK0AG6eS4Gzus53Gb5TKJS 21 | kHA/PhshsZp9Bp7G1FJ8s4YVo5N2hh2zQVkn3Wh9Y+kzfHQJrK51nO9lEvkCgYBi 22 | BuKWle1gzAcJdnhDHRoJMIJJtQbVDYhFnBMALXJAmu1lcFzGe0GlMq1PKqCfXr6I 23 | eiXawQmZtJJP1LPPBmOsd2U06KQGHcS00xucvQmVCOrjSdnZ/3SqxsqbH8DOgj+t 24 | ZUzXLwHA+N99rJEK9Hob4kfh7ECjpgobPnIXfKKazQKBgQChAuiXHtf/Qq18hY3u 25 | x48zFWjGgfd6GpOBZYkXOwGdCJgnYjZbE26LZEnYbwPh8ZUA2vp7mgHRJkD5e3Fj 26 | ERuJLCw86WqyYZmLEuBciYGjCZqR5nbavfwsziWD00jeNruds2ZwKxRfFm4V7o2S 27 | WLd/RUatd2Uu9f3B2J78OUdnxg== 28 | -----END PRIVATE KEY----- 29 | -------------------------------------------------------------------------------- /examples/ListObjects.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import Conduit 22 | import Network.Minio 23 | import Prelude 24 | 25 | -- | The following example uses minio's play server at 26 | -- https://play.min.io. The endpoint and associated 27 | -- credentials are provided via the libary constant, 28 | -- 29 | -- > minioPlayCI :: ConnectInfo 30 | main :: IO () 31 | main = do 32 | let bucket = "test" 33 | 34 | -- Performs a recursive listing of all objects under bucket "test" 35 | -- on play.min.io. 36 | res <- 37 | runMinio minioPlayCI $ 38 | runConduit $ 39 | listObjects bucket Nothing True .| mapM_C (liftIO . print) 40 | print res 41 | 42 | {- 43 | Following is the output of the above program on a local MinIO server. 44 | 45 | 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}] 46 | -} 47 | -------------------------------------------------------------------------------- /examples/ListIncompleteUploads.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import Conduit 22 | import Network.Minio 23 | import Prelude 24 | 25 | -- | The following example uses minio's play server at 26 | -- https://play.min.io. The endpoint and associated 27 | -- credentials are provided via the libary constant, 28 | -- 29 | -- > minioPlayCI :: ConnectInfo 30 | main :: IO () 31 | main = do 32 | let bucket = "test" 33 | 34 | -- Performs a recursive listing of incomplete uploads under bucket "test" 35 | -- on a local minio server. 36 | res <- 37 | runMinio minioPlayCI $ 38 | runConduit $ 39 | listIncompleteUploads bucket Nothing True .| mapM_C (liftIO . print) 40 | print res 41 | 42 | {- 43 | Following is the output of the above program on a local MinIO server. 44 | 45 | Right [UploadInfo { uiKey = "go1.6.2.linux-amd64.tar.gz" 46 | , uiUploadId = "063eb592-bdd7-4a0c-be48-34fb3ceb63e2" 47 | , uiInitTime = 2017-03-01 10:16:25.698 UTC 48 | , uiSize = 17731794 49 | } 50 | ] 51 | -} 52 | -------------------------------------------------------------------------------- /src/Network/Minio/Data/Time.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.Data.Time 18 | ( awsTimeFormat, 19 | awsTimeFormatBS, 20 | awsDateFormat, 21 | awsDateFormatBS, 22 | awsParseTime, 23 | iso8601TimeFormat, 24 | UrlExpiry, 25 | ) 26 | where 27 | 28 | import Data.ByteString.Char8 (pack) 29 | import qualified Data.Time as Time 30 | import Data.Time.Format.ISO8601 (iso8601Show) 31 | import Lib.Prelude 32 | 33 | -- | Time to expire for a presigned URL. It interpreted as a number of 34 | -- seconds. The maximum duration that can be specified is 7 days. 35 | type UrlExpiry = Int 36 | 37 | awsTimeFormat :: UTCTime -> [Char] 38 | awsTimeFormat = Time.formatTime Time.defaultTimeLocale "%Y%m%dT%H%M%SZ" 39 | 40 | awsTimeFormatBS :: UTCTime -> ByteString 41 | awsTimeFormatBS = pack . awsTimeFormat 42 | 43 | awsDateFormat :: UTCTime -> [Char] 44 | awsDateFormat = Time.formatTime Time.defaultTimeLocale "%Y%m%d" 45 | 46 | awsDateFormatBS :: UTCTime -> ByteString 47 | awsDateFormatBS = pack . awsDateFormat 48 | 49 | awsParseTime :: [Char] -> Maybe UTCTime 50 | awsParseTime = Time.parseTimeM False Time.defaultTimeLocale "%Y%m%dT%H%M%SZ" 51 | 52 | iso8601TimeFormat :: UTCTime -> [Char] 53 | iso8601TimeFormat = iso8601Show 54 | -------------------------------------------------------------------------------- /examples/PutObject.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import qualified Data.Conduit.Combinators as CC 22 | import Network.Minio 23 | import Prelude 24 | 25 | -- | The following example uses minio's play server at 26 | -- https://play.min.io. The endpoint and associated 27 | -- credentials are provided via the libary constant, 28 | -- 29 | -- > minioPlayCI :: ConnectInfo 30 | main :: IO () 31 | main = do 32 | let bucket = "test" 33 | object = "obj" 34 | localFile = "/etc/lsb-release" 35 | kb15 = 15 * 1024 36 | 37 | -- Eg 1. Upload a stream of repeating "a" using putObject with default options. 38 | res1 <- 39 | runMinio minioPlayCI $ 40 | putObject bucket object (CC.repeat "a") (Just kb15) defaultPutObjectOptions 41 | case res1 of 42 | Left e -> putStrLn $ "putObject failed." ++ show e 43 | Right () -> putStrLn "putObject succeeded." 44 | 45 | -- Eg 2. Upload a file using fPutObject with default options. 46 | res2 <- 47 | runMinio minioPlayCI $ 48 | fPutObject bucket object localFile defaultPutObjectOptions 49 | case res2 of 50 | Left e -> putStrLn $ "fPutObject failed." ++ show e 51 | Right () -> putStrLn "fPutObject succeeded." 52 | -------------------------------------------------------------------------------- /examples/CopyObject.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import Network.Minio 22 | import UnliftIO.Exception (catch, throwIO) 23 | 24 | -- | The following example uses minio's play server at 25 | -- https://play.min.io. The endpoint and associated 26 | -- credentials are provided via the libary constant, 27 | -- 28 | -- > minioPlayCI :: ConnectInfo 29 | main :: IO () 30 | main = do 31 | let bucket = "test" 32 | object = "obj" 33 | objectCopy = "obj-copy" 34 | localFile = "/etc/lsb-release" 35 | 36 | res1 <- runMinio minioPlayCI $ do 37 | -- 1. Make a bucket; Catch BucketAlreadyOwnedByYou exception. 38 | catch 39 | (makeBucket bucket Nothing) 40 | ( \e -> case e of 41 | BucketAlreadyOwnedByYou -> return () 42 | _ -> throwIO e 43 | ) 44 | 45 | -- 2. Upload a file to bucket/object. 46 | fPutObject bucket object localFile defaultPutObjectOptions 47 | 48 | -- 3. Copy bucket/object to bucket/objectCopy. 49 | copyObject 50 | defaultDestinationInfo {dstBucket = bucket, dstObject = objectCopy} 51 | defaultSourceInfo {srcBucket = bucket, srcObject = object} 52 | 53 | case res1 of 54 | Left e -> putStrLn $ "copyObject failed." ++ show e 55 | Right () -> putStrLn "copyObject succeeded." 56 | -------------------------------------------------------------------------------- /examples/PresignedPutObject.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import qualified Data.ByteString.Char8 as B 22 | import Data.CaseInsensitive (original) 23 | import Network.Minio 24 | 25 | -- | The following example uses minio's play server at 26 | -- https://play.min.io. The endpoint and associated 27 | -- credentials are provided via the libary constant, 28 | -- 29 | -- > minioPlayCI :: ConnectInfo 30 | main :: IO () 31 | main = do 32 | let -- Use headers to set user-metadata - note that this header will 33 | -- need to be set when the URL is used to make an upload. 34 | headers = 35 | [ ( "x-amz-meta-url-creator", 36 | "minio-hs-presigned-put-example" 37 | ) 38 | ] 39 | res <- runMinio minioPlayCI $ do 40 | -- generate a URL with 7 days expiry time 41 | presignedPutObjectUrl "my-bucket" "my-object" (7 * 24 * 3600) headers 42 | 43 | case res of 44 | Left e -> putStrLn $ "presignedPutObject URL failed." ++ show e 45 | Right url -> do 46 | -- We generate a curl command to demonstrate usage of the signed 47 | -- URL. 48 | let hdrOpt (k, v) = B.concat ["-H '", original k, ": ", v, "'"] 49 | curlCmd = 50 | B.intercalate " " $ 51 | ["curl "] 52 | ++ map hdrOpt headers 53 | ++ ["-T /tmp/myfile", B.concat ["'", url, "'"]] 54 | 55 | putStrLn $ 56 | "The following curl command would use the presigned " 57 | ++ "URL to upload the file at \"/tmp/myfile\":" 58 | B.putStrLn curlCmd 59 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # http://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | resolver: lts-22.19 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - "." 40 | # Dependency packages to be pulled from upstream that are not in the resolver 41 | # (e.g., acme-missiles-0.3) 42 | extra-deps: 43 | - crypton-connection-0.3.2 44 | 45 | # Override default flag values for local packages and extra-deps 46 | flags: {} 47 | 48 | # Extra package databases containing global packages 49 | extra-package-dbs: [] 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=1.1" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor 67 | -------------------------------------------------------------------------------- /src/Network/Minio/XmlCommon.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.XmlCommon where 18 | 19 | import qualified Data.Text as T 20 | import Data.Text.Read (decimal) 21 | import Data.Time (UTCTime) 22 | import Data.Time.Format.ISO8601 (iso8601ParseM) 23 | import Lib.Prelude (throwIO) 24 | import Network.Minio.Errors 25 | import Text.XML (Name (Name), def, parseLBS) 26 | import Text.XML.Cursor (Axis, Cursor, content, element, fromDocument, laxElement, ($/), (&/)) 27 | 28 | s3Name :: Text -> Text -> Name 29 | s3Name ns s = Name s (Just ns) Nothing 30 | 31 | uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e 32 | uncurry4 f (a, b, c, d) = f a b c d 33 | 34 | uncurry6 :: (a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g 35 | uncurry6 f (a, b, c, d, e, g) = f a b c d e g 36 | 37 | -- | Parse time strings from XML 38 | parseS3XMLTime :: (MonadIO m) => Text -> m UTCTime 39 | parseS3XMLTime t = 40 | maybe (throwIO $ MErrVXmlParse $ "timestamp parse failure: " <> t) return $ 41 | iso8601ParseM $ 42 | toString t 43 | 44 | parseDecimal :: (MonadIO m, Integral a) => Text -> m a 45 | parseDecimal numStr = 46 | either (throwIO . MErrVXmlParse . show) return $ 47 | fst <$> decimal numStr 48 | 49 | parseDecimals :: (MonadIO m, Integral a) => [Text] -> m [a] 50 | parseDecimals numStr = forM numStr parseDecimal 51 | 52 | s3Elem :: Text -> Text -> Axis 53 | s3Elem ns = element . s3Name ns 54 | 55 | parseRoot :: (MonadIO m) => LByteString -> m Cursor 56 | parseRoot = 57 | either (throwIO . MErrVXmlParse . show) (return . fromDocument) 58 | . parseLBS def 59 | 60 | parseErrResponse :: (MonadIO m) => LByteString -> m ServiceErr 61 | parseErrResponse xmldata = do 62 | r <- parseRoot xmldata 63 | let code = T.concat $ r $/ laxElement "Code" &/ content 64 | message = T.concat $ r $/ laxElement "Message" &/ content 65 | return $ toServiceErr code message 66 | -------------------------------------------------------------------------------- /examples/FileUploader.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs --package optparse-applicative --package filepath 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | {-# LANGUAGE ScopedTypeVariables #-} 21 | 22 | import Data.Text (pack) 23 | import Network.Minio 24 | import Options.Applicative 25 | import System.FilePath.Posix 26 | import UnliftIO (throwIO, try) 27 | import Prelude 28 | 29 | -- | The following example uses minio's play server at 30 | -- https://play.min.io. The endpoint and associated 31 | -- credentials are provided via the libary constant, 32 | -- 33 | -- > minioPlayCI :: ConnectInfo 34 | 35 | -- optparse-applicative package based command-line parsing. 36 | fileNameArgs :: Parser FilePath 37 | fileNameArgs = 38 | strArgument 39 | ( metavar "FILENAME" 40 | <> help "Name of file to upload to AWS S3 or a MinIO server" 41 | ) 42 | 43 | cmdParser :: ParserInfo FilePath 44 | cmdParser = 45 | info 46 | (helper <*> fileNameArgs) 47 | ( fullDesc 48 | <> progDesc "FileUploader" 49 | <> header 50 | "FileUploader - a simple file-uploader program using minio-hs" 51 | ) 52 | 53 | main :: IO () 54 | main = do 55 | let bucket = "my-bucket" 56 | 57 | -- Parse command line argument 58 | filepath <- execParser cmdParser 59 | let object = pack $ takeBaseName filepath 60 | 61 | res <- runMinio minioPlayCI $ do 62 | -- Make a bucket; catch bucket already exists exception if thrown. 63 | bErr <- try $ makeBucket bucket Nothing 64 | case bErr of 65 | Left BucketAlreadyOwnedByYou -> return () 66 | Left e -> throwIO e 67 | Right _ -> return () 68 | 69 | -- Upload filepath to bucket; object is derived from filepath. 70 | fPutObject bucket object filepath defaultPutObjectOptions 71 | 72 | case res of 73 | Left e -> putStrLn $ "file upload failed due to " ++ show e 74 | Right () -> putStrLn "file upload succeeded." 75 | -------------------------------------------------------------------------------- /src/Network/Minio/Data/ByteString.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | {-# LANGUAGE FlexibleInstances #-} 17 | 18 | module Network.Minio.Data.ByteString 19 | ( stripBS, 20 | UriEncodable (..), 21 | ) 22 | where 23 | 24 | import qualified Data.ByteString as B 25 | import qualified Data.ByteString.Builder as BB 26 | import qualified Data.ByteString.Char8 as BC8 27 | import qualified Data.ByteString.Lazy as LB 28 | import Data.Char (isAsciiLower, isAsciiUpper, isDigit, isSpace, toUpper) 29 | import qualified Data.Text as T 30 | import Numeric (showHex) 31 | 32 | stripBS :: ByteString -> ByteString 33 | stripBS = BC8.dropWhile isSpace . fst . BC8.spanEnd isSpace 34 | 35 | class UriEncodable s where 36 | uriEncode :: Bool -> s -> ByteString 37 | 38 | instance UriEncodable [Char] where 39 | uriEncode encodeSlash payload = 40 | LB.toStrict $ 41 | BB.toLazyByteString $ 42 | mconcat $ 43 | map (`uriEncodeChar` encodeSlash) payload 44 | 45 | instance UriEncodable ByteString where 46 | -- assumes that uriEncode is passed ASCII encoded strings. 47 | uriEncode encodeSlash bs = 48 | uriEncode encodeSlash $ BC8.unpack bs 49 | 50 | instance UriEncodable Text where 51 | uriEncode encodeSlash txt = 52 | uriEncode encodeSlash $ T.unpack txt 53 | 54 | -- | URI encode a char according to AWS S3 signing rules - see 55 | -- UriEncode() at 56 | -- https://docs.aws.amazon.com/AmazonS3/latest/API/sig-v4-header-based-auth.html 57 | uriEncodeChar :: Char -> Bool -> BB.Builder 58 | uriEncodeChar '/' True = BB.byteString "%2F" 59 | uriEncodeChar '/' False = BB.char7 '/' 60 | uriEncodeChar ch _ 61 | | isAsciiUpper ch 62 | || isAsciiLower ch 63 | || isDigit ch 64 | || (ch == '_') 65 | || (ch == '-') 66 | || (ch == '.') 67 | || (ch == '~') = 68 | BB.char7 ch 69 | | otherwise = mconcat $ map f $ B.unpack $ encodeUtf8 $ T.singleton ch 70 | where 71 | f :: Word8 -> BB.Builder 72 | f n = BB.char7 '%' <> BB.string7 hexStr 73 | where 74 | hexStr = map toUpper $ showHex q $ showHex r "" 75 | (q, r) = divMod n (16 :: Word8) 76 | -------------------------------------------------------------------------------- /src/Network/Minio/Credentials.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.Credentials 18 | ( CredentialValue (..), 19 | credentialValueText, 20 | STSCredentialProvider (..), 21 | AccessKey (..), 22 | SecretKey (..), 23 | SessionToken (..), 24 | ExpiryTime (..), 25 | STSCredentialStore, 26 | initSTSCredential, 27 | getSTSCredential, 28 | Creds (..), 29 | getCredential, 30 | Endpoint, 31 | 32 | -- * STS Assume Role 33 | defaultSTSAssumeRoleOptions, 34 | STSAssumeRole (..), 35 | STSAssumeRoleOptions (..), 36 | ) 37 | where 38 | 39 | import Data.Time (diffUTCTime, getCurrentTime) 40 | import qualified Network.HTTP.Client as NC 41 | import Network.Minio.Credentials.AssumeRole 42 | import Network.Minio.Credentials.Types 43 | import qualified UnliftIO.MVar as M 44 | 45 | data STSCredentialStore = STSCredentialStore 46 | { cachedCredentials :: M.MVar (CredentialValue, ExpiryTime), 47 | refreshAction :: Endpoint -> NC.Manager -> IO (CredentialValue, ExpiryTime) 48 | } 49 | 50 | initSTSCredential :: (STSCredentialProvider p) => p -> IO STSCredentialStore 51 | initSTSCredential p = do 52 | let action = retrieveSTSCredentials p 53 | -- start with dummy credential, so that refresh happens for first request. 54 | now <- getCurrentTime 55 | mvar <- M.newMVar (CredentialValue mempty mempty mempty, coerce now) 56 | return $ 57 | STSCredentialStore 58 | { cachedCredentials = mvar, 59 | refreshAction = action 60 | } 61 | 62 | getSTSCredential :: STSCredentialStore -> Endpoint -> NC.Manager -> IO (CredentialValue, Bool) 63 | getSTSCredential store ep mgr = M.modifyMVar (cachedCredentials store) $ \cc@(v, expiry) -> do 64 | now <- getCurrentTime 65 | if diffUTCTime now (coerce expiry) > 0 66 | then do 67 | res <- refreshAction store ep mgr 68 | return (res, (fst res, True)) 69 | else return (cc, (v, False)) 70 | 71 | data Creds 72 | = CredsStatic CredentialValue 73 | | CredsSTS STSCredentialStore 74 | 75 | getCredential :: Creds -> Endpoint -> NC.Manager -> IO CredentialValue 76 | getCredential (CredsStatic v) _ _ = return v 77 | getCredential (CredsSTS s) ep mgr = fst <$> getSTSCredential s ep mgr 78 | -------------------------------------------------------------------------------- /test/Network/Minio/JsonParser/Test.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2018 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.JsonParser.Test 18 | ( jsonParserTests, 19 | ) 20 | where 21 | 22 | import Lib.Prelude 23 | import Network.Minio.Errors 24 | import Network.Minio.JsonParser 25 | import Test.Tasty 26 | import Test.Tasty.HUnit 27 | import UnliftIO (MonadUnliftIO) 28 | 29 | jsonParserTests :: TestTree 30 | jsonParserTests = 31 | testGroup 32 | "JSON Parser Tests" 33 | [ testCase "Test parseErrResponseJSON" testParseErrResponseJSON 34 | ] 35 | 36 | tryValidationErr :: (MonadUnliftIO m) => m a -> m (Either MErrV a) 37 | tryValidationErr = try 38 | 39 | assertValidationErr :: MErrV -> Assertion 40 | assertValidationErr e = assertFailure $ "Failed due to validation error => " ++ show e 41 | 42 | testParseErrResponseJSON :: Assertion 43 | testParseErrResponseJSON = do 44 | -- 1. Test parsing of an invalid error json. 45 | parseResE <- tryValidationErr $ parseErrResponseJSON "ClearlyInvalidJSON" 46 | when (isRight parseResE) $ 47 | assertFailure $ 48 | "Parsing should have failed => " ++ show parseResE 49 | 50 | forM_ cases $ \(jsondata, sErr) -> do 51 | parseErr <- tryValidationErr $ parseErrResponseJSON jsondata 52 | either assertValidationErr (@?= sErr) parseErr 53 | where 54 | cases = 55 | [ -- 2. Test parsing of a valid error json. 56 | ( "{\"Code\":\"InvalidAccessKeyId\",\"Message\":\"The access key ID you provided does not exist in our records.\",\"Key\":\"\",\"BucketName\":\"\",\"Resource\":\"/minio/admin/v1/info\",\"RequestId\":\"3L137\",\"HostId\":\"3L137\"}", 57 | ServiceErr "InvalidAccessKeyId" "The access key ID you provided does not exist in our records." 58 | ), 59 | -- 3. Test parsing of a valid, empty Resource. 60 | ( "{\"Code\":\"SignatureDoesNotMatch\",\"Message\":\"The request signature we calculated does not match the signature you provided. Check your key and signing method.\",\"Key\":\"\",\"BucketName\":\"\",\"Resource\":\"/minio/admin/v1/info\",\"RequestId\":\"3L137\",\"HostId\":\"3L137\"}", 61 | ServiceErr "SignatureDoesNotMatch" "The request signature we calculated does not match the signature you provided. Check your key and signing method." 62 | ) 63 | ] 64 | -------------------------------------------------------------------------------- /examples/SetConfig.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import Network.Minio 22 | import Network.Minio.AdminAPI 23 | import Prelude 24 | 25 | main :: IO () 26 | main = do 27 | res <- runMinio minioPlayCI $ 28 | do 29 | let config = "{\"version\":\"25\",\"credential\":{\"accessKey\":\"minio\",\"secretKey\":\"minio123\"},\"region\":\"\",\"browser\":\"on\",\"worm\":\"off\",\"domain\":\"\",\"storageclass\":{\"standard\":\"\",\"rrs\":\"\"},\"cache\":{\"drives\":[],\"expiry\":90,\"exclude\":[]},\"notify\":{\"amqp\":{\"2\":{\"enable\":false,\"url\":\"amqp://guest:guest@localhost:5672/\",\"exchange\":\"minio\",\"routingKey\":\"minio\",\"exchangeType\":\"direct\",\"deliveryMode\":0,\"mandatory\":false,\"immediate\":false,\"durable\":false,\"internal\":false,\"noWait\":false,\"autoDeleted\":false}},\"elasticsearch\":{\"1\":{\"enable\":false,\"format\":\"namespace\",\"url\":\"http://localhost:9200\",\"index\":\"minio_events\"}},\"kafka\":{\"1\":{\"enable\":false,\"brokers\":null,\"topic\":\"\"}},\"mqtt\":{\"1\":{\"enable\":false,\"broker\":\"\",\"topic\":\"\",\"qos\":0,\"clientId\":\"\",\"username\":\"\",\"password\":\"\",\"reconnectInterval\":0,\"keepAliveInterval\":0}},\"mysql\":{\"1\":{\"enable\":false,\"format\":\"namespace\",\"dsnString\":\"\",\"table\":\"\",\"host\":\"\",\"port\":\"\",\"user\":\"\",\"password\":\"\",\"database\":\"\"}},\"nats\":{\"1\":{\"enable\":false,\"address\":\"\",\"subject\":\"\",\"username\":\"\",\"password\":\"\",\"token\":\"\",\"secure\":false,\"pingInterval\":0,\"streaming\":{\"enable\":false,\"clusterID\":\"\",\"clientID\":\"\",\"async\":false,\"maxPubAcksInflight\":0}}},\"postgresql\":{\"1\":{\"enable\":false,\"format\":\"namespace\",\"connectionString\":\"\",\"table\":\"\",\"host\":\"\",\"port\":\"\",\"user\":\"\",\"password\":\"\",\"database\":\"\"}},\"redis\":{\"test1\":{\"enable\":true,\"format\":\"namespace\",\"address\":\"127.0.0.1:6379\",\"password\":\"\",\"key\":\"bucketevents_ns\"},\"test2\":{\"enable\":true,\"format\":\"access\",\"address\":\"127.0.0.1:6379\",\"password\":\"\",\"key\":\"bucketevents_log\"}},\"webhook\":{\"1\":{\"enable\":true,\"endpoint\":\"http://localhost:3000\"},\"2\":{\"enable\":true,\"endpoint\":\"http://localhost:3001\"}}}}" 30 | setConfig config 31 | print res 32 | -------------------------------------------------------------------------------- /src/Network/Minio/APICommon.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2018 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.APICommon where 18 | 19 | import qualified Conduit as C 20 | import qualified Data.ByteString as BS 21 | import qualified Data.ByteString.Lazy as LB 22 | import Data.Conduit.Binary (sourceHandleRange) 23 | import qualified Data.Text as T 24 | import Lib.Prelude 25 | import qualified Network.HTTP.Conduit as NC 26 | import qualified Network.HTTP.Types as HT 27 | import Network.Minio.Data 28 | import Network.Minio.Data.Crypto 29 | import Network.Minio.Errors 30 | 31 | sha256Header :: ByteString -> HT.Header 32 | sha256Header = ("x-amz-content-sha256",) 33 | 34 | -- | This function throws an error if the payload is a conduit (as it 35 | -- will not be possible to re-read the conduit after it is consumed). 36 | getPayloadSHA256Hash :: Payload -> Minio ByteString 37 | getPayloadSHA256Hash (PayloadBS bs) = return $ hashSHA256 bs 38 | getPayloadSHA256Hash (PayloadH h off size) = 39 | hashSHA256FromSource $ 40 | sourceHandleRange 41 | h 42 | (return . fromIntegral $ off) 43 | (return . fromIntegral $ size) 44 | getPayloadSHA256Hash (PayloadC _ _) = throwIO MErrVUnexpectedPayload 45 | 46 | getRequestBody :: Payload -> NC.RequestBody 47 | getRequestBody (PayloadBS bs) = NC.RequestBodyBS bs 48 | getRequestBody (PayloadH h off size) = 49 | NC.requestBodySource size $ 50 | sourceHandleRange 51 | h 52 | (return . fromIntegral $ off) 53 | (return . fromIntegral $ size) 54 | getRequestBody (PayloadC n src) = NC.requestBodySource n src 55 | 56 | mkStreamingPayload :: Payload -> Payload 57 | mkStreamingPayload payload = 58 | case payload of 59 | PayloadBS bs -> 60 | PayloadC 61 | (fromIntegral $ BS.length bs) 62 | (C.sourceLazy $ LB.fromStrict bs) 63 | PayloadH h off len -> 64 | PayloadC len $ 65 | sourceHandleRange 66 | h 67 | (return . fromIntegral $ off) 68 | (return . fromIntegral $ len) 69 | _ -> payload 70 | 71 | isStreamingPayload :: Payload -> Bool 72 | isStreamingPayload (PayloadC _ _) = True 73 | isStreamingPayload _ = False 74 | 75 | -- | Checks if the connect info is for Amazon S3. 76 | isAWSConnectInfo :: ConnectInfo -> Bool 77 | isAWSConnectInfo ci = ".amazonaws.com" `T.isSuffixOf` connectHost ci 78 | 79 | bucketHasPeriods :: Bucket -> Bool 80 | bucketHasPeriods b = isJust $ T.find (== '.') b 81 | -------------------------------------------------------------------------------- /src/Network/Minio/Data/Crypto.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.Data.Crypto 18 | ( hashSHA256, 19 | hashSHA256FromSource, 20 | hashMD5, 21 | hashMD5ToBase64, 22 | hashMD5FromSource, 23 | hmacSHA256, 24 | hmacSHA256RawBS, 25 | digestToBS, 26 | digestToBase16, 27 | encodeToBase64, 28 | ) 29 | where 30 | 31 | import Crypto.Hash 32 | ( Digest, 33 | MD5 (..), 34 | SHA256 (..), 35 | hashWith, 36 | ) 37 | import Crypto.Hash.Conduit (sinkHash) 38 | import Crypto.MAC.HMAC (HMAC, hmac) 39 | import Data.ByteArray (ByteArrayAccess, convert) 40 | import Data.ByteArray.Encoding (Base (Base16, Base64), convertToBase) 41 | import qualified Data.Conduit as C 42 | 43 | hashSHA256 :: ByteString -> ByteString 44 | hashSHA256 = digestToBase16 . hashWith SHA256 45 | 46 | hashSHA256FromSource :: (Monad m) => C.ConduitM () ByteString m () -> m ByteString 47 | hashSHA256FromSource src = do 48 | digest <- C.connect src sinkSHA256Hash 49 | return $ digestToBase16 digest 50 | where 51 | -- To help with type inference 52 | sinkSHA256Hash :: (Monad m) => C.ConduitM ByteString Void m (Digest SHA256) 53 | sinkSHA256Hash = sinkHash 54 | 55 | -- Returns MD5 hash hex encoded. 56 | hashMD5 :: ByteString -> ByteString 57 | hashMD5 = digestToBase16 . hashWith MD5 58 | 59 | hashMD5FromSource :: (Monad m) => C.ConduitM () ByteString m () -> m ByteString 60 | hashMD5FromSource src = do 61 | digest <- C.connect src sinkMD5Hash 62 | return $ digestToBase16 digest 63 | where 64 | -- To help with type inference 65 | sinkMD5Hash :: (Monad m) => C.ConduitM ByteString Void m (Digest MD5) 66 | sinkMD5Hash = sinkHash 67 | 68 | hmacSHA256 :: ByteString -> ByteString -> HMAC SHA256 69 | hmacSHA256 message key = hmac key message 70 | 71 | hmacSHA256RawBS :: ByteString -> ByteString -> ByteString 72 | hmacSHA256RawBS message key = convert $ hmacSHA256 message key 73 | 74 | digestToBS :: (ByteArrayAccess a) => a -> ByteString 75 | digestToBS = convert 76 | 77 | digestToBase16 :: (ByteArrayAccess a) => a -> ByteString 78 | digestToBase16 = convertToBase Base16 79 | 80 | -- Returns MD5 hash base 64 encoded. 81 | hashMD5ToBase64 :: (ByteArrayAccess a) => a -> ByteString 82 | hashMD5ToBase64 = convertToBase Base64 . hashWith MD5 83 | 84 | encodeToBase64 :: (ByteArrayAccess a) => a -> ByteString 85 | encodeToBase64 = convertToBase Base64 86 | -------------------------------------------------------------------------------- /src/Network/Minio/Errors.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.Errors 18 | ( MErrV (..), 19 | ServiceErr (..), 20 | MinioErr (..), 21 | toServiceErr, 22 | ) 23 | where 24 | 25 | import Control.Exception (IOException) 26 | import qualified Network.HTTP.Conduit as NC 27 | 28 | --------------------------------- 29 | -- Errors 30 | --------------------------------- 31 | 32 | -- | Various validation errors 33 | data MErrV 34 | = MErrVSinglePUTSizeExceeded Int64 35 | | MErrVPutSizeExceeded Int64 36 | | MErrVETagHeaderNotFound 37 | | MErrVInvalidObjectInfoResponse 38 | | MErrVInvalidSrcObjSpec Text 39 | | MErrVInvalidSrcObjByteRange (Int64, Int64) 40 | | MErrVCopyObjSingleNoRangeAccepted 41 | | MErrVRegionNotSupported Text 42 | | MErrVXmlParse Text 43 | | MErrVInvalidBucketName Text 44 | | MErrVInvalidObjectName Text 45 | | MErrVInvalidUrlExpiry Int 46 | | MErrVJsonParse Text 47 | | MErrVInvalidHealPath 48 | | MErrVMissingCredentials 49 | | MErrVInvalidEncryptionKeyLength 50 | | MErrVStreamingBodyUnexpectedEOF 51 | | MErrVUnexpectedPayload 52 | | MErrVSTSEndpointNotFound 53 | deriving stock (Show, Eq) 54 | 55 | instance Exception MErrV 56 | 57 | -- | Errors returned by S3 compatible service 58 | data ServiceErr 59 | = BucketAlreadyExists 60 | | BucketAlreadyOwnedByYou 61 | | NoSuchBucket 62 | | InvalidBucketName 63 | | NoSuchKey 64 | | SelectErr Text Text 65 | | ServiceErr Text Text 66 | deriving stock (Show, Eq) 67 | 68 | instance Exception ServiceErr 69 | 70 | toServiceErr :: Text -> Text -> ServiceErr 71 | toServiceErr "NoSuchKey" _ = NoSuchKey 72 | toServiceErr "NoSuchBucket" _ = NoSuchBucket 73 | toServiceErr "InvalidBucketName" _ = InvalidBucketName 74 | toServiceErr "BucketAlreadyOwnedByYou" _ = BucketAlreadyOwnedByYou 75 | toServiceErr "BucketAlreadyExists" _ = BucketAlreadyExists 76 | toServiceErr code message = ServiceErr code message 77 | 78 | -- | Errors thrown by the library 79 | data MinioErr 80 | = MErrHTTP NC.HttpException 81 | | MErrIO IOException 82 | | MErrService ServiceErr 83 | | MErrValidation MErrV 84 | deriving stock (Show) 85 | 86 | instance Eq MinioErr where 87 | MErrHTTP _ == MErrHTTP _ = True 88 | MErrHTTP _ == _ = False 89 | MErrIO _ == MErrIO _ = True 90 | MErrIO _ == _ = False 91 | MErrService a == MErrService b = a == b 92 | MErrService _ == _ = False 93 | MErrValidation a == MErrValidation b = a == b 94 | MErrValidation _ == _ = False 95 | 96 | instance Exception MinioErr 97 | -------------------------------------------------------------------------------- /examples/PresignedPostPolicy.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import qualified Data.ByteString as B 22 | import qualified Data.ByteString.Char8 as Char8 23 | import qualified Data.HashMap.Strict as H 24 | import qualified Data.Text.Encoding as Enc 25 | import qualified Data.Time as Time 26 | import Network.Minio 27 | 28 | -- | The following example uses minio's play server at 29 | -- https://play.min.io. The endpoint and associated 30 | -- credentials are provided via the libary constant, 31 | -- 32 | -- > minioPlayCI :: ConnectInfo 33 | main :: IO () 34 | main = do 35 | now <- Time.getCurrentTime 36 | let bucket = "my-bucket" 37 | object = "photos/my-object" 38 | -- set an expiration time of 10 days 39 | expireTime = Time.addUTCTime (3600 * 24 * 10) now 40 | -- create a policy with expiration time and conditions - since the 41 | -- conditions are validated, newPostPolicy returns an Either value 42 | policyE = 43 | newPostPolicy 44 | expireTime 45 | [ -- set the object name condition 46 | ppCondKey object, 47 | -- set the bucket name condition 48 | ppCondBucket bucket, 49 | -- set the size range of object as 1B to 10MiB 50 | ppCondContentLengthRange 1 (10 * 1024 * 1024), 51 | -- set content type as jpg image 52 | ppCondContentType "image/jpeg", 53 | -- on success set the server response code to 200 54 | ppCondSuccessActionStatus 200 55 | ] 56 | 57 | case policyE of 58 | Left err -> print err 59 | Right policy -> do 60 | res <- runMinio minioPlayCI $ do 61 | (url, formData) <- presignedPostPolicy policy 62 | 63 | -- a curl command is output to demonstrate using the generated 64 | -- URL and form-data 65 | let formFn (k, v) = 66 | B.concat 67 | [ "-F ", 68 | Enc.encodeUtf8 k, 69 | "=", 70 | "'", 71 | v, 72 | "'" 73 | ] 74 | formOptions = B.intercalate " " $ map formFn $ H.toList formData 75 | 76 | return $ 77 | B.intercalate 78 | " " 79 | ["curl", formOptions, "-F file=@/tmp/photo.jpg", url] 80 | 81 | case res of 82 | Left e -> putStrLn $ "post-policy error: " ++ show e 83 | Right cmd -> do 84 | putStrLn "Put a photo at /tmp/photo.jpg and run command:\n" 85 | 86 | -- print the generated curl command 87 | Char8.putStrLn cmd 88 | -------------------------------------------------------------------------------- /examples/PresignedGetObject.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --resolver lts-14.11 runghc --package minio-hs 3 | 4 | -- 5 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 6 | -- 7 | -- Licensed under the Apache License, Version 2.0 (the "License"); 8 | -- you may not use this file except in compliance with the License. 9 | -- You may obtain a copy of the License at 10 | -- 11 | -- http://www.apache.org/licenses/LICENSE-2.0 12 | -- 13 | -- Unless required by applicable law or agreed to in writing, software 14 | -- distributed under the License is distributed on an "AS IS" BASIS, 15 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | -- See the License for the specific language governing permissions and 17 | -- limitations under the License. 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | import Control.Monad.IO.Class (liftIO) 22 | import qualified Data.ByteString.Char8 as B 23 | import Data.CaseInsensitive (original) 24 | import qualified Data.Conduit.Combinators as CC 25 | import qualified Data.Text.Encoding as E 26 | import Network.Minio 27 | 28 | -- | The following example uses minio's play server at 29 | -- https://play.min.io. The endpoint and associated 30 | -- credentials are provided via the libary constant, 31 | -- 32 | -- > minioPlayCI :: ConnectInfo 33 | main :: IO () 34 | main = do 35 | let bucket = "my-bucket" 36 | object = "my-object" 37 | kb15 = 15 * 1024 38 | -- Set query parameter to modify content disposition response 39 | -- header 40 | queryParam = 41 | [ ( "response-content-disposition", 42 | Just "attachment; filename=\"your-filename.txt\"" 43 | ) 44 | ] 45 | 46 | res <- runMinio minioPlayCI $ do 47 | liftIO $ B.putStrLn "Upload a file that we will fetch with a presigned URL..." 48 | putObject bucket object (CC.repeat "a") (Just kb15) defaultPutObjectOptions 49 | liftIO $ putStrLn "Done. Object created at: my-bucket/my-object" 50 | 51 | -- Extract Etag of uploaded object 52 | oi <- statObject bucket object defaultGetObjectOptions 53 | let etag = oiETag oi 54 | 55 | -- Set header to add an if-match constraint - this makes sure 56 | -- the fetching fails if the object is changed on the server 57 | let headers = [("If-Match", E.encodeUtf8 etag)] 58 | 59 | -- Generate a URL with 7 days expiry time - note that the headers 60 | -- used above must be added to the request with the signed URL 61 | -- generated. 62 | url <- 63 | presignedGetObjectUrl 64 | "my-bucket" 65 | "my-object" 66 | (7 * 24 * 3600) 67 | queryParam 68 | headers 69 | 70 | return (headers, etag, url) 71 | 72 | case res of 73 | Left e -> putStrLn $ "presignedPutObject URL failed." ++ show e 74 | Right (headers, _, url) -> do 75 | -- We generate a curl command to demonstrate usage of the signed 76 | -- URL. 77 | let hdrOpt (k, v) = B.concat ["-H '", original k, ": ", v, "'"] 78 | curlCmd = 79 | B.intercalate " " $ 80 | ["curl --fail"] 81 | ++ map hdrOpt headers 82 | ++ ["-o /tmp/myfile", B.concat ["'", url, "'"]] 83 | 84 | putStrLn $ 85 | "The following curl command would use the presigned " 86 | ++ "URL to fetch the object and write it to \"/tmp/myfile\":" 87 | B.putStrLn curlCmd 88 | -------------------------------------------------------------------------------- /src/Network/Minio/Credentials/Types.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 17 | {-# LANGUAGE StrictData #-} 18 | 19 | module Network.Minio.Credentials.Types where 20 | 21 | import qualified Data.ByteArray as BA 22 | import Lib.Prelude (UTCTime) 23 | import qualified Network.HTTP.Client as NC 24 | 25 | -- | Access Key type. 26 | newtype AccessKey = AccessKey {unAccessKey :: Text} 27 | deriving stock (Show) 28 | deriving newtype (Eq, IsString, Semigroup, Monoid) 29 | 30 | -- | Secret Key type - has a show instance that does not print the value. 31 | newtype SecretKey = SecretKey {unSecretKey :: BA.ScrubbedBytes} 32 | deriving stock (Show) 33 | deriving newtype (Eq, IsString, Semigroup, Monoid) 34 | 35 | -- | Session Token type - has a show instance that does not print the value. 36 | newtype SessionToken = SessionToken {unSessionToken :: BA.ScrubbedBytes} 37 | deriving stock (Show) 38 | deriving newtype (Eq, IsString, Semigroup, Monoid) 39 | 40 | -- | Object storage credential data type. It has support for the optional 41 | -- [SessionToken](https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_temp_use-resources.html) 42 | -- for using temporary credentials requested via STS. 43 | -- 44 | -- The show instance for this type does not print the value of secrets for 45 | -- security. 46 | -- 47 | -- @since 1.7.0 48 | data CredentialValue = CredentialValue 49 | { cvAccessKey :: AccessKey, 50 | cvSecretKey :: SecretKey, 51 | cvSessionToken :: Maybe SessionToken 52 | } 53 | deriving stock (Eq, Show) 54 | 55 | scrubbedToText :: BA.ScrubbedBytes -> Text 56 | scrubbedToText = 57 | let b2t :: ByteString -> Text 58 | b2t = decodeUtf8 59 | s2b :: BA.ScrubbedBytes -> ByteString 60 | s2b = BA.convert 61 | in b2t . s2b 62 | 63 | -- | Convert a 'CredentialValue' to a text tuple. Use this to output the 64 | -- credential to files or other programs. 65 | credentialValueText :: CredentialValue -> (Text, Text, Maybe Text) 66 | credentialValueText cv = 67 | ( coerce $ cvAccessKey cv, 68 | (scrubbedToText . coerce) $ cvSecretKey cv, 69 | scrubbedToText . coerce <$> cvSessionToken cv 70 | ) 71 | 72 | -- | Endpoint represented by host, port and TLS enabled flag. 73 | type Endpoint = (ByteString, Int, Bool) 74 | 75 | -- | Typeclass for STS credential providers. 76 | -- 77 | -- @since 1.7.0 78 | class STSCredentialProvider p where 79 | retrieveSTSCredentials :: 80 | p -> 81 | -- | STS Endpoint (host, port, isSecure) 82 | Endpoint -> 83 | NC.Manager -> 84 | IO (CredentialValue, ExpiryTime) 85 | getSTSEndpoint :: p -> Maybe Text 86 | 87 | -- | 'ExpiryTime' represents a time at which a credential expires. 88 | newtype ExpiryTime = ExpiryTime {unExpiryTime :: UTCTime} 89 | deriving stock (Show) 90 | deriving newtype (Eq) 91 | -------------------------------------------------------------------------------- /src/Network/Minio/CopyObject.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.CopyObject where 18 | 19 | import qualified Data.List as List 20 | import Lib.Prelude 21 | import Network.Minio.Data 22 | import Network.Minio.Errors 23 | import Network.Minio.S3API 24 | import Network.Minio.Utils 25 | 26 | -- | Copy an object using single or multipart copy strategy. 27 | copyObjectInternal :: 28 | Bucket -> 29 | Object -> 30 | SourceInfo -> 31 | Minio ETag 32 | copyObjectInternal b' o srcInfo = do 33 | let sBucket = srcBucket srcInfo 34 | sObject = srcObject srcInfo 35 | 36 | -- get source object size with a head request 37 | oi <- headObject sBucket sObject [] 38 | let srcSize = oiSize oi 39 | 40 | -- check that byte offsets are valid if specified in cps 41 | let rangeMay = srcRange srcInfo 42 | range = maybe (0, srcSize) identity rangeMay 43 | startOffset = fst range 44 | endOffset = snd range 45 | 46 | when 47 | ( isJust rangeMay 48 | && ( (startOffset < 0) 49 | || (endOffset < startOffset) 50 | || (endOffset >= srcSize) 51 | ) 52 | ) 53 | $ throwIO 54 | $ MErrVInvalidSrcObjByteRange range 55 | 56 | -- 1. If sz > 64MiB (minPartSize) use multipart copy, OR 57 | -- 2. If startOffset /= 0 use multipart copy 58 | let destSize = 59 | (\(a, b) -> b - a + 1) $ 60 | maybe (0, srcSize - 1) identity rangeMay 61 | 62 | if destSize > minPartSize || (endOffset - startOffset + 1 /= srcSize) 63 | then multiPartCopyObject b' o srcInfo srcSize 64 | else fst <$> copyObjectSingle b' o srcInfo {srcRange = Nothing} [] 65 | 66 | -- | Given the input byte range of the source object, compute the 67 | -- splits for a multipart copy object procedure. Minimum part size 68 | -- used is minPartSize. 69 | selectCopyRanges :: (Int64, Int64) -> [(PartNumber, (Int64, Int64))] 70 | selectCopyRanges (st, end) = 71 | zip pns $ 72 | zipWith (\x y -> (st + x, st + x + y - 1)) startOffsets partSizes 73 | where 74 | size = end - st + 1 75 | (pns, startOffsets, partSizes) = List.unzip3 $ selectPartSizes size 76 | 77 | -- | Perform a multipart copy object action. Since we cannot verify 78 | -- existing parts based on the source object, there is no resuming 79 | -- copy action support. 80 | multiPartCopyObject :: 81 | Bucket -> 82 | Object -> 83 | SourceInfo -> 84 | Int64 -> 85 | Minio ETag 86 | multiPartCopyObject b o cps srcSize = do 87 | uid <- newMultipartUpload b o [] 88 | 89 | let byteRange = maybe (0, srcSize - 1) identity $ srcRange cps 90 | partRanges = selectCopyRanges byteRange 91 | partSources = 92 | map 93 | (\(x, (start, end)) -> (x, cps {srcRange = Just (start, end)})) 94 | partRanges 95 | dstInfo = defaultDestinationInfo {dstBucket = b, dstObject = o} 96 | 97 | copiedParts <- 98 | limitedMapConcurrently 99 | 10 100 | ( \(pn, cps') -> do 101 | (etag, _) <- copyObjectPart dstInfo cps' uid pn [] 102 | return (pn, etag) 103 | ) 104 | partSources 105 | 106 | completeMultipartUpload b o uid copiedParts 107 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | import qualified Data.ByteString as B 18 | import qualified Data.List as L 19 | import Lib.Prelude 20 | import Network.Minio.API.Test 21 | import Network.Minio.CopyObject 22 | import Network.Minio.Data 23 | import Network.Minio.Utils.Test 24 | import Network.Minio.XmlGenerator.Test 25 | import Network.Minio.XmlParser.Test 26 | import Test.Tasty 27 | import Test.Tasty.QuickCheck as QC 28 | 29 | main :: IO () 30 | main = defaultMain tests 31 | 32 | tests :: TestTree 33 | tests = testGroup "Tests" [properties, unitTests] 34 | 35 | properties :: TestTree 36 | properties = testGroup "Properties" [qcProps] -- [scProps] 37 | 38 | -- scProps = testGroup "(checked by SmallCheck)" 39 | -- [ SC.testProperty "sort == sort . reverse" $ 40 | -- \list -> sort (list :: [Int]) == sort (reverse list) 41 | -- , SC.testProperty "Fermat's little theorem" $ 42 | -- \x -> ((x :: Integer)^7 - x) `mod` 7 == 0 43 | -- -- the following property does not hold 44 | -- , SC.testProperty "Fermat's last theorem" $ 45 | -- \x y z n -> 46 | -- (n :: Integer) >= 3 SC.==> x^n + y^n /= (z^n :: Integer) 47 | -- ] 48 | 49 | qcProps :: TestTree 50 | qcProps = 51 | testGroup 52 | "(checked by QuickCheck)" 53 | [ QC.testProperty "selectPartSizes:" $ 54 | \n -> 55 | let (pns, offs, sizes) = L.unzip3 (selectPartSizes n) 56 | -- check that pns increments from 1. 57 | isPNumsAscendingFrom1 = all (uncurry (==)) $ zip pns [1 ..] 58 | consPairs [] = [] 59 | consPairs [_] = [] 60 | consPairs (a : (b : c)) = (a, b) : consPairs (b : c) 61 | -- check `offs` is monotonically increasing. 62 | isOffsetsAsc = all (uncurry (<)) $ consPairs offs 63 | -- check sizes sums to n. 64 | isSumSizeOk = sum sizes == n 65 | -- check sizes are constant except last 66 | isSizesConstantExceptLast = 67 | all (uncurry (==)) (consPairs $ L.init sizes) 68 | -- check each part except last is at least minPartSize; 69 | -- last part may be 0 only if it is the only part. 70 | nparts = length sizes 71 | isMinPartSizeOk = 72 | if 73 | | nparts > 1 -> -- last part can be smaller but > 0 74 | all (>= minPartSize) (take (nparts - 1) sizes) 75 | && all (> 0) (drop (nparts - 1) sizes) 76 | | nparts == 1 -> -- size may be 0 here. 77 | maybe True (\x -> x >= 0 && x <= minPartSize) $ 78 | listToMaybe sizes 79 | | otherwise -> False 80 | in n < 0 81 | || ( isPNumsAscendingFrom1 82 | && isOffsetsAsc 83 | && isSumSizeOk 84 | && isSizesConstantExceptLast 85 | && isMinPartSizeOk 86 | ), 87 | QC.testProperty "selectCopyRanges:" $ 88 | \(start, end) -> 89 | let (_, pairs) = L.unzip (selectCopyRanges (start, end)) 90 | -- is last part's snd offset end? 91 | isLastPartOk = maybe False ((end ==) . snd) $ lastMay pairs 92 | -- is first part's fst offset start 93 | isFirstPartOk = maybe False ((start ==) . fst) $ listToMaybe pairs 94 | -- each pair is >=64MiB except last, and all those parts 95 | -- have same size. 96 | initSizes = maybe [] (map (\(a, b) -> b - a + 1) . init) (nonEmpty pairs) 97 | isPartSizesOk = 98 | all (>= minPartSize) initSizes 99 | && maybe 100 | True 101 | (\k -> all (== k) initSizes) 102 | (listToMaybe initSizes) 103 | -- returned offsets are contiguous. 104 | fsts = drop 1 $ map fst pairs 105 | snds = take (length pairs - 1) $ map snd pairs 106 | isContParts = 107 | length fsts == length snds 108 | && all (\(a, b) -> a == b + 1) (zip fsts snds) 109 | in start < 0 110 | || start > end 111 | || (isLastPartOk && isFirstPartOk && isPartSizesOk && isContParts), 112 | QC.testProperty "mkSSECKey:" $ 113 | \w8s -> 114 | let bs = B.pack w8s 115 | r = mkSSECKey bs 116 | in case r of 117 | Just _ -> B.length bs == 32 118 | Nothing -> B.length bs /= 32 119 | ] 120 | 121 | unitTests :: TestTree 122 | unitTests = 123 | testGroup 124 | "Unit tests" 125 | [ xmlGeneratorTests, 126 | xmlParserTests, 127 | bucketNameValidityTests, 128 | objectNameValidityTests, 129 | parseServerInfoJSONTest, 130 | parseHealStatusTest, 131 | parseHealStartRespTest, 132 | limitedMapConcurrentlyTests 133 | ] 134 | -------------------------------------------------------------------------------- /src/Network/Minio/ListOps.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017-2019 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.ListOps where 18 | 19 | import qualified Data.Conduit as C 20 | import qualified Data.Conduit.Combinators as CC 21 | import qualified Data.Conduit.List as CL 22 | import Network.Minio.Data 23 | ( Bucket, 24 | ListObjectsResult 25 | ( lorCPrefixes, 26 | lorHasMore, 27 | lorNextToken, 28 | lorObjects 29 | ), 30 | ListObjectsV1Result 31 | ( lorCPrefixes', 32 | lorHasMore', 33 | lorNextMarker, 34 | lorObjects' 35 | ), 36 | ListPartsResult (lprHasMore, lprNextPart, lprParts), 37 | ListUploadsResult 38 | ( lurHasMore, 39 | lurNextKey, 40 | lurNextUpload, 41 | lurUploads 42 | ), 43 | Minio, 44 | Object, 45 | ObjectInfo, 46 | ObjectPartInfo (opiSize), 47 | UploadId, 48 | UploadInfo (UploadInfo), 49 | ) 50 | import Network.Minio.S3API 51 | ( listIncompleteParts', 52 | listIncompleteUploads', 53 | listObjects', 54 | listObjectsV1', 55 | ) 56 | 57 | -- | Represents a list output item - either an object or an object 58 | -- prefix (i.e. a directory). 59 | data ListItem 60 | = ListItemObject ObjectInfo 61 | | ListItemPrefix Text 62 | deriving stock (Show, Eq) 63 | 64 | -- | @'listObjects' bucket prefix recurse@ lists objects in a bucket 65 | -- similar to a file system tree traversal. 66 | -- 67 | -- If @prefix@ is not 'Nothing', only items with the given prefix are 68 | -- listed, otherwise items under the bucket are returned. 69 | -- 70 | -- If @recurse@ is set to @True@ all directories under the prefix are 71 | -- recursively traversed and only objects are returned. 72 | -- 73 | -- If @recurse@ is set to @False@, objects and directories immediately 74 | -- under the given prefix are returned (no recursive traversal is 75 | -- performed). 76 | listObjects :: Bucket -> Maybe Text -> Bool -> C.ConduitM () ListItem Minio () 77 | listObjects bucket prefix recurse = loop Nothing 78 | where 79 | loop :: Maybe Text -> C.ConduitM () ListItem Minio () 80 | loop nextToken = do 81 | let delimiter = bool (Just "/") Nothing recurse 82 | 83 | res <- lift $ listObjects' bucket prefix nextToken delimiter Nothing 84 | CL.sourceList $ map ListItemObject $ lorObjects res 85 | unless recurse $ 86 | CL.sourceList $ 87 | map ListItemPrefix $ 88 | lorCPrefixes res 89 | when (lorHasMore res) $ 90 | loop (lorNextToken res) 91 | 92 | -- | Lists objects - similar to @listObjects@, however uses the older 93 | -- V1 AWS S3 API. Prefer @listObjects@ to this. 94 | listObjectsV1 :: 95 | Bucket -> 96 | Maybe Text -> 97 | Bool -> 98 | C.ConduitM () ListItem Minio () 99 | listObjectsV1 bucket prefix recurse = loop Nothing 100 | where 101 | loop :: Maybe Text -> C.ConduitM () ListItem Minio () 102 | loop nextMarker = do 103 | let delimiter = bool (Just "/") Nothing recurse 104 | 105 | res <- lift $ listObjectsV1' bucket prefix nextMarker delimiter Nothing 106 | CL.sourceList $ map ListItemObject $ lorObjects' res 107 | unless recurse $ 108 | CL.sourceList $ 109 | map ListItemPrefix $ 110 | lorCPrefixes' res 111 | when (lorHasMore' res) $ 112 | loop (lorNextMarker res) 113 | 114 | -- | List incomplete uploads in a bucket matching the given prefix. If 115 | -- recurse is set to True incomplete uploads for the given prefix are 116 | -- recursively listed. 117 | listIncompleteUploads :: 118 | Bucket -> 119 | Maybe Text -> 120 | Bool -> 121 | C.ConduitM () UploadInfo Minio () 122 | listIncompleteUploads bucket prefix recurse = loop Nothing Nothing 123 | where 124 | loop :: Maybe Text -> Maybe Text -> C.ConduitM () UploadInfo Minio () 125 | loop nextKeyMarker nextUploadIdMarker = do 126 | let delimiter = bool (Just "/") Nothing recurse 127 | 128 | res <- 129 | lift $ 130 | listIncompleteUploads' 131 | bucket 132 | prefix 133 | delimiter 134 | nextKeyMarker 135 | nextUploadIdMarker 136 | Nothing 137 | 138 | aggrSizes <- lift $ 139 | forM (lurUploads res) $ \(uKey, uId, _) -> do 140 | partInfos <- 141 | C.runConduit $ 142 | listIncompleteParts bucket uKey uId 143 | C..| CC.sinkList 144 | return $ foldl' (\sizeSofar p -> opiSize p + sizeSofar) 0 partInfos 145 | 146 | CL.sourceList $ 147 | zipWith 148 | ( curry 149 | ( \((uKey, uId, uInitTime), size) -> 150 | UploadInfo uKey uId uInitTime size 151 | ) 152 | ) 153 | (lurUploads res) 154 | aggrSizes 155 | 156 | when (lurHasMore res) $ 157 | loop (lurNextKey res) (lurNextUpload res) 158 | 159 | -- | List object parts of an ongoing multipart upload for given 160 | -- bucket, object and uploadId. 161 | listIncompleteParts :: 162 | Bucket -> 163 | Object -> 164 | UploadId -> 165 | C.ConduitM () ObjectPartInfo Minio () 166 | listIncompleteParts bucket object uploadId = loop Nothing 167 | where 168 | loop :: Maybe Text -> C.ConduitM () ObjectPartInfo Minio () 169 | loop nextPartMarker = do 170 | res <- 171 | lift $ 172 | listIncompleteParts' 173 | bucket 174 | object 175 | uploadId 176 | Nothing 177 | nextPartMarker 178 | CL.sourceList $ lprParts res 179 | when (lprHasMore res) $ 180 | loop (show <$> lprNextPart res) 181 | -------------------------------------------------------------------------------- /src/Network/Minio/PutObject.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017-2019 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.PutObject 18 | ( putObjectInternal, 19 | ObjectData (..), 20 | selectPartSizes, 21 | ) 22 | where 23 | 24 | import Conduit (takeC) 25 | import qualified Conduit as C 26 | import qualified Data.ByteString.Lazy as LBS 27 | import qualified Data.Conduit.Binary as CB 28 | import qualified Data.Conduit.Combinators as CC 29 | import qualified Data.Conduit.List as CL 30 | import qualified Data.List as List 31 | import Lib.Prelude 32 | import Network.Minio.Data 33 | import Network.Minio.Errors 34 | import Network.Minio.S3API 35 | import Network.Minio.Utils 36 | 37 | -- | A data-type to represent the source data for an object. A 38 | -- file-path or a producer-conduit may be provided. 39 | -- 40 | -- For files, a size may be provided - this is useful in cases when 41 | -- the file size cannot be automatically determined or if only some 42 | -- prefix of the file is desired. 43 | -- 44 | -- For streams also, a size may be provided. This is useful to limit 45 | -- the input - if it is not provided, upload will continue until the 46 | -- stream ends or the object reaches `maxObjectSize` size. 47 | data ObjectData m 48 | = -- | Takes filepath and optional 49 | -- size. 50 | ODFile FilePath (Maybe Int64) 51 | | -- | Pass 52 | -- size 53 | -- (bytes) 54 | -- if 55 | -- known. 56 | ODStream (C.ConduitM () ByteString m ()) (Maybe Int64) 57 | 58 | -- | Put an object from ObjectData. This high-level API handles 59 | -- objects of all sizes, and even if the object size is unknown. 60 | putObjectInternal :: 61 | Bucket -> 62 | Object -> 63 | PutObjectOptions -> 64 | ObjectData Minio -> 65 | Minio ETag 66 | putObjectInternal b o opts (ODStream src sizeMay) = do 67 | case sizeMay of 68 | -- unable to get size, so assume non-seekable file 69 | Nothing -> sequentialMultipartUpload b o opts Nothing src 70 | -- got file size, so check for single/multipart upload 71 | Just size -> 72 | if 73 | | size <= 64 * oneMiB -> do 74 | bs <- C.runConduit $ src C..| takeC (fromIntegral size) C..| CB.sinkLbs 75 | putObjectSingle' b o (pooToHeaders opts) $ LBS.toStrict bs 76 | | size > maxObjectSize -> throwIO $ MErrVPutSizeExceeded size 77 | | otherwise -> sequentialMultipartUpload b o opts (Just size) src 78 | putObjectInternal b o opts (ODFile fp sizeMay) = do 79 | hResE <- withNewHandle fp $ \h -> 80 | liftA2 (,) (isHandleSeekable h) (getFileSize h) 81 | 82 | (isSeekable, handleSizeMay) <- 83 | either 84 | (const $ return (False, Nothing)) 85 | return 86 | hResE 87 | 88 | -- prefer given size to queried size. 89 | let finalSizeMay = listToMaybe $ catMaybes [sizeMay, handleSizeMay] 90 | 91 | case finalSizeMay of 92 | -- unable to get size, so assume non-seekable file 93 | Nothing -> sequentialMultipartUpload b o opts Nothing $ CB.sourceFile fp 94 | -- got file size, so check for single/multipart upload 95 | Just size -> 96 | if 97 | | size <= 64 * oneMiB -> 98 | either throwIO return 99 | =<< withNewHandle fp (\h -> putObjectSingle b o (pooToHeaders opts) h 0 size) 100 | | size > maxObjectSize -> throwIO $ MErrVPutSizeExceeded size 101 | | isSeekable -> parallelMultipartUpload b o opts fp size 102 | | otherwise -> 103 | sequentialMultipartUpload b o opts (Just size) $ 104 | CB.sourceFile fp 105 | 106 | parallelMultipartUpload :: 107 | Bucket -> 108 | Object -> 109 | PutObjectOptions -> 110 | FilePath -> 111 | Int64 -> 112 | Minio ETag 113 | parallelMultipartUpload b o opts filePath size = do 114 | -- get a new upload id. 115 | uploadId <- newMultipartUpload b o (pooToHeaders opts) 116 | 117 | let partSizeInfo = selectPartSizes size 118 | 119 | let threads = fromMaybe 10 $ pooNumThreads opts 120 | 121 | -- perform upload with 'threads' threads 122 | uploadedPartsE <- 123 | limitedMapConcurrently 124 | (fromIntegral threads) 125 | (uploadPart uploadId) 126 | partSizeInfo 127 | 128 | -- if there were any errors, rethrow exception. 129 | mapM_ throwIO $ lefts uploadedPartsE 130 | 131 | -- if we get here, all parts were successfully uploaded. 132 | completeMultipartUpload b o uploadId $ rights uploadedPartsE 133 | where 134 | uploadPart uploadId (partNum, offset, sz) = 135 | withNewHandle filePath $ \h -> do 136 | let payload = PayloadH h offset sz 137 | putObjectPart b o uploadId partNum [] payload 138 | 139 | -- | Upload multipart object from conduit source sequentially 140 | sequentialMultipartUpload :: 141 | Bucket -> 142 | Object -> 143 | PutObjectOptions -> 144 | Maybe Int64 -> 145 | C.ConduitM () ByteString Minio () -> 146 | Minio ETag 147 | sequentialMultipartUpload b o opts sizeMay src = do 148 | -- get a new upload id. 149 | uploadId <- newMultipartUpload b o (pooToHeaders opts) 150 | 151 | -- upload parts in loop 152 | let partSizes = selectPartSizes $ maybe maxObjectSize identity sizeMay 153 | (pnums, _, sizes) = List.unzip3 partSizes 154 | uploadedParts <- 155 | C.runConduit $ 156 | src 157 | C..| chunkBSConduit (map fromIntegral sizes) 158 | C..| CL.map PayloadBS 159 | C..| uploadPart' uploadId pnums 160 | C..| CC.sinkList 161 | 162 | -- complete multipart upload 163 | completeMultipartUpload b o uploadId uploadedParts 164 | where 165 | uploadPart' _ [] = return () 166 | uploadPart' uid (pn : pns) = do 167 | payloadMay <- C.await 168 | case payloadMay of 169 | Nothing -> return () 170 | Just payload -> do 171 | pinfo <- lift $ putObjectPart b o uid pn [] payload 172 | C.yield pinfo 173 | uploadPart' uid pns 174 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | Changelog 2 | ========== 3 | 4 | ## Version 1.7.0 -- Unreleased 5 | 6 | * Fix data type `EventMessage` to not export partial fields (#179) 7 | * Bump up min bound on time dep and fix deprecation warnings (#181) 8 | * Add `dev` flag to cabal for building with warnings as errors (#182) 9 | * Fix AWS region map (#185) 10 | * Fix XML generator tests (#187) 11 | * Add support for STS Assume Role API (#188) 12 | 13 | ### Breaking changes in 1.7.0 14 | 15 | * `Credentials` type has been removed. Use `CredentialValue` instead. 16 | * `Provider` type has been replaced with `CredentialLoader`. 17 | * `EventMessage` data type is updated. 18 | 19 | ## Version 1.6.0 20 | 21 | * HLint fixes - some types were changed to newtype (#173) 22 | * Fix XML generation test for S3 SELECT (#161) 23 | * Use region specific endpoints for AWS S3 in presigned Urls (#164) 24 | * Replace protolude with relude and build with GHC 9.0.2 (#168) 25 | * Support aeson 2 (#169) 26 | * CI updates and code formatting changes with ormolu 0.5.0.0 27 | 28 | ## Version 1.5.3 29 | 30 | * Fix windows build 31 | * Fix support for Yandex Storage (#147) 32 | * Fix for HEAD requests to S3/Minio (#155) 33 | * Bump up some dependencies, new code formatting, Github CI, example fixes and other minor improvements. 34 | 35 | ## Version 1.5.2 36 | 37 | * Fix region `us-west-2` for AWS S3 (#139) 38 | * Build examples in CI 39 | * Disable live-server tests by default, but run them in CI 40 | * Drop support for GHC 8.2.x 41 | 42 | ## Version 1.5.1 43 | 44 | * Add support for GHC 8.8 45 | 46 | ## Version 1.5.0 47 | 48 | * Switch to faster map data type - all previous usage of 49 | Data.Map.Strict and Data.Set is replaced with Data.HashMap.Strict 50 | and Data.HashSet. 51 | * Add `oiUserMetadata` to parse and return user metadata stored with 52 | an object. 53 | * Add `GetObjectResponse` data type for the value returned by 54 | `getObject`. It now contains parsed ObjectInfo along with the 55 | conduit of object bytes. 56 | 57 | ## Version 1.4.0 58 | 59 | * Expose runMinioRes and runMinioResWith (#129) 60 | * Improve Haddocks (#127) 61 | * Fix list objects APIs to return directory prefixes when run with 62 | recurse set to False (#126) 63 | * Use streaming signature for streaming payloads when on an insecure 64 | connection (#123) 65 | 66 | ## Version 1.3.1 67 | 68 | * Add TLS helpers to check if server uses TLS, and to disable 69 | certificate validation for easier testing (#121) 70 | 71 | ## Version 1.3.0 72 | 73 | * Retry requests that timeout using full-jitter backoff (#119) 74 | * Accept GetObjectOptions in statObject (#112) 75 | * Add encryption options to GetObjectOptions and PutObjectOptions (#111) 76 | * Add missing Haddock documentation (#110) 77 | * Add support for S3Select API (#108) 78 | * New travis with support for multiple GHCs (#106) 79 | * Fix region setting in presigned url functions (#107) 80 | 81 | ## Version 1.2.0 82 | 83 | * Export Provider and findFirst to look for credentials (#103) 84 | 85 | ## Version 1.1.0 86 | 87 | This version brings the following changes: 88 | 89 | * Adds experimental Admin APIs (#88, #91, #93, #94, #95, #100) 90 | * Adds support for using Google Compute Storage service when S3 91 | compatibility mode is enabled (#96, #99) 92 | 93 | This version also brings some breaking changes (via #101): 94 | 95 | * Adds IsString instance to load server address, and updates 96 | initialization API to be more user friendly 97 | * Drops usage of data-default package and exposes explicit default 98 | values for various types used in the library. 99 | 100 | ## Version 1.0.1 101 | 102 | This version brings the following (non-breaking) changes: 103 | 104 | * Remove dependency on text-format (#86) 105 | * Remove direct dependency on exceptions (#87) 106 | * Adds lower-bounds on dependencies. 107 | 108 | ## Version 1.0.0 109 | 110 | This new release changes the following APIs to add new capabilities: 111 | 112 | * Copy Object API now supports more options for source and destination (#73) 113 | * get/put Object functions now support a wider set of options via a 114 | separate settings parameter (#71, #72) 115 | * getBucketPolicy and setBucketPolicy APIs are added (#82) 116 | * The library now uses UnliftIO (#83) 117 | 118 | ## Version 0.3.2 119 | 120 | This release brings the following changes: 121 | 122 | * Add `removeIncompleteUpload` API (#49) 123 | * Add presigned operations APIs (#56) 124 | * Add presigned Post Policy API (#58) 125 | * Skip SHA256 checksum header for secure connections (#65) 126 | * Remove resuming capability in PutObject (#67) 127 | * Add ListObjectsV1 API support (#66) 128 | * Add Bucket Notification APIs (#59) 129 | * Reverse #54 - tests fix. 130 | 131 | ## Version 0.3.1 132 | 133 | This is a bug-fix release: 134 | 135 | * Fix concurrency bug in `limitedMapConcurrently` (#53) 136 | * Fix tests related to listing incomplete uploads to accommodate MinIO 137 | server's changed behaviour to not list incomplete uploads. Note that 138 | running these tests against AWS S3 are expected to fail. (#54) 139 | 140 | ## Version 0.3.0 141 | 142 | This release includes a breaking change: 143 | 144 | Users of the library need not call `runResourceT` explicitly after 145 | calling `runMinio`. This is now done, within the `runMinio` call 146 | making usage a bit simpler. 147 | 148 | Other changes: 149 | 150 | * Export ListUploadsResult and ListObjectsResult (#48) 151 | * Also take max-keys as an argument for listObjects and max-uploads 152 | for listIncompleteUploads. 153 | * Add bucket and object name validation (#45) 154 | * Add bucketExists and headBucket APIs (#42) 155 | 156 | ## Version 0.2.1 157 | 158 | * Update dependencies, and switch to Stackage LTS 8.5 159 | 160 | ## Version 0.2.0 161 | 162 | This is an interim release which brings some new features. However, 163 | the library is not complete and APIs may change. 164 | 165 | * Remove `listIncompleteParts` API and augment `listIncompleteUploads` 166 | API with information about aggregate size of parts uploaded. 167 | * Refactors error types and simpler error throwing/handling behaviour. 168 | * Add `removeObject` API to delete objects from the service. 169 | * Rename `Network.Minio.getService` to `Network.Minio.listBuckets`. 170 | * Add `docs/API.md` and examples directory with comprehensive 171 | documentation and examples of high-level APIs exported by the 172 | library. 173 | * Rename types: 174 | * Rename PartInfo -> PartTuple 175 | * Rename ListPartInfo -> ObjectPartInfo 176 | * Add a bucket region cache to avoid locating a bucket's region for 177 | every operation (mainly useful for AWS S3). 178 | * Add new `copyObject` API to perform server side object copying. 179 | * Rename `putObjectFromSource` API as `putObject`. 180 | * Separate out tests into two suites, one with a live-server and the 181 | other without any external dependencies. 182 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # MinIO Haskell Client SDK for Amazon S3 Compatible Cloud Storage [![CI](https://github.com/minio/minio-hs/actions/workflows/ci.yml/badge.svg)](https://github.com/minio/minio-hs/actions/workflows/ci.yml)[![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) 2 | 3 | The MinIO Haskell Client SDK provides simple APIs to access [MinIO](https://min.io) and any Amazon S3 compatible object storage. 4 | 5 | This guide assumes that you have a working [Haskell development environment](https://www.haskell.org/downloads/). 6 | 7 | ## Installation 8 | 9 | ### Add to your project 10 | 11 | Simply add `minio-hs` to your project's `.cabal` dependencies section or if you are using hpack, to your `package.yaml` file as usual. 12 | 13 | ### Try it out in a [REPL](https://en.wikipedia.org/wiki/Read%E2%80%93eval%E2%80%93print_loop) 14 | 15 | #### For a cabal based environment 16 | 17 | Download the library source and change to the extracted directory: 18 | 19 | ``` sh 20 | $ cabal get minio-hs 21 | $ cd minio-hs-1.6.0/ # directory name could be different 22 | ``` 23 | 24 | Then load the `ghci` REPL environment with the library and browse the available APIs: 25 | 26 | ``` sh 27 | $ cabal repl 28 | ghci> :browse Network.Minio 29 | ``` 30 | 31 | #### For a stack based environment 32 | 33 | From your home folder or any non-haskell project directory, just run: 34 | 35 | ```sh 36 | stack install minio-hs 37 | ``` 38 | 39 | Then start an interpreter session and browse the available APIs with: 40 | 41 | ```sh 42 | $ stack ghci 43 | > :browse Network.Minio 44 | ``` 45 | 46 | ## Examples 47 | 48 | The [examples](https://github.com/minio/minio-hs/tree/master/examples) folder contains many examples that you can try out and use to learn and to help with developing your own projects. 49 | 50 | ### Quick-Start Example - File Uploader 51 | 52 | This example program connects to a MinIO object storage server, makes a bucket on the server and then uploads a file to the bucket. 53 | 54 | We will use the MinIO server running at https://play.min.io in this example. Feel free to use this service for testing and development. Access credentials are present in the library and are open to the public. 55 | 56 | ### FileUploader.hs 57 | ``` haskell 58 | #!/usr/bin/env stack 59 | -- stack --resolver lts-14.11 runghc --package minio-hs --package optparse-applicative --package filepath 60 | 61 | -- 62 | -- MinIO Haskell SDK, (C) 2017-2019 MinIO, Inc. 63 | -- 64 | -- Licensed under the Apache License, Version 2.0 (the "License"); 65 | -- you may not use this file except in compliance with the License. 66 | -- You may obtain a copy of the License at 67 | -- 68 | -- http://www.apache.org/licenses/LICENSE-2.0 69 | -- 70 | -- Unless required by applicable law or agreed to in writing, software 71 | -- distributed under the License is distributed on an "AS IS" BASIS, 72 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 73 | -- See the License for the specific language governing permissions and 74 | -- limitations under the License. 75 | -- 76 | 77 | 78 | {-# LANGUAGE OverloadedStrings #-} 79 | {-# LANGUAGE ScopedTypeVariables #-} 80 | import Network.Minio 81 | 82 | import Data.Monoid ((<>)) 83 | import Data.Text (pack) 84 | import Options.Applicative 85 | import System.FilePath.Posix 86 | import UnliftIO (throwIO, try) 87 | 88 | import Prelude 89 | 90 | -- | The following example uses minio's play server at 91 | -- https://play.min.io. The endpoint and associated 92 | -- credentials are provided via the libary constant, 93 | -- 94 | -- > minioPlayCI :: ConnectInfo 95 | -- 96 | 97 | -- optparse-applicative package based command-line parsing. 98 | fileNameArgs :: Parser FilePath 99 | fileNameArgs = strArgument 100 | (metavar "FILENAME" 101 | <> help "Name of file to upload to AWS S3 or a MinIO server") 102 | 103 | cmdParser = info 104 | (helper <*> fileNameArgs) 105 | (fullDesc 106 | <> progDesc "FileUploader" 107 | <> header 108 | "FileUploader - a simple file-uploader program using minio-hs") 109 | 110 | main :: IO () 111 | main = do 112 | let bucket = "my-bucket" 113 | 114 | -- Parse command line argument 115 | filepath <- execParser cmdParser 116 | let object = pack $ takeBaseName filepath 117 | 118 | res <- runMinio minioPlayCI $ do 119 | -- Make a bucket; catch bucket already exists exception if thrown. 120 | bErr <- try $ makeBucket bucket Nothing 121 | 122 | -- If the bucket already exists, we would get a specific 123 | -- `ServiceErr` exception thrown. 124 | case bErr of 125 | Left BucketAlreadyOwnedByYou -> return () 126 | Left e -> throwIO e 127 | Right _ -> return () 128 | 129 | -- Upload filepath to bucket; object name is derived from filepath. 130 | fPutObject bucket object filepath defaultPutObjectOptions 131 | 132 | case res of 133 | Left e -> putStrLn $ "file upload failed due to " ++ show e 134 | Right () -> putStrLn "file upload succeeded." 135 | ``` 136 | 137 | ### Run FileUploader 138 | 139 | ``` sh 140 | ./FileUploader.hs "path/to/my/file" 141 | 142 | ``` 143 | 144 | ## Contribute 145 | 146 | [Contributors Guide](https://github.com/minio/minio-hs/blob/master/CONTRIBUTING.md) 147 | 148 | ### Development 149 | 150 | #### Download the source 151 | 152 | ```sh 153 | $ git clone https://github.com/minio/minio-hs.git 154 | $ cd minio-hs/ 155 | ``` 156 | 157 | #### Build the package: 158 | 159 | With `cabal`: 160 | 161 | ```sh 162 | $ # Configure cabal for development enabling all optional flags defined by the package. 163 | $ cabal configure --enable-tests --test-show-details=direct -fexamples -fdev -flive-test 164 | $ cabal build 165 | ``` 166 | 167 | With `stack`: 168 | 169 | ``` sh 170 | $ stack build --test --no-run-tests --flag minio-hs:live-test --flag minio-hs:dev --flag minio-hs:examples 171 | ``` 172 | #### Running tests: 173 | 174 | A section of the tests use the remote MinIO Play server at `https://play.min.io` 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` with the credentials `access_key=minio` and `secret_key=minio123`, just set the environment `MINIO_LOCAL` to any value (and unset it to switch back to Play). 175 | 176 | With `cabal`: 177 | 178 | ```sh 179 | $ export MINIO_LOCAL=1 # to run live tests against local MinIO server 180 | $ cabal test 181 | ``` 182 | 183 | With `stack`: 184 | 185 | ``` sh 186 | $ export MINIO_LOCAL=1 # to run live tests against local MinIO server 187 | stack test --flag minio-hs:live-test --flag minio-hs:dev 188 | ``` 189 | 190 | This will run all the test suites. 191 | 192 | #### Building documentation: 193 | 194 | ```sh 195 | $ cabal haddock 196 | $ # OR 197 | $ stack haddock 198 | ``` 199 | -------------------------------------------------------------------------------- /src/Network/Minio/XmlGenerator.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.XmlGenerator 18 | ( mkCreateBucketConfig, 19 | mkCompleteMultipartUploadRequest, 20 | mkPutNotificationRequest, 21 | mkSelectRequest, 22 | ) 23 | where 24 | 25 | import qualified Data.ByteString.Lazy as LBS 26 | import qualified Data.Text as T 27 | import Network.Minio.Data 28 | import Network.Minio.XmlCommon 29 | import Text.XML 30 | 31 | -- | Create a bucketConfig request body XML 32 | mkCreateBucketConfig :: Text -> Region -> ByteString 33 | mkCreateBucketConfig ns location = LBS.toStrict $ renderLBS def bucketConfig 34 | where 35 | s3Element n = Element (s3Name ns n) mempty 36 | root = 37 | s3Element 38 | "CreateBucketConfiguration" 39 | [ NodeElement $ 40 | s3Element 41 | "LocationConstraint" 42 | [NodeContent location] 43 | ] 44 | bucketConfig = Document (Prologue [] Nothing []) root [] 45 | 46 | -- | Create a completeMultipartUpload request body XML 47 | mkCompleteMultipartUploadRequest :: [PartTuple] -> ByteString 48 | mkCompleteMultipartUploadRequest partInfo = 49 | LBS.toStrict $ renderLBS def cmur 50 | where 51 | root = 52 | Element "CompleteMultipartUpload" mempty $ 53 | map (NodeElement . mkPart) partInfo 54 | mkPart (n, etag) = 55 | Element 56 | "Part" 57 | mempty 58 | [ NodeElement $ 59 | Element 60 | "PartNumber" 61 | mempty 62 | [NodeContent $ T.pack $ show n], 63 | NodeElement $ 64 | Element 65 | "ETag" 66 | mempty 67 | [NodeContent etag] 68 | ] 69 | cmur = Document (Prologue [] Nothing []) root [] 70 | 71 | -- Simplified XML representation without element attributes. 72 | data XNode 73 | = XNode Text [XNode] 74 | | XLeaf Text Text 75 | deriving stock (Eq, Show) 76 | 77 | toXML :: Text -> XNode -> ByteString 78 | toXML ns node = 79 | LBS.toStrict $ 80 | renderLBS def $ 81 | Document (Prologue [] Nothing []) (xmlNode node) [] 82 | where 83 | xmlNode :: XNode -> Element 84 | xmlNode (XNode name nodes) = 85 | Element (s3Name ns name) mempty $ 86 | map (NodeElement . xmlNode) nodes 87 | xmlNode (XLeaf name content) = 88 | Element 89 | (s3Name ns name) 90 | mempty 91 | [NodeContent content] 92 | 93 | class ToXNode a where 94 | toXNode :: a -> XNode 95 | 96 | instance ToXNode Event where 97 | toXNode = XLeaf "Event" . toText 98 | 99 | instance ToXNode Notification where 100 | toXNode (Notification qc tc lc) = 101 | XNode "NotificationConfiguration" $ 102 | map (toXNodesWithArnName "QueueConfiguration" "Queue") qc 103 | ++ map (toXNodesWithArnName "TopicConfiguration" "Topic") tc 104 | ++ map (toXNodesWithArnName "CloudFunctionConfiguration" "CloudFunction") lc 105 | 106 | toXNodesWithArnName :: Text -> Text -> NotificationConfig -> XNode 107 | toXNodesWithArnName eltName arnName (NotificationConfig itemId arn events fRule) = 108 | XNode eltName $ 109 | [XLeaf "Id" itemId, XLeaf arnName arn] 110 | ++ map toXNode events 111 | ++ [toXNode fRule] 112 | 113 | instance ToXNode Filter where 114 | toXNode (Filter (FilterKey (FilterRules rules))) = 115 | XNode "Filter" [XNode "S3Key" (map getFRXNode rules)] 116 | 117 | getFRXNode :: FilterRule -> XNode 118 | getFRXNode (FilterRule n v) = 119 | XNode 120 | "FilterRule" 121 | [ XLeaf "Name" n, 122 | XLeaf "Value" v 123 | ] 124 | 125 | mkPutNotificationRequest :: Text -> Notification -> ByteString 126 | mkPutNotificationRequest ns = toXML ns . toXNode 127 | 128 | mkSelectRequest :: SelectRequest -> ByteString 129 | mkSelectRequest r = LBS.toStrict $ renderLBS def sr 130 | where 131 | sr = Document (Prologue [] Nothing []) root [] 132 | root = 133 | Element "SelectRequest" mempty $ 134 | [ NodeElement 135 | ( Element 136 | "Expression" 137 | mempty 138 | [NodeContent $ srExpression r] 139 | ), 140 | NodeElement 141 | ( Element 142 | "ExpressionType" 143 | mempty 144 | [NodeContent $ show $ srExpressionType r] 145 | ), 146 | NodeElement 147 | ( Element "InputSerialization" mempty $ 148 | inputSerializationNodes $ 149 | srInputSerialization r 150 | ), 151 | NodeElement 152 | ( Element "OutputSerialization" mempty $ 153 | outputSerializationNodes $ 154 | srOutputSerialization r 155 | ) 156 | ] 157 | ++ maybe [] reqProgElem (srRequestProgressEnabled r) 158 | reqProgElem enabled = 159 | [ NodeElement 160 | ( Element 161 | "RequestProgress" 162 | mempty 163 | [ NodeElement 164 | ( Element 165 | "Enabled" 166 | mempty 167 | [ NodeContent 168 | (if enabled then "TRUE" else "FALSE") 169 | ] 170 | ) 171 | ] 172 | ) 173 | ] 174 | inputSerializationNodes is = 175 | comprTypeNode (isCompressionType is) 176 | ++ [NodeElement $ formatNode (isFormatInfo is)] 177 | comprTypeNode (Just c) = 178 | [ NodeElement $ 179 | Element 180 | "CompressionType" 181 | mempty 182 | [ NodeContent $ case c of 183 | CompressionTypeNone -> "NONE" 184 | CompressionTypeGzip -> "GZIP" 185 | CompressionTypeBzip2 -> "BZIP2" 186 | ] 187 | ] 188 | comprTypeNode Nothing = [] 189 | kvElement (k, v) = Element (Name k Nothing Nothing) mempty [NodeContent v] 190 | formatNode (InputFormatCSV c) = 191 | Element 192 | "CSV" 193 | mempty 194 | (map (NodeElement . kvElement) (csvPropsList c)) 195 | formatNode (InputFormatJSON p) = 196 | Element 197 | "JSON" 198 | mempty 199 | [ NodeElement 200 | ( Element 201 | "Type" 202 | mempty 203 | [ NodeContent $ case jsonipType p of 204 | JSONTypeDocument -> "DOCUMENT" 205 | JSONTypeLines -> "LINES" 206 | ] 207 | ) 208 | ] 209 | formatNode InputFormatParquet = Element "Parquet" mempty [] 210 | outputSerializationNodes (OutputSerializationJSON j) = 211 | [ NodeElement 212 | ( Element "JSON" mempty $ 213 | rdElem $ 214 | jsonopRecordDelimiter j 215 | ) 216 | ] 217 | outputSerializationNodes (OutputSerializationCSV c) = 218 | [ NodeElement $ 219 | Element 220 | "CSV" 221 | mempty 222 | (map (NodeElement . kvElement) (csvPropsList c)) 223 | ] 224 | rdElem Nothing = [] 225 | rdElem (Just t) = 226 | [ NodeElement $ 227 | Element 228 | "RecordDelimiter" 229 | mempty 230 | [NodeContent t] 231 | ] 232 | -------------------------------------------------------------------------------- /test/Network/Minio/XmlGenerator/Test.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | {-# LANGUAGE QuasiQuotes #-} 17 | 18 | module Network.Minio.XmlGenerator.Test 19 | ( xmlGeneratorTests, 20 | ) 21 | where 22 | 23 | import qualified Data.ByteString.Lazy as LBS 24 | import Lib.Prelude 25 | import Network.Minio.Data 26 | import Network.Minio.TestHelpers 27 | import Network.Minio.XmlGenerator 28 | import Network.Minio.XmlParser (parseNotification) 29 | import Test.Tasty 30 | import Test.Tasty.HUnit 31 | import Text.RawString.QQ (r) 32 | import Text.XML (def, parseLBS) 33 | 34 | xmlGeneratorTests :: TestTree 35 | xmlGeneratorTests = 36 | testGroup 37 | "XML Generator Tests" 38 | [ testCase "Test mkCreateBucketConfig" testMkCreateBucketConfig, 39 | testCase "Test mkCompleteMultipartUploadRequest" testMkCompleteMultipartUploadRequest, 40 | testCase "Test mkPutNotificationRequest" testMkPutNotificationRequest, 41 | testCase "Test mkSelectRequest" testMkSelectRequest 42 | ] 43 | 44 | testMkCreateBucketConfig :: Assertion 45 | testMkCreateBucketConfig = do 46 | let ns = "http://s3.amazonaws.com/doc/2006-03-01/" 47 | assertEqual "CreateBucketConfiguration xml should match: " expected $ 48 | mkCreateBucketConfig ns "EU" 49 | where 50 | expected = 51 | "\ 52 | \\ 53 | \EU\ 54 | \" 55 | 56 | testMkCompleteMultipartUploadRequest :: Assertion 57 | testMkCompleteMultipartUploadRequest = 58 | assertEqual "completeMultipartUpload xml should match: " expected $ 59 | mkCompleteMultipartUploadRequest [(1, "abc")] 60 | where 61 | expected = 62 | "\ 63 | \\ 64 | \\ 65 | \1abc\ 66 | \\ 67 | \" 68 | 69 | testMkPutNotificationRequest :: Assertion 70 | testMkPutNotificationRequest = 71 | forM_ cases $ \val -> do 72 | let ns = "http://s3.amazonaws.com/doc/2006-03-01/" 73 | result = fromStrictBS $ mkPutNotificationRequest ns val 74 | ntf <- runExceptT $ runTestNS $ parseNotification result 75 | either 76 | (\_ -> assertFailure "XML Parse Error!") 77 | (@?= val) 78 | ntf 79 | where 80 | cases = 81 | [ Notification 82 | [] 83 | [ NotificationConfig 84 | "YjVkM2Y0YmUtNGI3NC00ZjQyLWEwNGItNDIyYWUxY2I0N2M4" 85 | "arn:aws:sns:us-east-1:account-id:s3notificationtopic2" 86 | [ReducedRedundancyLostObject, ObjectCreated] 87 | defaultFilter 88 | ] 89 | [], 90 | Notification 91 | [ NotificationConfig 92 | "1" 93 | "arn:aws:sqs:us-west-2:444455556666:s3notificationqueue" 94 | [ObjectCreatedPut] 95 | ( Filter $ 96 | FilterKey $ 97 | FilterRules 98 | [ FilterRule "prefix" "images/", 99 | FilterRule "suffix" ".jpg" 100 | ] 101 | ), 102 | NotificationConfig 103 | "" 104 | "arn:aws:sqs:us-east-1:356671443308:s3notificationqueue" 105 | [ObjectCreated] 106 | defaultFilter 107 | ] 108 | [ NotificationConfig 109 | "" 110 | "arn:aws:sns:us-east-1:356671443308:s3notificationtopic2" 111 | [ReducedRedundancyLostObject] 112 | defaultFilter 113 | ] 114 | [ NotificationConfig 115 | "ObjectCreatedEvents" 116 | "arn:aws:lambda:us-west-2:35667example:function:CreateThumbnail" 117 | [ObjectCreated] 118 | defaultFilter 119 | ] 120 | ] 121 | 122 | testMkSelectRequest :: Assertion 123 | testMkSelectRequest = mapM_ assertFn cases 124 | where 125 | assertFn (a, b) = 126 | let generatedReqDoc = parseLBS def $ LBS.fromStrict $ mkSelectRequest a 127 | expectedReqDoc = parseLBS def $ LBS.fromStrict b 128 | in case (generatedReqDoc, expectedReqDoc) of 129 | (Right genDoc, Right expDoc) -> assertEqual "selectRequest XML should match: " expDoc genDoc 130 | (Left err, _) -> assertFailure $ "Generated selectRequest failed to parse as XML" ++ show err 131 | (_, Left err) -> assertFailure $ "Expected selectRequest failed to parse as XML" ++ show err 132 | cases = 133 | [ ( SelectRequest 134 | "Select * from S3Object" 135 | SQL 136 | ( InputSerialization 137 | (Just CompressionTypeGzip) 138 | ( InputFormatCSV $ 139 | fileHeaderInfo FileHeaderIgnore 140 | <> recordDelimiter "\n" 141 | <> fieldDelimiter "," 142 | <> quoteCharacter "\"" 143 | <> quoteEscapeCharacter "\"" 144 | ) 145 | ) 146 | ( OutputSerializationCSV $ 147 | quoteFields QuoteFieldsAsNeeded 148 | <> recordDelimiter "\n" 149 | <> fieldDelimiter "," 150 | <> quoteCharacter "\"" 151 | <> quoteEscapeCharacter "\"" 152 | ) 153 | (Just False), 154 | [r|Select * from S3ObjectSQLGZIP,IGNORE"" 155 | ,""ASNEEDED 156 | FALSE|] 157 | ), 158 | ( setRequestProgressEnabled False $ 159 | setInputCompressionType CompressionTypeGzip $ 160 | selectRequest 161 | "Select * from S3Object" 162 | documentJsonInput 163 | (outputJSONFromRecordDelimiter "\n"), 164 | [r|Select * from S3ObjectSQLGZIPDOCUMENT 165 | FALSE|] 166 | ), 167 | ( setRequestProgressEnabled False $ 168 | setInputCompressionType CompressionTypeNone $ 169 | selectRequest 170 | "Select * from S3Object" 171 | defaultParquetInput 172 | ( outputCSVFromProps $ 173 | quoteFields QuoteFieldsAsNeeded 174 | <> recordDelimiter "\n" 175 | <> fieldDelimiter "," 176 | <> quoteCharacter "\"" 177 | <> quoteEscapeCharacter "\"" 178 | ), 179 | [r|Select * from S3ObjectSQLNONE,""ASNEEDED 180 | FALSE|] 181 | ) 182 | ] 183 | -------------------------------------------------------------------------------- /src/Network/Minio/XmlParser.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.XmlParser 18 | ( parseListBuckets, 19 | parseLocation, 20 | parseNewMultipartUpload, 21 | parseCompleteMultipartUploadResponse, 22 | parseCopyObjectResponse, 23 | parseListObjectsResponse, 24 | parseListObjectsV1Response, 25 | parseListUploadsResponse, 26 | parseListPartsResponse, 27 | parseErrResponse, 28 | parseNotification, 29 | parseSelectProgress, 30 | ) 31 | where 32 | 33 | import qualified Data.ByteString.Lazy as LB 34 | import qualified Data.HashMap.Strict as H 35 | import Data.List (zip4, zip6) 36 | import qualified Data.Text as T 37 | import Data.Time 38 | import Network.Minio.Data 39 | import Network.Minio.XmlCommon 40 | import Text.XML.Cursor hiding (bool) 41 | 42 | -- | Parse the response XML of a list buckets call. 43 | parseListBuckets :: (MonadReader env m, HasSvcNamespace env, MonadIO m) => LByteString -> m [BucketInfo] 44 | parseListBuckets xmldata = do 45 | r <- parseRoot xmldata 46 | ns <- asks getSvcNamespace 47 | let s3Elem' = s3Elem ns 48 | names = r $// s3Elem' "Bucket" &// s3Elem' "Name" &/ content 49 | timeStrings = r $// s3Elem' "Bucket" &// s3Elem' "CreationDate" &/ content 50 | 51 | times <- mapM parseS3XMLTime timeStrings 52 | return $ zipWith BucketInfo names times 53 | 54 | -- | Parse the response XML of a location request. 55 | parseLocation :: (MonadIO m) => LByteString -> m Region 56 | parseLocation xmldata = do 57 | r <- parseRoot xmldata 58 | let region = T.concat $ r $/ content 59 | return $ bool "us-east-1" region $ region /= "" 60 | 61 | -- | Parse the response XML of an newMultipartUpload call. 62 | parseNewMultipartUpload :: (MonadReader env m, HasSvcNamespace env, MonadIO m) => LByteString -> m UploadId 63 | parseNewMultipartUpload xmldata = do 64 | r <- parseRoot xmldata 65 | ns <- asks getSvcNamespace 66 | let s3Elem' = s3Elem ns 67 | return $ T.concat $ r $// s3Elem' "UploadId" &/ content 68 | 69 | -- | Parse the response XML of completeMultipartUpload call. 70 | parseCompleteMultipartUploadResponse :: (MonadReader env m, HasSvcNamespace env, MonadIO m) => LByteString -> m ETag 71 | parseCompleteMultipartUploadResponse xmldata = do 72 | r <- parseRoot xmldata 73 | ns <- asks getSvcNamespace 74 | let s3Elem' = s3Elem ns 75 | return $ T.concat $ r $// s3Elem' "ETag" &/ content 76 | 77 | -- | Parse the response XML of copyObject and copyObjectPart 78 | parseCopyObjectResponse :: (MonadReader env m, HasSvcNamespace env, MonadIO m) => LByteString -> m (ETag, UTCTime) 79 | parseCopyObjectResponse xmldata = do 80 | r <- parseRoot xmldata 81 | ns <- asks getSvcNamespace 82 | let s3Elem' = s3Elem ns 83 | mtimeStr = T.concat $ r $// s3Elem' "LastModified" &/ content 84 | 85 | mtime <- parseS3XMLTime mtimeStr 86 | return (T.concat $ r $// s3Elem' "ETag" &/ content, mtime) 87 | 88 | -- | Parse the response XML of a list objects v1 call. 89 | parseListObjectsV1Response :: 90 | (MonadReader env m, HasSvcNamespace env, MonadIO m) => 91 | LByteString -> 92 | m ListObjectsV1Result 93 | parseListObjectsV1Response xmldata = do 94 | r <- parseRoot xmldata 95 | ns <- asks getSvcNamespace 96 | let s3Elem' = s3Elem ns 97 | hasMore = ["true"] == (r $/ s3Elem' "IsTruncated" &/ content) 98 | nextMarker = listToMaybe $ r $/ s3Elem' "NextMarker" &/ content 99 | prefixes = r $/ s3Elem' "CommonPrefixes" &/ s3Elem' "Prefix" &/ content 100 | keys = r $/ s3Elem' "Contents" &/ s3Elem' "Key" &/ content 101 | modTimeStr = r $/ s3Elem' "Contents" &/ s3Elem' "LastModified" &/ content 102 | etagsList = r $/ s3Elem' "Contents" &/ s3Elem' "ETag" &/ content 103 | -- if response xml contains empty etag response fill them with as 104 | -- many empty Text for the zip4 below to work as intended. 105 | etags = etagsList ++ repeat "" 106 | sizeStr = r $/ s3Elem' "Contents" &/ s3Elem' "Size" &/ content 107 | 108 | modTimes <- mapM parseS3XMLTime modTimeStr 109 | sizes <- parseDecimals sizeStr 110 | 111 | let objects = 112 | map (uncurry6 ObjectInfo) $ 113 | zip6 keys modTimes etags sizes (repeat H.empty) (repeat H.empty) 114 | 115 | return $ ListObjectsV1Result hasMore nextMarker objects prefixes 116 | 117 | -- | Parse the response XML of a list objects call. 118 | parseListObjectsResponse :: (MonadReader env m, HasSvcNamespace env, MonadIO m) => LByteString -> m ListObjectsResult 119 | parseListObjectsResponse xmldata = do 120 | r <- parseRoot xmldata 121 | ns <- asks getSvcNamespace 122 | let s3Elem' = s3Elem ns 123 | hasMore = ["true"] == (r $/ s3Elem' "IsTruncated" &/ content) 124 | nextToken = listToMaybe $ r $/ s3Elem' "NextContinuationToken" &/ content 125 | prefixes = r $/ s3Elem' "CommonPrefixes" &/ s3Elem' "Prefix" &/ content 126 | keys = r $/ s3Elem' "Contents" &/ s3Elem' "Key" &/ content 127 | modTimeStr = r $/ s3Elem' "Contents" &/ s3Elem' "LastModified" &/ content 128 | etagsList = r $/ s3Elem' "Contents" &/ s3Elem' "ETag" &/ content 129 | -- if response xml contains empty etag response fill them with as 130 | -- many empty Text for the zip4 below to work as intended. 131 | etags = etagsList ++ repeat "" 132 | sizeStr = r $/ s3Elem' "Contents" &/ s3Elem' "Size" &/ content 133 | 134 | modTimes <- mapM parseS3XMLTime modTimeStr 135 | sizes <- parseDecimals sizeStr 136 | 137 | let objects = 138 | map (uncurry6 ObjectInfo) $ 139 | zip6 keys modTimes etags sizes (repeat H.empty) (repeat H.empty) 140 | 141 | return $ ListObjectsResult hasMore nextToken objects prefixes 142 | 143 | -- | Parse the response XML of a list incomplete multipart upload call. 144 | parseListUploadsResponse :: (MonadReader env m, HasSvcNamespace env, MonadIO m) => LByteString -> m ListUploadsResult 145 | parseListUploadsResponse xmldata = do 146 | r <- parseRoot xmldata 147 | ns <- asks getSvcNamespace 148 | let s3Elem' = s3Elem ns 149 | hasMore = ["true"] == (r $/ s3Elem' "IsTruncated" &/ content) 150 | prefixes = r $/ s3Elem' "CommonPrefixes" &/ s3Elem' "Prefix" &/ content 151 | nextKey = listToMaybe $ r $/ s3Elem' "NextKeyMarker" &/ content 152 | nextUpload = listToMaybe $ r $/ s3Elem' "NextUploadIdMarker" &/ content 153 | uploadKeys = r $/ s3Elem' "Upload" &/ s3Elem' "Key" &/ content 154 | uploadIds = r $/ s3Elem' "Upload" &/ s3Elem' "UploadId" &/ content 155 | uploadInitTimeStr = r $/ s3Elem' "Upload" &/ s3Elem' "Initiated" &/ content 156 | 157 | uploadInitTimes <- mapM parseS3XMLTime uploadInitTimeStr 158 | 159 | let uploads = zip3 uploadKeys uploadIds uploadInitTimes 160 | 161 | return $ ListUploadsResult hasMore nextKey nextUpload uploads prefixes 162 | 163 | parseListPartsResponse :: (MonadReader env m, HasSvcNamespace env, MonadIO m) => LByteString -> m ListPartsResult 164 | parseListPartsResponse xmldata = do 165 | r <- parseRoot xmldata 166 | ns <- asks getSvcNamespace 167 | let s3Elem' = s3Elem ns 168 | hasMore = ["true"] == (r $/ s3Elem' "IsTruncated" &/ content) 169 | nextPartNumStr = listToMaybe $ r $/ s3Elem' "NextPartNumberMarker" &/ content 170 | partNumberStr = r $/ s3Elem' "Part" &/ s3Elem' "PartNumber" &/ content 171 | partModTimeStr = r $/ s3Elem' "Part" &/ s3Elem' "LastModified" &/ content 172 | partETags = r $/ s3Elem' "Part" &/ s3Elem' "ETag" &/ content 173 | partSizeStr = r $/ s3Elem' "Part" &/ s3Elem' "Size" &/ content 174 | 175 | partModTimes <- mapM parseS3XMLTime partModTimeStr 176 | partSizes <- parseDecimals partSizeStr 177 | partNumbers <- parseDecimals partNumberStr 178 | nextPartNum <- parseDecimals $ maybeToList nextPartNumStr 179 | 180 | let partInfos = 181 | map (uncurry4 ObjectPartInfo) $ 182 | zip4 partNumbers partETags partSizes partModTimes 183 | 184 | return $ ListPartsResult hasMore (listToMaybe nextPartNum) partInfos 185 | 186 | parseNotification :: (MonadReader env m, HasSvcNamespace env, MonadIO m) => LByteString -> m Notification 187 | parseNotification xmldata = do 188 | r <- parseRoot xmldata 189 | ns <- asks getSvcNamespace 190 | let s3Elem' = s3Elem ns 191 | qcfg = map node $ r $/ s3Elem' "QueueConfiguration" 192 | tcfg = map node $ r $/ s3Elem' "TopicConfiguration" 193 | lcfg = map node $ r $/ s3Elem' "CloudFunctionConfiguration" 194 | Notification 195 | <$> mapM (parseNode ns "Queue") qcfg 196 | <*> mapM (parseNode ns "Topic") tcfg 197 | <*> mapM (parseNode ns "CloudFunction") lcfg 198 | where 199 | getFilterRule ns c = 200 | let name = T.concat $ c $/ s3Elem ns "Name" &/ content 201 | value = T.concat $ c $/ s3Elem ns "Value" &/ content 202 | in FilterRule name value 203 | parseNode ns arnName nodeData = do 204 | let c = fromNode nodeData 205 | itemId = T.concat $ c $/ s3Elem ns "Id" &/ content 206 | arn = T.concat $ c $/ s3Elem ns arnName &/ content 207 | events = mapMaybe textToEvent (c $/ s3Elem ns "Event" &/ content) 208 | rules = 209 | c 210 | $/ s3Elem ns "Filter" 211 | &/ s3Elem ns "S3Key" 212 | &/ s3Elem ns "FilterRule" 213 | &| getFilterRule ns 214 | return $ 215 | NotificationConfig 216 | itemId 217 | arn 218 | events 219 | (Filter $ FilterKey $ FilterRules rules) 220 | 221 | parseSelectProgress :: (MonadIO m) => ByteString -> m Progress 222 | parseSelectProgress xmldata = do 223 | r <- parseRoot $ LB.fromStrict xmldata 224 | let bScanned = T.concat $ r $/ element "BytesScanned" &/ content 225 | bProcessed = T.concat $ r $/ element "BytesProcessed" &/ content 226 | bReturned = T.concat $ r $/ element "BytesReturned" &/ content 227 | Progress 228 | <$> parseDecimal bScanned 229 | <*> parseDecimal bProcessed 230 | <*> parseDecimal bReturned 231 | -------------------------------------------------------------------------------- /src/Network/Minio.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | -- | 18 | -- Module: Network.Minio 19 | -- Copyright: (c) 2017-2023 MinIO Dev Team 20 | -- License: Apache 2.0 21 | -- Maintainer: MinIO Dev Team 22 | -- 23 | -- Types and functions to conveniently access S3 compatible object 24 | -- storage servers like MinIO. 25 | module Network.Minio 26 | ( -- * Credentials 27 | CredentialValue (..), 28 | credentialValueText, 29 | AccessKey (..), 30 | SecretKey (..), 31 | SessionToken (..), 32 | 33 | -- ** Credential Loaders 34 | 35 | -- | Run actions that retrieve 'CredentialValue's from the environment or 36 | -- files or other custom sources. 37 | CredentialLoader, 38 | fromAWSConfigFile, 39 | fromAWSEnv, 40 | fromMinioEnv, 41 | findFirst, 42 | 43 | -- * Connecting to object storage 44 | ConnectInfo, 45 | setRegion, 46 | setCreds, 47 | setCredsFrom, 48 | isConnectInfoSecure, 49 | disableTLSCertValidation, 50 | MinioConn, 51 | mkMinioConn, 52 | 53 | -- ** Connection helpers 54 | 55 | -- | These are helpers to construct 'ConnectInfo' values for common 56 | -- cases. 57 | minioPlayCI, 58 | awsCI, 59 | gcsCI, 60 | 61 | -- ** STS Credential types 62 | STSAssumeRole (..), 63 | STSAssumeRoleOptions (..), 64 | defaultSTSAssumeRoleOptions, 65 | requestSTSCredential, 66 | setSTSCredential, 67 | ExpiryTime (..), 68 | STSCredentialProvider, 69 | 70 | -- * Minio Monad 71 | 72 | ---------------- 73 | 74 | -- | The Minio Monad provides connection-reuse, bucket-location 75 | -- caching, resource management and simpler error handling 76 | -- functionality. All actions on object storage are performed within 77 | -- this Monad. 78 | Minio, 79 | runMinioWith, 80 | runMinio, 81 | runMinioResWith, 82 | runMinioRes, 83 | 84 | -- * Bucket Operations 85 | 86 | -- ** Creation, removal and querying 87 | Bucket, 88 | makeBucket, 89 | removeBucket, 90 | bucketExists, 91 | Region, 92 | getLocation, 93 | 94 | -- ** Listing buckets 95 | BucketInfo (..), 96 | listBuckets, 97 | 98 | -- ** Listing objects 99 | listObjects, 100 | listObjectsV1, 101 | ListItem (..), 102 | ObjectInfo, 103 | oiObject, 104 | oiModTime, 105 | oiETag, 106 | oiSize, 107 | oiUserMetadata, 108 | oiMetadata, 109 | 110 | -- ** Listing incomplete uploads 111 | listIncompleteUploads, 112 | UploadId, 113 | UploadInfo (..), 114 | listIncompleteParts, 115 | ObjectPartInfo (..), 116 | 117 | -- ** Bucket Notifications 118 | getBucketNotification, 119 | putBucketNotification, 120 | removeAllBucketNotification, 121 | Notification (..), 122 | defaultNotification, 123 | NotificationConfig (..), 124 | Arn, 125 | Event (..), 126 | Filter (..), 127 | defaultFilter, 128 | FilterKey (..), 129 | defaultFilterKey, 130 | FilterRules (..), 131 | defaultFilterRules, 132 | FilterRule (..), 133 | 134 | -- * Object Operations 135 | Object, 136 | 137 | -- ** File-based operations 138 | fGetObject, 139 | fPutObject, 140 | 141 | -- ** Conduit-based streaming operations 142 | putObject, 143 | PutObjectOptions, 144 | defaultPutObjectOptions, 145 | pooContentType, 146 | pooContentEncoding, 147 | pooContentDisposition, 148 | pooContentLanguage, 149 | pooCacheControl, 150 | pooStorageClass, 151 | pooUserMetadata, 152 | pooNumThreads, 153 | pooSSE, 154 | getObject, 155 | GetObjectOptions, 156 | defaultGetObjectOptions, 157 | gooRange, 158 | gooIfMatch, 159 | gooIfNoneMatch, 160 | gooIfModifiedSince, 161 | gooIfUnmodifiedSince, 162 | gooSSECKey, 163 | GetObjectResponse, 164 | gorObjectInfo, 165 | gorObjectStream, 166 | 167 | -- ** Server-side object copying 168 | copyObject, 169 | SourceInfo, 170 | defaultSourceInfo, 171 | srcBucket, 172 | srcObject, 173 | srcRange, 174 | srcIfMatch, 175 | srcIfNoneMatch, 176 | srcIfModifiedSince, 177 | srcIfUnmodifiedSince, 178 | DestinationInfo, 179 | defaultDestinationInfo, 180 | dstBucket, 181 | dstObject, 182 | 183 | -- ** Querying object info 184 | statObject, 185 | 186 | -- ** Object removal operations 187 | removeObject, 188 | removeIncompleteUpload, 189 | 190 | -- ** Select Object Content with SQL 191 | module Network.Minio.SelectAPI, 192 | 193 | -- * Server-Side Encryption Helpers 194 | mkSSECKey, 195 | SSECKey, 196 | SSE (..), 197 | 198 | -- * Presigned Operations 199 | presignedPutObjectUrl, 200 | presignedGetObjectUrl, 201 | presignedHeadObjectUrl, 202 | UrlExpiry, 203 | 204 | -- ** POST (browser) upload helpers 205 | 206 | -- | Please see 207 | -- https://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-HTTPPOSTConstructPolicy.html 208 | -- for detailed information. 209 | newPostPolicy, 210 | presignedPostPolicy, 211 | showPostPolicy, 212 | PostPolicy, 213 | PostPolicyError (..), 214 | 215 | -- *** Post Policy condition helpers 216 | PostPolicyCondition, 217 | ppCondBucket, 218 | ppCondContentLengthRange, 219 | ppCondContentType, 220 | ppCondKey, 221 | ppCondKeyStartsWith, 222 | ppCondSuccessActionStatus, 223 | 224 | -- * Error handling 225 | 226 | -- | Data types representing various errors that may occur while 227 | -- working with an object storage service. 228 | MinioErr (..), 229 | MErrV (..), 230 | ServiceErr (..), 231 | ) 232 | where 233 | 234 | {- 235 | This module exports the high-level MinIO API for object storage. 236 | -} 237 | 238 | import qualified Data.Conduit as C 239 | import qualified Data.Conduit.Binary as CB 240 | import qualified Data.Conduit.Combinators as CC 241 | import Network.Minio.API 242 | import Network.Minio.CopyObject 243 | import Network.Minio.Credentials 244 | import Network.Minio.Data 245 | import Network.Minio.Errors 246 | import Network.Minio.ListOps 247 | import Network.Minio.PutObject 248 | import Network.Minio.S3API 249 | import Network.Minio.SelectAPI 250 | 251 | -- | Lists buckets. 252 | listBuckets :: Minio [BucketInfo] 253 | listBuckets = getService 254 | 255 | -- | Fetch the object and write it to the given file safely. The 256 | -- object is first written to a temporary file in the same directory 257 | -- and then moved to the given path. 258 | fGetObject :: Bucket -> Object -> FilePath -> GetObjectOptions -> Minio () 259 | fGetObject bucket object fp opts = do 260 | src <- getObject bucket object opts 261 | C.connect (gorObjectStream src) $ CB.sinkFileCautious fp 262 | 263 | -- | Upload the given file to the given object. 264 | fPutObject :: 265 | Bucket -> 266 | Object -> 267 | FilePath -> 268 | PutObjectOptions -> 269 | Minio () 270 | fPutObject bucket object f opts = 271 | void $ putObjectInternal bucket object opts $ ODFile f Nothing 272 | 273 | -- | Put an object from a conduit source. The size can be provided if 274 | -- known; this helps the library select optimal part sizes to perform 275 | -- a multipart upload. If not specified, it is assumed that the object 276 | -- can be potentially 5TiB and selects multipart sizes appropriately. 277 | putObject :: 278 | Bucket -> 279 | Object -> 280 | C.ConduitM () ByteString Minio () -> 281 | Maybe Int64 -> 282 | PutObjectOptions -> 283 | Minio () 284 | putObject bucket object src sizeMay opts = 285 | void $ putObjectInternal bucket object opts $ ODStream src sizeMay 286 | 287 | -- | Perform a server-side copy operation to create an object based on 288 | -- the destination specification in DestinationInfo from the source 289 | -- specification in SourceInfo. This function performs a multipart 290 | -- copy operation if the new object is to be greater than 5GiB in 291 | -- size. 292 | copyObject :: DestinationInfo -> SourceInfo -> Minio () 293 | copyObject dstInfo srcInfo = 294 | void $ 295 | copyObjectInternal 296 | (dstBucket dstInfo) 297 | (dstObject dstInfo) 298 | srcInfo 299 | 300 | -- | Remove an object from the object store. 301 | removeObject :: Bucket -> Object -> Minio () 302 | removeObject = deleteObject 303 | 304 | -- | Get an object from the object store. 305 | getObject :: 306 | Bucket -> 307 | Object -> 308 | GetObjectOptions -> 309 | Minio GetObjectResponse 310 | getObject bucket object opts = 311 | getObject' bucket object [] $ gooToHeaders opts 312 | 313 | -- | Get an object's metadata from the object store. It accepts the 314 | -- same options as GetObject. 315 | statObject :: Bucket -> Object -> GetObjectOptions -> Minio ObjectInfo 316 | statObject b o opts = headObject b o $ gooToHeaders opts 317 | 318 | -- | Creates a new bucket in the object store. The Region can be 319 | -- optionally specified. If not specified, it will use the region 320 | -- configured in ConnectInfo, which is by default, the US Standard 321 | -- Region. 322 | makeBucket :: Bucket -> Maybe Region -> Minio () 323 | makeBucket bucket regionMay = do 324 | region <- maybe (asks $ connectRegion . mcConnInfo) return regionMay 325 | putBucket bucket region 326 | addToRegionCache bucket region 327 | 328 | -- | Removes a bucket from the object store. 329 | removeBucket :: Bucket -> Minio () 330 | removeBucket bucket = do 331 | deleteBucket bucket 332 | deleteFromRegionCache bucket 333 | 334 | -- | Query the object store if a given bucket is present. 335 | bucketExists :: Bucket -> Minio Bool 336 | bucketExists = headBucket 337 | 338 | -- | Removes an ongoing multipart upload of an object. 339 | removeIncompleteUpload :: Bucket -> Object -> Minio () 340 | removeIncompleteUpload bucket object = do 341 | uploads <- 342 | C.runConduit $ 343 | listIncompleteUploads bucket (Just object) False 344 | C..| CC.sinkList 345 | mapM_ (abortMultipartUpload bucket object) (uiUploadId <$> uploads) 346 | -------------------------------------------------------------------------------- /src/Network/Minio/SelectAPI.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017-2019 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.SelectAPI 18 | ( -- | The `selectObjectContent` allows querying CSV, JSON or Parquet 19 | -- format objects in AWS S3 and in MinIO using SQL Select 20 | -- statements. This allows significant reduction of data transfer 21 | -- from object storage for computation-intensive tasks, as relevant 22 | -- data is filtered close to the storage. 23 | selectObjectContent, 24 | SelectRequest, 25 | selectRequest, 26 | 27 | -- *** Input Serialization 28 | InputSerialization, 29 | defaultCsvInput, 30 | linesJsonInput, 31 | documentJsonInput, 32 | defaultParquetInput, 33 | setInputCSVProps, 34 | CompressionType (..), 35 | setInputCompressionType, 36 | 37 | -- *** CSV Format details 38 | 39 | -- | CSV format options such as delimiters and quote characters are 40 | -- specified using using the functions below. Options are combined 41 | -- monoidally. 42 | CSVProp, 43 | recordDelimiter, 44 | fieldDelimiter, 45 | quoteCharacter, 46 | quoteEscapeCharacter, 47 | commentCharacter, 48 | allowQuotedRecordDelimiter, 49 | FileHeaderInfo (..), 50 | fileHeaderInfo, 51 | QuoteFields (..), 52 | quoteFields, 53 | 54 | -- *** Output Serialization 55 | OutputSerialization, 56 | defaultCsvOutput, 57 | defaultJsonOutput, 58 | outputCSVFromProps, 59 | outputJSONFromRecordDelimiter, 60 | 61 | -- *** Progress messages 62 | setRequestProgressEnabled, 63 | 64 | -- *** Interpreting Select output 65 | 66 | -- | The conduit returned by `selectObjectContent` returns values of 67 | -- the `EventMessage` data type. This returns the query output 68 | -- messages formatted according to the chosen output serialization, 69 | -- interleaved with progress messages (if enabled by 70 | -- `setRequestProgressEnabled`), and at the end a statistics 71 | -- message. 72 | -- 73 | -- If the application is interested in only the payload, then 74 | -- `getPayloadBytes` can be used. For example to simply print the 75 | -- payload to stdout: 76 | -- 77 | -- > resultConduit <- selectObjectContent bucket object mySelectRequest 78 | -- > runConduit $ resultConduit .| getPayloadBytes .| stdoutC 79 | -- 80 | -- Note that runConduit, the connect operator (.|) and stdoutC are 81 | -- all from the "conduit" package. 82 | getPayloadBytes, 83 | EventMessage (..), 84 | Progress (..), 85 | Stats, 86 | ) 87 | where 88 | 89 | import Conduit ((.|)) 90 | import qualified Conduit as C 91 | import qualified Data.Binary as Bin 92 | import qualified Data.ByteString as B 93 | import qualified Data.ByteString.Lazy as LB 94 | import Data.Digest.CRC32 (crc32, crc32Update) 95 | import Lib.Prelude 96 | import qualified Network.HTTP.Conduit as NC 97 | import qualified Network.HTTP.Types as HT 98 | import Network.Minio.API 99 | import Network.Minio.Data 100 | import Network.Minio.Errors 101 | import Network.Minio.Utils 102 | import Network.Minio.XmlGenerator 103 | import Network.Minio.XmlParser 104 | import UnliftIO (MonadUnliftIO) 105 | 106 | data EventStreamException 107 | = ESEPreludeCRCFailed 108 | | ESEMessageCRCFailed 109 | | ESEUnexpectedEndOfStream 110 | | ESEDecodeFail [Char] 111 | | ESEInvalidHeaderType 112 | | ESEInvalidHeaderValueType 113 | | ESEInvalidMessageType 114 | deriving stock (Eq, Show) 115 | 116 | instance Exception EventStreamException 117 | 118 | -- chunkSize in bytes is 32KiB 119 | chunkSize :: Int 120 | chunkSize = 32 * 1024 121 | 122 | parseBinary :: (Bin.Binary a) => ByteString -> IO a 123 | parseBinary b = do 124 | case Bin.decodeOrFail $ LB.fromStrict b of 125 | Left (_, _, msg) -> throwIO $ ESEDecodeFail msg 126 | Right (_, _, r) -> return r 127 | 128 | bytesToHeaderName :: Text -> IO MsgHeaderName 129 | bytesToHeaderName t = case t of 130 | ":message-type" -> return MessageType 131 | ":event-type" -> return EventType 132 | ":content-type" -> return ContentType 133 | ":error-code" -> return ErrorCode 134 | ":error-message" -> return ErrorMessage 135 | _ -> throwIO ESEInvalidHeaderType 136 | 137 | parseHeaders :: 138 | (MonadUnliftIO m) => 139 | Word32 -> 140 | C.ConduitM ByteString a m [MessageHeader] 141 | parseHeaders 0 = return [] 142 | parseHeaders hdrLen = do 143 | bs1 <- readNBytes 1 144 | n :: Word8 <- liftIO $ parseBinary bs1 145 | 146 | headerKeyBytes <- readNBytes $ fromIntegral n 147 | let headerKey = decodeUtf8Lenient headerKeyBytes 148 | headerName <- liftIO $ bytesToHeaderName headerKey 149 | 150 | bs2 <- readNBytes 1 151 | headerValueType :: Word8 <- liftIO $ parseBinary bs2 152 | when (headerValueType /= 7) $ throwIO ESEInvalidHeaderValueType 153 | 154 | bs3 <- readNBytes 2 155 | vLen :: Word16 <- liftIO $ parseBinary bs3 156 | headerValueBytes <- readNBytes $ fromIntegral vLen 157 | let headerValue = decodeUtf8Lenient headerValueBytes 158 | m = (headerName, headerValue) 159 | k = 1 + fromIntegral n + 1 + 2 + fromIntegral vLen 160 | 161 | ms <- parseHeaders (hdrLen - k) 162 | return (m : ms) 163 | 164 | -- readNBytes returns N bytes read from the string and throws an 165 | -- exception if N bytes are not present on the stream. 166 | readNBytes :: (MonadUnliftIO m) => Int -> C.ConduitM ByteString a m ByteString 167 | readNBytes n = do 168 | b <- LB.toStrict <$> (C.takeCE n .| C.sinkLazy) 169 | if B.length b /= n 170 | then throwIO ESEUnexpectedEndOfStream 171 | else return b 172 | 173 | crcCheck :: 174 | (MonadUnliftIO m) => 175 | C.ConduitM ByteString ByteString m () 176 | crcCheck = do 177 | b <- readNBytes 12 178 | n :: Word32 <- liftIO $ parseBinary $ B.take 4 b 179 | preludeCRC :: Word32 <- liftIO $ parseBinary $ B.drop 8 b 180 | when (crc32 (B.take 8 b) /= preludeCRC) $ 181 | throwIO ESEPreludeCRCFailed 182 | 183 | -- we do not yield the checksum 184 | C.yield $ B.take 8 b 185 | 186 | -- 12 bytes have been read off the current message. Now read the 187 | -- next (n-12)-4 bytes and accumulate the checksum, and yield it. 188 | let startCrc = crc32 b 189 | finalCrc <- accumulateYield (fromIntegral n - 16) startCrc 190 | 191 | bs <- readNBytes 4 192 | expectedCrc :: Word32 <- liftIO $ parseBinary bs 193 | 194 | when (finalCrc /= expectedCrc) $ 195 | throwIO ESEMessageCRCFailed 196 | 197 | -- we unconditionally recurse - downstream figures out when to 198 | -- quit reading the stream 199 | crcCheck 200 | where 201 | accumulateYield n checkSum = do 202 | let toRead = min n chunkSize 203 | b <- readNBytes toRead 204 | let c' = crc32Update checkSum b 205 | n' = n - B.length b 206 | C.yield b 207 | if n' > 0 208 | then accumulateYield n' c' 209 | else return c' 210 | 211 | handleMessage :: (MonadUnliftIO m) => C.ConduitT ByteString EventMessage m () 212 | handleMessage = do 213 | b1 <- readNBytes 4 214 | msgLen :: Word32 <- liftIO $ parseBinary b1 215 | 216 | b2 <- readNBytes 4 217 | hdrLen :: Word32 <- liftIO $ parseBinary b2 218 | 219 | hs <- parseHeaders hdrLen 220 | 221 | let payloadLen = msgLen - hdrLen - 16 222 | getHdrVal h = fmap snd . find ((h ==) . fst) 223 | eventHdrValue = getHdrVal EventType hs 224 | msgHdrValue = getHdrVal MessageType hs 225 | errCode = getHdrVal ErrorCode hs 226 | errMsg = getHdrVal ErrorMessage hs 227 | 228 | case msgHdrValue of 229 | Just "event" -> do 230 | case eventHdrValue of 231 | Just "Records" -> passThrough $ fromIntegral payloadLen 232 | Just "Cont" -> return () 233 | Just "Progress" -> do 234 | bs <- readNBytes $ fromIntegral payloadLen 235 | progress <- parseSelectProgress bs 236 | C.yield $ ProgressEventMessage progress 237 | Just "Stats" -> do 238 | bs <- readNBytes $ fromIntegral payloadLen 239 | stats <- parseSelectProgress bs 240 | C.yield $ StatsEventMessage stats 241 | Just "End" -> return () 242 | _ -> throwIO ESEInvalidMessageType 243 | when (eventHdrValue /= Just "End") handleMessage 244 | Just "error" -> do 245 | let reqMsgMay = RequestLevelErrorMessage <$> errCode <*> errMsg 246 | maybe (throwIO ESEInvalidMessageType) C.yield reqMsgMay 247 | _ -> throwIO ESEInvalidMessageType 248 | where 249 | passThrough 0 = return () 250 | passThrough n = do 251 | let c = min n chunkSize 252 | b <- readNBytes c 253 | C.yield $ RecordPayloadEventMessage b 254 | passThrough $ n - B.length b 255 | 256 | selectProtoConduit :: 257 | (MonadUnliftIO m) => 258 | C.ConduitT ByteString EventMessage m () 259 | selectProtoConduit = crcCheck .| handleMessage 260 | 261 | -- | selectObjectContent calls the SelectRequest on the given 262 | -- object. It returns a Conduit of event messages that can be consumed 263 | -- by the client. 264 | selectObjectContent :: 265 | Bucket -> 266 | Object -> 267 | SelectRequest -> 268 | Minio (C.ConduitT () EventMessage Minio ()) 269 | selectObjectContent b o r = do 270 | let reqInfo = 271 | defaultS3ReqInfo 272 | { riMethod = HT.methodPost, 273 | riBucket = Just b, 274 | riObject = Just o, 275 | riPayload = PayloadBS $ mkSelectRequest r, 276 | riNeedsLocation = False, 277 | riQueryParams = [("select", Nothing), ("select-type", Just "2")] 278 | } 279 | -- print $ mkSelectRequest r 280 | resp <- mkStreamRequest reqInfo 281 | return $ NC.responseBody resp .| selectProtoConduit 282 | 283 | -- | A helper conduit that returns only the record payload bytes. 284 | getPayloadBytes :: (MonadIO m) => C.ConduitT EventMessage ByteString m () 285 | getPayloadBytes = do 286 | evM <- C.await 287 | case evM of 288 | Just v -> do 289 | case v of 290 | RecordPayloadEventMessage b -> C.yield b 291 | RequestLevelErrorMessage c m -> liftIO $ throwIO $ SelectErr c m 292 | _ -> return () 293 | getPayloadBytes 294 | Nothing -> return () 295 | -------------------------------------------------------------------------------- /src/Network/Minio/Credentials/AssumeRole.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.Credentials.AssumeRole where 18 | 19 | import qualified Data.ByteArray as BA 20 | import qualified Data.ByteString.Lazy as LB 21 | import qualified Data.Text as T 22 | import qualified Data.Time as Time 23 | import Data.Time.Units (Second) 24 | import Lib.Prelude (UTCTime, throwIO) 25 | import Network.HTTP.Client (RequestBody (RequestBodyBS)) 26 | import qualified Network.HTTP.Client as NC 27 | import Network.HTTP.Types (hContentType, methodPost, renderSimpleQuery) 28 | import Network.HTTP.Types.Header (hHost) 29 | import Network.Minio.Credentials.Types 30 | import Network.Minio.Data.Crypto (hashSHA256) 31 | import Network.Minio.Errors (MErrV (..)) 32 | import Network.Minio.Sign.V4 33 | import Network.Minio.Utils (getHostHeader, httpLbs) 34 | import Network.Minio.XmlCommon 35 | import Text.XML.Cursor hiding (bool) 36 | 37 | stsVersion :: ByteString 38 | stsVersion = "2011-06-15" 39 | 40 | defaultDurationSeconds :: Second 41 | defaultDurationSeconds = 3600 42 | 43 | -- | Assume Role API argument. 44 | -- 45 | -- @since 1.7.0 46 | data STSAssumeRole = STSAssumeRole 47 | { -- | Credentials to use in the AssumeRole STS API. 48 | sarCredentials :: CredentialValue, 49 | -- | Optional settings. 50 | sarOptions :: STSAssumeRoleOptions 51 | } 52 | 53 | -- | Options for STS Assume Role API. 54 | data STSAssumeRoleOptions = STSAssumeRoleOptions 55 | { -- | STS endpoint to which the request will be made. For MinIO, this is the 56 | -- same as the server endpoint. For AWS, this has to be the Security Token 57 | -- Service endpoint. If using with 'setSTSCredential', this option can be 58 | -- left as 'Nothing' and the endpoint in 'ConnectInfo' will be used. 59 | saroEndpoint :: Maybe Text, 60 | -- | Desired validity for the generated credentials. 61 | saroDurationSeconds :: Maybe Second, 62 | -- | IAM policy to apply for the generated credentials. 63 | saroPolicyJSON :: Maybe ByteString, 64 | -- | Location is usually required for AWS. 65 | saroLocation :: Maybe Text, 66 | saroRoleARN :: Maybe Text, 67 | saroRoleSessionName :: Maybe Text 68 | } 69 | 70 | -- | Default STS Assume Role options - all options are Nothing, except for 71 | -- duration which is set to 1 hour. 72 | defaultSTSAssumeRoleOptions :: STSAssumeRoleOptions 73 | defaultSTSAssumeRoleOptions = 74 | STSAssumeRoleOptions 75 | { saroEndpoint = Nothing, 76 | saroDurationSeconds = Just 3600, 77 | saroPolicyJSON = Nothing, 78 | saroLocation = Nothing, 79 | saroRoleARN = Nothing, 80 | saroRoleSessionName = Nothing 81 | } 82 | 83 | data AssumeRoleCredentials = AssumeRoleCredentials 84 | { arcCredentials :: CredentialValue, 85 | arcExpiration :: UTCTime 86 | } 87 | deriving stock (Show, Eq) 88 | 89 | data AssumeRoleResult = AssumeRoleResult 90 | { arrSourceIdentity :: Text, 91 | arrAssumedRoleArn :: Text, 92 | arrAssumedRoleId :: Text, 93 | arrRoleCredentials :: AssumeRoleCredentials 94 | } 95 | deriving stock (Show, Eq) 96 | 97 | -- | parseSTSAssumeRoleResult parses an XML response of the following form: 98 | -- 99 | -- 100 | -- 101 | -- Alice 102 | -- 103 | -- arn:aws:sts::123456789012:assumed-role/demo/TestAR 104 | -- ARO123EXAMPLE123:TestAR 105 | -- 106 | -- 107 | -- ASIAIOSFODNN7EXAMPLE 108 | -- wJalrXUtnFEMI/K7MDENG/bPxRfiCYzEXAMPLEKEY 109 | -- 110 | -- AQoDYXdzEPT//////////wEXAMPLEtc764bNrC9SAPBSM22wDOk4x4HIZ8j4FZTwdQW 111 | -- LWsKWHGBuFqwAeMicRXmxfpSPfIeoIYRqTflfKD8YUuwthAx7mSEI/qkPpKPi/kMcGd 112 | -- QrmGdeehM4IC1NtBmUpp2wUE8phUZampKsburEDy0KPkyQDYwT7WZ0wq5VSXDvp75YU 113 | -- 9HFvlRd8Tx6q6fE8YQcHNVXAkiY9q6d+xo0rKwT38xVqr7ZD0u0iPPkUL64lIZbqBAz 114 | -- +scqKmlzm8FDrypNC9Yjc8fPOLn9FX9KSYvKTr4rvx3iSIlTJabIQwj2ICCR/oLxBA== 115 | -- 116 | -- 2019-11-09T13:34:41Z 117 | -- 118 | -- 6 119 | -- 120 | -- 121 | -- c6104cbe-af31-11e0-8154-cbc7ccf896c7 122 | -- 123 | -- 124 | parseSTSAssumeRoleResult :: (MonadIO m) => ByteString -> Text -> m AssumeRoleResult 125 | parseSTSAssumeRoleResult xmldata namespace = do 126 | r <- parseRoot $ LB.fromStrict xmldata 127 | let s3Elem' = s3Elem namespace 128 | sourceIdentity = 129 | T.concat $ 130 | r 131 | $/ s3Elem' "AssumeRoleResult" 132 | &/ s3Elem' "SourceIdentity" 133 | &/ content 134 | roleArn = 135 | T.concat $ 136 | r 137 | $/ s3Elem' "AssumeRoleResult" 138 | &/ s3Elem' "AssumedRoleUser" 139 | &/ s3Elem' "Arn" 140 | &/ content 141 | roleId = 142 | T.concat $ 143 | r 144 | $/ s3Elem' "AssumeRoleResult" 145 | &/ s3Elem' "AssumedRoleUser" 146 | &/ s3Elem' "AssumedRoleId" 147 | &/ content 148 | 149 | convSB :: Text -> BA.ScrubbedBytes 150 | convSB = BA.convert . (encodeUtf8 :: Text -> ByteString) 151 | 152 | credsInfo = do 153 | cr <- 154 | maybe (Left $ MErrVXmlParse "No Credentials Element found") Right $ 155 | listToMaybe $ 156 | r $/ s3Elem' "AssumeRoleResult" &/ s3Elem' "Credentials" 157 | let cur = fromNode $ node cr 158 | return 159 | ( CredentialValue 160 | { cvAccessKey = 161 | coerce $ 162 | T.concat $ 163 | cur $/ s3Elem' "AccessKeyId" &/ content, 164 | cvSecretKey = 165 | coerce $ 166 | convSB $ 167 | T.concat $ 168 | cur 169 | $/ s3Elem' "SecretAccessKey" 170 | &/ content, 171 | cvSessionToken = 172 | Just $ 173 | coerce $ 174 | convSB $ 175 | T.concat $ 176 | cur 177 | $/ s3Elem' "SessionToken" 178 | &/ content 179 | }, 180 | T.concat $ cur $/ s3Elem' "Expiration" &/ content 181 | ) 182 | creds <- either throwIO pure credsInfo 183 | expiry <- parseS3XMLTime $ snd creds 184 | let roleCredentials = 185 | AssumeRoleCredentials 186 | { arcCredentials = fst creds, 187 | arcExpiration = expiry 188 | } 189 | return 190 | AssumeRoleResult 191 | { arrSourceIdentity = sourceIdentity, 192 | arrAssumedRoleArn = roleArn, 193 | arrAssumedRoleId = roleId, 194 | arrRoleCredentials = roleCredentials 195 | } 196 | 197 | instance STSCredentialProvider STSAssumeRole where 198 | getSTSEndpoint = saroEndpoint . sarOptions 199 | retrieveSTSCredentials sar (host', port', isSecure') mgr = do 200 | -- Assemble STS request 201 | let requiredParams = 202 | [ ("Action", "AssumeRole"), 203 | ("Version", stsVersion) 204 | ] 205 | opts = sarOptions sar 206 | 207 | durSecs :: Int = 208 | fromIntegral $ 209 | fromMaybe defaultDurationSeconds $ 210 | saroDurationSeconds opts 211 | otherParams = 212 | [ ("RoleArn",) . encodeUtf8 <$> saroRoleARN opts, 213 | ("RoleSessionName",) . encodeUtf8 <$> saroRoleSessionName opts, 214 | Just ("DurationSeconds", show durSecs), 215 | ("Policy",) <$> saroPolicyJSON opts 216 | ] 217 | parameters = requiredParams ++ catMaybes otherParams 218 | (host, port, isSecure) = 219 | case getSTSEndpoint sar of 220 | Just ep -> 221 | let endPt = NC.parseRequest_ $ toString ep 222 | in (NC.host endPt, NC.port endPt, NC.secure endPt) 223 | Nothing -> (host', port', isSecure') 224 | reqBody = renderSimpleQuery False parameters 225 | req = 226 | NC.defaultRequest 227 | { NC.host = host, 228 | NC.port = port, 229 | NC.secure = isSecure, 230 | NC.method = methodPost, 231 | NC.requestHeaders = 232 | [ (hHost, getHostHeader (host, port)), 233 | (hContentType, "application/x-www-form-urlencoded") 234 | ], 235 | NC.requestBody = RequestBodyBS reqBody 236 | } 237 | 238 | -- Sign the STS request. 239 | timeStamp <- liftIO Time.getCurrentTime 240 | let sp = 241 | SignParams 242 | { spAccessKey = coerce $ cvAccessKey $ sarCredentials sar, 243 | spSecretKey = coerce $ cvSecretKey $ sarCredentials sar, 244 | spSessionToken = coerce $ cvSessionToken $ sarCredentials sar, 245 | spService = ServiceSTS, 246 | spTimeStamp = timeStamp, 247 | spRegion = saroLocation opts, 248 | spExpirySecs = Nothing, 249 | spPayloadHash = Just $ hashSHA256 reqBody 250 | } 251 | signHeaders = signV4 sp req 252 | signedReq = 253 | req 254 | { NC.requestHeaders = NC.requestHeaders req ++ signHeaders 255 | } 256 | 257 | -- Make the STS request 258 | resp <- httpLbs signedReq mgr 259 | result <- 260 | parseSTSAssumeRoleResult 261 | (toStrict $ NC.responseBody resp) 262 | "https://sts.amazonaws.com/doc/2011-06-15/" 263 | return 264 | ( arcCredentials $ arrRoleCredentials result, 265 | coerce $ arcExpiration $ arrRoleCredentials result 266 | ) 267 | -------------------------------------------------------------------------------- /src/Network/Minio/Utils.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.Utils where 18 | 19 | import qualified Conduit as C 20 | import Control.Monad.IO.Unlift (MonadUnliftIO) 21 | import qualified Control.Monad.Trans.Resource as R 22 | import qualified Data.ByteString as B 23 | import qualified Data.ByteString.Lazy as LB 24 | import Data.CaseInsensitive (mk, original) 25 | import qualified Data.Conduit.Binary as CB 26 | import qualified Data.HashMap.Strict as H 27 | import qualified Data.Text as T 28 | import Data.Text.Read (decimal) 29 | import Data.Time 30 | ( defaultTimeLocale, 31 | parseTimeM, 32 | rfc822DateFormat, 33 | ) 34 | import Lib.Prelude 35 | import Network.HTTP.Conduit (Response) 36 | import qualified Network.HTTP.Conduit as NC 37 | import qualified Network.HTTP.Types as HT 38 | import qualified Network.HTTP.Types.Header as Hdr 39 | import Network.Minio.Data.ByteString 40 | import Network.Minio.JsonParser (parseErrResponseJSON) 41 | import Network.Minio.XmlCommon (parseErrResponse) 42 | import qualified System.IO as IO 43 | import qualified UnliftIO as U 44 | import qualified UnliftIO.Async as A 45 | 46 | allocateReadFile :: 47 | (MonadUnliftIO m, R.MonadResource m) => 48 | FilePath -> 49 | m (R.ReleaseKey, Handle) 50 | allocateReadFile fp = do 51 | (rk, hdlE) <- R.allocate (openReadFile fp) cleanup 52 | either (\(e :: U.IOException) -> throwIO e) (return . (rk,)) hdlE 53 | where 54 | openReadFile f = U.try $ IO.openBinaryFile f IO.ReadMode 55 | cleanup = either (const $ return ()) IO.hClose 56 | 57 | -- | Queries the file size from the handle. Catches any file operation 58 | -- exceptions and returns Nothing instead. 59 | getFileSize :: 60 | (MonadUnliftIO m) => 61 | Handle -> 62 | m (Maybe Int64) 63 | getFileSize h = do 64 | resE <- liftIO $ try $ fromIntegral <$> IO.hFileSize h 65 | case resE of 66 | Left (_ :: U.IOException) -> return Nothing 67 | Right s -> return $ Just s 68 | 69 | -- | Queries if handle is seekable. Catches any file operation 70 | -- exceptions and return False instead. 71 | isHandleSeekable :: 72 | (R.MonadResource m) => 73 | Handle -> 74 | m Bool 75 | isHandleSeekable h = do 76 | resE <- liftIO $ try $ IO.hIsSeekable h 77 | case resE of 78 | Left (_ :: U.IOException) -> return False 79 | Right v -> return v 80 | 81 | -- | Helper function that opens a handle to the filepath and performs 82 | -- the given action on it. Exceptions of type MError are caught and 83 | -- returned - both during file handle allocation and when the action 84 | -- is run. 85 | withNewHandle :: 86 | (MonadUnliftIO m, R.MonadResource m) => 87 | FilePath -> 88 | (Handle -> m a) -> 89 | m (Either U.IOException a) 90 | withNewHandle fp fileAction = do 91 | -- opening a handle can throw MError exception. 92 | handleE <- try $ allocateReadFile fp 93 | either (return . Left) doAction handleE 94 | where 95 | doAction (rkey, h) = do 96 | -- fileAction may also throw MError exception, so we catch and 97 | -- return it. 98 | resE <- try $ fileAction h 99 | R.release rkey 100 | return resE 101 | 102 | mkHeaderFromPairs :: [(ByteString, ByteString)] -> [HT.Header] 103 | mkHeaderFromPairs = map (first mk) 104 | 105 | lookupHeader :: HT.HeaderName -> [HT.Header] -> Maybe ByteString 106 | lookupHeader hdr = listToMaybe . map snd . filter (\(h, _) -> h == hdr) 107 | 108 | getETagHeader :: [HT.Header] -> Maybe Text 109 | getETagHeader hs = decodeUtf8Lenient <$> lookupHeader Hdr.hETag hs 110 | 111 | getMetadata :: [HT.Header] -> [(Text, Text)] 112 | getMetadata = 113 | map (\(x, y) -> (decodeUtf8Lenient $ original x, decodeUtf8Lenient $ stripBS y)) 114 | 115 | -- | If the given header name has the @X-Amz-Meta-@ prefix, it is 116 | -- stripped and a Just is returned. 117 | userMetadataHeaderNameMaybe :: Text -> Maybe Text 118 | userMetadataHeaderNameMaybe k = 119 | let prefix = T.toCaseFold "X-Amz-Meta-" 120 | n = T.length prefix 121 | in if T.toCaseFold (T.take n k) == prefix 122 | then Just (T.drop n k) 123 | else Nothing 124 | 125 | toMaybeMetadataHeader :: (Text, Text) -> Maybe (Text, Text) 126 | toMaybeMetadataHeader (k, v) = 127 | (,v) <$> userMetadataHeaderNameMaybe k 128 | 129 | getNonUserMetadataMap :: [(Text, Text)] -> H.HashMap Text Text 130 | getNonUserMetadataMap = 131 | H.fromList 132 | . filter 133 | ( isNothing 134 | . userMetadataHeaderNameMaybe 135 | . fst 136 | ) 137 | 138 | addXAmzMetaPrefix :: Text -> Text 139 | addXAmzMetaPrefix s 140 | | isJust (userMetadataHeaderNameMaybe s) = s 141 | | otherwise = "X-Amz-Meta-" <> s 142 | 143 | mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header] 144 | mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix x, encodeUtf8 y)) 145 | 146 | -- | This function collects all headers starting with `x-amz-meta-` 147 | -- and strips off this prefix, and returns a map. 148 | getUserMetadataMap :: [(Text, Text)] -> H.HashMap Text Text 149 | getUserMetadataMap = 150 | H.fromList 151 | . mapMaybe toMaybeMetadataHeader 152 | 153 | getHostHeader :: (ByteString, Int) -> ByteString 154 | getHostHeader (host_, port_) = 155 | if port_ == 80 || port_ == 443 156 | then host_ 157 | else host_ <> ":" <> show port_ 158 | 159 | getLastModifiedHeader :: [HT.Header] -> Maybe UTCTime 160 | getLastModifiedHeader hs = do 161 | modTimebs <- decodeUtf8Lenient <$> lookupHeader Hdr.hLastModified hs 162 | parseTimeM True defaultTimeLocale rfc822DateFormat (T.unpack modTimebs) 163 | 164 | getContentLength :: [HT.Header] -> Maybe Int64 165 | getContentLength hs = do 166 | nbs <- decodeUtf8Lenient <$> lookupHeader Hdr.hContentLength hs 167 | fst <$> either (const Nothing) Just (decimal nbs) 168 | 169 | decodeUtf8Lenient :: ByteString -> Text 170 | decodeUtf8Lenient = decodeUtf8With lenientDecode 171 | 172 | isSuccessStatus :: HT.Status -> Bool 173 | isSuccessStatus sts = 174 | let s = HT.statusCode sts 175 | in (s >= 200 && s < 300) 176 | 177 | httpLbs :: 178 | (MonadIO m) => 179 | NC.Request -> 180 | NC.Manager -> 181 | m (NC.Response LByteString) 182 | httpLbs req mgr = do 183 | respE <- liftIO $ tryHttpEx $ NC.httpLbs req mgr 184 | resp <- either throwIO return respE 185 | unless (isSuccessStatus $ NC.responseStatus resp) $ 186 | case contentTypeMay resp of 187 | Just "application/xml" | expectBody -> do 188 | sErr <- parseErrResponse $ NC.responseBody resp 189 | throwIO sErr 190 | Just "application/json" | expectBody -> do 191 | sErr <- parseErrResponseJSON $ NC.responseBody resp 192 | throwIO sErr 193 | _ -> 194 | throwIO $ 195 | NC.HttpExceptionRequest req $ 196 | NC.StatusCodeException (void resp) (showBS resp) 197 | 198 | return resp 199 | where 200 | tryHttpEx :: 201 | IO (NC.Response LByteString) -> 202 | IO (Either NC.HttpException (NC.Response LByteString)) 203 | tryHttpEx = try 204 | contentTypeMay resp = 205 | lookupHeader Hdr.hContentType $ 206 | NC.responseHeaders resp 207 | expectBody = NC.method req /= HT.methodHead 208 | 209 | http :: 210 | (MonadUnliftIO m, R.MonadResource m) => 211 | NC.Request -> 212 | NC.Manager -> 213 | m (Response (C.ConduitT () ByteString m ())) 214 | http req mgr = do 215 | respE <- tryHttpEx $ NC.http req mgr 216 | resp <- either throwIO return respE 217 | unless (isSuccessStatus $ NC.responseStatus resp) $ 218 | case contentTypeMay resp of 219 | Just "application/xml" | expectBody -> do 220 | respBody <- C.connect (NC.responseBody resp) CB.sinkLbs 221 | sErr <- parseErrResponse respBody 222 | throwIO sErr 223 | _ -> do 224 | content <- LB.toStrict . NC.responseBody <$> NC.lbsResponse resp 225 | throwIO $ 226 | NC.HttpExceptionRequest req $ 227 | NC.StatusCodeException (void resp) content 228 | 229 | return resp 230 | where 231 | tryHttpEx :: 232 | (MonadUnliftIO m) => 233 | m a -> 234 | m (Either NC.HttpException a) 235 | tryHttpEx = try 236 | contentTypeMay resp = 237 | lookupHeader Hdr.hContentType $ 238 | NC.responseHeaders resp 239 | expectBody = NC.method req /= HT.methodHead 240 | 241 | -- Similar to mapConcurrently but limits the number of threads that 242 | -- can run using a quantity semaphore. 243 | limitedMapConcurrently :: 244 | (MonadUnliftIO m) => 245 | Int -> 246 | (t -> m a) -> 247 | [t] -> 248 | m [a] 249 | limitedMapConcurrently 0 _ _ = return [] 250 | limitedMapConcurrently count act args = do 251 | t' <- U.newTVarIO count 252 | threads <- mapM (A.async . wThread t') args 253 | mapM A.wait threads 254 | where 255 | wThread t arg = 256 | U.bracket_ (waitSem t) (signalSem t) $ act arg 257 | -- quantity semaphore implementation using TVar 258 | waitSem t = U.atomically $ do 259 | v <- U.readTVar t 260 | if v > 0 261 | then U.writeTVar t (v - 1) 262 | else U.retrySTM 263 | signalSem t = U.atomically $ do 264 | v <- U.readTVar t 265 | U.writeTVar t (v + 1) 266 | 267 | -- helper function to 'drop' empty optional parameter. 268 | mkQuery :: Text -> Maybe Text -> Maybe (Text, Text) 269 | mkQuery k mv = (k,) <$> mv 270 | 271 | -- helper function to build query parameters that are optional. 272 | -- don't use it with mandatory query params with empty value. 273 | mkOptionalParams :: [(Text, Maybe Text)] -> HT.Query 274 | mkOptionalParams params = HT.toQuery $ uncurry mkQuery <$> params 275 | 276 | -- | Conduit that rechunks bytestrings into the given chunk 277 | -- lengths. Stops after given chunk lengths are yielded. Stops if 278 | -- there are no more chunks to yield or if a shorter chunk is 279 | -- received. Does not throw any errors. 280 | chunkBSConduit :: (Monad m) => [Int] -> C.ConduitM ByteString ByteString m () 281 | chunkBSConduit [] = return () 282 | chunkBSConduit (s : ss) = do 283 | bs <- fmap LB.toStrict $ C.takeCE s C..| C.sinkLazy 284 | if 285 | | B.length bs == s -> C.yield bs >> chunkBSConduit ss 286 | | B.length bs > 0 -> C.yield bs 287 | | otherwise -> return () 288 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | # Trigger the workflow on push or pull request, but only for the master branch 4 | on: 5 | pull_request: 6 | branches: [master] 7 | push: 8 | branches: [master] 9 | 10 | # This ensures that previous jobs for the PR are canceled when the PR is 11 | # updated. 12 | concurrency: 13 | group: ${{ github.workflow }}-${{ github.head_ref }} 14 | cancel-in-progress: true 15 | 16 | # Env vars for tests 17 | env: 18 | MINIO_ACCESS_KEY: minio 19 | MINIO_SECRET_KEY: minio123 20 | MINIO_LOCAL: 1 21 | 22 | jobs: 23 | ormolu: 24 | runs-on: ubuntu-latest 25 | steps: 26 | - uses: actions/checkout@v4 27 | - uses: haskell-actions/run-ormolu@v15 28 | with: 29 | version: "0.5.0.1" 30 | 31 | hlint: 32 | runs-on: ubuntu-latest 33 | steps: 34 | - uses: actions/checkout@v4 35 | 36 | - name: "Set up HLint" 37 | uses: haskell-actions/hlint-setup@v2 38 | with: 39 | version: "3.5" 40 | 41 | - name: "Run HLint" 42 | uses: haskell-actions/hlint-run@v2 43 | with: 44 | path: '["src/", "test/", "examples"]' 45 | fail-on: warning 46 | 47 | cabal: 48 | name: ${{ matrix.os }} / ghc-${{ matrix.ghc }} / cabal-${{ matrix.cabal }} 49 | runs-on: ${{ matrix.os }} 50 | needs: ormolu 51 | strategy: 52 | matrix: 53 | os: [ubuntu-latest, windows-latest, macos-latest] 54 | cabal: ["3.8", "latest"] 55 | ghc: 56 | - "9.8" 57 | - "9.6" 58 | - "9.4" 59 | - "9.2" 60 | - "9.0" 61 | - "8.10" 62 | exclude: 63 | # macos llvm issue for versions less than 9.2 64 | - os: macos-latest 65 | ghc: "8.10" 66 | - os: macos-latest 67 | ghc: "9.0" 68 | # Cabal 3.8 supports GHC < 9.6 69 | - cabal: "3.8" 70 | ghc: "9.6" 71 | - cabal: "3.8" 72 | ghc: "9.8" 73 | 74 | steps: 75 | - uses: actions/checkout@v4 76 | if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' 77 | 78 | - uses: haskell-actions/setup@v2 79 | id: setup 80 | name: Setup Haskell 81 | with: 82 | ghc-version: ${{ matrix.ghc }} 83 | cabal-version: ${{ matrix.cabal }} 84 | cabal-update: true 85 | 86 | - name: Configure 87 | run: | 88 | cabal configure --enable-tests --enable-benchmarks --test-show-details=direct -fexamples -fdev -flive-test 89 | cabal build all --dry-run 90 | # The last step generates dist-newstyle/cache/plan.json for the cache key. 91 | 92 | - name: Restore cached dependencies 93 | uses: actions/cache/restore@v4 94 | id: cache 95 | env: 96 | key: ${{ runner.os }}-ghc-${{ steps.setup.outputs.ghc-version }}-cabal-${{ steps.setup.outputs.cabal-version }} 97 | with: 98 | path: ${{ steps.setup.outputs.cabal-store }} 99 | key: ${{ env.key }}-plan-${{ hashFiles('**/plan.json') }} 100 | restore-keys: ${{ env.key }}- 101 | 102 | - name: Install dependencies 103 | # If we had an exact cache hit, the dependencies will be up to date. 104 | if: steps.cache.outputs.cache-hit != 'true' 105 | run: cabal build all --only-dependencies 106 | 107 | # Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail. 108 | - name: Save cached dependencies 109 | uses: actions/cache/save@v4 110 | # If we had an exact cache hit, trying to save the cache would error because of key clash. 111 | if: steps.cache.outputs.cache-hit != 'true' 112 | with: 113 | path: ${{ steps.setup.outputs.cabal-store }} 114 | key: ${{ steps.cache.outputs.cache-primary-key }} 115 | 116 | - name: Build 117 | run: | 118 | cabal build all 119 | 120 | - name: Setup TLS certs for MinIO for testing (Linux) 121 | if: matrix.os == 'ubuntu-latest' 122 | run: | 123 | mkdir -p /tmp/minio /tmp/minio-config/certs 124 | cp test/cert/* /tmp/minio-config/certs/ 125 | (cd /tmp/minio; wget -q https://dl.min.io/server/minio/release/linux-amd64/minio; chmod +x ./minio) 126 | sudo cp /tmp/minio-config/certs/public.crt /usr/local/share/ca-certificates/ 127 | sudo update-ca-certificates 128 | 129 | ## Currently disable TLS setup for MacOS due to issues in trusting it on MacOS. 130 | - name: Setup TLS certs for MinIO for testing (MacOS) 131 | if: matrix.os == 'macos-latest' 132 | run: | 133 | mkdir -p /tmp/minio /tmp/minio-config/certs 134 | cp test/cert/* /tmp/minio-config/certs/ 135 | (cd /tmp/minio; wget -q https://dl.min.io/server/minio/release/darwin-amd64/minio; chmod +x ./minio) 136 | # sudo security add-trusted-cert -d -r trustRoot -k /Library/Keychains/System.keychain /tmp/minio-config/certs/public.crt 137 | 138 | - name: Setup MinIO for testing (Windows) 139 | if: matrix.os == 'windows-latest' 140 | run: | 141 | New-Item -ItemType Directory -Path "$env:temp/minio-config/certs/" 142 | Copy-Item -Path test\cert\* -Destination "$env:temp/minio-config/certs/" 143 | Invoke-WebRequest -Uri https://dl.minio.io/server/minio/release/windows-amd64/minio.exe -OutFile $HOME/minio.exe 144 | Import-Certificate -FilePath "$env:temp/minio-config/certs/public.crt" -CertStoreLocation Cert:\LocalMachine\Root 145 | 146 | - name: Test (Linux) 147 | if: matrix.os == 'ubuntu-latest' 148 | env: 149 | MINIO_SECURE: 1 150 | run: | 151 | /tmp/minio/minio server --quiet --certs-dir /tmp/minio-config/certs data1 data2 data3 data4 2>&1 > minio.log & 152 | ghc --version 153 | cabal --version 154 | cabal test all 155 | 156 | - name: Test (MacOS) 157 | if: matrix.os == 'macos-latest' 158 | # # Leave MINIO_SECURE unset to disable TLS in tests. 159 | # env: 160 | # MINIO_SECURE: 1 161 | run: | 162 | /tmp/minio/minio server --quiet data1 data2 data3 data4 2>&1 > minio.log & 163 | ghc --version 164 | cabal --version 165 | cabal test all 166 | 167 | - name: Test (Windows) 168 | if: matrix.os == 'windows-latest' 169 | env: 170 | MINIO_SECURE: 1 171 | run: | 172 | Start-Process -NoNewWindow -FilePath "$HOME/minio.exe" -ArgumentList "--certs-dir", "$env:temp/minio-config/certs", "server", "$env:temp/data1", "$env:temp/data2", "$env:temp/data3", "$env:temp/data4" 173 | ghc --version 174 | cabal --version 175 | cabal test all 176 | 177 | stack: 178 | name: stack / ghc ${{ matrix.ghc }} 179 | runs-on: ${{ matrix.os }} 180 | env: 181 | MINIO_SECURE: 1 182 | strategy: 183 | matrix: 184 | ghc: 185 | - "8.10.7" 186 | - "9.0.2" 187 | - "9.2.8" 188 | - "9.4.8" 189 | - "9.6.5" 190 | - "9.8.2" 191 | os: [ubuntu-latest] 192 | 193 | steps: 194 | - uses: actions/checkout@v4 195 | if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' 196 | 197 | - uses: haskell-actions/setup@v2 198 | with: 199 | ghc-version: ${{ matrix.ghc }} 200 | enable-stack: true 201 | stack-version: "latest" 202 | 203 | - uses: actions/cache@v4 204 | name: Cache ~/.stack 205 | with: 206 | path: ~/.stack 207 | key: ${{ runner.os }}-stack-global-${{ hashFiles('stack.yaml') }}-${{ hashFiles('package.yaml') }} 208 | restore-keys: | 209 | ${{ runner.os }}-stack-global- 210 | - uses: actions/cache@v4 211 | name: Cache .stack-work 212 | with: 213 | path: .stack-work 214 | key: ${{ runner.os }}-stack-work-${{ hashFiles('stack.yaml') }}-${{ hashFiles('package.yaml') }}-${{ hashFiles('**/*.hs') }} 215 | restore-keys: | 216 | ${{ runner.os }}-stack-work- 217 | 218 | - name: Install dependencies 219 | run: | 220 | stack --version 221 | stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies 222 | 223 | - name: Build 224 | run: | 225 | stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --flag minio-hs:examples --flag minio-hs:live-test --flag minio-hs:dev 226 | 227 | - name: Setup MinIO for testing (Linux) 228 | if: matrix.os == 'ubuntu-latest' 229 | run: | 230 | mkdir -p /tmp/minio /tmp/minio-config/certs 231 | cp test/cert/* /tmp/minio-config/certs/ 232 | (cd /tmp/minio; wget -q https://dl.min.io/server/minio/release/linux-amd64/minio; chmod +x ./minio) 233 | sudo cp /tmp/minio-config/certs/public.crt /usr/local/share/ca-certificates/ 234 | sudo update-ca-certificates 235 | 236 | - name: Setup MinIO for testing (MacOS) 237 | if: matrix.os == 'macos-latest' 238 | run: | 239 | mkdir -p /tmp/minio /tmp/minio-config/certs 240 | cp test/cert/* /tmp/minio-config/certs/ 241 | (cd /tmp/minio; wget -q https://dl.min.io/server/minio/release/darwin-amd64/minio; chmod +x ./minio) 242 | sudo security add-trusted-cert -d -r trustRoot -k /Library/Keychains/System.keychain /tmp/minio-config/certs/public.crt 243 | 244 | - name: Setup MinIO for testing (Windows) 245 | if: matrix.os == 'windows-latest' 246 | run: | 247 | New-Item -ItemType Directory -Path "$env:temp/minio-config/certs/" 248 | Copy-Item -Path test\cert\* -Destination "$env:temp/minio-config/certs/" 249 | Invoke-WebRequest -Uri https://dl.minio.io/server/minio/release/windows-amd64/minio.exe -OutFile $HOME/minio.exe 250 | Import-Certificate -FilePath "$env:temp/minio-config/certs/public.crt" -CertStoreLocation Cert:\LocalMachine\Root 251 | 252 | - name: Test (Non-Windows) 253 | if: matrix.os != 'windows-latest' 254 | run: | 255 | /tmp/minio/minio server --quiet --certs-dir /tmp/minio-config/certs data1 data2 data3 data4 2>&1 > minio.log & 256 | ghc --version 257 | stack --version 258 | stack test --system-ghc --flag minio-hs:live-test --flag minio-hs:dev 259 | 260 | - name: Test (Windows) 261 | if: matrix.os == 'windows-latest' 262 | run: | 263 | Start-Process -NoNewWindow -FilePath "$HOME/minio.exe" -ArgumentList "--certs-dir", "$env:temp/minio-config/certs", "server", "$env:temp/data1", "$env:temp/data2", "$env:temp/data3", "$env:temp/data4" 264 | ghc --version 265 | cabal --version 266 | stack test --system-ghc --flag minio-hs:live-test --flag minio-hs:dev 267 | -------------------------------------------------------------------------------- /test/Network/Minio/API/Test.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc. 3 | -- 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | -- 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | -- 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | -- 16 | 17 | module Network.Minio.API.Test 18 | ( bucketNameValidityTests, 19 | objectNameValidityTests, 20 | parseServerInfoJSONTest, 21 | parseHealStatusTest, 22 | parseHealStartRespTest, 23 | ) 24 | where 25 | 26 | import Data.Aeson (eitherDecode) 27 | import Network.Minio.API 28 | import Network.Minio.AdminAPI 29 | import Test.Tasty 30 | import Test.Tasty.HUnit 31 | 32 | assertBool' :: Bool -> Assertion 33 | assertBool' = assertBool "Test failed!" 34 | 35 | bucketNameValidityTests :: TestTree 36 | bucketNameValidityTests = 37 | testGroup 38 | "Bucket Name Validity Tests" 39 | [ testCase "Too short 1" $ assertBool' $ not $ isValidBucketName "", 40 | testCase "Too short 2" $ assertBool' $ not $ isValidBucketName "ab", 41 | testCase "Too long 1" $ assertBool' $ not $ isValidBucketName "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", 42 | testCase "Has upper case" $ assertBool' $ not $ isValidBucketName "ABCD", 43 | testCase "Has punctuation" $ assertBool' $ not $ isValidBucketName "abc,2", 44 | testCase "Has hyphen at end" $ assertBool' $ not $ isValidBucketName "abc-", 45 | testCase "Has consecutive dot" $ assertBool' $ not $ isValidBucketName "abck..eedg", 46 | testCase "Looks like IP" $ assertBool' $ not $ isValidBucketName "10.0.0.1", 47 | testCase "Valid bucket name 1" $ assertBool' $ isValidBucketName "abcd.pqeq.rea", 48 | testCase "Valid bucket name 2" $ assertBool' $ isValidBucketName "abcdedgh1d", 49 | testCase "Valid bucket name 3" $ assertBool' $ isValidBucketName "abc-de-dg-h1d" 50 | ] 51 | 52 | objectNameValidityTests :: TestTree 53 | objectNameValidityTests = 54 | testGroup 55 | "Object Name Validity Tests" 56 | [ testCase "Empty name" $ assertBool' $ not $ isValidObjectName "", 57 | testCase "Has unicode characters" $ assertBool' $ isValidObjectName "日本国" 58 | ] 59 | 60 | parseServerInfoJSONTest :: TestTree 61 | parseServerInfoJSONTest = 62 | testGroup "Parse MinIO Admin API ServerInfo JSON test" $ 63 | map 64 | ( \(tName, tDesc, tfn, tVal) -> 65 | testCase tName $ 66 | assertBool tDesc $ 67 | tfn (eitherDecode tVal :: Either [Char] [ServerInfo]) 68 | ) 69 | testCases 70 | where 71 | testCases = 72 | [ ("FSBackend", "Verify server info json parsing for FS backend", isRight, fsJSON), 73 | ("Erasure Backend", "Verify server info json parsing for Erasure backend", isRight, erasureJSON), 74 | ("Unknown Backend", "Verify server info json parsing for invalid backend", isLeft, invalidJSON) 75 | ] 76 | fsJSON = "[{\"error\":\"\",\"addr\":\"192.168.1.218:9000\",\"data\":{\"storage\":{\"Used\":20530,\"Backend\":{\"Type\":1,\"OnlineDisks\":0,\"OfflineDisks\":0,\"StandardSCData\":0,\"StandardSCParity\":0,\"RRSCData\":0,\"RRSCParity\":0,\"Sets\":null}},\"network\":{\"transferred\":808,\"received\":1160},\"http\":{\"totalHEADs\":{\"count\":0,\"avgDuration\":\"0s\"},\"successHEADs\":{\"count\":0,\"avgDuration\":\"0s\"},\"totalGETs\":{\"count\":1,\"avgDuration\":\"0s\"},\"successGETs\":{\"count\":1,\"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\":5992503019270,\"version\":\"DEVELOPMENT.GOGET\",\"commitID\":\"DEVELOPMENT.GOGET\",\"region\":\"\",\"sqsARN\":[]}}}]" 77 | erasureJSON = "[{\"error\":\"\",\"addr\":\"192.168.1.218:9000\",\"data\":{\"storage\":{\"Used\":83084,\"Backend\":{\"Type\":2,\"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\":[]}}}]" 78 | 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\":[]}}}]" 79 | 80 | parseHealStatusTest :: TestTree 81 | parseHealStatusTest = 82 | testGroup "Parse MinIO Admin API HealStatus JSON test" $ 83 | map 84 | ( \(tName, tDesc, tfn, tVal) -> 85 | testCase tName $ 86 | assertBool tDesc $ 87 | tfn (eitherDecode tVal :: Either [Char] HealStatus) 88 | ) 89 | testCases 90 | where 91 | testCases = 92 | [ ("Good", "Verify heal result item for erasure backend", isRight, erasureJSON'), 93 | ("Corrupted", "Verify heal result item for erasure backend", isLeft, invalidJSON'), 94 | ("Incorrect Value", "Verify heal result item for erasure backend", isLeft, invalidItemType) 95 | ] 96 | erasureJSON' = "{\"Summary\":\"finished\",\"StartTime\":\"2018-06-05T08:09:47.644465513Z\",\"NumDisks\":4,\"Settings\":{\"recursive\":false,\"dryRun\":false},\"Items\":[{\"resultId\":1,\"type\":\"metadata\",\"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}]}" 97 | invalidJSON' = "{\"Summary\":\"finished\",\"StartTime\":\"2018-06-05T08:09:47.644465513Z\",\"NumDisks\":4,\"Settings\":{\"recursive\":false,\"dryRun\":false},\"Items\":[{\"resultId\":1,\"type\":\"metadata\",\"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}]" 98 | 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}]}" 99 | 100 | parseHealStartRespTest :: TestTree 101 | parseHealStartRespTest = 102 | testGroup "Parse MinIO Admin API HealStartResp JSON test" $ 103 | map 104 | ( \(tName, tDesc, tfn, tVal) -> 105 | testCase tName $ 106 | assertBool tDesc $ 107 | tfn (eitherDecode tVal :: Either [Char] HealStartResp) 108 | ) 109 | testCases 110 | where 111 | testCases = 112 | [ ("Good", "Verify heal start response for erasure backend", isRight, hsrJSON), 113 | ("Missing Token", "Verify heal start response for erasure backend", isLeft, missingTokenJSON) 114 | ] 115 | hsrJSON = "{\"clientToken\":\"3a3aca49-77dd-4b78-bba7-0978f119b23e\",\"clientAddress\":\"127.0.0.1\",\"startTime\":\"2018-06-05T08:09:47.644394493Z\"}" 116 | missingTokenJSON = "{\"clientAddress\":\"127.0.0.1\",\"startTime\":\"2018-06-05T08:09:47.644394493Z\"}" 117 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | --------------------------------------------------------------------------------