--
-- MinIO Haskell SDK, (C) 2017, 2018 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
  ( 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 (S3ReqInfo -> Minio (Response LByteString))
-> S3ReqInfo -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riNeedsLocation :: Bool
riNeedsLocation = Bool
False
        }
  LByteString -> Minio [BucketInfo]
forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m [BucketInfo]
parseListBuckets (LByteString -> Minio [BucketInfo])
-> LByteString -> Minio [BucketInfo]
forall a b. (a -> b) -> a -> b
$ Response LByteString -> LByteString
forall body. Response body -> body
NC.responseBody Response LByteString
resp

-- Parse headers from getObject and headObject calls.
parseGetObjectHeaders :: Object -> [HT.Header] -> Maybe ObjectInfo
parseGetObjectHeaders :: Object -> [Header] -> Maybe ObjectInfo
parseGetObjectHeaders Object
object [Header]
headers =
  let metadataPairs :: [(Object, Object)]
metadataPairs = [Header] -> [(Object, Object)]
getMetadata [Header]
headers
      userMetadata :: HashMap Object Object
userMetadata = [(Object, Object)] -> HashMap Object Object
getUserMetadataMap [(Object, Object)]
metadataPairs
      metadata :: HashMap Object Object
metadata = [(Object, Object)] -> HashMap Object Object
getNonUserMetadataMap [(Object, Object)]
metadataPairs
   in Object
-> UTCTime
-> Object
-> Int64
-> HashMap Object Object
-> HashMap Object Object
-> ObjectInfo
ObjectInfo
        (Object
 -> UTCTime
 -> Object
 -> Int64
 -> HashMap Object Object
 -> HashMap Object Object
 -> ObjectInfo)
