--
-- 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 Network.Minio.Data
  ( Bucket,
    ListObjectsResult
      ( lorCPrefixes,
        lorHasMore,
        lorNextToken,
        lorObjects
      ),
    ListObjectsV1Result
      ( lorCPrefixes',
        lorHasMore',
        lorNextMarker,
        lorObjects'
      ),
    ListPartsResult (lprHasMore, lprNextPart, lprParts),
    ListUploadsResult
      ( lurHasMore,
        lurNextKey,
        lurNextUpload,
        lurUploads
      ),
    Minio,
    Object,
    ObjectInfo,
    ObjectPartInfo (opiSize),
    UploadId,
    UploadInfo (UploadInfo),
  )
import Network.Minio.S3API
  ( listIncompleteParts',
    listIncompleteUploads',
    listObjects',
    listObjectsV1',
  )

-- | Represents a list output item - either an object or an object
-- prefix (i.e. a directory).
data ListItem
  = ListItemObject ObjectInfo
  | ListItemPrefix Text
  deriving stock (Int -> ListItem -> ShowS
[ListItem] -> ShowS
ListItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListItem] -> ShowS
$cshowList :: [ListItem] -> ShowS
show :: ListItem -> String
$cshow :: ListItem -> String
showsPrec :: Int -> ListItem -> ShowS
$cshowsPrec :: Int -> ListItem -> ShowS
Show, ListItem -> ListItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListItem -> ListItem -> Bool
$c/= :: ListItem -> ListItem -> Bool
== :: ListItem -> ListItem -> Bool
$c== :: ListItem -> ListItem -> Bool
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 :: Text -> Maybe Text -> Bool -> ConduitM () ListItem Minio ()
listObjects Text
bucket Maybe Text
prefix Bool
recurse = Maybe Text -> ConduitM () ListItem Minio ()
loop forall a. Maybe a
Nothing
  where
    loop :: Maybe Text -> C.ConduitM () ListItem Minio ()
    loop :: Maybe Text -> ConduitM () ListItem Minio ()
loop Maybe Text
nextToken = do
      let delimiter :: Maybe Text
delimiter = forall a. a -> a -> Bool -> a
bool (forall a. a -> Maybe a
Just Text
"/") forall a. Maybe a
Nothing Bool
recurse

      ListObjectsResult
res <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Minio ListObjectsResult
listObjects' Text
bucket Maybe Text
prefix Maybe Text
nextToken Maybe Text
delimiter forall a. Maybe a
Nothing
      forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ObjectInfo -> ListItem
ListItemObject forall a b. (a -> b) -> a -> b
$ ListObjectsResult -> [ObjectInfo]
lorObjects ListObjectsResult
res
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
recurse forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> [a] -> [b]
map Text -> ListItem
ListItemPrefix forall a b. (a -> b) -> a -> b
$
            ListObjectsResult -> [Text]
lorCPrefixes ListObjectsResult
res
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ListObjectsResult -> Bool
lorHasMore ListObjectsResult
res) forall a b. (a -> b) -> a -> b
$
        Maybe Text -> ConduitM () ListItem Minio ()
loop (ListObjectsResult -> Maybe Text
lorNextToken ListObjectsResult
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 :: Text -> Maybe Text -> Bool -> ConduitM () ListItem Minio ()
listObjectsV1 Text
bucket Maybe Text
prefix Bool
recurse = Maybe Text -> ConduitM () ListItem Minio ()
loop forall a. Maybe a
Nothing
  where
    loop :: Maybe Text -> C.ConduitM () ListItem Minio ()
    loop :: Maybe Text -> ConduitM () ListItem Minio ()
loop Maybe Text
nextMarker = do
      let delimiter :: Maybe Text
delimiter = forall a. a -> a -> Bool -> a
bool (forall a. a -> Maybe a
Just Text
"/") forall a. Maybe a
Nothing Bool
recurse

      ListObjectsV1Result
res <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Minio ListObjectsV1Result
listObjectsV1' Text
bucket Maybe Text
prefix Maybe Text
nextMarker Maybe Text
delimiter forall a. Maybe a
Nothing
      forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ObjectInfo -> ListItem
ListItemObject forall a b. (a -> b) -> a -> b
$ ListObjectsV1Result -> [ObjectInfo]
lorObjects' ListObjectsV1Result
res
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
recurse forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> [a] -> [b]
map Text -> ListItem
ListItemPrefix forall a b. (a -> b) -> a -> b
$
            ListObjectsV1Result -> [Text]
lorCPrefixes' ListObjectsV1Result
res
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ListObjectsV1Result -> Bool
lorHasMore' ListObjectsV1Result
res) forall a b. (a -> b) -> a -> b
$
        Maybe Text -> ConduitM () ListItem Minio ()
