Move runResourceT into Minio monad (#50)
This commit is contained in:
parent
2e7984b71c
commit
dca4462879
@ -91,7 +91,7 @@ main = do
|
|||||||
filepath <- execParser cmdParser
|
filepath <- execParser cmdParser
|
||||||
let object = pack $ takeBaseName filepath
|
let object = pack $ takeBaseName filepath
|
||||||
|
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ do
|
||||||
-- Make a bucket; catch bucket already exists exception if thrown.
|
-- Make a bucket; catch bucket already exists exception if thrown.
|
||||||
catchIf (== BucketAlreadyOwnedByYou) (makeBucket bucket Nothing) ignoreMinioErr
|
catchIf (== BucketAlreadyOwnedByYou) (makeBucket bucket Nothing) ignoreMinioErr
|
||||||
|
|
||||||
|
|||||||
27
docs/API.md
27
docs/API.md
@ -117,7 +117,7 @@ performs connection pooling, bucket location caching (if enabled) and
|
|||||||
error handling.
|
error handling.
|
||||||
|
|
||||||
The `runMinio` function performs the provided action in the `Minio`
|
The `runMinio` function performs the provided action in the `Minio`
|
||||||
monad and returns a `ResourceT IO (Either MinioErr a)` value:
|
monad and returns a `IO (Either MinioErr a)` value:
|
||||||
|
|
||||||
``` haskell
|
``` haskell
|
||||||
{-# Language OverloadedStrings #-}
|
{-# Language OverloadedStrings #-}
|
||||||
@ -126,7 +126,7 @@ import Network.Minio
|
|||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
result <- runResourceT $ runMinio def $ do
|
result <- runMinio def $ do
|
||||||
buckets <- listBuckets
|
buckets <- listBuckets
|
||||||
return $ length buckets
|
return $ length buckets
|
||||||
|
|
||||||
@ -139,9 +139,6 @@ The above performs a `listBuckets` operation and returns the number of
|
|||||||
buckets in the server. If there were any errors, they will be returned
|
buckets in the server. If there were any errors, they will be returned
|
||||||
as values of type `MinioErr` as a `Left` value.
|
as values of type `MinioErr` as a `Left` value.
|
||||||
|
|
||||||
`runResourceT` takes a value from `ResourceT IO a` to `IO a`. It takes
|
|
||||||
care of running finalizers to free resources.
|
|
||||||
|
|
||||||
## 2. Bucket operations
|
## 2. Bucket operations
|
||||||
|
|
||||||
<a name="listBuckets"></a>
|
<a name="listBuckets"></a>
|
||||||
@ -185,7 +182,7 @@ __Example__
|
|||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ do
|
||||||
makeBucket bucketName (Just "us-east-1")
|
makeBucket bucketName (Just "us-east-1")
|
||||||
|
|
||||||
case res of
|
case res of
|
||||||
@ -216,7 +213,7 @@ __Example__
|
|||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ do
|
||||||
removeBucket "mybucket"
|
removeBucket "mybucket"
|
||||||
|
|
||||||
case res of
|
case res of
|
||||||
@ -272,7 +269,7 @@ main = do
|
|||||||
|
|
||||||
-- Performs a recursive listing of all objects under bucket "test"
|
-- Performs a recursive listing of all objects under bucket "test"
|
||||||
-- on play.minio.io.
|
-- on play.minio.io.
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ do
|
||||||
listObjects bucket Nothing True $$ sinkList
|
listObjects bucket Nothing True $$ sinkList
|
||||||
print res
|
print res
|
||||||
|
|
||||||
@ -323,7 +320,7 @@ main = do
|
|||||||
|
|
||||||
-- Performs a recursive listing of all incompletely uploaded objects
|
-- Performs a recursive listing of all incompletely uploaded objects
|
||||||
-- under bucket "test" on play.minio.io.
|
-- under bucket "test" on play.minio.io.
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ do
|
||||||
listIncompleteUploads bucket Nothing True $$ sinkList
|
listIncompleteUploads bucket Nothing True $$ sinkList
|
||||||
print res
|
print res
|
||||||
|
|
||||||
@ -372,7 +369,7 @@ main = do
|
|||||||
|
|
||||||
-- Lists the parts in an incompletely uploaded object identified by
|
-- Lists the parts in an incompletely uploaded object identified by
|
||||||
-- bucket, object and upload ID.
|
-- bucket, object and upload ID.
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ do
|
||||||
source <- getObject bucket object
|
source <- getObject bucket object
|
||||||
source $$+- sinkLbs
|
source $$+- sinkLbs
|
||||||
|
|
||||||
@ -413,7 +410,7 @@ main = do
|
|||||||
object = "myobject"
|
object = "myobject"
|
||||||
kb15 = 15 * 1024
|
kb15 = 15 * 1024
|
||||||
|
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ do
|
||||||
putObject bucket object (CC.repeat "a") (Just kb15)
|
putObject bucket object (CC.repeat "a") (Just kb15)
|
||||||
|
|
||||||
case res of
|
case res of
|
||||||
@ -459,7 +456,7 @@ main = do
|
|||||||
object = "my-object"
|
object = "my-object"
|
||||||
localFile = "/etc/lsb-release"
|
localFile = "/etc/lsb-release"
|
||||||
|
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ do
|
||||||
src <- fGetObject bucket object localFile
|
src <- fGetObject bucket object localFile
|
||||||
(src $$+- sinkLbs)
|
(src $$+- sinkLbs)
|
||||||
|
|
||||||
@ -497,7 +494,7 @@ main = do
|
|||||||
object = "myobject"
|
object = "myobject"
|
||||||
localFile = "/etc/lsb-release"
|
localFile = "/etc/lsb-release"
|
||||||
|
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ do
|
||||||
fPutObject bucket object localFile
|
fPutObject bucket object localFile
|
||||||
|
|
||||||
case res of
|
case res of
|
||||||
@ -545,7 +542,7 @@ main = do
|
|||||||
object = "myobject"
|
object = "myobject"
|
||||||
srcObject = "/mybucket/srcObject"
|
srcObject = "/mybucket/srcObject"
|
||||||
|
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ do
|
||||||
copyObject bucket object def { cpSource = srcObject }
|
copyObject bucket object def { cpSource = srcObject }
|
||||||
|
|
||||||
case res of
|
case res of
|
||||||
@ -579,7 +576,7 @@ main = do
|
|||||||
bucket = "mybucket"
|
bucket = "mybucket"
|
||||||
object = "myobject"
|
object = "myobject"
|
||||||
|
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ do
|
||||||
removeObject bucket object
|
removeObject bucket object
|
||||||
|
|
||||||
case res of
|
case res of
|
||||||
|
|||||||
@ -34,10 +34,10 @@ main :: IO ()
|
|||||||
main = do
|
main = do
|
||||||
let bucket = "missingbucket"
|
let bucket = "missingbucket"
|
||||||
|
|
||||||
res1 <- runResourceT $ runMinio minioPlayCI $ do
|
res1 <- runMinio minioPlayCI $ do
|
||||||
foundBucket <- bucketExists bucket
|
foundBucket <- bucketExists bucket
|
||||||
liftIO $ putStrLn $ "Does " ++ show bucket ++ " exist? - " ++ show foundBucket
|
liftIO $ putStrLn $ "Does " ++ show bucket ++ " exist? - " ++ show foundBucket
|
||||||
|
|
||||||
case res1 of
|
case res1 of
|
||||||
Left e -> putStrLn $ "bucketExists failed." ++ (show e)
|
Left e -> putStrLn $ "bucketExists failed." ++ show e
|
||||||
Right () -> return ()
|
Right () -> return ()
|
||||||
|
|||||||
@ -42,7 +42,7 @@ main = do
|
|||||||
objectCopy = "obj-copy"
|
objectCopy = "obj-copy"
|
||||||
localFile = "/etc/lsb-release"
|
localFile = "/etc/lsb-release"
|
||||||
|
|
||||||
res1 <- runResourceT $ runMinio minioPlayCI $ do
|
res1 <- runMinio minioPlayCI $ do
|
||||||
-- 1. Make a bucket; Catch BucketAlreadyOwnedByYou exception.
|
-- 1. Make a bucket; Catch BucketAlreadyOwnedByYou exception.
|
||||||
catchIf (== BucketAlreadyOwnedByYou) (makeBucket bucket Nothing) ignoreMinioErr
|
catchIf (== BucketAlreadyOwnedByYou) (makeBucket bucket Nothing) ignoreMinioErr
|
||||||
|
|
||||||
|
|||||||
@ -61,7 +61,7 @@ main = do
|
|||||||
filepath <- execParser cmdParser
|
filepath <- execParser cmdParser
|
||||||
let object = pack $ takeBaseName filepath
|
let object = pack $ takeBaseName filepath
|
||||||
|
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ do
|
||||||
-- Make a bucket; catch bucket already exists exception if thrown.
|
-- Make a bucket; catch bucket already exists exception if thrown.
|
||||||
catchIf (== BucketAlreadyOwnedByYou) (makeBucket bucket Nothing) ignoreMinioErr
|
catchIf (== BucketAlreadyOwnedByYou) (makeBucket bucket Nothing) ignoreMinioErr
|
||||||
|
|
||||||
|
|||||||
@ -36,7 +36,7 @@ main = do
|
|||||||
let
|
let
|
||||||
bucket = "my-bucket"
|
bucket = "my-bucket"
|
||||||
object = "my-object"
|
object = "my-object"
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ do
|
||||||
src <- getObject bucket object
|
src <- getObject bucket object
|
||||||
(src $$+- sinkLbs)
|
(src $$+- sinkLbs)
|
||||||
|
|
||||||
|
|||||||
@ -35,9 +35,9 @@ main = do
|
|||||||
let
|
let
|
||||||
bucket = "test"
|
bucket = "test"
|
||||||
object = "passwd"
|
object = "passwd"
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $
|
||||||
headObject bucket object
|
headObject bucket object
|
||||||
|
|
||||||
case res of
|
case res of
|
||||||
Left e -> putStrLn $ "headObject failed." ++ (show e)
|
Left e -> putStrLn $ "headObject failed." ++ show e
|
||||||
Right objInfo -> putStrLn $ "headObject succeeded." ++ (show objInfo)
|
Right objInfo -> putStrLn $ "headObject succeeded." ++ show objInfo
|
||||||
|
|||||||
@ -34,8 +34,8 @@ import Prelude
|
|||||||
-- region of the first bucket returned.
|
-- region of the first bucket returned.
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
firstRegionE <- runResourceT $ runMinio minioPlayCI $ do
|
firstRegionE <- runMinio minioPlayCI $ do
|
||||||
buckets <- listBuckets
|
buckets <- listBuckets
|
||||||
liftIO $ print $ "Top 5 buckets: " ++ (show $ take 5 buckets)
|
liftIO $ print $ "Top 5 buckets: " ++ show (take 5 buckets)
|
||||||
getLocation $ biName $ head buckets
|
getLocation $ biName $ head buckets
|
||||||
print firstRegionE
|
print firstRegionE
|
||||||
|
|||||||
@ -38,7 +38,7 @@ main = do
|
|||||||
|
|
||||||
-- Performs a recursive listing of incomplete uploads under bucket "test"
|
-- Performs a recursive listing of incomplete uploads under bucket "test"
|
||||||
-- on a local minio server.
|
-- on a local minio server.
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $
|
||||||
listIncompleteUploads bucket Nothing True $$ sinkList
|
listIncompleteUploads bucket Nothing True $$ sinkList
|
||||||
print res
|
print res
|
||||||
|
|
||||||
|
|||||||
@ -39,7 +39,7 @@ main = do
|
|||||||
|
|
||||||
-- Performs a recursive listing of all objects under bucket "test"
|
-- Performs a recursive listing of all objects under bucket "test"
|
||||||
-- on play.minio.io.
|
-- on play.minio.io.
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $
|
||||||
listObjects bucket Nothing True C.$$ CC.sinkList
|
listObjects bucket Nothing True C.$$ CC.sinkList
|
||||||
print res
|
print res
|
||||||
|
|
||||||
|
|||||||
@ -34,7 +34,7 @@ main :: IO ()
|
|||||||
main = do
|
main = do
|
||||||
let
|
let
|
||||||
bucket = "my-bucket"
|
bucket = "my-bucket"
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $
|
||||||
-- N B the region provided for makeBucket is optional.
|
-- N B the region provided for makeBucket is optional.
|
||||||
makeBucket bucket (Just "us-east-1")
|
makeBucket bucket (Just "us-east-1")
|
||||||
print res
|
print res
|
||||||
|
|||||||
@ -39,16 +39,16 @@ main = do
|
|||||||
kb15 = 15 * 1024
|
kb15 = 15 * 1024
|
||||||
|
|
||||||
-- Eg 1. Upload a stream of repeating "a" using putObject.
|
-- Eg 1. Upload a stream of repeating "a" using putObject.
|
||||||
res1 <- runResourceT $ runMinio minioPlayCI $ do
|
res1 <- runMinio minioPlayCI $
|
||||||
putObject bucket object (CC.repeat "a") (Just kb15)
|
putObject bucket object (CC.repeat "a") (Just kb15)
|
||||||
case res1 of
|
case res1 of
|
||||||
Left e -> putStrLn $ "putObject failed." ++ (show e)
|
Left e -> putStrLn $ "putObject failed." ++ show e
|
||||||
Right () -> putStrLn "putObject succeeded."
|
Right () -> putStrLn "putObject succeeded."
|
||||||
|
|
||||||
|
|
||||||
-- Eg 2. Upload a file using fPutObject.
|
-- Eg 2. Upload a file using fPutObject.
|
||||||
res2 <- runResourceT $ runMinio minioPlayCI $ do
|
res2 <- runMinio minioPlayCI $
|
||||||
fPutObject bucket object localFile
|
fPutObject bucket object localFile
|
||||||
case res2 of
|
case res2 of
|
||||||
Left e -> putStrLn $ "fPutObject failed." ++ (show e)
|
Left e -> putStrLn $ "fPutObject failed." ++ show e
|
||||||
Right () -> putStrLn "fPutObject succeeded."
|
Right () -> putStrLn "fPutObject succeeded."
|
||||||
|
|||||||
@ -28,7 +28,7 @@ main = do
|
|||||||
bucket = "mybucket"
|
bucket = "mybucket"
|
||||||
object = "myobject"
|
object = "myobject"
|
||||||
|
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $
|
||||||
removeObject bucket object
|
removeObject bucket object
|
||||||
|
|
||||||
case res of
|
case res of
|
||||||
|
|||||||
@ -34,6 +34,5 @@ main :: IO ()
|
|||||||
main = do
|
main = do
|
||||||
let
|
let
|
||||||
bucket = "my-bucket"
|
bucket = "my-bucket"
|
||||||
res <- runResourceT $ runMinio minioPlayCI $ do
|
res <- runMinio minioPlayCI $ removeBucket bucket
|
||||||
removeBucket bucket
|
|
||||||
print res
|
print res
|
||||||
|
|||||||
@ -25,7 +25,6 @@ module Network.Minio
|
|||||||
|
|
||||||
, Minio
|
, Minio
|
||||||
, runMinio
|
, runMinio
|
||||||
, runResourceT
|
|
||||||
, def
|
, def
|
||||||
|
|
||||||
-- * Error handling
|
-- * Error handling
|
||||||
@ -77,7 +76,6 @@ module Network.Minio
|
|||||||
This module exports the high-level Minio API for object storage.
|
This module exports the high-level Minio API for object storage.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
import Control.Monad.Trans.Resource (runResourceT)
|
|
||||||
import qualified Data.Conduit as C
|
import qualified Data.Conduit as C
|
||||||
import qualified Data.Conduit.Binary as CB
|
import qualified Data.Conduit.Binary as CB
|
||||||
import Data.Default (def)
|
import Data.Default (def)
|
||||||
|
|||||||
@ -342,10 +342,10 @@ connect ci = do
|
|||||||
return $ MinioConn ci mgr
|
return $ MinioConn ci mgr
|
||||||
|
|
||||||
-- | Run the Minio action and return the result or an error.
|
-- | Run the Minio action and return the result or an error.
|
||||||
runMinio :: ConnectInfo -> Minio a -> ResourceT IO (Either MinioErr a)
|
runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
|
||||||
runMinio ci m = do
|
runMinio ci m = do
|
||||||
conn <- liftIO $ connect ci
|
conn <- liftIO $ connect ci
|
||||||
flip evalStateT Map.empty . flip runReaderT conn . unMinio $
|
runResourceT . flip evalStateT Map.empty . flip runReaderT conn . unMinio $
|
||||||
fmap Right m `MC.catches`
|
fmap Right m `MC.catches`
|
||||||
[ MC.Handler handlerServiceErr
|
[ MC.Handler handlerServiceErr
|
||||||
, MC.Handler handlerHE
|
, MC.Handler handlerHE
|
||||||
|
|||||||
@ -83,7 +83,7 @@ funTestWithBucket t minioTest = testCaseSteps t $ \step -> do
|
|||||||
let b = T.concat [funTestBucketPrefix, T.pack bktSuffix]
|
let b = T.concat [funTestBucketPrefix, T.pack bktSuffix]
|
||||||
liftStep = liftIO . step
|
liftStep = liftIO . step
|
||||||
connInfo <- maybe minioPlayCI (const def) <$> lookupEnv "MINIO_LOCAL"
|
connInfo <- maybe minioPlayCI (const def) <$> lookupEnv "MINIO_LOCAL"
|
||||||
ret <- runResourceT $ runMinio connInfo $ do
|
ret <- runMinio connInfo $ do
|
||||||
liftStep $ "Creating bucket for test - " ++ t
|
liftStep $ "Creating bucket for test - " ++ t
|
||||||
foundBucket <- bucketExists b
|
foundBucket <- bucketExists b
|
||||||
liftIO $ foundBucket @?= False
|
liftIO $ foundBucket @?= False
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user