-> Maybe Object
-> Maybe
     (UTCTime
      -> Object
      -> Int64
      -> HashMap Object Object
      -> HashMap Object Object
      -> ObjectInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Maybe Object
forall a. a -> Maybe a
Just Object
object
        Maybe
  (UTCTime
   -> Object
   -> Int64
   -> HashMap Object Object
   -> HashMap Object Object
   -> ObjectInfo)
-> Maybe UTCTime
-> Maybe
     (Object
      -> Int64
      -> HashMap Object Object
      -> HashMap Object Object
      -> ObjectInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Header] -> Maybe UTCTime
getLastModifiedHeader [Header]
headers
        Maybe
  (Object
   -> Int64
   -> HashMap Object Object
   -> HashMap Object Object
   -> ObjectInfo)
-> Maybe Object
-> Maybe
     (Int64
      -> HashMap Object Object -> HashMap Object Object -> ObjectInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Header] -> Maybe Object
getETagHeader [Header]
headers
        Maybe
  (Int64
   -> HashMap Object Object -> HashMap Object Object -> ObjectInfo)
-> Maybe Int64
-> Maybe
     (HashMap Object Object -> HashMap Object Object -> ObjectInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Header] -> Maybe Int64
getContentLength [Header]
headers
        Maybe
  (HashMap Object Object -> HashMap Object Object -> ObjectInfo)
-> Maybe (HashMap Object Object)
-> Maybe (HashMap Object Object -> ObjectInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap Object Object -> Maybe (HashMap Object Object)
forall a. a -> Maybe a
Just HashMap Object Object
userMetadata
        Maybe (HashMap Object Object -> ObjectInfo)
-> Maybe (HashMap Object Object) -> Maybe ObjectInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap Object Object -> Maybe (HashMap Object Object)
forall a. a -> Maybe a
Just HashMap Object Object
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' :: Object -> Object -> Query -> [Header] -> Minio GetObjectResponse
getObject' Object
bucket Object
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 = Object -> [Header] -> Maybe ObjectInfo
parseGetObjectHeaders Object
object ([Header] -> Maybe ObjectInfo) -> [Header] -> Maybe ObjectInfo
forall a b. (a -> b) -> a -> b
$ Response (ConduitM () ByteString Minio ()) -> [Header]
forall body. Response body -> [Header]
NC.responseHeaders Response (ConduitM () ByteString Minio ())
resp
  ObjectInfo
objInfo <-
    Minio ObjectInfo
-> (ObjectInfo -> Minio ObjectInfo)
-> Maybe ObjectInfo
-> Minio ObjectInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (MErrV -> Minio ObjectInfo
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVInvalidObjectInfoResponse)
      ObjectInfo -> Minio ObjectInfo
forall (m :: * -> *) a. Monad m => a -> m a
return
      Maybe ObjectInfo
objInfoMaybe
  GetObjectResponse -> Minio GetObjectResponse
forall (m :: * -> *) a. Monad m => a -> m a
return (GetObjectResponse -> Minio GetObjectResponse)
-> GetObjectResponse -> Minio GetObjectResponse
forall a b. (a -> b) -> a -> b
$
    GetObjectResponse :: ObjectInfo -> ConduitM () ByteString Minio () -> GetObjectResponse
GetObjectResponse
      { gorObjectInfo :: ObjectInfo
gorObjectInfo = ObjectInfo
objInfo,
        gorObjectStream :: ConduitM () ByteString Minio ()
gorObjectStream = Response (ConduitM () ByteString Minio ())
-> ConduitM () ByteString Minio ()
forall body. Response body -> body
NC.responseBody Response (ConduitM () ByteString Minio ())
resp
      }
  where
    reqInfo :: S3ReqInfo
reqInfo =
      S3ReqInfo
defaultS3ReqInfo
        { riBucket :: Maybe Object
riBucket = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
bucket,
          riObject :: Maybe Object
riObject = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
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.
              [Header] -> [Header] -> [Header]
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 :: Object -> Object -> Minio ()
putBucket Object
bucket Object
location = do
  Object
ns <- (MinioConn -> Object) -> Minio Object
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> Object
forall env. HasSvcNamespace env => env -> Object
getSvcNamespace
  Minio (Response LByteString) -> Minio ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Minio (Response LByteString) -> Minio ())
-> Minio (Response LByteString) -> Minio ()
forall a b. (a -> b) -> a -> b
$
    S3ReqInfo -> Minio (Response LByteString)
executeRequest (S3ReqInfo -> Minio (Response LByteString))
-> S3ReqInfo -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPut,
          riBucket :: Maybe Object
riBucket = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
bucket,
          riPayload :: Payload
riPayload = ByteString -> Payload
PayloadBS (ByteString -> Payload) -> ByteString -> Payload
forall a b. (a -> b) -> a -> b
$ Object -> Object -> ByteString
mkCreateBucketConfig Object
ns Object
location,
          riNeedsLocation :: Bool
riNeedsLocation = Bool
False
        }

-- | Single PUT object size.
maxSinglePutObjectSizeBytes :: Int64
maxSinglePutObjectSizeBytes :: Int64
maxSinglePutObjectSizeBytes = Int64
5 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1024 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1024 Int64 -> Int64 -> Int64
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' :: Object -> Object -> [Header] -> ByteString -> Minio Object
putObjectSingle' Object
bucket Object
object [Header]
headers ByteString
bs = do
  let size :: Int64
size = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs)
  -- check length is within single PUT object size.
  Bool -> Minio () -> Minio ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
size Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
maxSinglePutObjectSizeBytes) (Minio () -> Minio ()) -> Minio () -> Minio ()
forall a b. (a -> b) -> a -> b
$
    MErrV -> Minio ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (MErrV -> Minio ()) -> MErrV -> Minio ()
forall a b. (a -> b) -> a -> b
$
      Int64 -> MErrV
MErrVSinglePUTSizeExceeded Int64
size

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

  let rheaders :: [Header]
rheaders = Response LByteString -> [Header]
forall body. Response body -> [Header]
NC.responseHeaders Response LByteString
resp
      etag :: Maybe Object
etag = [Header] -> Maybe Object
getETagHeader [Header]
rheaders
  Minio Object
-> (Object -> Minio Object) -> Maybe Object -> Minio Object
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (MErrV -> Minio Object
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVETagHeaderNotFound)
    Object -> Minio Object
