--
-- MinIO Haskell SDK, (C) 2017-2023 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.S3API
-- Copyright:   (c) 2017-2023 MinIO Dev Team
-- License:     Apache 2.0
-- Maintainer:  MinIO Dev Team <dev@min.io>
--
-- Lower-level API for S3 compatible object stores. Start with @Network.Minio@
-- and use this only if needed.
module Network.Minio.S3API
  ( Region,
    getLocation,

    -- * Listing buckets

    --------------------
    getService,

    -- * Listing objects

    --------------------
    ListObjectsResult (..),
    ListObjectsV1Result (..),
    listObjects',
    listObjectsV1',

    -- * Retrieving buckets
    headBucket,

    -- * Retrieving objects

    -----------------------
    getObject',
    headObject,

    -- * Creating buckets and objects

    ---------------------------------
    putBucket,
    ETag,
    maxSinglePutObjectSizeBytes,
    putObjectSingle',
    putObjectSingle,
    copyObjectSingle,

    -- * Multipart Upload APIs

    --------------------------
    UploadId,
    PartTuple,
    Payload (..),
    PartNumber,
    newMultipartUpload,
    putObjectPart,
    copyObjectPart,
    completeMultipartUpload,
    abortMultipartUpload,
    ListUploadsResult (..),
    listIncompleteUploads',
    ListPartsResult (..),
    listIncompleteParts',

    -- * Deletion APIs

    --------------------------
    deleteBucket,
    deleteObject,

    -- * Presigned Operations

    -----------------------------
    module Network.Minio.PresignedOperations,

    -- ** Bucket Policies
    getBucketPolicy,
    setBucketPolicy,

    -- * Bucket Notifications

    -------------------------
    Notification (..),
    NotificationConfig (..),
    Arn,
    Event (..),
    Filter (..),
    FilterKey (..),
    FilterRules (..),
    FilterRule (..),
    getBucketNotification,
    putBucketNotification,
    removeAllBucketNotification,
  )
where

import qualified Data.ByteString as BS
import qualified Data.Text as T
import Lib.Prelude
import qualified Network.HTTP.Conduit as NC
import qualified Network.HTTP.Types as HT
import Network.HTTP.Types.Status (status404)
import Network.Minio.API
import Network.Minio.APICommon
import Network.Minio.Data
import Network.Minio.Errors
import Network.Minio.PresignedOperations
import Network.Minio.Utils
import Network.Minio.XmlGenerator
import Network.Minio.XmlParser
import UnliftIO (Handler (Handler))

-- | Fetch all buckets from the service.
getService :: Minio [BucketInfo]
getService :: Minio [BucketInfo]
getService = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riNeedsLocation :: Bool
riNeedsLocation = Bool
False
        }
  forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m [BucketInfo]
parseListBuckets forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
NC.responseBody Response LByteString
resp

-- Parse headers from getObject and headObject calls.
parseGetObjectHeaders :: Object -> [HT.Header] -> Maybe ObjectInfo
parseGetObjectHeaders :: Text -> [Header] -> Maybe ObjectInfo
parseGetObjectHeaders Text
object [Header]
headers =
  let metadataPairs :: [(Text, Text)]
metadataPairs = [Header] -> [(Text, Text)]
getMetadata [Header]
headers
      userMetadata :: HashMap Text Text
userMetadata = [(Text, Text)] -> HashMap Text Text
getUserMetadataMap [(Text, Text)]
metadataPairs
      metadata :: HashMap Text Text
metadata = [(Text, Text)] -> HashMap Text Text
getNonUserMetadataMap [(Text, Text)]
metadataPairs
   in Text
-> UTCTime
-> Text
-> Int64
-> HashMap Text Text
-> HashMap Text Text
-> ObjectInfo
ObjectInfo
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a
Just Text
object
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Header] -> Maybe UTCTime
getLastModifiedHeader [Header]
headers
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Header] -> Maybe Text
getETagHeader [Header]
headers
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Header] -> Maybe Int64
getContentLength [Header]
headers
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> Maybe a
Just HashMap Text Text
userMetadata
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> Maybe a
Just HashMap Text Text
metadata

-- | GET an object from the service and return parsed ObjectInfo and a
-- conduit source for the object content
getObject' ::
  Bucket ->
  Object ->
  HT.Query ->
  [HT.Header] ->
  Minio GetObjectResponse
