Add some basic documentation

This commit is contained in:
Aditya Manthramurthy 2017-01-18 00:08:22 +05:30
parent 6db483c2bc
commit 20481ef019
6 changed files with 81 additions and 53 deletions

View File

@ -13,8 +13,7 @@ import Control.Monad.Trans.Resource (runResourceT)
main :: IO () main :: IO ()
main = do main = do
mc <- connect defaultConnectInfo t <- runResourceT $ runMinio defaultConnectInfo $ do
t <- runResourceT $ runMinio mc $ do
res <- getService res <- getService
print res print res
-- case res of -- case res of

View File

@ -1,6 +1,6 @@
name: minio-hs name: minio-hs
version: 0.1.0.0 version: 0.1.0.0
synopsis: Initial project template from stack synopsis: A Minio client library, compatible with S3 like services.
description: Please see README.md description: Please see README.md
homepage: https://github.com/donatello/minio-hs#readme homepage: https://github.com/donatello/minio-hs#readme
license: BSD3 license: BSD3

View File

@ -1,5 +1,29 @@
module Network.Minio module Network.Minio
( module Exports (
D.ConnectInfo(..)
, D.defaultConnectInfo
, D.connect
, D.Minio
, D.runMinio
-- * Error handling
-----------------------
-- | Test
, D.MinioErr(..)
, D.MErrV(..)
-- * Data Types
----------------
-- | Data types representing various object store concepts.
, D.Bucket
, D.Object
, D.BucketInfo(..)
, S.getService
, S.getLocation
, fGetObject , fGetObject
, fPutObject , fPutObject
) where ) where
@ -8,21 +32,10 @@ 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 Network.Minio.S3API as import qualified Network.Minio.S3API as S
Exports (
getService
, getLocation
)
import Network.Minio.Data as import qualified Network.Minio.Data as D
Exports (
runMinio
, defaultConnectInfo
, connect
, ConnectInfo(..)
)
-- import System.FilePath (FilePath)
import qualified System.IO as IO import qualified System.IO as IO
import qualified Data.Conduit as C import qualified Data.Conduit as C
import qualified Control.Monad.Trans.Resource as R import qualified Control.Monad.Trans.Resource as R
@ -34,11 +47,15 @@ import Network.Minio.Data
import Network.Minio.S3API import Network.Minio.S3API
import Network.Minio.Utils import Network.Minio.Utils
-- | Fetch the object and write it to the given file safely. The
-- object is first written to a temporary file in the same directory
-- and then moved to the given path.
fGetObject :: Bucket -> Object -> FilePath -> Minio () fGetObject :: Bucket -> Object -> FilePath -> Minio ()
fGetObject bucket object fp = do fGetObject bucket object fp = do
(_, src) <- getObject bucket object [] [] (_, src) <- getObject bucket object [] []
src C.$$+- CB.sinkFileCautious fp src C.$$+- CB.sinkFileCautious fp
-- | Upload the given file to the given object.
fPutObject :: Bucket -> Object -> FilePath -> Minio () fPutObject :: Bucket -> Object -> FilePath -> Minio ()
fPutObject bucket object fp = do fPutObject bucket object fp = do
(releaseKey, h) <- allocateReadFile fp (releaseKey, h) <- allocateReadFile fp

View File

