Fix listing to also return common prefixes (#126)

- Also bump up to 1.4.0 as this is a breaking change.

minio-hs.cabal

@@ -1,5 +1,5 @@
 name:                minio-hs
-version:             1.3.1
+version:             1.4.0
 synopsis:            A MinIO Haskell Library for Amazon S3 compatible cloud
                      storage.
 description:         The MinIO Haskell client library provides simple APIs to

src/Network/Minio.hs

@@ -1,5 +1,5 @@
 --
--- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc.
+-- 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.
@@ -86,6 +86,7 @@ module Network.Minio
   , oiSize
   , oiMetadata
 
+  , ListItem(..)
   , listObjects
   , listObjectsV1
 

src/Network/Minio/Data.hs

@@ -435,7 +435,7 @@ data ListObjectsV1Result = ListObjectsV1Result {
 
 -- | Represents information about an object.
 data ObjectInfo = ObjectInfo
-  { oiObject   :: Object -- ^ Oject key
+  { oiObject   :: Object -- ^ Object key
   , oiModTime  :: UTCTime -- ^ Mdification time of the object
   , oiETag     :: ETag -- ^ ETag of the object
   , oiSize     :: Int64 -- ^ Size of the object in bytes

src/Network/Minio/ListOps.hs

@@ -1,5 +1,5 @@
 --
--- MinIO Haskell SDK, (C) 2017 MinIO, Inc.
+-- 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.
@@ -25,34 +25,54 @@ import           Lib.Prelude
 import           Network.Minio.Data
 import           Network.Minio.S3API
 
--- | List objects in a bucket matching the given prefix. If recurse is
+-- | Represents a list output item - either an object or an object
--- set to True objects matching prefix are recursively listed.
+-- prefix (i.e. a directory).
-listObjects :: Bucket -> Maybe Text -> Bool -> C.ConduitM () ObjectInfo Minio ()
+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 () ObjectInfo Minio ()
+    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 $ lorObjects res
+      CL.sourceList $ map ListItemObject $ lorObjects res
+      unless recurse $
+        CL.sourceList $ map ListItemPrefix $ lorCPrefixes res
       when (lorHasMore res) $
         loop (lorNextToken res)
 
--- | List objects in a bucket matching the given prefix. If recurse is
+-- | Lists objects - similar to @listObjects@, however uses the older
--- set to True objects matching prefix are recursively listed.
+-- V1 AWS S3 API. Prefer @listObjects@ to this.
 listObjectsV1 :: Bucket -> Maybe Text -> Bool
-              -> C.ConduitM () ObjectInfo Minio ()
+              -> C.ConduitM () ListItem Minio ()
 listObjectsV1 bucket prefix recurse = loop Nothing
   where
-    loop :: Maybe Text -> C.ConduitM () ObjectInfo Minio ()
+    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 $ lorObjects' res
+      CL.sourceList $ map ListItemObject $ lorObjects' res
+      unless recurse $
+        CL.sourceList $ map ListItemPrefix $ lorCPrefixes' res
       when (lorHasMore' res) $
         loop (lorNextMarker res)
 

test/LiveServer.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 --
--- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc.
+-- 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.
@@ -295,22 +295,66 @@ highLevelListingTest = funTestWithBucket "High-level listObjects Test" $
   \step bucket -> do
       step "High-level listObjects Test"
       step "put 3 objects"
-      let expectedObjects = ["dir/o1", "dir/dir1/o2", "dir/dir2/o3"]
+      let expectedObjects = ["dir/o1", "dir/dir1/o2", "dir/dir2/o3", "o4"]
+          extractObjectsFromList os =
+              mapM (\t -> case t of
+                       ListItemObject o -> Just $ oiObject o
+                       _                -> Nothing) os
+          expectedNonRecList = ["o4", "dir/"]
+          extractObjectsAndDirsFromList os =
+              map (\t -> case t of
+                      ListItemObject o -> oiObject o
+                      ListItemPrefix d -> d) os
+
       forM_ expectedObjects $
         \obj -> fPutObject bucket obj "/etc/lsb-release" defaultPutObjectOptions
 
       step "High-level listing of objects"
+      items <- C.runConduit $ listObjects bucket Nothing False C..| sinkList
+      liftIO $ assertEqual "Objects/Dirs match failed!" expectedNonRecList $
+        extractObjectsAndDirsFromList items
+
+      step "High-level recursive listing of objects"
       objects <- C.runConduit $ listObjects bucket Nothing True C..| sinkList
 
-      liftIO $ assertEqual "Objects match failed!" (sort expectedObjects)
+      liftIO $ assertEqual "Objects match failed!"
-        (map oiObject objects)
+        (Just $ sort expectedObjects) $
+        extractObjectsFromList objects
 
       step "High-level listing of objects (version 1)"
+      itemsV1 <- C.runConduit $ listObjectsV1 bucket Nothing False C..| sinkList
+      liftIO $ assertEqual "Objects/Dirs match failed!" expectedNonRecList $
+        extractObjectsAndDirsFromList itemsV1
+
+      step "High-level recursive listing of objects (version 1)"
       objectsV1 <- C.runConduit $ listObjectsV1 bucket Nothing True C..|
                    sinkList
 
-      liftIO $ assertEqual "Objects match failed!" (sort expectedObjects)
+      liftIO $ assertEqual "Objects match failed!"
-        (map oiObject objectsV1)
+        (Just $ sort expectedObjects) $
+        extractObjectsFromList objectsV1
+
+      let expectedPrefListing = ["dir/o1", "dir/dir1/", "dir/dir2/"]
+          expectedPrefListingRec = Just ["dir/dir1/o2", "dir/dir2/o3", "dir/o1"]
+      step "High-level listing with prefix"
+      prefItems <- C.runConduit $ listObjects bucket (Just "dir/") False C..| sinkList
+      liftIO $ assertEqual "Objects/Dirs under prefix match failed!"
+        expectedPrefListing $ extractObjectsAndDirsFromList prefItems
+
+      step "High-level listing with prefix recursive"
+      prefItemsRec <- C.runConduit $ listObjects bucket (Just "dir/") True C..| sinkList
+      liftIO $ assertEqual "Objects/Dirs under prefix match recursive failed!"
+        expectedPrefListingRec $ extractObjectsFromList prefItemsRec
+
+      step "High-level listing with prefix (version 1)"
+      prefItemsV1 <- C.runConduit $ listObjectsV1 bucket (Just "dir/") False C..| sinkList
+      liftIO $ assertEqual "Objects/Dirs under prefix match failed!"
+        expectedPrefListing $ extractObjectsAndDirsFromList prefItemsV1
+
+      step "High-level listing with prefix recursive (version 1)"
+      prefItemsRecV1 <- C.runConduit $ listObjectsV1 bucket (Just "dir/") True C..| sinkList
+      liftIO $ assertEqual "Objects/Dirs under prefix match recursive failed!"
+        expectedPrefListingRec $ extractObjectsFromList prefItemsRecV1
 
       step "Cleanup actions"
       forM_ expectedObjects $