getObject' :: Text -> Text -> Query -> [Header] -> Minio GetObjectResponse
getObject' Text
bucket Text
object Query
queryParams [Header]
headers = do
  Response (ConduitM () ByteString Minio ())
resp <- S3ReqInfo -> Minio (Response (ConduitM () ByteString Minio ()))
mkStreamRequest S3ReqInfo
reqInfo
  let objInfoMaybe :: Maybe ObjectInfo
objInfoMaybe = Text -> [Header] -> Maybe ObjectInfo
parseGetObjectHeaders Text
object forall a b. (a -> b) -> a -> b
$ forall body. Response body -> [Header]
NC.responseHeaders Response (ConduitM () ByteString Minio ())
resp
  ObjectInfo
objInfo <-
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVInvalidObjectInfoResponse)
      forall (m :: * -> *) a. Monad m => a -> m a
return
      Maybe ObjectInfo
objInfoMaybe
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    GetObjectResponse
      { gorObjectInfo :: ObjectInfo
gorObjectInfo = ObjectInfo
objInfo,
        gorObjectStream :: ConduitM () ByteString Minio ()
gorObjectStream = forall body. Response body -> body
NC.responseBody Response (ConduitM () ByteString Minio ())
resp
      }
  where
    reqInfo :: S3ReqInfo
reqInfo =
      S3ReqInfo
defaultS3ReqInfo
        { riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riObject :: Maybe Text
riObject = forall a. a -> Maybe a
Just Text
object,
          riQueryParams :: Query
riQueryParams = Query
queryParams,
          riHeaders :: [Header]
riHeaders =
            [Header]
headers
              -- This header is required for safety as otherwise http-client,
              -- sends Accept-Encoding: gzip, and the server may actually gzip
              -- body. In that case Content-Length header will be missing.
              forall a. Semigroup a => a -> a -> a
<> [(HeaderName
"Accept-Encoding", ByteString
"identity")]
        }

-- | Creates a bucket via a PUT bucket call.
putBucket :: Bucket -> Region -> Minio ()
putBucket :: Text -> Text -> Minio ()
putBucket Text
bucket Text
location = do
  Text
ns <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall env. HasSvcNamespace env => env -> Text
getSvcNamespace
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPut,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riPayload :: Payload
riPayload = ByteString -> Payload
PayloadBS forall a b. (a -> b) -> a -> b
$ Text -> Text -> ByteString
mkCreateBucketConfig Text
ns Text
location,
          riNeedsLocation :: Bool
riNeedsLocation = Bool
False
        }

-- | Single PUT object size.
maxSinglePutObjectSizeBytes :: Int64
maxSinglePutObjectSizeBytes :: Int64
maxSinglePutObjectSizeBytes = Int64
5 forall a. Num a => a -> a -> a
* Int64
1024 forall a. Num a => a -> a -> a
* Int64
1024 forall a. Num a => a -> a -> a
* Int64
1024

-- | PUT an object into the service. This function performs a single
-- PUT object call and uses a strict ByteString as the object
-- data. `putObjectSingle` is preferable as the object data will not
-- be resident in memory.
putObjectSingle' :: Bucket -> Object -> [HT.Header] -> ByteString -> Minio ETag
putObjectSingle' :: Text -> Text -> [Header] -> ByteString -> Minio Text
putObjectSingle' Text
bucket Text
object [Header]
headers ByteString
bs = do
  let size :: Int64
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs)
  -- check length is within single PUT object size.
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
size forall a. Ord a => a -> a -> Bool
> Int64
maxSinglePutObjectSizeBytes) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$
      Int64 -> MErrV
MErrVSinglePUTSizeExceeded Int64
size

  let payload :: Payload
payload = Payload -> Payload
mkStreamingPayload forall a b. (a -> b) -> a -> b
$ ByteString -> Payload
PayloadBS ByteString
bs
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPut,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riObject :: Maybe Text
riObject = forall a. a -> Maybe a
Just Text
object,
          riHeaders :: [Header]
riHeaders = [Header]
headers,
          riPayload :: Payload
riPayload = Payload
payload
        }

  let rheaders :: [Header]
rheaders = forall body. Response body -> [Header]
NC.responseHeaders Response LByteString
resp
      etag :: Maybe Text
etag = [Header] -> Maybe Text
getETagHeader [Header]
rheaders
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVETagHeaderNotFound)
    forall (m :: * -> *) a. Monad m => a -> m a