@ -46,12 +46,21 @@ defaultConnectInfo :: ConnectInfo
defaultConnectInfo = defaultConnectInfo =
ConnectInfo "localhost" 9000 "minio" "minio123" False ConnectInfo "localhost" 9000 "minio" "minio123" False
-- |
-- Represents a bucket in the object store
type Bucket = Text type Bucket = Text
-- |
-- Represents an object name
type Object = Text type Object = Text
-- FIXME: This could be a Sum Type with all defined regions for AWS. -- |
-- Represents a region
-- TODO: This could be a Sum Type with all defined regions for AWS.
type Location = Text type Location = Text
-- |
-- BucketInfo returned for list buckets call
data BucketInfo = BucketInfo { data BucketInfo = BucketInfo {
biName :: Bucket biName :: Bucket
, biCreationDate :: UTCTime , biCreationDate :: UTCTime
@ -85,9 +94,13 @@ getPathFromRI ri = B.concat $ parts
getRegionFromRI :: RequestInfo -> Text getRegionFromRI :: RequestInfo -> Text
getRegionFromRI ri = maybe "us-east-1" identity (riRegion ri) getRegionFromRI ri = maybe "us-east-1" identity (riRegion ri)
-- | Various validation errors
data MErrV = MErrVSinglePUTSizeExceeded Int64 data MErrV = MErrVSinglePUTSizeExceeded Int64
deriving (Show) deriving (Show)
-- |
-- Minio Error data type for various errors/exceptions caught and
-- returned.
data MinioErr = MErrMsg ByteString -- generic data MinioErr = MErrMsg ByteString -- generic
| MErrHttp HttpException -- http exceptions | MErrHttp HttpException -- http exceptions
| MErrXml ByteString -- XML parsing/generation errors | MErrXml ByteString -- XML parsing/generation errors
@ -116,19 +129,24 @@ instance MonadBaseControl IO Minio where
liftBaseWith f = Minio $ liftBaseWith $ \q -> f (q . unMinio) liftBaseWith f = Minio $ liftBaseWith $ \q -> f (q . unMinio)
restoreM = Minio . restoreM restoreM = Minio . restoreM
-- MinioConn holds connection info and a connection pool -- | MinioConn holds connection info and a connection pool
data MinioConn = MinioConn { data MinioConn = MinioConn {
mcConnInfo :: ConnectInfo mcConnInfo :: ConnectInfo
, mcConnManager :: NC.Manager , mcConnManager :: NC.Manager
} }
-- | Takes connection information and returns a connection object to
-- be passed to @runMinio
connect :: ConnectInfo -> IO MinioConn connect :: ConnectInfo -> IO MinioConn
connect ci = do connect ci = do
mgr <- NC.newManager defaultManagerSettings mgr <- NC.newManager defaultManagerSettings
return $ MinioConn ci mgr return $ MinioConn ci mgr
runMinio :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a) -- | Run the Minio action and return the result or error.
runMinio conn = runExceptT . flip runReaderT conn . unMinio runMinio :: ConnectInfo -> Minio a -> ResourceT IO (Either MinioErr a)
runMinio ci m = do
conn <- liftIO $ connect ci
runExceptT . flip runReaderT conn . unMinio $ m
s3Name :: Text -> Name s3Name :: Text -> Name
s3Name s = Name s (Just "http://s3.amazonaws.com/doc/2006-03-01/") Nothing s3Name s = Name s (Just "http://s3.amazonaws.com/doc/2006-03-01/") Nothing

View File

@ -23,12 +23,14 @@ import Network.Minio.XmlParser
import Network.Minio.XmlGenerator import Network.Minio.XmlGenerator
-- | Fetch all buckets from the service.
getService :: Minio [BucketInfo] getService :: Minio [BucketInfo]
getService = do getService = do
resp <- executeRequest $ resp <- executeRequest $
requestInfo HT.methodGet Nothing Nothing [] [] EPayload requestInfo HT.methodGet Nothing Nothing [] [] EPayload
parseListBuckets $ NC.responseBody resp parseListBuckets $ NC.responseBody resp
-- | Fetch bucket location (region)
getLocation :: Bucket -> Minio Text getLocation :: Bucket -> Minio Text
getLocation bucket = do getLocation bucket = do
resp <- executeRequest $ resp <- executeRequest $
@ -36,6 +38,8 @@ getLocation bucket = do
EPayload EPayload
parseLocation $ NC.responseBody resp parseLocation $ NC.responseBody resp
-- | GET an object from the service and return the response headers
-- and a conduit source for the object content
getObject :: Bucket -> Object -> HT.Query -> [HT.Header] getObject :: Bucket -> Object -> HT.Query -> [HT.Header]
-> Minio ([HT.Header], C.ResumableSource Minio ByteString) -> Minio ([HT.Header], C.ResumableSource Minio ByteString)
getObject bucket object queryParams headers = do getObject bucket object queryParams headers = do
@ -45,15 +49,19 @@ getObject bucket object queryParams headers = do
reqInfo = requestInfo HT.methodGet (Just bucket) (Just object) reqInfo = requestInfo HT.methodGet (Just bucket) (Just object)
queryParams headers EPayload queryParams headers EPayload
-- | Creates a bucket via a PUT bucket call.
putBucket :: Bucket -> Location -> Minio () putBucket :: Bucket -> Location -> Minio ()
putBucket bucket location = do putBucket bucket location = do
void $ executeRequest $ void $ executeRequest $
requestInfo HT.methodPut (Just bucket) Nothing [] [] $ requestInfo HT.methodPut (Just bucket) Nothing [] [] $
PayloadBS $ mkCreateBucketConfig location PayloadBS $ mkCreateBucketConfig location
-- | Single PUT object size.
maxSinglePutObjectSizeBytes :: Int64 maxSinglePutObjectSizeBytes :: Int64
maxSinglePutObjectSizeBytes = 5 * 1024 * 1024 * 1024 maxSinglePutObjectSizeBytes = 5 * 1024 * 1024 * 1024
-- | PUT an object into the service. This function performs a single
-- PUT object calls, and so can only transfer objects upto 5GiB.
putObject :: Bucket -> Object -> [HT.Header] -> Int64 putObject :: Bucket -> Object -> [HT.Header] -> Int64
-> Int64 -> Handle -> Minio () -> Int64 -> Handle -> Minio ()
putObject bucket object headers offset size h = do putObject bucket object headers offset size h = do
@ -66,12 +74,13 @@ putObject bucket object headers offset size h = do
requestInfo HT.methodPut (Just bucket) (Just object) [] headers $ requestInfo HT.methodPut (Just bucket) (Just object) [] headers $
PayloadH h offset size PayloadH h offset size
-- | DELETE a bucket from the service.
deleteBucket :: Bucket -> Minio () deleteBucket :: Bucket -> Minio ()
deleteBucket bucket = do deleteBucket bucket = do
void $ executeRequest $ void $ executeRequest $
requestInfo HT.methodDelete (Just bucket) Nothing [] [] EPayload requestInfo HT.methodDelete (Just bucket) Nothing [] [] EPayload
-- | DELETE an object from the service.
deleteObject :: Bucket -> Object -> Minio () deleteObject :: Bucket -> Object -> Minio ()
deleteObject bucket object = do deleteObject bucket object = do
void $ executeRequest $ void $ executeRequest $

View File

@ -20,7 +20,7 @@ main = defaultMain tests
-- main = putStrLn ("Test suite not yet implemented" :: Text) -- main = putStrLn ("Test suite not yet implemented" :: Text)
tests :: TestTree tests :: TestTree
tests = testGroup "Tests" [properties, unitTests] tests = testGroup "Tests" [properties, unitTests, liveServerUnitTests]
properties :: TestTree properties :: TestTree
properties = testGroup "Properties" [] -- [scProps, qcProps] properties = testGroup "Properties" [] -- [scProps, qcProps]
@ -47,46 +47,31 @@ properties = testGroup "Properties" [] -- [scProps, qcProps]
-- (n :: Integer) >= 3 QC.==> x^n + y^n /= (z^n :: Integer) -- (n :: Integer) >= 3 QC.==> x^n + y^n /= (z^n :: Integer)
-- ] -- ]
unitTests :: TestTree liveServerUnitTests :: TestTree
unitTests = testGroup "Unit tests" liveServerUnitTests = testGroup "Unit tests against a live server"
[ testCaseSteps "Check getService returns without exception" $ \step -> do [ testCase "Check getService returns without exception" $ do
step "Preparing..." ret <- runResourceT $ runMinio defaultConnectInfo $ getService
mc <- connect defaultConnectInfo
step "Running test.."
ret <- runResourceT $ runMinio mc $ getService
isRight ret @? ("getService failure => " ++ show ret) isRight ret @? ("getService failure => " ++ show ret)
, testCaseSteps "Simple fGetObject works" $ \step -> do
step "Preparing..."
mc <- connect defaultConnectInfo , testCase "Simple fGetObject works" $ do
ret <- runResourceT $ runMinio defaultConnectInfo $
step "Running test.."
ret <- runResourceT $ runMinio mc $
fGetObject "testbucket" "lsb-release" "/tmp/out" fGetObject "testbucket" "lsb-release" "/tmp/out"
isRight ret @? ("fGetObject failure => " ++ show ret) isRight ret @? ("fGetObject failure => " ++ show ret)
, testCaseSteps "Simple putObject works" $ \step -> do , testCase "Simple putObject works" $ do
step "Preparing..." ret <- runResourceT $ runMinio defaultConnectInfo $
mc <- connect defaultConnectInfo
step "Running test.."
ret <- runResourceT $ runMinio mc $
fPutObject "testbucket" "lsb-release" "/etc/lsb-release" fPutObject "testbucket" "lsb-release" "/etc/lsb-release"
isRight ret @? ("putObject failure => " ++ show ret) isRight ret @? ("putObject failure => " ++ show ret)
, testCaseSteps "Simple putObject fails with non-existent file" $ \step -> do , testCase "Simple putObject fails with non-existent file" $ do
step "Preparing..." ret <- runResourceT $ runMinio defaultConnectInfo $
mc <- connect defaultConnectInfo
step "Running test.."
ret <- runResourceT $ runMinio mc $
fPutObject "testbucket" "lsb-release" "/etc/lsb-releaseXXX" fPutObject "testbucket" "lsb-release" "/etc/lsb-releaseXXX"
isLeft ret @? ("putObject unexpected success => " ++ show ret) isLeft ret @? ("putObject unexpected success => " ++ show ret)
]
unitTests :: TestTree
unitTests = testGroup "Unit tests"
[ testCase "Test mkCreateBucketConfig." testMkCreateBucketConfig
, testCase "Test mkCreateBucketConfig." testMkCreateBucketConfig
, testCase "Test parseLocation." testParseLocation , testCase "Test parseLocation." testParseLocation
] ]