loop (ListObjectsV1Result -> Maybe Text
lorNextMarker ListObjectsV1Result
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 :: Text -> Maybe Text -> Bool -> ConduitM () UploadInfo Minio ()
listIncompleteUploads Text
bucket Maybe Text
prefix Bool
recurse = Maybe Text -> Maybe Text -> ConduitM () UploadInfo Minio ()
loop forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  where
    loop :: Maybe Text -> Maybe Text -> C.ConduitM () UploadInfo Minio ()
    loop :: Maybe Text -> Maybe Text -> ConduitM () UploadInfo Minio ()
loop Maybe Text
nextKeyMarker Maybe Text
nextUploadIdMarker = do
      let delimiter :: Maybe Text
delimiter = forall a. a -> a -> Bool -> a
bool (forall a. a -> Maybe a
Just Text
"/") forall a. Maybe a
Nothing Bool
recurse

      ListUploadsResult
res <-
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
          Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Minio ListUploadsResult
listIncompleteUploads'
            Text
bucket
            Maybe Text
prefix
            Maybe Text
delimiter
            Maybe Text
nextKeyMarker
            Maybe Text
nextUploadIdMarker
            forall a. Maybe a
Nothing

      [Int64]
aggrSizes <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (ListUploadsResult -> [(Text, Text, UTCTime)]
lurUploads ListUploadsResult
res) forall a b. (a -> b) -> a -> b
$ \(Text
uKey, Text
uId, UTCTime
_) -> do
          [ObjectPartInfo]
partInfos <-
            forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit forall a b. (a -> b) -> a -> b
$
              Text -> Text -> Text -> ConduitM () ObjectPartInfo Minio ()
listIncompleteParts Text
bucket Text
uKey Text
uId
                forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CC.sinkList
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int64
sizeSofar ObjectPartInfo
p -> ObjectPartInfo -> Int64
opiSize ObjectPartInfo
p forall a. Num a => a -> a -> a
+ Int64
sizeSofar) Int64
0 [ObjectPartInfo]
partInfos

      forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList forall a b. (a -> b) -> a -> b
$
        forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
          ( forall a b c. ((a, b) -> c) -> a -> b -> c
curry
              ( \((Text
uKey, Text
uId, UTCTime
uInitTime), Int64
size) ->
                  Text -> Text -> UTCTime -> Int64 -> UploadInfo
UploadInfo Text
uKey Text
uId UTCTime
uInitTime Int64
size
              )
          )
          (ListUploadsResult -> [(Text, Text, UTCTime)]
lurUploads ListUploadsResult
res)
          [Int64]
aggrSizes

      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ListUploadsResult -> Bool
lurHasMore ListUploadsResult
res) forall a b. (a -> b) -> a -> b
$
        Maybe Text -> Maybe Text -> ConduitM () UploadInfo Minio ()
loop (ListUploadsResult -> Maybe Text
lurNextKey ListUploadsResult
res) (ListUploadsResult -> Maybe Text
lurNextUpload ListUploadsResult
res)

-- | List object parts of an ongoing multipart upload for given
-- bucket, object and uploadId.
listIncompleteParts ::
  Bucket ->
  Object ->
  UploadId ->
  C.ConduitM () ObjectPartInfo Minio ()
listIncompleteParts :: Text -> Text -> Text -> ConduitM () ObjectPartInfo Minio ()
listIncompleteParts Text
bucket Text
object Text
uploadId = Maybe Text -> ConduitM () ObjectPartInfo Minio ()
loop forall a. Maybe a
Nothing
  where
    loop :: Maybe Text -> C.ConduitM () ObjectPartInfo Minio ()
    loop :: Maybe Text -> ConduitM () ObjectPartInfo Minio ()
loop Maybe Text
nextPartMarker = do
      ListPartsResult
res <-
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
          Text
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Minio ListPartsResult
listIncompleteParts'
            Text
bucket
            Text
object
            Text
uploadId
            forall a. Maybe a
Nothing
            Maybe Text
nextPartMarker
      forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList forall a b. (a -> b) -> a -> b
$ ListPartsResult -> [ObjectPartInfo]
lprParts ListPartsResult
res
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ListPartsResult -> Bool
lprHasMore ListPartsResult
res) forall a b. (a -> b) -> a -> b
$
        Maybe Text -> ConduitM () ObjectPartInfo Minio ()
loop (forall b a. (Show a, IsString b) => a -> b
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListPartsResult -> Maybe Int
lprNextPart ListPartsResult
res)