--
-- 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
-- Copyright:   (c) 2017-2023 MinIO Dev Team
-- License:     Apache 2.0
-- Maintainer:  MinIO Dev Team <dev@min.io>
--
-- Types and functions to conveniently access S3 compatible object
-- storage servers like MinIO.
module Network.Minio
  ( -- * Credentials
    CredentialValue (..),
    credentialValueText,
    AccessKey (..),
    SecretKey (..),
    SessionToken (..),

    -- ** Credential Loaders

    -- | Run actions that retrieve 'CredentialValue's from the environment or
    -- files or other custom sources.
    CredentialLoader,
    fromAWSConfigFile,
    fromAWSEnv,
    fromMinioEnv,
    findFirst,

    -- * Connecting to object storage
    ConnectInfo,
    setRegion,
    setCreds,
    setCredsFrom,
    isConnectInfoSecure,
    disableTLSCertValidation,
    MinioConn,
    mkMinioConn,

    -- ** Connection helpers

    -- | These are helpers to construct 'ConnectInfo' values for common
    -- cases.
    minioPlayCI,
    awsCI,
    gcsCI,

    -- ** STS Credential types
    STSAssumeRole (..),
    STSAssumeRoleOptions (..),
    defaultSTSAssumeRoleOptions,
    requestSTSCredential,
    setSTSCredential,
    ExpiryTime (..),
    STSCredentialProvider,

    -- * Minio Monad

    ----------------

    -- | The Minio Monad provides connection-reuse, bucket-location
    -- caching, resource management and simpler error handling
    -- functionality. All actions on object storage are performed within
    -- this Monad.
    Minio,
    runMinioWith,
    runMinio,
    runMinioResWith,
    runMinioRes,

    -- * Bucket Operations

    -- ** Creation, removal and querying
    Bucket,
    makeBucket,
    removeBucket,
    bucketExists,
    Region,
    getLocation,

    -- ** Listing buckets
    BucketInfo (..),
    listBuckets,

    -- ** Listing objects
    listObjects,
    listObjectsV1,
    ListItem (..),
    ObjectInfo,
    oiObject,
    oiModTime,
    oiETag,
    oiSize,
    oiUserMetadata,
    oiMetadata,

    -- ** Listing incomplete uploads
    listIncompleteUploads,
    UploadId,
    UploadInfo (..),
    listIncompleteParts,
    ObjectPartInfo (..),

    -- ** Bucket Notifications
    getBucketNotification,
    putBucketNotification,
    removeAllBucketNotification,
    Notification (..),
    defaultNotification,
    NotificationConfig (..),
    Arn,
    Event (..),
    Filter (..),
    defaultFilter,
    FilterKey (..),
    defaultFilterKey,
    FilterRules (..),
    defaultFilterRules,
    FilterRule (..),

    -- * Object Operations
    Object,

    -- ** File-based operations
    fGetObject,
    fPutObject,

    -- ** Conduit-based streaming operations
    putObject,
    PutObjectOptions,
    defaultPutObjectOptions,
    pooContentType,
    pooContentEncoding,
    pooContentDisposition,
    pooContentLanguage,
    pooCacheControl,
    pooStorageClass,
    pooUserMetadata,
    pooNumThreads,
    pooSSE,
    getObject,
    GetObjectOptions,
    defaultGetObjectOptions,
    gooRange,
    gooIfMatch,
    gooIfNoneMatch,
    gooIfModifiedSince,
    gooIfUnmodifiedSince,
    gooSSECKey,
    GetObjectResponse,
    gorObjectInfo,
    gorObjectStream,

    -- ** Server-side object copying
    copyObject,
    SourceInfo,
    defaultSourceInfo,
    srcBucket,
    srcObject,
    srcRange,
    srcIfMatch,
    srcIfNoneMatch,
    srcIfModifiedSince,
    srcIfUnmodifiedSince,
    DestinationInfo,
    defaultDestinationInfo,
    dstBucket,
    dstObject,

    -- ** Querying object info
    statObject,

    -- ** Object removal operations
    removeObject,
    removeIncompleteUpload,

    -- ** Select Object Content with SQL
    module Network.Minio.SelectAPI,

    -- * Server-Side Encryption Helpers
    mkSSECKey,
    SSECKey,
    SSE (..),

    -- * Presigned Operations
    presignedPutObjectUrl,
    presignedGetObjectUrl,
    presignedHeadObjectUrl,
    UrlExpiry,

    -- ** POST (browser) upload helpers

    -- | Please see
    -- https://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-HTTPPOSTConstructPolicy.html
    -- for detailed information.
    newPostPolicy,
    presignedPostPolicy,
    showPostPolicy,
    PostPolicy,
    PostPolicyError (..),

    -- *** Post Policy condition helpers
    PostPolicyCondition,
    ppCondBucket,
    ppCondContentLengthRange,
    ppCondContentType,
    ppCondKey,
    ppCondKeyStartsWith,
    ppCondSuccessActionStatus,

    -- * Error handling

    -- | Data types representing various errors that may occur while
    -- working with an object storage service.
    MinioErr (..),
    MErrV (..),
    ServiceErr (..),
  )