return
    Maybe Text
etag

-- | PUT an object into the service. This function performs a single
-- PUT object call, and so can only transfer objects upto 5GiB.
putObjectSingle ::
  Bucket ->
  Object ->
  [HT.Header] ->
  Handle ->
  Int64 ->
  Int64 ->
  Minio ETag
putObjectSingle :: Text -> Text -> [Header] -> Handle -> Int64 -> Int64 -> Minio Text
putObjectSingle Text
bucket Text
object [Header]
headers Handle
h Int64
offset Int64
size = do
  -- check length is within single PUT object size.
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
size forall a. Ord a => a -> a -> Bool
> Int64
maxSinglePutObjectSizeBytes) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$
      Int64 -> MErrV
MErrVSinglePUTSizeExceeded Int64
size

  -- content-length header is automatically set by library.
  let payload :: Payload
payload = Payload -> Payload
mkStreamingPayload forall a b. (a -> b) -> a -> b
$ Handle -> Int64 -> Int64 -> Payload
PayloadH Handle
h Int64
offset Int64
size
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPut,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riObject :: Maybe Text
riObject = forall a. a -> Maybe a
Just Text
object,
          riHeaders :: [Header]
riHeaders = [Header]
headers,
          riPayload :: Payload
riPayload = Payload
payload
        }

  let rheaders :: [Header]
rheaders = forall body. Response body -> [Header]
NC.responseHeaders Response LByteString
resp
      etag :: Maybe Text
etag = [Header] -> Maybe Text
getETagHeader [Header]
rheaders
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVETagHeaderNotFound)
    forall (m :: * -> *) a. Monad m => a -> m a
return
    Maybe Text
etag

-- | List objects in a bucket matching prefix up to delimiter,
-- starting from nextMarker.
listObjectsV1' ::
  Bucket ->
  Maybe Text ->
  Maybe Text ->
  Maybe Text ->
  Maybe Int ->
  Minio ListObjectsV1Result
listObjectsV1' :: Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Minio ListObjectsV1Result
listObjectsV1' Text
bucket Maybe Text
prefix Maybe Text
nextMarker Maybe Text
delimiter Maybe Int
maxKeys = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodGet,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riQueryParams :: Query
riQueryParams = [(Text, Maybe Text)] -> Query
mkOptionalParams [(Text, Maybe Text)]
params
        }
  forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m ListObjectsV1Result
parseListObjectsV1Response forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
NC.responseBody Response LByteString
resp
  where
    params :: [(Text, Maybe Text)]
params =
      [ (Text
"marker", Maybe Text
nextMarker),
        (Text
"prefix", Maybe Text
prefix),
        (Text
"delimiter", Maybe Text
delimiter),
        (Text
"max-keys", forall b a. (Show a, IsString b) => a -> b
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxKeys)
      ]

-- | List objects in a bucket matching prefix up to delimiter,
-- starting from nextToken.
listObjects' ::
  Bucket ->
  Maybe Text ->
  Maybe Text ->
  Maybe Text ->
  Maybe Int ->
  Minio ListObjectsResult
listObjects' :: Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Minio ListObjectsResult
listObjects' Text
bucket Maybe Text
prefix Maybe Text
nextToken Maybe Text
delimiter Maybe Int
maxKeys = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodGet,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riQueryParams :: Query
riQueryParams = [(Text, Maybe Text)] -> Query
mkOptionalParams [(Text, Maybe Text)]
params
        }
  forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m ListObjectsResult
parseListObjectsResponse forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
NC.responseBody Response LByteString
resp
  where
    params :: [(Text, Maybe Text)]
params =
      [ (Text
"list-type", forall a. a -> Maybe a
Just Text
"2"),
        (Text
"continuation_token", Maybe Text
nextToken),
        (Text
"prefix", Maybe Text
prefix),
        (Text
"delimiter", Maybe Text
delimiter),
        (Text
"max-keys", forall b a. (Show a, IsString b) => a -> b
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxKeys)
      ]

-- | DELETE a bucket from the service.
deleteBucket :: Bucket -> Minio ()
deleteBucket :: Text -> Minio ()
deleteBucket Text
bucket =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodDelete,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket
        }

