diff --git a/minio-hs.cabal b/minio-hs.cabal --- a/minio-hs.cabal +++ b/minio-hs.cabal @@ -1,5 +1,5 @@ name: minio-hs -version: 0.0.1 +version: 0.1.0 synopsis: A Minio client library, compatible with S3 like services. description: Please see README.md homepage: https://github.com/donatello/minio-hs#readme diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs --- a/src/Network/Minio.hs +++ b/src/Network/Minio.hs @@ -4,7 +4,6 @@ ConnectInfo(..) , awsCI , minioPlayCI - , connect , Minio , runMinio @@ -24,6 +23,9 @@ , Bucket , Object , BucketInfo(..) + , ObjectInfo(..) + , UploadInfo(..) + , ListPartInfo(..) , UploadId , ObjectData(..) @@ -31,6 +33,7 @@ ---------------------- , getService , getLocation + , makeBucket , listObjects , listIncompleteUploads @@ -43,6 +46,7 @@ , putObjectFromSource , getObject + , statObject ) where @@ -87,3 +91,16 @@ -- | Get an object from the object store as a resumable source (conduit). getObject :: Bucket -> Object -> Minio (C.ResumableSource Minio ByteString) getObject bucket object = snd <$> getObject' bucket object [] [] + +-- | Creates a new bucket in the object store. The Region can be +-- optionally specified. If not specified, it will use the region +-- configured in ConnectInfo, which is by default, the US Standard +-- Region. +makeBucket :: Bucket -> Maybe Region -> Minio () +makeBucket bucket regionMay= do + region <- maybe (asks $ connectRegion . mcConnInfo) return regionMay + putBucket bucket region + +-- | Get an object's metadata from the object store. +statObject :: Bucket -> Object -> Minio ObjectInfo +statObject bucket object = headObject bucket object diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -23,10 +23,11 @@ , connectAccessKey :: Text , connectSecretKey :: Text , connectIsSecure :: Bool + , connectRegion :: Region } deriving (Eq, Show) instance Default ConnectInfo where - def = ConnectInfo "localhost" 9000 "minio" "minio123" False + def = ConnectInfo "localhost" 9000 "minio" "minio123" False "us-east-1" -- | -- Default aws ConnectInfo. Credentials should be supplied before use. @@ -229,6 +230,7 @@ data MErrV = MErrVSinglePUTSizeExceeded Int64 | MErrVPutSizeExceeded Int64 | MErrVETagHeaderNotFound + | MErrVInvalidObjectInfoResponse deriving (Show, Eq) -- | Errors thrown by the library diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -1,6 +1,7 @@ module Network.Minio.S3API ( - getLocation + Region + , getLocation -- * Listing buckets -------------------- @@ -8,24 +9,33 @@ -- * Listing objects -------------------- + , ListObjectsResult , listObjects' -- * Retrieving objects ----------------------- , getObject' + , headObject -- * Creating buckets and objects --------------------------------- , putBucket + , ETag , putObjectSingle -- * Multipart Upload APIs -------------------------- + , UploadId + , PartInfo + , Payload(..) + , PartNumber , newMultipartUpload , putObjectPart , completeMultipartUpload , abortMultipartUpload + , ListUploadsResult , listIncompleteUploads' + , ListPartsResult , listIncompleteParts' -- * Deletion APIs @@ -56,7 +66,7 @@ parseListBuckets $ NC.responseBody resp -- | Fetch bucket location (region) -getLocation :: Bucket -> Minio Text +getLocation :: Bucket -> Minio Region getLocation bucket = do resp <- executeRequest $ def { riBucket = Just bucket , riQueryParams = [("location", Nothing)] @@ -74,7 +84,8 @@ reqInfo = def { riBucket = Just bucket , riObject = Just object , riQueryParams = queryParams - , riHeaders = headers} + , riHeaders = headers + } -- | Creates a bucket via a PUT bucket call. putBucket :: Bucket -> Region -> Minio () @@ -113,8 +124,6 @@ (throwM $ ValidationError MErrVETagHeaderNotFound) return etag - - -- | List objects in a bucket matching prefix up to delimiter, -- starting from nextToken. listObjects' :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text @@ -247,3 +256,20 @@ , ("part-number-marker", partNumMarker) , ("max-parts", maxParts) ] + +-- | Get metadata of an object. +headObject :: Bucket -> Object -> Minio ObjectInfo +headObject bucket object = do + resp <- executeRequest $ def { riMethod = HT.methodHead + , riBucket = Just bucket + , riObject = Just object + } + + let + headers = NC.responseHeaders resp + modTime = getLastModifiedHeader headers + etag = getETagHeader headers + size = getContentLength headers + + maybe (throwM $ ValidationError MErrVInvalidObjectInfoResponse) return $ + ObjectInfo <$> Just object <*> modTime <*> etag <*> size diff --git a/src/Network/Minio/Utils.hs b/src/Network/Minio/Utils.hs --- a/src/Network/Minio/Utils.hs +++ b/src/Network/Minio/Utils.hs @@ -9,17 +9,25 @@ import qualified Data.ByteString as B import qualified Data.Conduit as C +import qualified Data.Text as T import Data.Text.Encoding.Error (lenientDecode) +import Data.Text.Read (decimal) +import Data.Time import qualified Network.HTTP.Client as NClient import Network.HTTP.Conduit (Response) import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Types as HT +import qualified Network.HTTP.Types.Header as Hdr import qualified System.IO as IO import Lib.Prelude import Network.Minio.Data +-- | Represent the time format string returned by S3 API calls. +s3TimeFormat :: [Char] +s3TimeFormat = iso8601DateFormat $ Just "%T%QZ" + allocateReadFile :: (R.MonadResource m, R.MonadResourceBase m) => FilePath -> m (R.ReleaseKey, Handle) allocateReadFile fp = do @@ -72,7 +80,18 @@ lookupHeader hdr = headMay . map snd . filter (\(h, _) -> h == hdr) getETagHeader :: [HT.Header] -> Maybe Text -getETagHeader hs = decodeUtf8Lenient <$> lookupHeader "ETag" hs +getETagHeader hs = decodeUtf8Lenient <$> lookupHeader Hdr.hETag hs + +getLastModifiedHeader :: [HT.Header] -> Maybe UTCTime +getLastModifiedHeader hs = do + modTimebs <- decodeUtf8Lenient <$> lookupHeader Hdr.hLastModified hs + parseTimeM True defaultTimeLocale rfc822DateFormat (T.unpack modTimebs) + +getContentLength :: [HT.Header] -> Maybe Int64 +getContentLength hs = do + nbs <- decodeUtf8Lenient <$> lookupHeader Hdr.hContentLength hs + fst <$> hush (decimal nbs) + decodeUtf8Lenient :: ByteString -> Text decodeUtf8Lenient = decodeUtf8With lenientDecode diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs --- a/src/Network/Minio/XmlParser.hs +++ b/src/Network/Minio/XmlParser.hs @@ -19,6 +19,7 @@ import Lib.Prelude import Network.Minio.Data +import Network.Minio.Utils (s3TimeFormat) -- | Helper functions. @@ -28,19 +29,17 @@ uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e uncurry4 f (a, b, c, d) = f a b c d --- | Represent the time format string returned by S3 API calls. -s3TimeFormat :: [Char] -s3TimeFormat = iso8601DateFormat $ Just "%T%QZ" - -- | Parse time strings from XML parseS3XMLTime :: (MonadThrow m) => Text -> m UTCTime parseS3XMLTime = either (throwM . XMLParseError) return . parseTimeM True defaultTimeLocale s3TimeFormat . T.unpack +parseDecimal :: (MonadThrow m, Integral a) => Text -> m a +parseDecimal numStr = either (throwM . XMLParseError . show) return $ fst <$> decimal numStr + parseDecimals :: (MonadThrow m, Integral a) => [Text] -> m [a] -parseDecimals numStr = forM numStr $ \str -> - either (throwM . XMLParseError . show) return $ fst <$> decimal str +parseDecimals numStr = forM numStr parseDecimal s3Elem :: Text -> Axis s3Elem = element . s3Name diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,7 +1,7 @@ -import Test.QuickCheck (generate) import qualified Test.QuickCheck as Q import Test.Tasty import Test.Tasty.HUnit +import Test.Tasty.QuickCheck as QC import Lib.Prelude @@ -16,9 +16,11 @@ import Data.Conduit.Combinators (sinkList) import Data.Default (Default(..)) import qualified Data.Text as T +import qualified Data.List as L import Network.Minio import Network.Minio.Data +import Network.Minio.PutObject import Network.Minio.S3API import Network.Minio.Utils import Network.Minio.XmlGenerator.Test @@ -31,7 +33,7 @@ tests = testGroup "Tests" [properties, unitTests, liveServerUnitTests] properties :: TestTree -properties = testGroup "Properties" [] -- [scProps, qcProps] +properties = testGroup "Properties" [qcProps] -- [scProps] -- scProps = testGroup "(checked by SmallCheck)" -- [ SC.testProperty "sort == sort . reverse" $ @@ -44,17 +46,41 @@ -- (n :: Integer) >= 3 SC.==> x^n + y^n /= (z^n :: Integer) -- ] --- qcProps = testGroup "(checked by QuickCheck)" --- [ QC.testProperty "sort == sort . reverse" $ --- \list -> sort (list :: [Int]) == sort (reverse list) --- , QC.testProperty "Fermat's little theorem" $ --- \x -> ((x :: Integer)^7 - x) `mod` 7 == 0 --- -- the following property does not hold --- , QC.testProperty "Fermat's last theorem" $ --- \x y z n -> --- (n :: Integer) >= 3 QC.==> x^n + y^n /= (z^n :: Integer) --- ] +qcProps :: TestTree +qcProps = testGroup "(checked by QuickCheck)" + [ QC.testProperty "selectPartSizes: simple properties" $ + \n -> let (pns, offs, sizes) = L.unzip3 (selectPartSizes n) + -- check that pns increments from 1. + isPNumsAscendingFrom1 = all (\(a, b) -> a == b) $ zip pns [1..] + + consPairs [] = [] + consPairs [_] = [] + consPairs (a:(b:c)) = (a, b):(consPairs (b:c)) + + -- check `offs` is monotonically increasing. + isOffsetsAsc = all (\(a, b) -> a < b) $ consPairs offs + + -- check sizes sums to n. + isSumSizeOk = n < 0 || (sum sizes == n && all (> 0) sizes) + + -- check sizes are constant except last + isSizesConstantExceptLast = + n <= 0 || all (\(a, b) -> a == b) (consPairs $ L.init sizes) + + in isPNumsAscendingFrom1 && isOffsetsAsc && isSumSizeOk && + isSizesConstantExceptLast + + , QC.testProperty "selectPartSizes: part-size is at least 64MiB" $ + \n -> let (_, _, sizes) = L.unzip3 (selectPartSizes n) + mib64 = 64 * 1024 * 1024 + in if | length sizes > 1 -> -- last part can be smaller but > 0 + all (>= mib64) (L.init sizes) && L.last sizes > 0 + | length sizes == 1 -> maybe True (> 0) $ head sizes + | otherwise -> True + ] + + -- conduit that generates random binary stream of given length randomDataSrc :: MonadIO m => Int64 -> C.Producer m ByteString randomDataSrc s' = genBS s' @@ -90,7 +116,7 @@ liftStep = liftIO . step ret <- runResourceT $ runMinio def $ do liftStep $ "Creating bucket for test - " ++ t - putBucket b "us-east-1" + makeBucket b def minioTest liftStep b deleteBucket b isRight ret @? ("Functional test " ++ t ++ " failed => " ++ show ret) @@ -299,6 +325,21 @@ incompleteParts <- (listIncompleteParts bucket object uid) $$ sinkList liftIO $ (length incompleteParts) @?= 10 + , funTestWithBucket "High-level statObject Test" $ \step bucket -> do + let + object = "sample" + zeroByte = 0 + + step "create an object" + inputFile <- mkRandFile zeroByte + fPutObject bucket object inputFile + + step "get metadata of the object" + res <- statObject bucket object + liftIO $ (oiSize res) @?= 0 + + step "delete object" + deleteObject bucket object ] unitTests :: TestTree