where

{-
This module exports the high-level MinIO API for object storage.
-}

import qualified Data.Conduit as C
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.Combinators as CC
import Network.Minio.API
import Network.Minio.CopyObject
import Network.Minio.Credentials
import Network.Minio.Data
import Network.Minio.Errors
import Network.Minio.ListOps
import Network.Minio.PutObject
import Network.Minio.S3API
import Network.Minio.SelectAPI

-- | Lists buckets.
listBuckets :: Minio [BucketInfo]
listBuckets :: Minio [BucketInfo]
listBuckets = Minio [BucketInfo]
getService

-- | Fetch the object and write it to the given file safely. The
-- object is first written to a temporary file in the same directory
-- and then moved to the given path.
fGetObject :: Bucket -> Object -> FilePath -> GetObjectOptions -> Minio ()
fGetObject :: Bucket -> Bucket -> FilePath -> GetObjectOptions -> Minio ()
fGetObject Bucket
bucket Bucket
object FilePath
fp GetObjectOptions
opts = do
  GetObjectResponse
src <- Bucket -> Bucket -> GetObjectOptions -> Minio GetObjectResponse
getObject Bucket
bucket Bucket
object GetObjectOptions
opts
  forall (m :: * -> *) a r.
Monad m =>
ConduitT () a m () -> ConduitT a Void m r -> m r
C.connect (GetObjectResponse -> ConduitM () ByteString Minio ()
gorObjectStream GetObjectResponse
src) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitM ByteString o m ()
CB.sinkFileCautious FilePath
fp

-- | Upload the given file to the given object.
fPutObject ::
  Bucket ->
  Object ->
  FilePath ->
  PutObjectOptions ->
  Minio ()
fPutObject :: Bucket -> Bucket -> FilePath -> PutObjectOptions -> Minio ()
fPutObject Bucket
bucket Bucket
object FilePath
f PutObjectOptions
opts =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Bucket
-> Bucket -> PutObjectOptions -> ObjectData Minio -> Minio Bucket
putObjectInternal Bucket
bucket Bucket
object PutObjectOptions
opts forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). FilePath -> Maybe Int64 -> ObjectData m
ODFile FilePath
f forall a. Maybe a
Nothing

-- | Put an object from a conduit source. The size can be provided if
-- known; this helps the library select optimal part sizes to perform
-- a multipart upload. If not specified, it is assumed that the object
-- can be potentially 5TiB and selects multipart sizes appropriately.
putObject ::
  Bucket ->
  Object ->
  C.ConduitM () ByteString Minio () ->
  Maybe Int64 ->
  PutObjectOptions ->
  Minio ()
putObject :: Bucket
-> Bucket
-> ConduitM () ByteString Minio ()
-> Maybe Int64
-> PutObjectOptions
-> Minio ()
putObject Bucket
bucket Bucket
object ConduitM () ByteString Minio ()
src Maybe Int64
sizeMay PutObjectOptions
opts =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Bucket
-> Bucket -> PutObjectOptions -> ObjectData Minio -> Minio Bucket
putObjectInternal Bucket
bucket Bucket
object PutObjectOptions
opts forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
ConduitM () ByteString m () -> Maybe Int64 -> ObjectData m
ODStream ConduitM () ByteString Minio ()
src Maybe Int64
sizeMay