-- | DELETE an object from the service.
deleteObject :: Bucket -> Object -> Minio ()
deleteObject :: Text -> Text -> Minio ()
deleteObject Text
bucket Text
object =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodDelete,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riObject :: Maybe Text
riObject = forall a. a -> Maybe a
Just Text
object
        }

-- | Create a new multipart upload.
newMultipartUpload :: Bucket -> Object -> [HT.Header] -> Minio UploadId
newMultipartUpload :: Text -> Text -> [Header] -> Minio Text
newMultipartUpload Text
bucket Text
object [Header]
headers = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPost,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riObject :: Maybe Text
riObject = forall a. a -> Maybe a
Just Text
object,
          riQueryParams :: Query
riQueryParams = [(ByteString
"uploads", forall a. Maybe a
Nothing)],
          riHeaders :: [Header]
riHeaders = [Header]
headers
        }
  forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m Text
parseNewMultipartUpload forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
NC.responseBody Response LByteString
resp

-- | PUT a part of an object as part of a multipart upload.
putObjectPart ::
  Bucket ->
  Object ->
  UploadId ->
  PartNumber ->
  [HT.Header] ->
  Payload ->
  Minio PartTuple
putObjectPart :: Text
-> Text
-> Text
-> PartNumber
-> [Header]
-> Payload
-> Minio PartTuple
putObjectPart Text
bucket Text
object Text
uploadId PartNumber
partNumber [Header]
headers Payload
payload = do
  -- transform payload to conduit to enable streaming signature
  let payload' :: Payload
payload' = Payload -> Payload
mkStreamingPayload Payload
payload
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPut,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riObject :: Maybe Text
riObject = forall a. a -> Maybe a
Just Text
object,
          riQueryParams :: Query
riQueryParams = [(Text, Maybe Text)] -> Query
mkOptionalParams [(Text, Maybe Text)]
params,
          riHeaders :: [Header]
riHeaders = [Header]
headers,
          riPayload :: Payload
riPayload = Payload
payload'
        }
  let rheaders :: [Header]
rheaders = forall body. Response body -> [Header]
NC.responseHeaders Response LByteString
resp
      etag :: Maybe Text
etag = [Header] -> Maybe Text
getETagHeader [Header]
rheaders
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVETagHeaderNotFound)
    (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PartNumber
partNumber,))
    Maybe Text
etag
  where
    params :: [(Text, Maybe Text)]
params =
      [ (Text
"uploadId", forall a. a -> Maybe a
Just Text
uploadId),
        (Text
"partNumber", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show PartNumber
partNumber)
      ]

srcInfoToHeaders :: SourceInfo -> [HT.Header]
srcInfoToHeaders :: SourceInfo -> [Header]
srcInfoToHeaders SourceInfo
srcInfo =
  ( HeaderName
"x-amz-copy-source",
    forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
T.concat
        [ Text
"/",
          SourceInfo -> Text
srcBucket SourceInfo
srcInfo,
          Text
"/",
          SourceInfo -> Text
srcObject SourceInfo
srcInfo
        ]
  )
    forall a. a -> [a] -> [a]
: [Header]
rangeHdr
    forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> [(a, b)]
zip [HeaderName]
names [ByteString]
values
  where
    names :: [HeaderName]
names =
      [ HeaderName
"x-amz-copy-source-if-match",
        HeaderName
"x-amz-copy-source-if-none-match",
        HeaderName
"x-amz-copy-source-if-unmodified-since",
        HeaderName
"x-amz-copy-source-if-modified-since"
      ]
    values :: [ByteString]
values =
      forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceInfo
srcInfo forall a b. a -> (a -> b) -> b
&))
        [ SourceInfo -> Maybe Text
srcIfMatch,
          SourceInfo -> Maybe Text
srcIfNoneMatch,
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> Text
formatRFC1123 forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceInfo -> Maybe UTCTime
srcIfUnmodifiedSince,
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> Text
formatRFC1123 forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceInfo -> Maybe UTCTime
srcIfModifiedSince
        ]
    rangeHdr :: [Header]
rangeHdr =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((\ByteRange
a -> [(HeaderName
"x-amz-copy-source-range", ByteRanges -> ByteString
HT.renderByteRanges [ByteRange
a])]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64, Int64) -> ByteRange
toByteRange) (SourceInfo -> Maybe (Int64, Int64)
srcRange SourceInfo
srcInfo)
    toByteRange :: (Int64, Int64) -> HT.ByteRange
    toByteRange :: (Int64, Int64) -> ByteRange
