121 lines
4.5 KiB
Haskell
121 lines
4.5 KiB
Haskell
--
|
|
-- MinIO Haskell SDK, (C) 2017-2019 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.ListOps where
|
|
|
|
import qualified Data.Conduit as C
|
|
import qualified Data.Conduit.Combinators as CC
|
|
import qualified Data.Conduit.List as CL
|
|
|
|
import Lib.Prelude
|
|
|
|
import Network.Minio.Data
|
|
import Network.Minio.S3API
|
|
|
|
-- | Represents a list output item - either an object or an object
|
|
-- prefix (i.e. a directory).
|
|
data ListItem = ListItemObject ObjectInfo
|
|
| ListItemPrefix Text
|
|
deriving (Show, Eq)
|
|
|
|
-- | @'listObjects' bucket prefix recurse@ lists objects in a bucket
|
|
-- similar to a file system tree traversal.
|
|
--
|
|
-- If @prefix@ is not 'Nothing', only items with the given prefix are
|
|
-- listed, otherwise items under the bucket are returned.
|
|
--
|
|
-- If @recurse@ is set to @True@ all directories under the prefix are
|
|
-- recursively traversed and only objects are returned.
|
|
--
|
|
-- If @recurse@ is set to @False@, objects and directories immediately
|
|
-- under the given prefix are returned (no recursive traversal is
|
|
-- performed).
|
|
listObjects :: Bucket -> Maybe Text -> Bool -> C.ConduitM () ListItem Minio ()
|
|
listObjects bucket prefix recurse = loop Nothing
|
|
where
|
|
loop :: Maybe Text -> C.ConduitM () ListItem Minio ()
|
|
loop nextToken = do
|
|
let
|
|
delimiter = bool (Just "/") Nothing recurse
|
|
|
|
res <- lift $ listObjects' bucket prefix nextToken delimiter Nothing
|
|
CL.sourceList $ map ListItemObject $ lorObjects res
|
|
unless recurse $
|
|
CL.sourceList $ map ListItemPrefix $ lorCPrefixes res
|
|
when (lorHasMore res) $
|
|
loop (lorNextToken res)
|
|
|
|
-- | Lists objects - similar to @listObjects@, however uses the older
|
|
-- V1 AWS S3 API. Prefer @listObjects@ to this.
|
|
listObjectsV1 :: Bucket -> Maybe Text -> Bool
|
|
-> C.ConduitM () ListItem Minio ()
|
|
listObjectsV1 bucket prefix recurse = loop Nothing
|
|
where
|
|
loop :: Maybe Text -> C.ConduitM () ListItem Minio ()
|
|
loop nextMarker = do
|
|
let
|
|
delimiter = bool (Just "/") Nothing recurse
|
|
|
|
res <- lift $ listObjectsV1' bucket prefix nextMarker delimiter Nothing
|
|
CL.sourceList $ map ListItemObject $ lorObjects' res
|
|
unless recurse $
|
|
CL.sourceList $ map ListItemPrefix $ lorCPrefixes' res
|
|
when (lorHasMore' res) $
|
|
loop (lorNextMarker res)
|
|
|
|
-- | List incomplete uploads in a bucket matching the given prefix. If
|
|
-- recurse is set to True incomplete uploads for the given prefix are
|
|
-- recursively listed.
|
|
listIncompleteUploads :: Bucket -> Maybe Text -> Bool
|
|
-> C.ConduitM () UploadInfo Minio ()
|
|
listIncompleteUploads bucket prefix recurse = loop Nothing Nothing
|
|
where
|
|
loop :: Maybe Text -> Maybe Text -> C.ConduitM () UploadInfo Minio ()
|
|
loop nextKeyMarker nextUploadIdMarker = do
|
|
let
|
|
delimiter = bool (Just "/") Nothing recurse
|
|
|
|
res <- lift $ listIncompleteUploads' bucket prefix delimiter
|
|
nextKeyMarker nextUploadIdMarker Nothing
|
|
|
|
aggrSizes <- lift $ forM (lurUploads res) $ \(uKey, uId, _) -> do
|
|
partInfos <- C.runConduit $ listIncompleteParts bucket uKey uId
|
|
C..| CC.sinkList
|
|
return $ foldl (\sizeSofar p -> opiSize p + sizeSofar) 0 partInfos
|
|
|
|
CL.sourceList $
|
|
map (\((uKey, uId, uInitTime), size) ->
|
|
UploadInfo uKey uId uInitTime size
|
|
) $ zip (lurUploads res) aggrSizes
|
|
|
|
when (lurHasMore res) $
|
|
loop (lurNextKey res) (lurNextUpload res)
|
|
|
|
|
|
-- | List object parts of an ongoing multipart upload for given
|
|
-- bucket, object and uploadId.
|
|
listIncompleteParts :: Bucket -> Object -> UploadId
|
|
-> C.ConduitM () ObjectPartInfo Minio ()
|
|
listIncompleteParts bucket object uploadId = loop Nothing
|
|
where
|
|
loop :: Maybe Text -> C.ConduitM () ObjectPartInfo Minio ()
|
|
loop nextPartMarker = do
|
|
res <- lift $ listIncompleteParts' bucket object uploadId Nothing
|
|
nextPartMarker
|
|
CL.sourceList $ lprParts res
|
|
when (lprHasMore res) $
|
|
loop (show <$> lprNextPart res)
|