-- | Perform a server-side copy operation to create an object based on
-- the destination specification in DestinationInfo from the source
-- specification in SourceInfo. This function performs a multipart
-- copy operation if the new object is to be greater than 5GiB in
-- size.
copyObject :: DestinationInfo -> SourceInfo -> Minio ()
copyObject :: DestinationInfo -> SourceInfo -> Minio ()
copyObject DestinationInfo
dstInfo SourceInfo
srcInfo =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
    Bucket -> Bucket -> SourceInfo -> Minio Bucket
copyObjectInternal
      (DestinationInfo -> Bucket
dstBucket DestinationInfo
dstInfo)
      (DestinationInfo -> Bucket
dstObject DestinationInfo
dstInfo)
      SourceInfo
srcInfo

-- | Remove an object from the object store.
removeObject :: Bucket -> Object -> Minio ()
removeObject :: Bucket -> Bucket -> Minio ()
removeObject = Bucket -> Bucket -> Minio ()
deleteObject

-- | Get an object from the object store.
getObject ::
  Bucket ->
  Object ->
  GetObjectOptions ->
  Minio GetObjectResponse
getObject :: Bucket -> Bucket -> GetObjectOptions -> Minio GetObjectResponse
getObject Bucket
bucket Bucket
object GetObjectOptions
opts =
  Bucket -> Bucket -> Query -> [Header] -> Minio GetObjectResponse
getObject' Bucket
bucket Bucket
object [] forall a b. (a -> b) -> a -> b
$ GetObjectOptions -> [Header]
gooToHeaders GetObjectOptions
opts

-- | Get an object's metadata from the object store. It accepts the
-- same options as GetObject.
statObject :: Bucket -> Object -> GetObjectOptions -> Minio ObjectInfo
statObject :: Bucket -> Bucket -> GetObjectOptions -> Minio ObjectInfo
statObject Bucket
b Bucket
o GetObjectOptions
opts = Bucket -> Bucket -> [Header] -> Minio ObjectInfo
headObject Bucket
b Bucket
o forall a b. (a -> b) -> a -> b
$ GetObjectOptions -> [Header]
gooToHeaders GetObjectOptions
opts

-- | Creates a new bucket in the object store. The Region can be
-- optionally specified. If not specified, it will use the region
-- configured in ConnectInfo, which is by default, the US Standard
-- Region.
makeBucket :: Bucket -> Maybe Region -> Minio ()
makeBucket :: Bucket -> Maybe Bucket -> Minio ()
makeBucket Bucket
bucket Maybe Bucket
regionMay = do
  Bucket
region <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Bucket
connectRegion forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinioConn -> ConnectInfo
mcConnInfo) forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bucket
regionMay
  Bucket -> Bucket -> Minio ()
putBucket Bucket
bucket Bucket
region
  Bucket -> Bucket -> Minio ()
addToRegionCache Bucket
bucket Bucket
region

-- | Removes a bucket from the object store.
removeBucket :: Bucket -> Minio ()
removeBucket :: Bucket -> Minio ()
removeBucket Bucket
bucket = do
  Bucket -> Minio ()
deleteBucket Bucket
bucket
  Bucket -> Minio ()
deleteFromRegionCache Bucket
bucket

-- | Query the object store if a given bucket is present.
bucketExists :: Bucket -> Minio Bool
bucketExists :: Bucket -> Minio Bool
bucketExists = Bucket -> Minio Bool
headBucket

-- | Removes an ongoing multipart upload of an object.
removeIncompleteUpload :: Bucket -> Object -> Minio ()
removeIncompleteUpload :: Bucket -> Bucket -> Minio ()
removeIncompleteUpload Bucket
bucket Bucket
object = do
  [UploadInfo]
uploads <-
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit forall a b. (a -> b) -> a -> b
$
      Bucket -> Maybe Bucket -> Bool -> ConduitM () UploadInfo Minio ()
listIncompleteUploads Bucket
bucket (forall a. a -> Maybe a
Just Bucket
object) Bool
False
        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 (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bucket -> Bucket -> Bucket -> Minio ()
abortMultipartUpload Bucket
bucket Bucket
object) (UploadInfo -> Bucket
uiUploadId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UploadInfo]
uploads)