Add copyObject example. (#30)

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."

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 $
+      _ -> throwM $ NC.StatusCodeException (NC.responseStatus resp) [] def
-           MErrHTTP $ 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 $
+      _ -> throwM $ NC.StatusCodeException (NC.responseStatus resp) [] def
-           MErrHTTP $ NC.StatusCodeException (NC.responseStatus resp) [] def
 
   return resp
   where

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 ()