From 843fd6123bb4b750113859e13cdfb7ee23ec8f5e Mon Sep 17 00:00:00 2001 From: Krishnan Parthasarathi Date: Wed, 15 Mar 2017 15:26:48 +0530 Subject: [PATCH] Add copyObject example. (#30) --- examples/CopyObject.hs | 59 ++++++++++++++++++++++++++++++++++++++ src/Network/Minio/Utils.hs | 16 +++++------ test/LiveServer.hs | 8 +++--- 3 files changed, 70 insertions(+), 13 deletions(-) create mode 100755 examples/CopyObject.hs diff --git a/examples/CopyObject.hs b/examples/CopyObject.hs new file mode 100755 index 0000000..271017d --- /dev/null +++ b/examples/CopyObject.hs @@ -0,0 +1,59 @@ +#!/usr/bin/env stack +-- stack --resolver lts-6.27 runghc --package minio-hs + +-- +-- Minio Haskell SDK, (C) 2017 Minio, Inc. +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- + +{-# Language OverloadedStrings #-} +import Network.Minio + +import Control.Monad.Catch (catchIf) +import qualified Data.Text as T +import Prelude + +-- | The following example uses minio's play server at +-- https://play.minio.io:9000. The endpoint and associated +-- credentials are provided via the libary constant, +-- +-- > minioPlayCI :: ConnectInfo +-- + +ignoreMinioErr :: ServiceErr -> Minio () +ignoreMinioErr = return . const () + +main :: IO () +main = do + let + bucket = "test" + object = "obj" + objectCopy = "obj-copy" + localFile = "/etc/lsb-release" + + res1 <- runResourceT $ runMinio minioPlayCI $ do + -- 1. Make a bucket; Catch BucketAlreadyOwnedByYou exception. + catchIf (== BucketAlreadyOwnedByYou) (makeBucket bucket Nothing) ignoreMinioErr + + -- 2. Upload a file to bucket/object. + fPutObject bucket object localFile + + -- 3. Copy bucket/object to bucket/objectCopy. + copyObject bucket objectCopy def { + cpSource = T.concat ["/", bucket, "/", object] + } + + case res1 of + Left e -> putStrLn $ "copyObject failed." ++ (show e) + Right () -> putStrLn "copyObject succeeded." diff --git a/src/Network/Minio/Utils.hs b/src/Network/Minio/Utils.hs index e6997d3..23c8314 100644 --- a/src/Network/Minio/Utils.hs +++ b/src/Network/Minio/Utils.hs @@ -43,11 +43,11 @@ import Lib.Prelude import Network.Minio.Errors import Network.Minio.XmlParser (parseErrResponse) -allocateReadFile :: (R.MonadResource m, R.MonadResourceBase m) +allocateReadFile :: (R.MonadResource m, R.MonadResourceBase m, MonadCatch m) => FilePath -> m (R.ReleaseKey, Handle) allocateReadFile fp = do (rk, hdlE) <- R.allocate (openReadFile fp) cleanup - either (throwM . MErrIO) (return . (rk,)) hdlE + either (\(e :: IOException) -> throwM e) (return . (rk,)) hdlE where openReadFile f = ExL.try $ IO.openBinaryFile f IO.ReadMode cleanup = either (const $ return ()) IO.hClose @@ -77,7 +77,7 @@ isHandleSeekable h = do -- returned - both during file handle allocation and when the action -- is run. withNewHandle :: (R.MonadResourceBase m, R.MonadResource m, MonadCatch m) - => FilePath -> (Handle -> m a) -> m (Either MinioErr a) + => FilePath -> (Handle -> m a) -> m (Either IOException a) withNewHandle fp fileAction = do -- opening a handle can throw MError exception. handleE <- MC.try $ allocateReadFile fp @@ -125,10 +125,9 @@ httpLbs req mgr = do case contentTypeMay resp of Just "application/xml" -> do sErr <- parseErrResponse $ NC.responseBody resp - throwM $ MErrService sErr + throwM sErr - _ -> throwM $ - MErrHTTP $ NC.StatusCodeException (NC.responseStatus resp) [] def + _ -> throwM $ NC.StatusCodeException (NC.responseStatus resp) [] def return resp where @@ -148,10 +147,9 @@ http req mgr = do Just "application/xml" -> do respBody <- NC.responseBody resp C.$$+- CB.sinkLbs sErr <- parseErrResponse $ respBody - throwM $ MErrService sErr + throwM sErr - _ -> throwM $ - MErrHTTP $ NC.StatusCodeException (NC.responseStatus resp) [] def + _ -> throwM $ NC.StatusCodeException (NC.responseStatus resp) [] def return resp where diff --git a/test/LiveServer.hs b/test/LiveServer.hs index 1eba27d..293ae2f 100644 --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -103,13 +103,13 @@ liveServerUnitTests = testGroup "Unit tests against a live server" step "makeBucket again to check if BucketAlreadyOwnedByYou exception is raised." mbE <- MC.try $ makeBucket bucket Nothing case mbE of - Left exn -> liftIO $ exn @?= (MErrService BucketAlreadyOwnedByYou) + Left exn -> liftIO $ exn @?= BucketAlreadyOwnedByYou _ -> return () step "makeBucket with an invalid bucket name and check for appropriate exception." invalidMBE <- MC.try $ makeBucket "invalidBucketName" Nothing case invalidMBE of - Left exn -> liftIO $ exn @?= (MErrService InvalidBucketName) + Left exn -> liftIO $ exn @?= InvalidBucketName _ -> return () step "getLocation works" @@ -122,7 +122,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server" step "fPutObject onto a non-existent bucket and check for NoSuchBucket exception" fpE <- MC.try $ fPutObject "nosuchbucket" "lsb-release" "/etc/lsb-release" case fpE of - Left exn -> liftIO $ exn @?= (MErrService NoSuchBucket) + Left exn -> liftIO $ exn @?= NoSuchBucket _ -> return () outFile <- mkRandFile 0 @@ -132,7 +132,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server" step "fGetObject a non-existent object and check for NoSuchKey exception" resE <- MC.try $ fGetObject bucket "noSuchKey" outFile case resE of - Left exn -> liftIO $ exn @?= (MErrService NoSuchKey) + Left exn -> liftIO $ exn @?= NoSuchKey _ -> return ()