minio-hs 0.2.1 → 0.3.0

raw patch · 15 files changed

+227/−92 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• minio-hs.cabal +3/−2
• src/Network/Minio.hs +6/−3
• src/Network/Minio/API.hs +62/−15
• src/Network/Minio/Data.hs +8/−9
• src/Network/Minio/Data/ByteString.hs +5/−5
• src/Network/Minio/Errors.hs +3/−1
• src/Network/Minio/ListOps.hs +4/−5
• src/Network/Minio/PutObject.hs +2/−2
• src/Network/Minio/S3API.hs +49/−16
• src/Network/Minio/Sign/V4.hs +12/−14
• src/Network/Minio/Utils.hs +8/−10
• src/Network/Minio/XmlParser.hs +5/−5
• test/LiveServer.hs +6/−4
• test/Network/Minio/API/Test.hs +50/−0
• test/Spec.hs +4/−1

@@ -1,5 +1,5 @@ name:                minio-hs-version:             0.2.1+version:             0.3.0 synopsis:            A Minio client library, compatible with S3 like services. description:         minio-hs provides simple APIs to access Minio and Amazon                      S3 compatible object storage server. For more details,@@ -106,6 +106,7 @@                      , Network.Minio.S3API                      , Network.Minio.Sign.V4                      , Network.Minio.Utils+                     , Network.Minio.API.Test                      , Network.Minio.XmlGenerator                      , Network.Minio.XmlGenerator.Test                      , Network.Minio.XmlParser@@ -190,7 +191,6 @@                      , transformers-base                      , xml-conduit   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N-  -- ghc-options:         -Wall   default-language:    Haskell2010   default-extensions:  FlexibleContexts                      , FlexibleInstances@@ -215,6 +215,7 @@                      , Network.Minio.S3API                      , Network.Minio.Sign.V4                      , Network.Minio.Utils+                     , Network.Minio.API.Test                      , Network.Minio.XmlGenerator                      , Network.Minio.XmlGenerator.Test                      , Network.Minio.XmlParser

@@ -25,7 +25,6 @@    , Minio   , runMinio-  , runResourceT   , def    -- * Error handling@@ -53,6 +52,7 @@   ----------------------   , listBuckets   , getLocation+  , bucketExists   , makeBucket   , removeBucket @@ -76,7 +76,6 @@ 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.Binary as CB import           Data.Default (def)@@ -133,7 +132,7 @@  -- | Get an object's metadata from the object store. statObject :: Bucket -> Object -> Minio ObjectInfo-statObject bucket object = headObject bucket object+statObject = headObject  -- | Creates a new bucket in the object store. The Region can be -- optionally specified. If not specified, it will use the region@@ -149,3 +148,7 @@ removeBucket bucket = do   deleteBucket bucket   modify (Map.delete bucket)++-- | Query the object store if a given bucket is present.+bucketExists :: Bucket -> Minio Bool+bucketExists = headBucket