forall (m :: * -> *) a. Monad m => a -> m a
return
    Maybe Object
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 :: Object
-> Object -> [Header] -> Handle -> Int64 -> Int64 -> Minio Object
putObjectSingle Object
bucket Object
object [Header]
headers Handle
h Int64
offset Int64
size = do
  -- check length is within single PUT object size.
  Bool -> Minio () -> Minio ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
size Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
maxSinglePutObjectSizeBytes) (Minio () -> Minio ()) -> Minio () -> Minio ()
forall a b. (a -> b) -> a -> b
$
    MErrV -> Minio ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (MErrV -> Minio ()) -> MErrV -> Minio ()
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 (Payload -> Payload) -> Payload -> Payload
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 (S3ReqInfo -> Minio (Response LByteString))
-> S3ReqInfo -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPut,
          riBucket :: Maybe Object
riBucket = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
bucket,
          riObject :: Maybe Object
riObject = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
object,
          riHeaders :: [Header]
riHeaders = [Header]
headers,
          riPayload :: Payload
riPayload = Payload
payload
        }

  let rheaders :: [Header]
rheaders = Response LByteString -> [Header]
forall body. Response body -> [Header]
NC.responseHeaders Response LByteString
resp
      etag :: Maybe Object
etag = [Header] -> Maybe Object
getETagHeader [Header]
rheaders
  Minio Object
-> (Object -> Minio Object) -> Maybe Object -> Minio Object
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (MErrV -> Minio Object
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVETagHeaderNotFound)
    Object -> Minio Object
forall (m :: * -> *) a. Monad m => a -> m a
return
    Maybe Object
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' :: Object
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe Int
-> Minio ListObjectsV1Result
listObjectsV1' Object
bucket Maybe Object
prefix Maybe Object
nextMarker Maybe Object
delimiter Maybe Int
maxKeys = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest (S3ReqInfo -> Minio (Response LByteString))
-> S3ReqInfo -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodGet,
          riBucket :: Maybe Object
riBucket = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
bucket,
          riQueryParams :: Query
riQueryParams = [(Object, Maybe Object)] -> Query
mkOptionalParams [(Object, Maybe Object)]
params
        }
  LByteString -> Minio ListObjectsV1Result
forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m ListObjectsV1Result
parseListObjectsV1Response (LByteString -> Minio ListObjectsV1Result)
-> LByteString -> Minio ListObjectsV1Result
forall a b. (a -> b) -> a -> b
$ Response LByteString -> LByteString
forall body. Response body -> body
NC.responseBody Response LByteString
resp
  where
    params :: [(Object, Maybe Object)]
params =
      [ (Object
"marker", Maybe Object
nextMarker),
        (Object
"prefix", Maybe Object
prefix),
        (Object
"delimiter", Maybe Object
delimiter),
        (Object
"max-keys", Int -> Object
forall b a. (Show a, IsString b) => a -> b
show (Int -> Object) -> Maybe Int -> Maybe Object
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' :: Object
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe Int
-> Minio ListObjectsResult
listObjects' Object
bucket Maybe Object
prefix Maybe Object
nextToken Maybe Object
delimiter Maybe Int
maxKeys = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest (S3ReqInfo -> Minio (Response LByteString))
-> S3ReqInfo -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodGet,
          riBucket :: Maybe Object
riBucket = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
bucket,
          riQueryParams :: Query
riQueryParams = [(Object, Maybe Object)] -> Query
mkOptionalParams [(Object, Maybe Object)]
params
        }
  LByteString -> Minio ListObjectsResult
forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m ListObjectsResult
parseListObjectsResponse (LByteString -> Minio ListObjectsResult)
-> LByteString -> Minio ListObjectsResult
forall a b. (a -> b) -> a -> b
$ Response LByteString -> LByteString
forall body. Response body -> body
NC.responseBody Response LByteString
resp
  where
    params :: [(Object, Maybe Object)]
params =
      [ (Object
"list-type", Object -> Maybe Object
forall a. a -> Maybe a
Just Object
"2"),
        (Object
"continuation_token", Maybe Object
nextToken),
        (Object
"prefix", Maybe Object
prefix),
        (Object
"delimiter", Maybe Object
delimiter),
        (Object
"max-keys", Int -> Object
forall b a. (Show a, IsString b) => a -> b
show (Int -> Object) -> Maybe Int -> Maybe Object
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 :: Object -> Minio ()
deleteBucket Object
bucket =
  Minio (Response LByteString) -> Minio ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Minio (Response LByteString) -> Minio ())
-> Minio (Response LByteString) -> Minio ()
forall a b. (a -> b) -> a -> b
$
    S3ReqInfo -> Minio (Response LByteString)
executeRequest (S3ReqInfo -> Minio (Response LByteString))
-> S3ReqInfo -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodDelete,
          riBucket :: Maybe Object
riBucket = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
bucket
        }

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

-- | Create a new multipart upload.
newMultipartUpload :: Bucket -> Object -> [HT.Header] -> Minio UploadId
newMultipartUpload :: Object -> Object -> [Header] -> Minio Object
newMultipartUpload Object
bucket Object
object [Header]
headers = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest (S3ReqInfo -> Minio (Response LByteString))
-> S3ReqInfo -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPost,
          riBucket :: Maybe Object
riBucket = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
bucket,
          riObject :: Maybe Object
riObject = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
object,
          riQueryParams :: Query
riQueryParams = [(ByteString
"uploads", Maybe ByteString
forall a. Maybe a
Nothing)],
          riHeaders :: [Header]
riHeaders = [Header]
headers
        }
  LByteString -> Minio Object
forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m Object
parseNewMultipartUpload (LByteString -> Minio Object) -> LByteString -> Minio Object
forall a b. (a -> b) -> a -> b
$ Response LByteString -> LByteString
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 :: Object
-> Object
-> Object
-> PartNumber
-> [Header]
-> Payload
-> Minio PartTuple
putObjectPart Object
bucket Object
object Object
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 (S3ReqInfo -> Minio (Response LByteString))
-> S3ReqInfo -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPut,
          riBucket :: Maybe Object
riBucket = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
bucket,
          riObject :: Maybe Object
riObject = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
object,
          riQueryParams :: Query
riQueryParams = [(Object, Maybe Object)] -> Query
mkOptionalParams [(Object, Maybe Object)]
params,
          riHeaders :: [Header]
riHeaders = [Header]
headers,
          riPayload :: Payload
riPayload = Payload
payload'
        }
  let rheaders :: [Header]
rheaders = Response LByteString -> [Header]
forall body. Response body -> [Header]
NC.responseHeaders Response LByteString
resp
      etag :: Maybe Object
etag = [Header] -> Maybe Object
getETagHeader [Header]
rheaders
  Minio PartTuple
-> (Object -> Minio PartTuple) -> Maybe Object -> Minio PartTuple
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (MErrV -> Minio PartTuple
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVETagHeaderNotFound)
    (PartTuple -> Minio PartTuple
forall (m :: * -> *) a. Monad m => a -> m a
return (PartTuple -> Minio PartTuple)
-> (Object -> PartTuple) -> Object -> Minio PartTuple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PartNumber
partNumber,))
    Maybe Object
etag
  where
    params :: [(Object, Maybe Object)]
params =
      [ (Object
"uploadId", Object -> Maybe Object
forall a. a -> Maybe a
Just Object
uploadId),
        (Object
"partNumber", Object -> Maybe Object
forall a. a -> Maybe a
Just (Object -> Maybe Object) -> Object -> Maybe Object
forall a b. (a -> b) -> a -> b
$ PartNumber -> Object
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",
    Object -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Object -> ByteString) -> Object -> ByteString
forall a b. (a -> b) -> a -> b
$
      [Object] -> Object
T.concat
        [ Object
"/",
          SourceInfo -> Object
srcBucket SourceInfo
srcInfo,
          Object
"/",
          SourceInfo -> Object
srcObject SourceInfo
srcInfo
        ]
  )
    Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: [Header]