toByteRange (Int64
x, Int64
y) = Integer -> Integer -> ByteRange
HT.ByteRangeFromTo (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
y)

-- | Performs server-side copy of an object or part of an object as an
-- upload part of an ongoing multi-part upload.
copyObjectPart ::
  DestinationInfo ->
  SourceInfo ->
  UploadId ->
  PartNumber ->
  [HT.Header] ->
  Minio (ETag, UTCTime)
copyObjectPart :: DestinationInfo
-> SourceInfo
-> Text
-> PartNumber
-> [Header]
-> Minio (Text, UTCTime)
copyObjectPart DestinationInfo
dstInfo SourceInfo
srcInfo Text
uploadId PartNumber
partNumber [Header]
headers = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPut,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DestinationInfo -> Text
dstBucket DestinationInfo
dstInfo,
          riObject :: Maybe Text
riObject = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DestinationInfo -> Text
dstObject DestinationInfo
dstInfo,
          riQueryParams :: Query
riQueryParams = [(Text, Maybe Text)] -> Query
mkOptionalParams [(Text, Maybe Text)]
params,
          riHeaders :: [Header]
riHeaders = [Header]
headers forall a. [a] -> [a] -> [a]
++ SourceInfo -> [Header]
srcInfoToHeaders SourceInfo
srcInfo
        }

  forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m (Text, UTCTime)
parseCopyObjectResponse forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
NC.responseBody Response LByteString
resp
  where
    params :: [(Text, Maybe Text)]
params =
      [ (Text
"uploadId", forall a. a -> Maybe a
Just Text
uploadId),
        (Text
"partNumber", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show PartNumber
partNumber)
      ]

-- | Performs server-side copy of an object that is upto 5GiB in
-- size. If the object is greater than 5GiB, this function throws the
-- error returned by the server.
copyObjectSingle ::
  Bucket ->
  Object ->
  SourceInfo ->
  [HT.Header] ->
  Minio (ETag, UTCTime)
copyObjectSingle :: Text -> Text -> SourceInfo -> [Header] -> Minio (Text, UTCTime)
copyObjectSingle Text
bucket Text
object SourceInfo
srcInfo [Header]
headers = do
  -- validate that srcRange is Nothing for this API.
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ SourceInfo -> Maybe (Int64, Int64)
srcRange SourceInfo
srcInfo) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVCopyObjSingleNoRangeAccepted
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPut,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riObject :: Maybe Text
riObject = forall a. a -> Maybe a
Just Text
object,
          riHeaders :: [Header]
riHeaders = [Header]
headers forall a. [a] -> [a] -> [a]
++ SourceInfo -> [Header]
srcInfoToHeaders SourceInfo
srcInfo
        }
  forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m (Text, UTCTime)
parseCopyObjectResponse forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
NC.responseBody Response LByteString
resp

-- | Complete a multipart upload.
completeMultipartUpload ::
  Bucket ->
  Object ->
  UploadId ->
  [PartTuple] ->
  Minio ETag
completeMultipartUpload :: Text -> Text -> Text -> [PartTuple] -> Minio Text
completeMultipartUpload Text
bucket Text
object Text
uploadId [PartTuple]
partTuple = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPost,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riObject :: Maybe Text
riObject = forall a. a -> Maybe a
Just Text
object,
          riQueryParams :: Query
riQueryParams = [(Text, Maybe Text)] -> Query
mkOptionalParams [(Text, Maybe Text)]
params,
          riPayload :: Payload
riPayload =
            ByteString -> Payload
PayloadBS forall a b. (a -> b) -> a -> b
$
              [PartTuple] -> ByteString
mkCompleteMultipartUploadRequest [PartTuple]
partTuple
        }
  forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m Text
parseCompleteMultipartUploadResponse forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
NC.responseBody Response LByteString
resp
  where
    params :: [(Text, Maybe Text)]
params = [(Text
"uploadId", forall a. a -> Maybe a
Just Text
uploadId)]

-- | Abort a multipart upload.
abortMultipartUpload :: Bucket -> Object -> UploadId -> Minio ()
abortMultipartUpload :: Text -> Text -> Text -> Minio ()
abortMultipartUpload Text
bucket Text
object Text
uploadId =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodDelete,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riObject :: Maybe Text
riObject = forall a. a -> Maybe a
Just Text
object,
          riQueryParams :: Query
