minio-hs 0.0.1 → 0.1.0

raw patch · 7 files changed

+132/−28 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• minio-hs.cabal +1/−1
• src/Network/Minio.hs +18/−1
• src/Network/Minio/Data.hs +3/−1
• src/Network/Minio/S3API.hs +31/−5
• src/Network/Minio/Utils.hs +20/−1
• src/Network/Minio/XmlParser.hs +5/−6
• test/Spec.hs +54/−13

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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