rangeHdr
    [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [HeaderName] -> [ByteString] -> [Header]
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 =
      ((SourceInfo -> Maybe Object) -> Maybe ByteString)
-> [SourceInfo -> Maybe Object] -> [ByteString]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
        ((Object -> ByteString) -> Maybe Object -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Object -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Maybe Object -> Maybe ByteString)
-> ((SourceInfo -> Maybe Object) -> Maybe Object)
-> (SourceInfo -> Maybe Object)
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceInfo
srcInfo SourceInfo -> (SourceInfo -> Maybe Object) -> Maybe Object
forall a b. a -> (a -> b) -> b
&))
        [ SourceInfo -> Maybe Object
srcIfMatch,
          SourceInfo -> Maybe Object
srcIfNoneMatch,
          (UTCTime -> Object) -> Maybe UTCTime -> Maybe Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> Object
formatRFC1123 (Maybe UTCTime -> Maybe Object)
-> (SourceInfo -> Maybe UTCTime) -> SourceInfo -> Maybe Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceInfo -> Maybe UTCTime
srcIfUnmodifiedSince,
          (UTCTime -> Object) -> Maybe UTCTime -> Maybe Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> Object
formatRFC1123 (Maybe UTCTime -> Maybe Object)
-> (SourceInfo -> Maybe UTCTime) -> SourceInfo -> Maybe Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceInfo -> Maybe UTCTime
srcIfModifiedSince
        ]
    rangeHdr :: [Header]
rangeHdr =
      [Header]
-> ((Int64, Int64) -> [Header]) -> Maybe (Int64, Int64) -> [Header]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((\ByteRange
a -> [(HeaderName
"x-amz-copy-source-range", ByteRanges -> ByteString
HT.renderByteRanges [ByteRange
a])]) (ByteRange -> [Header])
-> ((Int64, Int64) -> ByteRange) -> (Int64, Int64) -> [Header]
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 (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x) (Int64 -> Integer
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
-> Object
-> PartNumber
-> [Header]
-> Minio (Object, UTCTime)
copyObjectPart DestinationInfo
dstInfo SourceInfo
srcInfo Object
uploadId PartNumber
partNumber [Header]
headers = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest (S3ReqInfo -> Minio (Response LByteString))
-> S3ReqInfo -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPut,
          riBucket :: Maybe Object
riBucket = Object -> Maybe Object
forall a. a -> Maybe a
Just (Object -> Maybe Object) -> Object -> Maybe Object
forall a b. (a -> b) -> a -> b
$ DestinationInfo -> Object
dstBucket DestinationInfo
dstInfo,
          riObject :: Maybe Object
riObject = Object -> Maybe Object
forall a. a -> Maybe a
Just (Object -> Maybe Object) -> Object -> Maybe Object
forall a b. (a -> b) -> a -> b
$ DestinationInfo -> Object
dstObject DestinationInfo
dstInfo,
          riQueryParams :: Query
riQueryParams = [(Object, Maybe Object)] -> Query
mkOptionalParams [(Object, Maybe Object)]
params,
          riHeaders :: [Header]
riHeaders = [Header]
headers [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ SourceInfo -> [Header]
srcInfoToHeaders SourceInfo
srcInfo
        }

  LByteString -> Minio (Object, UTCTime)
forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m (Object, UTCTime)
parseCopyObjectResponse (LByteString -> Minio (Object, UTCTime))
-> LByteString -> Minio (Object, UTCTime)
forall a b. (a -> b) -> a -> b
$ Response LByteString -> LByteString
forall body. Response body -> body
NC.responseBody Response LByteString
resp
  where
    params :: [(Object, Maybe Object)]
params =
      [ (Object
"uploadId", Object -> Maybe Object
forall a. a -> Maybe a
Just Object
uploadId),
        (Object
"partNumber", Object -> Maybe Object
forall a. a -> Maybe a
Just (Object -> Maybe Object) -> Object -> Maybe Object
forall a b. (a -> b) -> a -> b
$ PartNumber -> Object
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 :: Object
-> Object -> SourceInfo -> [Header] -> Minio (Object, UTCTime)
copyObjectSingle Object
bucket Object
object SourceInfo
srcInfo [Header]
headers = do
  -- validate that srcRange is Nothing for this API.
  Bool -> Minio () -> Minio ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Int64, Int64) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Int64, Int64) -> Bool) -> Maybe (Int64, Int64) -> Bool
forall a b. (a -> b) -> a -> b
$ SourceInfo -> Maybe (Int64, Int64)
srcRange SourceInfo
srcInfo) (Minio () -> Minio ()) -> Minio () -> Minio ()
forall a b. (a -> b) -> a -> b
$
    MErrV -> Minio ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVCopyObjSingleNoRangeAccepted
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest (S3ReqInfo -> Minio (Response LByteString))
-> S3ReqInfo -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodPut,
          riBucket :: Maybe Object