riQueryParams = [(Text, Maybe Text)] -> Query
mkOptionalParams [(Text, Maybe Text)]
params
        }
  where
    params :: [(Text, Maybe Text)]
params = [(Text
"uploadId", forall a. a -> Maybe a
Just Text
uploadId)]

-- | List incomplete multipart uploads.
listIncompleteUploads' ::
  Bucket ->
  Maybe Text ->
  Maybe Text ->
  Maybe Text ->
  Maybe Text ->
  Maybe Int ->
  Minio ListUploadsResult
listIncompleteUploads' :: Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Minio ListUploadsResult
listIncompleteUploads' Text
bucket Maybe Text
prefix Maybe Text
delimiter Maybe Text
keyMarker Maybe Text
uploadIdMarker Maybe Int
maxKeys = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodGet,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riQueryParams :: Query
riQueryParams = Query
params
        }
  forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m ListUploadsResult
parseListUploadsResponse forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
NC.responseBody Response LByteString
resp
  where
    -- build query params
    params :: Query
params =
      (ByteString
"uploads", forall a. Maybe a
Nothing)
        forall a. a -> [a] -> [a]
: [(Text, Maybe Text)] -> Query
mkOptionalParams
          [ (Text
"prefix", Maybe Text
prefix),
            (Text
"delimiter", Maybe Text
delimiter),
            (Text
"key-marker", Maybe Text
keyMarker),
            (Text
"upload-id-marker", Maybe Text
uploadIdMarker),
            (Text
"max-uploads", forall b a. (Show a, IsString b) => a -> b
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxKeys)
          ]

-- | List parts of an ongoing multipart upload.
listIncompleteParts' ::
  Bucket ->
  Object ->
  UploadId ->
  Maybe Text ->
  Maybe Text ->
  Minio ListPartsResult
listIncompleteParts' :: Text
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Minio ListPartsResult
listIncompleteParts' Text
bucket Text
object Text
uploadId Maybe Text
maxParts Maybe Text
partNumMarker = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodGet,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riObject :: Maybe Text
riObject = forall a. a -> Maybe a
Just Text
object,
          riQueryParams :: Query
riQueryParams = [(Text, Maybe Text)] -> Query
mkOptionalParams [(Text, Maybe Text)]
params
        }
  forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m ListPartsResult
parseListPartsResponse forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
NC.responseBody Response LByteString
resp
  where
    -- build optional query params
    params :: [(Text, Maybe Text)]
params =
      [ (Text
"uploadId", forall a. a -> Maybe a
Just Text
uploadId),
        (Text
"part-number-marker", Maybe Text
partNumMarker),
        (Text
"max-parts", Maybe Text
maxParts)
      ]

-- | Get metadata of an object.
headObject :: Bucket -> Object -> [HT.Header] -> Minio ObjectInfo
headObject :: Text -> Text -> [Header] -> Minio ObjectInfo
headObject Text
bucket Text
object [Header]
reqHeaders = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodHead,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riObject :: Maybe Text
riObject = forall a. a -> Maybe a
Just Text
object,
          riHeaders :: [Header]
riHeaders =
            [Header]
reqHeaders
              -- This header is required for safety as otherwise http-client,
              -- sends Accept-Encoding: gzip, and the server may actually gzip
              -- body. In that case Content-Length header will be missing.
              forall a. Semigroup a => a -> a -> a
<> [(HeaderName
"Accept-Encoding", ByteString
"identity")]
        }
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVInvalidObjectInfoResponse) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    Text -> [Header] -> Maybe ObjectInfo
parseGetObjectHeaders Text
object forall a b. (a -> b) -> a -> b
$
      forall body. Response body -> [Header]
NC.responseHeaders Response LByteString
resp

-- | Query the object store if a given bucket exists.
headBucket :: Bucket -> Minio Bool
headBucket :: Text -> Minio Bool
headBucket Text
bucket =
  Minio Bool
headBucketEx
    forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
`catches` [ forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ServiceErr -> Minio Bool
handleNoSuchBucket,
                forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler HttpException -> Minio Bool
handleStatus404
              ]
  where
    handleNoSuchBucket :: ServiceErr -> Minio Bool
    handleNoSuchBucket :: ServiceErr -> Minio Bool
handleNoSuchBucket ServiceErr
e
      | ServiceErr