@@ -22,13 +22,20 @@   , executeRequest   , mkStreamRequest   , getLocation++  , isValidBucketName+  , checkBucketNameValidity+  , isValidObjectName+  , checkObjectNameValidity   ) where  import qualified Data.Conduit as C import           Data.Conduit.Binary (sourceHandleRange) import           Data.Default (def) import qualified Data.Map as Map+import qualified Data.Char as C import qualified Data.Text as T+import qualified Data.ByteString as B import           Network.HTTP.Conduit (Response) import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Types as HT@@ -87,28 +94,26 @@  buildRequest :: RequestInfo -> Minio NC.Request buildRequest ri = do-  {--    If ListBuckets/MakeBucket/GetLocation then use connectRegion ci-    Else If discovery off use connectRegion ci-    Else {+  maybe (return ()) checkBucketNameValidity $ riBucket ri+  maybe (return ()) checkObjectNameValidity $ riObject ri -    // Here discovery is on-    Lookup region in regionMap-    If present use that-    Else getLocation-    }-  -}   ci <- asks mcConnInfo-  region <- if | not $ riNeedsLocation ri -> -- getService/makeBucket/getLocation-                                             -- don't need location++               -- getService/makeBucket/getLocation -- don't need+               -- location+  region <- if | not $ riNeedsLocation ri ->                    return $ Just $ connectRegion ci-               | not $ connectAutoDiscoverRegion ci -> -- if autodiscovery of location is disabled by user++               -- if autodiscovery of location is disabled by user+               | not $ connectAutoDiscoverRegion ci ->                    return $ Just $ connectRegion ci++               -- discover the region for the request                | otherwise -> discoverRegion ri    regionHost <- case region of     Nothing ->  return $ connectHost ci-    Just r -> if "amazonaws.com" `T.isSuffixOf` (connectHost ci)+    Just r -> if "amazonaws.com" `T.isSuffixOf` connectHost ci               then maybe                    (throwM $ MErrVRegionNotSupported r)                    return@@ -118,7 +123,7 @@    sha256Hash <- getPayloadSHA256Hash (riPayload ri)   let newRi = ri { riPayloadHash = sha256Hash-                 , riHeaders = sha256Header sha256Hash : (riHeaders ri)+                 , riHeaders = sha256Header sha256Hash : riHeaders ri                  , riRegion = region                  }       newCi = ci { connectHost = regionHost }@@ -149,3 +154,45 @@   req <- buildRequest ri   mgr <- asks mcConnManager   http req mgr++-- Bucket name validity check according to AWS rules.+isValidBucketName :: Bucket -> Bool+isValidBucketName bucket =+  not (or [ len < 3 || len > 63+          , or (map labelCheck labels)+          , or (map labelCharsCheck labels)+          , isIPCheck+          ])+  where+    len = T.length bucket+    labels = T.splitOn "." bucket++    -- does label `l` fail basic checks of length and start/end?+    labelCheck l = T.length l == 0 || T.head l == '-' || T.last l == '-'++    -- does label `l` have non-allowed characters?+    labelCharsCheck l = isJust $ T.find (\x -> not (C.isAsciiLower x ||+                                                    x == '-' ||+                                                    C.isDigit x)) l++    -- does label `l` have non-digit characters?+    labelNonDigits l = isJust $ T.find (not . C.isDigit) l+    labelAsNums = map (not . labelNonDigits) labels++    -- check if bucket name looks like an IP+    isIPCheck = and labelAsNums && length labelAsNums == 4++-- Throws exception iff bucket name is invalid according to AWS rules.+checkBucketNameValidity :: MonadThrow m => Bucket -> m ()+checkBucketNameValidity bucket =+  when (not $ isValidBucketName bucket) $+  throwM $ MErrVInvalidBucketName bucket++isValidObjectName :: Object -> Bool+isValidObjectName object =+  T.length object > 0 && B.length (encodeUtf8 object) <= 1024++checkObjectNameValidity :: MonadThrow m => Object -> m ()+checkObjectNameValidity object =+  when (not $ isValidObjectName object) $+  throwM $ MErrVInvalidObjectName object

@@ -233,7 +233,7 @@   } deriving (Show, Eq)  data CopyPartSource = CopyPartSource {-    cpSource :: Text -- | formatted like "/sourceBucket/sourceObject"+    cpSource :: Text -- | formatted like "\/sourceBucket\/sourceObject"   , cpSourceRange :: Maybe (Int64, Int64) -- | (0, 9) means first ten                                           -- bytes of the source                                           -- object@@ -248,12 +248,12 @@  cpsToHeaders :: CopyPartSource -> [HT.Header] cpsToHeaders cps = ("x-amz-copy-source", encodeUtf8 $ cpSource cps) :-                   (rangeHdr ++ (zip names values))+                   rangeHdr ++ zip names values   where     names = ["x-amz-copy-source-if-match", "x-amz-copy-source-if-none-match",              "x-amz-copy-source-if-unmodified-since",              "x-amz-copy-source-if-modified-since"]-    values = concatMap (maybeToList . fmap encodeUtf8 . (cps &))+    values = mapMaybe (fmap encodeUtf8 . (cps &))              [cpSourceIfMatch, cpSourceIfNoneMatch,               fmap formatRFC1123 . cpSourceIfUnmodifiedSince,               fmap formatRFC1123 . cpSourceIfModifiedSince]@@ -261,8 +261,7 @@              . HT.renderByteRanges              . (:[])              . uncurry HT.ByteRangeFromTo-           <$> (map (both fromIntegral) $-                maybeToList $ cpSourceRange cps)+           <$> map (both fromIntegral) (maybeToList $ cpSourceRange cps)  -- | Extract the source bucket and source object name. TODO: validate -- the bucket and object name extracted.@@ -299,7 +298,7 @@   def = RequestInfo HT.methodGet def def def def def "" def True  getPathFromRI :: RequestInfo -> ByteString-getPathFromRI ri = B.concat $ parts+getPathFromRI ri = B.concat parts   where     objPart = maybe [] (\o -> ["/", encodeUtf8 o]) $ riObject ri     parts = maybe ["/"] (\b -> "/" : encodeUtf8 b : objPart) $ riBucket ri@@ -343,11 +342,11 @@   return $ MinioConn ci mgr  -- | 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   conn <- liftIO $ connect ci-  flip evalStateT Map.empty . flip runReaderT conn . unMinio $-    (m >>= (return . Right)) `MC.catches`+  runResourceT . flip evalStateT Map.empty . flip runReaderT conn . unMinio $+    fmap Right m `MC.catches`     [ MC.Handler handlerServiceErr     , MC.Handler handlerHE     , MC.Handler handlerFE

@@ -25,7 +25,7 @@ import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Lazy as LB-import           Data.Char (isSpace, toUpper)+import           Data.Char (isSpace, toUpper, isAsciiUpper, isAsciiLower, isDigit) import qualified Data.Text as T import           Numeric (showHex) @@ -40,7 +40,7 @@ instance UriEncodable [Char] where   uriEncode encodeSlash payload =     LB.toStrict $ BB.toLazyByteString $ mconcat $-    map (flip uriEncodeChar encodeSlash) payload+    map (`uriEncodeChar` encodeSlash) payload  instance UriEncodable ByteString where   -- assumes that uriEncode is passed ASCII encoded strings.@@ -58,9 +58,9 @@ uriEncodeChar '/' True = BB.byteString "%2F" uriEncodeChar '/' False = BB.char7 '/' uriEncodeChar ch _-  | (ch >= 'A' && ch <= 'Z')-    || (ch >= 'a' && ch <= 'z')-    || (ch >= '0' && ch <= '9')+  | isAsciiUpper ch+    || isAsciiLower ch+    || isDigit ch     || (ch == '_')     || (ch == '-')     || (ch == '.')

@@ -34,7 +34,9 @@            | MErrVInvalidSrcObjByteRange (Int64, Int64)            | MErrVCopyObjSingleNoRangeAccepted            | MErrVRegionNotSupported Text-           | MErrXmlParse Text+           | MErrVXmlParse Text+           | MErrVInvalidBucketName Text+           | MErrVInvalidObjectName Text   deriving (Show, Eq)  instance Exception MErrV

@@ -35,7 +35,7 @@       let         delimiter = bool (Just "/") Nothing recurse -      res <- lift $ listObjects' bucket prefix nextToken delimiter+      res <- lift $ listObjects' bucket prefix nextToken delimiter Nothing       CL.sourceList $ lorObjects res       when (lorHasMore res) $         loop (lorNextToken res)@@ -53,12 +53,11 @@         delimiter = bool (Just "/") Nothing recurse        res <- lift $ listIncompleteUploads' bucket prefix delimiter-             nextKeyMarker nextUploadIdMarker+             nextKeyMarker nextUploadIdMarker Nothing -      aggrSizes <- lift $ forM (lurUploads res) $ \((uKey, uId, _)) -> do+      aggrSizes <- lift $ forM (lurUploads res) $ \(uKey, uId, _) -> do             partInfos <- listIncompleteParts bucket uKey uId C.$$ CC.sinkList-            return $ foldl (\sizeSofar p -> opiSize p + sizeSofar) 0-              $ partInfos+            return $ foldl (\sizeSofar p -> opiSize p + sizeSofar) 0 partInfos        CL.sourceList $         map (\((uKey, uId, uInitTime), size) ->

@@ -124,7 +124,7 @@ checkUploadNeeded payload n pmap = do   (md5hash, pSize) <- case payload of     PayloadBS bs -> return (hashMD5 bs, fromIntegral $ B.length bs)-    PayloadH h off size -> liftM (, size) $+    PayloadH h off size -> fmap (, size) $       hashMD5FromSource $ sourceHandleRange h (Just $ fromIntegral off)       (Just $ fromIntegral size)   case Map.lookup n pmap of@@ -266,7 +266,7 @@   copiedParts <- limitedMapConcurrently 10                  (\(pn, cps') -> do                      (etag, _) <- copyObjectPart b o cps' uid pn []-                     return $ (pn, etag)+                     return (pn, etag)                  )                  partSources 

@@ -25,9 +25,11 @@    -- * Listing objects   ---------------------  , ListObjectsResult+  , ListObjectsResult(..)   , listObjects' +  -- * Retrieving buckets+  , headBucket   -- * Retrieving objects   -----------------------   , getObject'@@ -52,7 +54,7 @@   , copyObjectPart   , completeMultipartUpload   , abortMultipartUpload-  , ListUploadsResult+  , ListUploadsResult(..)   , listIncompleteUploads'   , ListPartsResult(..)   , listIncompleteParts'@@ -64,12 +66,14 @@    ) where +import           Control.Monad.Catch (catches, Handler(..)) import qualified Data.Conduit as C import           Data.Default (def) import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Types as HT+import           Network.HTTP.Types.Status (status404) -import           Lib.Prelude+import           Lib.Prelude hiding (catches)  import           Network.Minio.API import           Network.Minio.Data@@ -93,7 +97,7 @@            -> Minio ([HT.Header], C.ResumableSource Minio ByteString) getObject' bucket object queryParams headers = do   resp <- mkStreamRequest reqInfo-  return $ (NC.responseHeaders resp, NC.responseBody resp)+  return (NC.responseHeaders resp, NC.responseBody resp)   where     reqInfo = def { riBucket = Just bucket                   , riObject = Just object@@ -103,8 +107,8 @@  -- | Creates a bucket via a PUT bucket call. putBucket :: Bucket -> Region -> Minio ()-putBucket bucket location = do-  void $ executeRequest $+putBucket bucket location = void $+  executeRequest $     def { riMethod = HT.methodPut         , riBucket = Just bucket         , riPayload = PayloadBS $ mkCreateBucketConfig location@@ -141,9 +145,9 @@  -- | List objects in a bucket matching prefix up to delimiter, -- starting from nextToken.-listObjects' :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text+listObjects' :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Int             -> Minio ListObjectsResult-listObjects' bucket prefix nextToken delimiter = do+listObjects' bucket prefix nextToken delimiter maxKeys = do   resp <- executeRequest $ def { riMethod = HT.methodGet                                , riBucket = Just bucket                                , riQueryParams = mkOptionalParams params@@ -155,20 +159,21 @@       , ("continuation_token", nextToken)       , ("prefix", prefix)       , ("delimiter", delimiter)+      , ("max-keys", show <$> maxKeys)       ]  -- | DELETE a bucket from the service. deleteBucket :: Bucket -> Minio ()-deleteBucket bucket = do-  void $ executeRequest $+deleteBucket bucket = void $+  executeRequest $     def { riMethod = HT.methodDelete         , riBucket = Just bucket         }  -- | DELETE an object from the service. deleteObject :: Bucket -> Object -> Minio ()-deleteObject bucket object = do-  void $ executeRequest $+deleteObject bucket object = void $+  executeRequest $     def { riMethod = HT.methodDelete         , riBucket = Just bucket         , riObject = Just object@@ -263,8 +268,8 @@  -- | Abort a multipart upload. abortMultipartUpload :: Bucket -> Object -> UploadId -> Minio ()-abortMultipartUpload bucket object uploadId = do-  void $ executeRequest $ def { riMethod = HT.methodDelete+abortMultipartUpload bucket object uploadId = void $+  executeRequest $ def { riMethod = HT.methodDelete                               , riBucket = Just bucket                               , riObject = Just object                               , riQueryParams = mkOptionalParams params@@ -274,8 +279,8 @@  -- | List incomplete multipart uploads. listIncompleteUploads' :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text-                       -> Maybe Text -> Minio ListUploadsResult-listIncompleteUploads' bucket prefix delimiter keyMarker uploadIdMarker = do+                       -> Maybe Text -> Maybe Int -> Minio ListUploadsResult+listIncompleteUploads' bucket prefix delimiter keyMarker uploadIdMarker maxKeys = do   resp <- executeRequest $ def { riMethod = HT.methodGet                                , riBucket = Just bucket                                , riQueryParams = params@@ -288,6 +293,7 @@              , ("delimiter", delimiter)              , ("key-marker", keyMarker)              , ("upload-id-marker", uploadIdMarker)+             , ("max-uploads", show <$> maxKeys)              ]  @@ -325,3 +331,30 @@    maybe (throwM MErrVInvalidObjectInfoResponse) return $     ObjectInfo <$> Just object <*> modTime <*> etag <*> size++++-- | Query the object store if a given bucket exists.+headBucket :: Bucket -> Minio Bool+headBucket bucket = headBucketEx `catches`+                    [ Handler handleNoSuchBucket+                    , Handler handleStatus404+                    ]++  where+    handleNoSuchBucket :: ServiceErr -> Minio Bool+    handleNoSuchBucket e | e == NoSuchBucket = return False+                         | otherwise = throwM e++    handleStatus404 :: NC.HttpException -> Minio Bool+    handleStatus404 e@(NC.HttpExceptionRequest _ (NC.StatusCodeException res _)) =+      if NC.responseStatus res == status404+      then return False+      else throwM e+    handleStatus404 e = throwM e++    headBucketEx = do+      resp <- executeRequest $ def { riMethod = HT.methodHead+                                   , riBucket = Just bucket+                                   }+      return $ NC.responseStatus resp == HT.ok200

@@ -98,10 +98,10 @@     outHeaders = authHeader : headersWithDate     timeBS = awsTimeFormatBS ts     dateHeader = (mk "X-Amz-Date", timeBS)-    hostHeader = (mk "host", encodeUtf8 $ format "{}:{}" $+    hostHeader = (mk "host", encodeUtf8 $ format "{}:{}"                    [connectHost ci, show $ connectPort ci]) -    headersWithDate = dateHeader : hostHeader : (riHeaders ri)+    headersWithDate = dateHeader : hostHeader : riHeaders ri      authHeader = (mk "Authorization", authHeaderValue) @@ -126,20 +126,20 @@                . hmacSHA256RawBS "s3"                . hmacSHA256RawBS (encodeUtf8 region)                . hmacSHA256RawBS (awsDateFormatBS ts)-               $ (B.concat ["AWS4", encodeUtf8 $ connectSecretKey ci])+               $ B.concat ["AWS4", encodeUtf8 $ connectSecretKey ci] -    stringToSign  = B.intercalate "\n" $-      ["AWS4-HMAC-SHA256",-       timeBS,-       scope,-       hashSHA256 $ canonicalRequest+    stringToSign  = B.intercalate "\n"+      [ "AWS4-HMAC-SHA256"+      , timeBS+      , scope+      , hashSHA256 canonicalRequest       ]      canonicalRequest = getCanonicalRequest ri headersToSign   getScope :: UTCTime -> Region -> ByteString-getScope ts region = B.intercalate "/" $ [+getScope ts region = B.intercalate "/" [   pack $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts,   encodeUtf8 region, "s3", "aws4_request"   ]@@ -148,11 +148,10 @@ getHeadersToSign h =   sort $   filter (flip Set.notMember ignoredHeaders . fst) $-  map (\(x, y) -> (CI.foldedCase x, stripBS y)) $-  h+  map (\(x, y) -> (CI.foldedCase x, stripBS y)) h  getCanonicalRequest :: RequestInfo -> [(ByteString, ByteString)] -> ByteString-getCanonicalRequest ri headersForSign = B.intercalate "\n" $ [+getCanonicalRequest ri headersForSign = B.intercalate "\n" [   riMethod ri,   uriEncode False path,   canonicalQueryString,@@ -170,7 +169,6 @@       riQueryParams ri      canonicalHeaders = B.concat $-      map (\(x, y) -> B.concat [x, ":", y, "\n"]) $-      headersForSign+      map (\(x, y) -> B.concat [x, ":", y, "\n"]) headersForSign      signedHeaders = B.intercalate ";" $ map fst headersForSign

@@ -117,7 +117,7 @@         => NC.Request -> NC.Manager         -> m (NC.Response LByteString) httpLbs req mgr = do-  respE <- liftIO $ tryHttpEx $ (NC.httpLbs req mgr)+  respE <- liftIO $ tryHttpEx $ NC.httpLbs req mgr   resp <- either throwM return respE   unless (isSuccessStatus $ NC.responseStatus resp) $     case contentTypeMay resp of@@ -126,11 +126,11 @@         throwM sErr        _ -> throwM $ NC.HttpExceptionRequest req $-        NC.StatusCodeException (const () <$> resp) (show resp)+        NC.StatusCodeException (void resp) (show resp)    return resp   where-    tryHttpEx :: (IO (NC.Response LByteString))+    tryHttpEx :: IO (NC.Response LByteString)               -> IO (Either NC.HttpException (NC.Response LByteString))     tryHttpEx = try     contentTypeMay resp = lookupHeader Hdr.hContentType $@@ -146,18 +146,18 @@     case contentTypeMay resp of       Just "application/xml" -> do         respBody <- NC.responseBody resp C.$$+- CB.sinkLbs-        sErr <- parseErrResponse $ respBody+        sErr <- parseErrResponse respBody         throwM sErr        _ -> do         content <- LB.toStrict . NC.responseBody <$> NC.lbsResponse resp         throwM $ NC.HttpExceptionRequest req $-           NC.StatusCodeException (const () <$> resp) $ content+           NC.StatusCodeException (void resp) content     return resp   where-    tryHttpEx :: (R.MonadResourceBase m) => (m a)+    tryHttpEx :: (R.MonadResourceBase m) => m a               -> m (Either NC.HttpException a)     tryHttpEx = ExL.try     contentTypeMay resp = lookupHeader Hdr.hContentType $ NC.responseHeaders resp@@ -189,7 +189,7 @@ -- helper function to build query parameters that are optional. -- don't use it with mandatory query params with empty value. mkOptionalParams :: [(Text, Maybe Text)] -> HT.Query-mkOptionalParams params = HT.toQuery $ (uncurry  mkQuery) <$> params+mkOptionalParams params = HT.toQuery $ uncurry  mkQuery <$> params  chunkBSConduit :: (Monad m, Integral a)                => [a] -> C.Conduit ByteString m ByteString@@ -199,9 +199,7 @@     loop n readChunks (size:sizes) = do       bsMay <- C.await       case bsMay of-        Nothing -> if n > 0-                   then C.yield $ B.concat readChunks-                   else return ()+        Nothing -> when (n > 0) $ C.yield $ B.concat readChunks         Just bs -> if n + fromIntegral (B.length bs) >= size                    then do let (a, b) = B.splitAt (fromIntegral $ size - n) bs                                chunkBS = B.concat $ readChunks ++ [a]

@@ -50,12 +50,12 @@  -- | Parse time strings from XML parseS3XMLTime :: (MonadThrow m) => Text -> m UTCTime-parseS3XMLTime = either (throwM . MErrXmlParse) return+parseS3XMLTime = either (throwM . MErrVXmlParse) return                . parseTimeM True defaultTimeLocale s3TimeFormat                . T.unpack  parseDecimal :: (MonadThrow m, Integral a) => Text -> m a-parseDecimal numStr = either (throwM . MErrXmlParse . show) return $ fst <$> decimal numStr+parseDecimal numStr = either (throwM . MErrVXmlParse . show) return $ fst <$> decimal numStr  parseDecimals :: (MonadThrow m, Integral a) => [Text] -> m [a] parseDecimals numStr = forM numStr parseDecimal@@ -64,7 +64,7 @@ s3Elem = element . s3Name  parseRoot :: (MonadThrow m) => LByteString -> m Cursor-parseRoot = either (throwM . MErrXmlParse . show) (return . fromDocument)+parseRoot = either (throwM . MErrVXmlParse . show) (return . fromDocument)           . parseLBS def  -- | Parse the response XML of a list buckets call.@@ -76,7 +76,7 @@     timeStrings = r $// s3Elem "Bucket" &// s3Elem "CreationDate" &/ content    times <- mapM parseS3XMLTime timeStrings-  return $ map (\(n, t) -> BucketInfo n t) $ zip names times+  return $ zipWith BucketInfo names times  -- | Parse the response XML of a location request. parseLocation :: (MonadThrow m) => LByteString -> m Region@@ -107,7 +107,7 @@     mtimeStr = T.concat $ r $// s3Elem "LastModified" &/ content    mtime <- parseS3XMLTime mtimeStr-  return $ (T.concat $ r $// s3Elem "ETag" &/ content, mtime)+  return (T.concat $ r $// s3Elem "ETag" &/ content, mtime)  -- | Parse the response XML of a list objects call. parseListObjectsResponse :: (MonadThrow m)

@@ -83,8 +83,10 @@   let b = T.concat [funTestBucketPrefix, T.pack bktSuffix]       liftStep = liftIO . step   connInfo <- maybe minioPlayCI (const def) <$> lookupEnv "MINIO_LOCAL"-  ret <- runResourceT $ runMinio connInfo $ do+  ret <- runMinio connInfo $ do     liftStep $ "Creating bucket for test - " ++ t+    foundBucket <- bucketExists b+    liftIO $ foundBucket @?= False     makeBucket b def     minioTest liftStep b     deleteBucket b@@ -109,7 +111,7 @@       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 @?= InvalidBucketName+        Left exn -> liftIO $ exn @?= MErrVInvalidBucketName "invalidBucketName"         _ -> return ()        step "getLocation works"@@ -239,7 +241,7 @@         fPutObject bucket (T.concat ["lsb-release", T.pack (show s)]) "/etc/lsb-release"        step "Simple list"-      res <- listObjects' bucket Nothing Nothing Nothing+      res <- listObjects' bucket Nothing Nothing Nothing Nothing       let expected = sort $ map (T.concat .                           ("lsb-release":) .                           (\x -> [x]) .@@ -260,7 +262,7 @@        step "list incomplete multipart uploads"       incompleteUploads <- listIncompleteUploads' bucket Nothing Nothing-                           Nothing Nothing+                           Nothing Nothing Nothing       liftIO $ (length $ lurUploads incompleteUploads) @?= 10        step "cleanup"

@@ -0,0 +1,50 @@+--+-- 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.+--++module Network.Minio.API.Test+  ( bucketNameValidityTests+  , objectNameValidityTests+  ) where++import Test.Tasty+import Test.Tasty.HUnit++import Lib.Prelude++import Network.Minio.API++assertBool' = assertBool "Test failed!"++bucketNameValidityTests :: TestTree+bucketNameValidityTests = testGroup "Bucket Name Validity Tests"+  [ testCase "Too short 1" $ assertBool' $ not $ isValidBucketName ""+  , testCase "Too short 2" $ assertBool' $ not $ isValidBucketName "ab"+  , testCase "Too long 1" $ assertBool' $ not $ isValidBucketName "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"+  , testCase "Has upper case" $ assertBool' $ not $ isValidBucketName "ABCD"+  , testCase "Has punctuation" $ assertBool' $ not $ isValidBucketName "abc,2"+  , testCase "Has hyphen at end" $ assertBool' $ not $ isValidBucketName "abc-"+  , testCase "Has consecutive dot" $ assertBool' $ not $ isValidBucketName "abck..eedg"+  , testCase "Looks like IP" $  assertBool' $ not $ isValidBucketName "10.0.0.1"+  , testCase "Valid bucket name 1" $ assertBool' $ isValidBucketName "abcd.pqeq.rea"+  , testCase "Valid bucket name 2" $ assertBool' $ isValidBucketName "abcdedgh1d"+  , testCase "Valid bucket name 3" $ assertBool' $ isValidBucketName "abc-de-dg-h1d"+  ]++objectNameValidityTests :: TestTree+objectNameValidityTests = testGroup "Object Name Validity Tests"+  [ testCase "Empty name" $ assertBool' $ not $ isValidObjectName ""+  , testCase "Has unicode characters" $ assertBool' $ isValidObjectName "日本国"+  ]

@@ -21,6 +21,7 @@  import           Lib.Prelude +import           Network.Minio.API.Test import           Network.Minio.PutObject import           Network.Minio.XmlGenerator.Test import           Network.Minio.XmlParser.Test@@ -110,4 +111,6 @@   ]  unitTests :: TestTree-unitTests = testGroup "Unit tests" [xmlGeneratorTests, xmlParserTests]+unitTests = testGroup "Unit tests" [xmlGeneratorTests, xmlParserTests,+                                    bucketNameValidityTests,+                                    objectNameValidityTests]