riBucket = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
bucket,
          riObject :: Maybe Object
riObject = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
object,
          riHeaders :: [Header]
riHeaders = [Header]
headers [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ SourceInfo -> [Header]
srcInfoToHeaders SourceInfo
srcInfo
        }
  LByteString -> Minio (Object, UTCTime)
forall env (m :: * -> *).
(MonadReader env m, HasSvcNamespace env, MonadIO m) =>
LByteString -> m (Object, UTCTime)
parseCopyObjectResponse (LByteString -> Minio (Object, UTCTime))
-> LByteString -> Minio (Object, UTCTime)
forall a b. (a -> b) -> a -> b
$ Response LByteString -> LByteString
forall body. Response body -> body
NC.responseBody Response LByteString
resp

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

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

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

-- | Get metadata of an object.
headObject :: Bucket -> Object -> [HT.Header] -> Minio ObjectInfo
headObject :: Object -> Object -> [Header] -> Minio ObjectInfo
headObject Object
bucket Object
object [Header]
reqHeaders = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest (S3ReqInfo -> Minio (Response LByteString))
-> S3ReqInfo -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodHead,
          riBucket :: Maybe Object
riBucket = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
bucket,
          riObject :: Maybe Object
riObject = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
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.
              [Header] -> [Header] -> [Header]
forall a. Semigroup a => a -> a -> a
<> [(HeaderName
"Accept-Encoding", ByteString
"identity")]
        }
  Minio ObjectInfo
-> (ObjectInfo -> Minio ObjectInfo)
-> Maybe ObjectInfo
-> Minio ObjectInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MErrV -> Minio ObjectInfo
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVInvalidObjectInfoResponse) ObjectInfo -> Minio ObjectInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ObjectInfo -> Minio ObjectInfo)
-> Maybe ObjectInfo -> Minio ObjectInfo
forall a b. (a -> b) -> a -> b
$
    Object -> [Header] -> Maybe ObjectInfo
parseGetObjectHeaders Object
object ([Header] -> Maybe ObjectInfo) -> [Header] -> Maybe ObjectInfo
forall a b. (a -> b) -> a -> b
$
      Response LByteString -> [Header]
forall body. Response body -> [Header]
NC.responseHeaders Response LByteString
resp

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

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

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

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

-- | Fetch the policy if any on a bucket.
getBucketPolicy :: Bucket -> Minio Text
getBucketPolicy :: Object -> Minio Object
getBucketPolicy Object
bucket = do
  Response LByteString
resp <-
    S3ReqInfo -> Minio (Response LByteString)
executeRequest (S3ReqInfo -> Minio (Response LByteString))
-> S3ReqInfo -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$
      S3ReqInfo
defaultS3ReqInfo
        { riMethod :: ByteString
riMethod = ByteString
HT.methodGet,
          riBucket :: Maybe Object
riBucket = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
bucket,
          riQueryParams :: Query
riQueryParams = [(ByteString
"policy", Maybe ByteString
forall a. Maybe a
Nothing)]
        }
  Object -> Minio Object
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> Minio Object) -> Object -> Minio Object
forall a b. (a -> b) -> a -> b
$ ByteString -> Object
decodeUtf8Lenient (ByteString -> Object) -> ByteString -> Object
forall a b. (a -> b) -> a -> b
$ LByteString -> ByteString
toStrictBS (LByteString -> ByteString) -> LByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response LByteString -> LByteString
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 :: Object -> Object -> Minio ()
setBucketPolicy Object
bucket Object
policy = do
  if Object -> Bool
T.null Object
policy
    then Object -> Minio ()
deleteBucketPolicy Object
bucket
    else Object -> Object -> Minio ()
putBucketPolicy Object
bucket Object
policy

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

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