e forall a. Eq a => a -> a -> Bool
== ServiceErr
NoSuchBucket = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      | Bool
otherwise = forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ServiceErr
e
    handleStatus404 :: NC.HttpException -> Minio Bool
    handleStatus404 :: HttpException -> Minio Bool
handleStatus404 e :: HttpException
e@(NC.HttpExceptionRequest Request
_ (NC.StatusCodeException Response ()
res ByteString
_)) =
      if forall body. Response body -> Status
NC.responseStatus Response ()
res forall a. Eq a => a -> a -> Bool
== Status
status404
        then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        else forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO HttpException
e
    handleStatus404 HttpException
e = forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO HttpException
e
    headBucketEx :: Minio Bool
headBucketEx = do
      Response LByteString
resp <-
        S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
          S3ReqInfo
defaultS3ReqInfo
            { riMethod :: ByteString
riMethod = ByteString
HT.methodHead,
              riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket
            }
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall body. Response body -> Status
NC.responseStatus Response LByteString
resp forall a. Eq a => a -> a -> Bool
== Status
HT.ok200

-- | Set the notification configuration on a bucket.
putBucketNotification :: Bucket -> Notification -> Minio ()
putBucketNotification :: Text -> Notification -> Minio ()
putBucketNotification Text
bucket Notification
ncfg = do
  Text
ns <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall env. HasSvcNamespace env => env -> Text
getSvcNamespace
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPut,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riQueryParams :: Query
riQueryParams = [(ByteString
"notification", forall a. Maybe a
Nothing)],
          riPayload :: Payload
riPayload =
            ByteString -> Payload
PayloadBS forall a b. (a -> b) -> a -> b
$
              Text -> Notification -> ByteString
mkPutNotificationRequest Text
ns Notification
ncfg
        }

-- | Retrieve the notification configuration on a bucket.
getBucketNotification :: Bucket -> Minio Notification
getBucketNotification :: Text -> Minio Notification
getBucketNotification Text
bucket = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodGet,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riQueryParams :: Query
riQueryParams = [(ByteString
"notification", forall a. Maybe a
Nothing)]
        }
  forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m Notification
parseNotification forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
NC.responseBody Response LByteString
resp

-- | Remove all notifications configured on a bucket.
removeAllBucketNotification :: Bucket -> Minio ()
removeAllBucketNotification :: Text -> Minio ()
removeAllBucketNotification = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Notification -> Minio ()
putBucketNotification Notification
defaultNotification

-- | Fetch the policy if any on a bucket.
getBucketPolicy :: Bucket -> Minio Text
getBucketPolicy :: Text -> Minio Text
getBucketPolicy Text
bucket = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodGet,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riQueryParams :: Query
riQueryParams = [(ByteString
"policy", forall a. Maybe a
Nothing)]
        }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8Lenient forall a b. (a -> b) -> a -> b
$ LByteString -> ByteString
toStrictBS forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
NC.responseBody Response LByteString
resp

-- | Set a new policy on a bucket.
-- As a special condition if the policy is empty
-- then we treat it as policy DELETE operation.
setBucketPolicy :: Bucket -> Text -> Minio ()
setBucketPolicy :: Text -> Text -> Minio ()
setBucketPolicy Text
bucket Text
policy = do
  if Text -> Bool
T.null Text
policy
    then Text -> Minio ()
deleteBucketPolicy Text
bucket
    else Text -> Text -> Minio ()
putBucketPolicy Text
bucket Text
policy

-- | Save a new policy on a bucket.
putBucketPolicy :: Bucket -> Text -> Minio ()
putBucketPolicy :: Text -> Text -> Minio ()
putBucketPolicy Text
bucket Text
policy = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPut,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riQueryParams :: Query
riQueryParams = [(ByteString
"policy", forall a. Maybe a
Nothing)],
          riPayload :: Payload
riPayload = ByteString -> Payload
PayloadBS forall a b. (a -> b) -> a -> b
$ forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
policy
        }

-- | Delete any policy set on a bucket.
deleteBucketPolicy :: Bucket -> Minio ()
deleteBucketPolicy :: Text -> Minio ()
deleteBucketPolicy Text
bucket = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
    S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodDelete,
          riBucket :: Maybe Text
riBucket = forall a. a -> Maybe a
Just Text
bucket,
          riQueryParams :: Query
riQueryParams = [(ByteString
"policy", forall a. Maybe a
Nothing)]
        }