--
-- 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.
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}

module Network.Minio.Data where

import qualified Conduit as C
import qualified Control.Concurrent.MVar as M
import Control.Monad.Trans.Except (throwE)
import Control.Monad.Trans.Resource
  ( MonadResource,
    MonadThrow (..),
    MonadUnliftIO,
    ResourceT,
    runResourceT,
  )
import qualified Data.Aeson as A
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.HashMap.Strict as H
import qualified Data.Ini as Ini
import qualified Data.List as List
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Time (defaultTimeLocale, formatTime)
import Lib.Prelude (UTCTime, throwIO)
import qualified Network.Connection as Conn
import Network.HTTP.Client (defaultManagerSettings)
import qualified Network.HTTP.Client.TLS as TLS
import qualified Network.HTTP.Conduit as NC
import Network.HTTP.Types
  ( ByteRange,
    Header,
    Method,
    Query,
    hRange,
  )
import qualified Network.HTTP.Types as HT
import Network.Minio.Credentials
import Network.Minio.Data.Crypto
  ( encodeToBase64,
    hashMD5ToBase64,
  )
import Network.Minio.Data.Time (UrlExpiry)
import Network.Minio.Errors
  ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials),
    MinioErr (..),
  )
import Network.Minio.Utils
import System.Directory (doesFileExist, getHomeDirectory)
import qualified System.Environment as Env
import System.FilePath.Posix (combine)
import qualified UnliftIO as U
import qualified UnliftIO.MVar as UM

-- | max obj size is 5TiB
maxObjectSize :: Int64
maxObjectSize :: Int64
maxObjectSize = 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
oneMiB

-- | minimum size of parts used in multipart operations.
minPartSize :: Int64
minPartSize :: Int64
minPartSize = Int64
64 forall a. Num a => a -> a -> a
* Int64
oneMiB

oneMiB :: Int64
oneMiB :: Int64
oneMiB = Int64
1024 forall a. Num a => a -> a -> a
* Int64
1024

-- | maximum number of parts that can be uploaded for a single object.
maxMultipartParts :: Int64
maxMultipartParts :: Int64
maxMultipartParts = Int64
10000

-- TODO: Add a type which provides typed constants for region.  this
-- type should have a IsString instance to infer the appropriate
-- constant.

-- | awsRegionMap - library constant
awsRegionMap :: H.HashMap Text Text
awsRegionMap :: HashMap Bucket Bucket
awsRegionMap =
  forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
    [ (Bucket
"us-east-1", Bucket
"s3.us-east-1.amazonaws.com"),
      (Bucket
"us-east-2", Bucket
"s3.us-east-2.amazonaws.com"),
      (Bucket
"us-west-1", Bucket
"s3.us-west-1.amazonaws.com"),
      (Bucket
"us-west-2", Bucket
"s3.us-west-2.amazonaws.com"),
      (Bucket
"ca-central-1", Bucket
"s3.ca-central-1.amazonaws.com"),
      (Bucket
"ap-south-1", Bucket
"s3.ap-south-1.amazonaws.com"),
      (Bucket
"ap-south-2", Bucket
"s3.ap-south-2.amazonaws.com"),
      (Bucket
"ap-northeast-1", Bucket
"s3.ap-northeast-1.amazonaws.com"),
      (Bucket
"ap-northeast-2", Bucket
"s3.ap-northeast-2.amazonaws.com"),
      (Bucket
"ap-northeast-3", Bucket
"s3.ap-northeast-3.amazonaws.com"),
      (Bucket
"ap-southeast-1", Bucket
"s3.ap-southeast-1.amazonaws.com"),
      (Bucket
"ap-southeast-2", Bucket
"s3.ap-southeast-2.amazonaws.com"),
      (Bucket
"ap-southeast-3", Bucket
"s3.ap-southeast-3.amazonaws.com"),
      (Bucket
"eu-west-1", Bucket
"s3.eu-west-1.amazonaws.com"),
      (Bucket
"eu-west-2", Bucket
"s3.eu-west-2.amazonaws.com"),
      (Bucket
"eu-west-3", Bucket
"s3.eu-west-3.amazonaws.com"),
      (Bucket
"eu-central-1", Bucket
"s3.eu-central-1.amazonaws.com"),
      (Bucket
"eu-central-2", Bucket
"s3.eu-central-2.amazonaws.com"),
      (Bucket
"eu-south-1", Bucket
"s3.eu-south-1.amazonaws.com"),
      (Bucket
"eu-south-2", Bucket
"s3.eu-south-2.amazonaws.com"),
      (Bucket
"af-south-1", Bucket
"s3.af-south-1.amazonaws.com"),
      (Bucket
"ap-east-1", Bucket
"s3.ap-east-1.amazonaws.com"),
      (Bucket
"cn-north-1", Bucket
"s3.cn-north-1.amazonaws.com.cn"),
      (Bucket
"cn-northwest-1", Bucket
"s3.cn-northwest-1.amazonaws.com.cn"),
      (Bucket
"eu-north-1", Bucket
"s3.eu-north-1.amazonaws.com"),
      (Bucket
"me-south-1", Bucket
"s3.me-south-1.amazonaws.com"),
      (Bucket
"me-central-1", Bucket
"s3.me-central-1.amazonaws.com"),
      (Bucket
"us-gov-east-1", Bucket
"s3.us-gov-east-1.amazonaws.com"),
      (Bucket
"us-gov-west-1", Bucket
"s3.us-gov-west-1.amazonaws.com"),
      (Bucket
"sa-east-1", Bucket
"s3.sa-east-1.amazonaws.com")
    ]

-- | Connection Info data type. To create a 'ConnectInfo' value,
-- enable the @OverloadedStrings@ language extension and use the
-- `IsString` instance to provide a URL, for example:
--
-- > let c :: ConnectInfo = "https://play.min.io"
data ConnectInfo = ConnectInfo
  { ConnectInfo -> Bucket
connectHost :: Text,
    ConnectInfo -> Int
connectPort :: Int,
    ConnectInfo -> Creds
connectCreds :: Creds,
    ConnectInfo -> Bool
connectIsSecure :: Bool,
    ConnectInfo -> Bucket
connectRegion :: Region,
    ConnectInfo -> Bool
connectAutoDiscoverRegion :: Bool,
    ConnectInfo -> Bool
connectDisableTLSCertValidation :: Bool
  }

getEndpoint :: ConnectInfo -> Endpoint
getEndpoint :: ConnectInfo -> Endpoint
getEndpoint ConnectInfo
ci = (forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Bucket
connectHost ConnectInfo
ci, ConnectInfo -> Int
connectPort ConnectInfo
ci, ConnectInfo -> Bool
connectIsSecure ConnectInfo
ci)

instance IsString ConnectInfo where
  fromString :: String -> ConnectInfo
fromString String
str =
    let req :: Request
req = String -> Request
NC.parseRequest_ String
str
     in ConnectInfo
          { connectHost :: Bucket
connectHost = ByteString -> Bucket
TE.decodeUtf8 forall a b. (a -> b) -> a -> b
$ Request -> ByteString
NC.host Request
req,
            connectPort :: Int
connectPort = Request -> Int
NC.port Request
req,
            connectCreds :: Creds
connectCreds = CredentialValue -> Creds
CredsStatic forall a b. (a -> b) -> a -> b
$ AccessKey -> SecretKey -> Maybe SessionToken -> CredentialValue
CredentialValue forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty,
            connectIsSecure :: Bool
connectIsSecure = Request -> Bool
NC.secure Request
req,
            connectRegion :: Bucket
connectRegion = Bucket
"",
            connectAutoDiscoverRegion :: Bool
connectAutoDiscoverRegion = Bool
True,
            connectDisableTLSCertValidation :: Bool
connectDisableTLSCertValidation = Bool
False
          }

-- | A 'CredentialLoader' is an action that may return a 'CredentialValue'.
-- Loaders may be chained together using 'findFirst'.
--
-- @since 1.7.0
type CredentialLoader = IO (Maybe CredentialValue)

-- | Combines the given list of loaders, by calling each one in
-- order until a 'CredentialValue' is returned.
findFirst :: [CredentialLoader] -> IO (Maybe CredentialValue)
findFirst :: [CredentialLoader] -> CredentialLoader
findFirst [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
findFirst (CredentialLoader
f : [CredentialLoader]
fs) = do
  Maybe CredentialValue
c <- CredentialLoader
f
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([CredentialLoader] -> CredentialLoader
findFirst [CredentialLoader]
fs) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) Maybe CredentialValue
c

-- | This action returns a 'CredentialValue' populated from
-- @~\/.aws\/credentials@
fromAWSConfigFile :: CredentialLoader
fromAWSConfigFile :: CredentialLoader
fromAWSConfigFile = do
  Either String CredentialValue
credsE <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
    String
homeDir <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO String
getHomeDirectory
    let awsCredsFile :: String
awsCredsFile = String
homeDir String -> String -> String
`combine` String
".aws" String -> String -> String
`combine` String
"credentials"
    Bool
fileExists <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
awsCredsFile
    forall a. a -> a -> Bool -> a
bool (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"FileNotFound") (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Bool
fileExists
    Ini
ini <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ String -> IO (Either String Ini)
Ini.readIniFile String
awsCredsFile
    Bucket
akey <-
      forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
          Bucket -> Bucket -> Ini -> Either String Bucket
Ini.lookupValue Bucket
"default" Bucket
"aws_access_key_id" Ini
ini
    Bucket
skey <-
      forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
          Bucket -> Bucket -> Ini -> Either String Bucket
Ini.lookupValue Bucket
"default" Bucket
"aws_secret_access_key" Ini
ini
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AccessKey -> SecretKey -> Maybe SessionToken -> CredentialValue
CredentialValue (coerce :: forall a b. Coercible a b => a -> b
coerce Bucket
akey) (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ Bucket -> String
T.unpack Bucket
skey) forall a. Maybe a
Nothing
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just Either String CredentialValue
credsE

-- | This action returns a 'CredentialValue` populated from @AWS_ACCESS_KEY_ID@
-- and @AWS_SECRET_ACCESS_KEY@ environment variables.
fromAWSEnv :: CredentialLoader
fromAWSEnv :: CredentialLoader
fromAWSEnv = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
  String
akey <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
Env.lookupEnv String
"AWS_ACCESS_KEY_ID"
  String
skey <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
Env.lookupEnv String
"AWS_SECRET_ACCESS_KEY"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AccessKey -> SecretKey -> Maybe SessionToken -> CredentialValue
CredentialValue (forall a. IsString a => String -> a
fromString String
akey) (forall a. IsString a => String -> a
fromString String
skey) forall a. Maybe a
Nothing

-- | This action returns a 'CredentialValue' populated from @MINIO_ACCESS_KEY@
-- and @MINIO_SECRET_KEY@ environment variables.
fromMinioEnv :: CredentialLoader
fromMinioEnv :: CredentialLoader
fromMinioEnv = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
  String
akey <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
Env.lookupEnv String
"MINIO_ACCESS_KEY"
  String
skey <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
Env.lookupEnv String
"MINIO_SECRET_KEY"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AccessKey -> SecretKey -> Maybe SessionToken -> CredentialValue
CredentialValue (forall a. IsString a => String -> a
fromString String
akey) (forall a. IsString a => String -> a
fromString String
skey) forall a. Maybe a
Nothing

-- | setCredsFrom retrieves access credentials from the first action in the
-- given list that succeeds and sets it in the 'ConnectInfo'.
setCredsFrom :: [CredentialLoader] -> ConnectInfo -> IO ConnectInfo
setCredsFrom :: [CredentialLoader] -> ConnectInfo -> IO ConnectInfo
setCredsFrom [CredentialLoader]
ps ConnectInfo
ci = do
  Maybe CredentialValue
pMay <- [CredentialLoader] -> CredentialLoader
findFirst [CredentialLoader]
ps
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVMissingCredentials)
    (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CredentialValue -> ConnectInfo -> ConnectInfo
`setCreds` ConnectInfo
ci))
    Maybe CredentialValue
pMay

-- | setCreds sets the given `CredentialValue` in the `ConnectInfo`.
setCreds :: CredentialValue -> ConnectInfo -> ConnectInfo
setCreds :: CredentialValue -> ConnectInfo -> ConnectInfo
setCreds CredentialValue
cv ConnectInfo
connInfo =
  ConnectInfo
connInfo
    { connectCreds :: Creds
connectCreds = CredentialValue -> Creds
CredsStatic CredentialValue
cv
    }

-- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
-- credentials via the STS API on demand. It is automatically refreshed on
-- expiry.
setSTSCredential :: (STSCredentialProvider p) => p -> ConnectInfo -> IO ConnectInfo
setSTSCredential :: forall p.
STSCredentialProvider p =>
p -> ConnectInfo -> IO ConnectInfo
setSTSCredential p
p ConnectInfo
ci = do
  STSCredentialStore
store <- forall p. STSCredentialProvider p => p -> IO STSCredentialStore
initSTSCredential p
p
  forall (m :: * -> *) a. Monad m => a -> m a
return ConnectInfo
ci {connectCreds :: Creds
connectCreds = STSCredentialStore -> Creds
CredsSTS STSCredentialStore
store}

-- | Set the S3 region parameter in the `ConnectInfo`
setRegion :: Region -> ConnectInfo -> ConnectInfo
setRegion :: Bucket -> ConnectInfo -> ConnectInfo
setRegion Bucket
r ConnectInfo
connInfo =
  ConnectInfo
connInfo
    { connectRegion :: Bucket
connectRegion = Bucket
r,
      connectAutoDiscoverRegion :: Bool
connectAutoDiscoverRegion = Bool
False
    }

-- | Check if the connection to object storage server is secure
-- (i.e. uses TLS)
isConnectInfoSecure :: ConnectInfo -> Bool
isConnectInfoSecure :: ConnectInfo -> Bool
isConnectInfoSecure = ConnectInfo -> Bool
connectIsSecure

-- | Disable TLS certificate validation completely! This makes TLS
-- insecure! Use only for testing with self-signed or temporary
-- certificates. Note that this option has no effect, if you provide
-- your own Manager in `mkMinioConn`.
disableTLSCertValidation :: ConnectInfo -> ConnectInfo
disableTLSCertValidation :: ConnectInfo -> ConnectInfo
disableTLSCertValidation ConnectInfo
c = ConnectInfo
c {connectDisableTLSCertValidation :: Bool
connectDisableTLSCertValidation = Bool
True}

getHostAddr :: ConnectInfo -> ByteString
getHostAddr :: ConnectInfo -> ByteString
getHostAddr ConnectInfo
ci = (ByteString, Int) -> ByteString
getHostHeader (forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Bucket
connectHost ConnectInfo
ci, ConnectInfo -> Int
connectPort ConnectInfo
ci)

-- | Default Google Compute Storage ConnectInfo. Works only for
-- "Simple Migration" use-case with interoperability mode enabled on
-- GCP console. For more information -
-- https://cloud.google.com/storage/docs/migrating
--
-- Credentials should be supplied before use.
gcsCI :: ConnectInfo
gcsCI :: ConnectInfo
gcsCI =
  Bucket -> ConnectInfo -> ConnectInfo
setRegion
    Bucket
"us"
    ConnectInfo
"https://storage.googleapis.com"

-- | Default AWS S3 ConnectInfo. Connects to "us-east-1". Credentials
-- should be supplied before use.
awsCI :: ConnectInfo
awsCI :: ConnectInfo
awsCI = ConnectInfo
"https://s3.amazonaws.com"

-- | <https://play.min.io MinIO Play Server>
-- ConnectInfo. Credentials are already filled in.
minioPlayCI :: ConnectInfo
minioPlayCI :: ConnectInfo
minioPlayCI =
  let playCreds :: CredentialValue
playCreds = AccessKey -> SecretKey -> Maybe SessionToken -> CredentialValue
CredentialValue AccessKey
"Q3AM3UQ867SPQQA43P2F" SecretKey
"zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG" forall a. Maybe a
Nothing
   in CredentialValue -> ConnectInfo -> ConnectInfo
setCreds CredentialValue
playCreds forall a b. (a -> b) -> a -> b
$
        Bucket -> ConnectInfo -> ConnectInfo
setRegion
          Bucket
"us-east-1"
          ConnectInfo
"https://play.min.io"

-- |
-- Represents a bucket in the object store
type Bucket = Text

-- |
-- Represents an object name
type Object = Text

-- | Represents a region
type Region = Text

-- | A type alias to represent an Entity-Tag returned by S3-compatible APIs.
type ETag = Text

-- | Data type to represent an object encryption key. Create one using
-- the `mkSSECKey` function.
newtype SSECKey = SSECKey BA.ScrubbedBytes
  deriving stock (SSECKey -> SSECKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SSECKey -> SSECKey -> Bool
$c/= :: SSECKey -> SSECKey -> Bool
== :: SSECKey -> SSECKey -> Bool
$c== :: SSECKey -> SSECKey -> Bool
Eq, Int -> SSECKey -> String -> String
[SSECKey] -> String -> String
SSECKey -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SSECKey] -> String -> String
$cshowList :: [SSECKey] -> String -> String
show :: SSECKey -> String
$cshow :: SSECKey -> String
showsPrec :: Int -> SSECKey -> String -> String
$cshowsPrec :: Int -> SSECKey -> String -> String
Show)

-- | Validates that the given ByteString is 32 bytes long and creates
-- an encryption key.
mkSSECKey :: (MonadThrow m) => ByteString -> m SSECKey
mkSSECKey :: forall (m :: * -> *). MonadThrow m => ByteString -> m SSECKey
mkSSECKey ByteString
keyBytes
  | ByteString -> Int
B.length ByteString
keyBytes forall a. Eq a => a -> a -> Bool
/= Int
32 =
      forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM MErrV
MErrVInvalidEncryptionKeyLength
  | Bool
otherwise =
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> SSECKey
SSECKey forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ByteString
keyBytes

-- | Data type to represent Server-Side-Encryption settings
data SSE where
  -- | Specifies SSE S3 encryption - server manages encryption keys
  SSE :: SSE
  -- | Specifies that KMS service should be used. The first argument
  -- to the constructor is the Key Id to be used by the server (if
  -- not specified, the default KMS key id is used). The second
  -- argument is the optional KMS context that must have a
  -- `A.ToJSON` instance - please refer to the AWS S3 documentation
  -- for detailed information.
  SSEKMS :: (A.ToJSON a) => Maybe ByteString -> Maybe a -> SSE
  -- | Specifies server-side encryption with customer provided
  -- key. The argument is the encryption key to be used.
  SSEC :: SSECKey -> SSE

toPutObjectHeaders :: SSE -> [HT.Header]
toPutObjectHeaders :: SSE -> [Header]
toPutObjectHeaders SSE
sseArg =
  let sseHeader :: CI ByteString
sseHeader = CI ByteString
"x-amz-server-side-encryption"
      sseKmsIdHeader :: CI ByteString
sseKmsIdHeader = CI ByteString
sseHeader forall a. Semigroup a => a -> a -> a
<> CI ByteString
"-aws-kms-key-id"
      sseKmsContextHeader :: CI ByteString
sseKmsContextHeader = CI ByteString
sseHeader forall a. Semigroup a => a -> a -> a
<> CI ByteString
"-context"
      ssecAlgo :: CI ByteString
ssecAlgo = CI ByteString
sseHeader forall a. Semigroup a => a -> a -> a
<> CI ByteString
"-customer-algorithm"
      ssecKey :: CI ByteString
ssecKey = CI ByteString
sseHeader forall a. Semigroup a => a -> a -> a
<> CI ByteString
"-customer-key"
      ssecKeyMD5 :: CI ByteString
ssecKeyMD5 = CI ByteString
ssecKey forall a. Semigroup a => a -> a -> a
<> CI ByteString
"-MD5"
   in case SSE
sseArg of
        SSE
SSE -> [(CI ByteString
sseHeader, ByteString
"AES256")]
        SSEKMS Maybe ByteString
keyIdMay Maybe a
ctxMay ->
          [(CI ByteString
sseHeader, ByteString
"aws:kms")]
            forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ByteString
k -> [(CI ByteString
sseKmsIdHeader, ByteString
k)]) Maybe ByteString
keyIdMay
            forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\a
k -> [(CI ByteString
sseKmsContextHeader, ByteString -> ByteString
LB.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
A.encode a
k)]) Maybe a
ctxMay
        SSEC (SSECKey ScrubbedBytes
sb) ->
          [ (CI ByteString
ssecAlgo, ByteString
"AES256"),
            (CI ByteString
ssecKey, forall a. ByteArrayAccess a => a -> ByteString
encodeToBase64 ScrubbedBytes
sb),
            (CI ByteString
ssecKeyMD5, forall a. ByteArrayAccess a => a -> ByteString
hashMD5ToBase64 ScrubbedBytes
sb)
          ]

-- | Data type for options in PutObject call.  Start with the empty
-- `defaultPutObjectOptions` and use various the various poo*
-- accessors.
data PutObjectOptions = PutObjectOptions
  { -- | Set a standard MIME type describing the format of the object.
    PutObjectOptions -> Maybe Bucket
pooContentType :: Maybe Text,
    -- | Set what content encodings have been applied to the object and thus
    -- what decoding mechanisms must be applied to obtain the media-type
    -- referenced by the Content-Type header field.
    PutObjectOptions -> Maybe Bucket
pooContentEncoding :: Maybe Text,
    -- | Set presentational information for the object.
    PutObjectOptions -> Maybe Bucket
pooContentDisposition :: Maybe Text,
    -- | Set to specify caching behavior for the object along the
    -- request/reply chain.
    PutObjectOptions -> Maybe Bucket
pooCacheControl :: Maybe Text,
    -- | Set to describe the language(s) intended for the audience.
    PutObjectOptions -> Maybe Bucket
pooContentLanguage :: Maybe Text,
    -- | Set to @STANDARD@ or @REDUCED_REDUNDANCY@ depending on your
    -- performance needs, storage class is @STANDARD@ by default (i.e
    -- when Nothing is passed).
    PutObjectOptions -> Maybe Bucket
pooStorageClass :: Maybe Text,
    -- | Set user defined metadata to store with the object.
    PutObjectOptions -> [(Bucket, Bucket)]
pooUserMetadata :: [(Text, Text)],
    -- | Set number of worker threads used to upload an object.
    PutObjectOptions -> Maybe Word
pooNumThreads :: Maybe Word,
    -- | Set object encryption parameters for the request.
    PutObjectOptions -> Maybe SSE
pooSSE :: Maybe SSE
  }

-- | Provide default `PutObjectOptions`.
defaultPutObjectOptions :: PutObjectOptions
defaultPutObjectOptions :: PutObjectOptions
defaultPutObjectOptions = Maybe Bucket
-> Maybe Bucket
-> Maybe Bucket
-> Maybe Bucket
-> Maybe Bucket
-> Maybe Bucket
-> [(Bucket, Bucket)]
-> Maybe Word
-> Maybe SSE
-> PutObjectOptions
PutObjectOptions forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing [] forall a. Maybe a
Nothing forall a. Maybe a
Nothing

pooToHeaders :: PutObjectOptions -> [HT.Header]
pooToHeaders :: PutObjectOptions -> [Header]
pooToHeaders PutObjectOptions
poo =
  [Header]
userMetadata
    forall a. [a] -> [a] -> [a]
++ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a} {b}. (a, Maybe b) -> Maybe (a, b)
tupToMaybe (forall a b. [a] -> [b] -> [(a, b)]
zip [CI ByteString]
names [Maybe ByteString]
values)
    forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] SSE -> [Header]
toPutObjectHeaders (PutObjectOptions -> Maybe SSE
pooSSE PutObjectOptions
poo)
  where
    tupToMaybe :: (a, Maybe b) -> Maybe (a, b)
tupToMaybe (a
k, Just b
v) = forall a. a -> Maybe a
Just (a
k, b
v)
    tupToMaybe (a
_, Maybe b
Nothing) = forall a. Maybe a
Nothing
    userMetadata :: [Header]
userMetadata = [(Bucket, Bucket)] -> [Header]
mkHeaderFromMetadata forall a b. (a -> b) -> a -> b
$ PutObjectOptions -> [(Bucket, Bucket)]
pooUserMetadata PutObjectOptions
poo
    names :: [CI ByteString]
names =
      [ CI ByteString
"content-type",
        CI ByteString
"content-encoding",
        CI ByteString
"content-disposition",
        CI ByteString
"content-language",
        CI ByteString
"cache-control",
        CI ByteString
"x-amz-storage-class"
      ]
    values :: [Maybe ByteString]
values =
      forall a b. (a -> b) -> [a] -> [b]
map
        (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
. (PutObjectOptions
poo forall a b. a -> (a -> b) -> b
&))
        [ PutObjectOptions -> Maybe Bucket
pooContentType,
          PutObjectOptions -> Maybe Bucket
pooContentEncoding,
          PutObjectOptions -> Maybe Bucket
pooContentDisposition,
          PutObjectOptions -> Maybe Bucket
pooContentLanguage,
          PutObjectOptions -> Maybe Bucket
pooCacheControl,
          PutObjectOptions -> Maybe Bucket
pooStorageClass
        ]

-- |
-- BucketInfo returned for list buckets call
data BucketInfo = BucketInfo
  { BucketInfo -> Bucket
biName :: Bucket,
    BucketInfo -> UTCTime
biCreationDate :: UTCTime
  }
  deriving stock (Int -> BucketInfo -> String -> String
[BucketInfo] -> String -> String
BucketInfo -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [BucketInfo] -> String -> String
$cshowList :: [BucketInfo] -> String -> String
show :: BucketInfo -> String
$cshow :: BucketInfo -> String
showsPrec :: Int -> BucketInfo -> String -> String
$cshowsPrec :: Int -> BucketInfo -> String -> String
Show, BucketInfo -> BucketInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BucketInfo -> BucketInfo -> Bool
$c/= :: BucketInfo -> BucketInfo -> Bool
== :: BucketInfo -> BucketInfo -> Bool
$c== :: BucketInfo -> BucketInfo -> Bool
Eq)

-- | A type alias to represent a part-number for multipart upload
type PartNumber = Int16

-- | Select part sizes - the logic is that the minimum part-size will
-- be 64MiB.
selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
selectPartSizes Int64
size =
  forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
List.zip3 [PartNumber
1 ..]) forall a b. (a -> b) -> a -> b
$
    forall a b. [(a, b)] -> ([a], [b])
List.unzip forall a b. (a -> b) -> a -> b
$
      Int64 -> Int64 -> [(Int64, Int64)]
loop Int64
0 Int64
size
  where
    ceil :: Double -> Int64
    ceil :: Double -> Int64
ceil = forall a b. (RealFrac a, Integral b) => a -> b
ceiling
    partSize :: Int64
partSize =
      forall a. Ord a => a -> a -> a
max
        Int64
minPartSize
        ( Double -> Int64
ceil forall a b. (a -> b) -> a -> b
$
            forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
size
              forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
maxMultipartParts
        )
    m :: Int64
m = Int64
partSize
    loop :: Int64 -> Int64 -> [(Int64, Int64)]
loop Int64
st Int64
sz
      | Int64
st forall a. Ord a => a -> a -> Bool
> Int64
sz = []
      | Int64
st forall a. Num a => a -> a -> a
+ Int64
m forall a. Ord a => a -> a -> Bool
>= Int64
sz = [(Int64
st, Int64
sz forall a. Num a => a -> a -> a
- Int64
st)]
      | Bool
otherwise = (Int64
st, Int64
m) forall a. a -> [a] -> [a]
: Int64 -> Int64 -> [(Int64, Int64)]
loop (Int64
st forall a. Num a => a -> a -> a
+ Int64
m) Int64
sz

-- | A type alias to represent an upload-id for multipart upload
type UploadId = Text

-- | A type to represent a part-number and etag.
type PartTuple = (PartNumber, ETag)

-- | Represents result from a listing of object parts of an ongoing
-- multipart upload.
data ListPartsResult = ListPartsResult
  { ListPartsResult -> Bool
lprHasMore :: Bool,
    ListPartsResult -> Maybe Int
lprNextPart :: Maybe Int,
    ListPartsResult -> [ObjectPartInfo]
lprParts :: [ObjectPartInfo]
  }
  deriving stock (Int -> ListPartsResult -> String -> String
[ListPartsResult] -> String -> String
ListPartsResult -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ListPartsResult] -> String -> String
$cshowList :: [ListPartsResult] -> String -> String
show :: ListPartsResult -> String
$cshow :: ListPartsResult -> String
showsPrec :: Int -> ListPartsResult -> String -> String
$cshowsPrec :: Int -> ListPartsResult -> String -> String
Show, ListPartsResult -> ListPartsResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPartsResult -> ListPartsResult -> Bool
$c/= :: ListPartsResult -> ListPartsResult -> Bool
== :: ListPartsResult -> ListPartsResult -> Bool
$c== :: ListPartsResult -> ListPartsResult -> Bool
Eq)

-- | Represents information about an object part in an ongoing
-- multipart upload.
data ObjectPartInfo = ObjectPartInfo
  { ObjectPartInfo -> PartNumber
opiNumber :: PartNumber,
    ObjectPartInfo -> Bucket
opiETag :: ETag,
    ObjectPartInfo -> Int64
opiSize :: Int64,
    ObjectPartInfo -> UTCTime
opiModTime :: UTCTime
  }
  deriving stock (Int -> ObjectPartInfo -> String -> String
[ObjectPartInfo] -> String -> String
ObjectPartInfo -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ObjectPartInfo] -> String -> String
$cshowList :: [ObjectPartInfo] -> String -> String
show :: ObjectPartInfo -> String
$cshow :: ObjectPartInfo -> String
showsPrec :: Int -> ObjectPartInfo -> String -> String
$cshowsPrec :: Int -> ObjectPartInfo -> String -> String
Show, ObjectPartInfo -> ObjectPartInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectPartInfo -> ObjectPartInfo -> Bool
$c/= :: ObjectPartInfo -> ObjectPartInfo -> Bool
== :: ObjectPartInfo -> ObjectPartInfo -> Bool
$c== :: ObjectPartInfo -> ObjectPartInfo -> Bool
Eq)

-- | Represents result from a listing of incomplete uploads to a
-- bucket.
data ListUploadsResult = ListUploadsResult
  { ListUploadsResult -> Bool
lurHasMore :: Bool,
    ListUploadsResult -> Maybe Bucket
lurNextKey :: Maybe Text,
    ListUploadsResult -> Maybe Bucket
lurNextUpload :: Maybe Text,
    ListUploadsResult -> [(Bucket, Bucket, UTCTime)]
lurUploads :: [(Object, UploadId, UTCTime)],
    ListUploadsResult -> [Bucket]
lurCPrefixes :: [Text]
  }
  deriving stock (Int -> ListUploadsResult -> String -> String
[ListUploadsResult] -> String -> String
ListUploadsResult -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ListUploadsResult] -> String -> String
$cshowList :: [ListUploadsResult] -> String -> String
show :: ListUploadsResult -> String
$cshow :: ListUploadsResult -> String
showsPrec :: Int -> ListUploadsResult -> String -> String
$cshowsPrec :: Int -> ListUploadsResult -> String -> String
Show, ListUploadsResult -> ListUploadsResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListUploadsResult -> ListUploadsResult -> Bool
$c/= :: ListUploadsResult -> ListUploadsResult -> Bool
== :: ListUploadsResult -> ListUploadsResult -> Bool
$c== :: ListUploadsResult -> ListUploadsResult -> Bool
Eq)

-- | Represents information about a multipart upload.
data UploadInfo = UploadInfo
  { UploadInfo -> Bucket
uiKey :: Object,
    UploadInfo -> Bucket
uiUploadId :: UploadId,
    UploadInfo -> UTCTime
uiInitTime :: UTCTime,
    UploadInfo -> Int64
uiSize :: Int64
  }
  deriving stock (Int -> UploadInfo -> String -> String
[UploadInfo] -> String -> String
UploadInfo -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [UploadInfo] -> String -> String
$cshowList :: [UploadInfo] -> String -> String
show :: UploadInfo -> String
$cshow :: UploadInfo -> String
showsPrec :: Int -> UploadInfo -> String -> String
$cshowsPrec :: Int -> UploadInfo -> String -> String
Show, UploadInfo -> UploadInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UploadInfo -> UploadInfo -> Bool
$c/= :: UploadInfo -> UploadInfo -> Bool
== :: UploadInfo -> UploadInfo -> Bool
$c== :: UploadInfo -> UploadInfo -> Bool
Eq)

-- | Represents result from a listing of objects in a bucket.
data ListObjectsResult = ListObjectsResult
  { ListObjectsResult -> Bool
lorHasMore :: Bool,
    ListObjectsResult -> Maybe Bucket
lorNextToken :: Maybe Text,
    ListObjectsResult -> [ObjectInfo]
lorObjects :: [ObjectInfo],
    ListObjectsResult -> [Bucket]
lorCPrefixes :: [Text]
  }
  deriving stock (Int -> ListObjectsResult -> String -> String
[ListObjectsResult] -> String -> String
ListObjectsResult -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ListObjectsResult] -> String -> String
$cshowList :: [ListObjectsResult] -> String -> String
show :: ListObjectsResult -> String
$cshow :: ListObjectsResult -> String
showsPrec :: Int -> ListObjectsResult -> String -> String
$cshowsPrec :: Int -> ListObjectsResult -> String -> String
Show, ListObjectsResult -> ListObjectsResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListObjectsResult -> ListObjectsResult -> Bool
$c/= :: ListObjectsResult -> ListObjectsResult -> Bool
== :: ListObjectsResult -> ListObjectsResult -> Bool
$c== :: ListObjectsResult -> ListObjectsResult -> Bool
Eq)

-- | Represents result from a listing of objects version 1 in a bucket.
data ListObjectsV1Result = ListObjectsV1Result
  { ListObjectsV1Result -> Bool
lorHasMore' :: Bool,
    ListObjectsV1Result -> Maybe Bucket
lorNextMarker :: Maybe Text,
    ListObjectsV1Result -> [ObjectInfo]
lorObjects' :: [ObjectInfo],
    ListObjectsV1Result -> [Bucket]
lorCPrefixes' :: [Text]
  }
  deriving stock (Int -> ListObjectsV1Result -> String -> String
[ListObjectsV1Result] -> String -> String
ListObjectsV1Result -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ListObjectsV1Result] -> String -> String
$cshowList :: [ListObjectsV1Result] -> String -> String
show :: ListObjectsV1Result -> String
$cshow :: ListObjectsV1Result -> String
showsPrec :: Int -> ListObjectsV1Result -> String -> String
$cshowsPrec :: Int -> ListObjectsV1Result -> String -> String
Show, ListObjectsV1Result -> ListObjectsV1Result -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListObjectsV1Result -> ListObjectsV1Result -> Bool
$c/= :: ListObjectsV1Result -> ListObjectsV1Result -> Bool
== :: ListObjectsV1Result -> ListObjectsV1Result -> Bool
$c== :: ListObjectsV1Result -> ListObjectsV1Result -> Bool
Eq)

-- | Represents information about an object.
data ObjectInfo = ObjectInfo
  { -- | Object key
    ObjectInfo -> Bucket
oiObject :: Object,
    -- | Modification time of the object
    ObjectInfo -> UTCTime
oiModTime :: UTCTime,
    -- | ETag of the object
    ObjectInfo -> Bucket
oiETag :: ETag,
    -- | Size of the object in bytes
    ObjectInfo -> Int64
oiSize :: Int64,
    -- | A map of user-metadata
    -- pairs stored with an
    -- object (keys will not
    -- have the @X-Amz-Meta-@
    -- prefix).
    ObjectInfo -> HashMap Bucket Bucket
oiUserMetadata :: H.HashMap Text Text,
    -- | A map of metadata
    -- key-value pairs (not
    -- including the
    -- user-metadata pairs)
    ObjectInfo -> HashMap Bucket Bucket
oiMetadata :: H.HashMap Text Text
  }
  deriving stock (Int -> ObjectInfo -> String -> String
[ObjectInfo] -> String -> String
ObjectInfo -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ObjectInfo] -> String -> String
$cshowList :: [ObjectInfo] -> String -> String
show :: ObjectInfo -> String
$cshow :: ObjectInfo -> String
showsPrec :: Int -> ObjectInfo -> String -> String
$cshowsPrec :: Int -> ObjectInfo -> String -> String
Show, ObjectInfo -> ObjectInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectInfo -> ObjectInfo -> Bool
$c/= :: ObjectInfo -> ObjectInfo -> Bool
== :: ObjectInfo -> ObjectInfo -> Bool
$c== :: ObjectInfo -> ObjectInfo -> Bool
Eq)

-- | Represents source object in server-side copy object
data SourceInfo = SourceInfo
  { -- | Bucket containing the source object
    SourceInfo -> Bucket
srcBucket :: Text,
    -- | Source object key
    SourceInfo -> Bucket
srcObject :: Text,
    -- | Source object
    -- byte-range
    -- (inclusive)
    SourceInfo -> Maybe (Int64, Int64)
srcRange :: Maybe (Int64, Int64),
    -- | ETag condition on source -
    -- object is copied only if the
    -- source object's ETag matches
    -- this value.
    SourceInfo -> Maybe Bucket
srcIfMatch :: Maybe Text,
    -- | ETag not match condition
    -- on source - object is copied
    -- if ETag does not match this
    -- value.
    SourceInfo -> Maybe Bucket
srcIfNoneMatch :: Maybe Text,
    -- | Copy source object only
    -- if the source has been
    -- modified since this time.
    SourceInfo -> Maybe UTCTime
srcIfModifiedSince :: Maybe UTCTime,
    -- | Copy source object only
    -- if the source has been
    -- un-modified since this
    -- given time.
    SourceInfo -> Maybe UTCTime
srcIfUnmodifiedSince :: Maybe UTCTime
  }
  deriving stock (Int -> SourceInfo -> String -> String
[SourceInfo] -> String -> String
SourceInfo -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SourceInfo] -> String -> String
$cshowList :: [SourceInfo] -> String -> String
show :: SourceInfo -> String
$cshow :: SourceInfo -> String
showsPrec :: Int -> SourceInfo -> String -> String
$cshowsPrec :: Int -> SourceInfo -> String -> String
Show, SourceInfo -> SourceInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceInfo -> SourceInfo -> Bool
$c/= :: SourceInfo -> SourceInfo -> Bool
== :: SourceInfo -> SourceInfo -> Bool
$c== :: SourceInfo -> SourceInfo -> Bool
Eq)

-- | Provide a default for `SourceInfo`
defaultSourceInfo :: SourceInfo
defaultSourceInfo :: SourceInfo
defaultSourceInfo = Bucket
-> Bucket
-> Maybe (Int64, Int64)
-> Maybe Bucket
-> Maybe Bucket
-> Maybe UTCTime
-> Maybe UTCTime
-> SourceInfo
SourceInfo Bucket
"" Bucket
"" forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | Represents destination object in server-side copy object
data DestinationInfo = DestinationInfo
  { -- | Destination bucket
    DestinationInfo -> Bucket
dstBucket :: Text,
    -- | Destination object key
    DestinationInfo -> Bucket
dstObject :: Text
  }
  deriving stock (Int -> DestinationInfo -> String -> String
[DestinationInfo] -> String -> String
DestinationInfo -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DestinationInfo] -> String -> String
$cshowList :: [DestinationInfo] -> String -> String
show :: DestinationInfo -> String
$cshow :: DestinationInfo -> String
showsPrec :: Int -> DestinationInfo -> String -> String
$cshowsPrec :: Int -> DestinationInfo -> String -> String
Show, DestinationInfo -> DestinationInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DestinationInfo -> DestinationInfo -> Bool
$c/= :: DestinationInfo -> DestinationInfo -> Bool
== :: DestinationInfo -> DestinationInfo -> Bool
$c== :: DestinationInfo -> DestinationInfo -> Bool
Eq)

-- | Provide a default for `DestinationInfo`
defaultDestinationInfo :: DestinationInfo
defaultDestinationInfo :: DestinationInfo
defaultDestinationInfo = Bucket -> Bucket -> DestinationInfo
DestinationInfo Bucket
"" Bucket
""

-- | Data type for options when getting an object from the
-- service. Start with the empty `defaultGetObjectOptions` and modify
-- it using the goo* functions.
data GetObjectOptions = GetObjectOptions
  { -- | Set object's data of given offset begin and end,
    -- [ByteRangeFromTo 0 9] means first ten bytes of the source object.
    GetObjectOptions -> Maybe ByteRange
gooRange :: Maybe ByteRange,
    -- | Set matching ETag condition, GetObject which matches the following
    -- ETag.
    GetObjectOptions -> Maybe Bucket
gooIfMatch :: Maybe ETag,
    -- | Set matching ETag none condition, GetObject which does not match
    -- the following ETag.
    GetObjectOptions -> Maybe Bucket
gooIfNoneMatch :: Maybe ETag,
    -- | Set object unmodified condition, GetObject unmodified since given time.
    GetObjectOptions -> Maybe UTCTime
gooIfUnmodifiedSince :: Maybe UTCTime,
    -- | Set object modified condition, GetObject modified since given time.
    GetObjectOptions -> Maybe UTCTime
gooIfModifiedSince :: Maybe UTCTime,
    -- | Specify SSE-C key
    GetObjectOptions -> Maybe SSECKey
gooSSECKey :: Maybe SSECKey
  }

-- | Provide default  `GetObjectOptions`.
defaultGetObjectOptions :: GetObjectOptions
defaultGetObjectOptions :: GetObjectOptions
defaultGetObjectOptions =
  Maybe ByteRange
-> Maybe Bucket
-> Maybe Bucket
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe SSECKey
-> GetObjectOptions
GetObjectOptions forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

gooToHeaders :: GetObjectOptions -> [HT.Header]
gooToHeaders :: GetObjectOptions -> [Header]
gooToHeaders GetObjectOptions
goo =
  [Header]
rangeHdr
    forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> [(a, b)]
zip [CI ByteString]
names [ByteString]
values
    forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (SSE -> [Header]
toPutObjectHeaders forall b c a. (b -> c) -> (a -> b) -> a -> c
. SSECKey -> SSE
SSEC) (GetObjectOptions -> Maybe SSECKey
gooSSECKey GetObjectOptions
goo)
  where
    names :: [CI ByteString]
names =
      [ CI ByteString
"If-Match",
        CI ByteString
"If-None-Match",
        CI ByteString
"If-Unmodified-Since",
        CI ByteString
"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
. (GetObjectOptions
goo forall a b. a -> (a -> b) -> b
&))
        [ GetObjectOptions -> Maybe Bucket
gooIfMatch,
          GetObjectOptions -> Maybe Bucket
gooIfNoneMatch,
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> Bucket
formatRFC1123 forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetObjectOptions -> Maybe UTCTime
gooIfUnmodifiedSince,
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> Bucket
formatRFC1123 forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetObjectOptions -> Maybe UTCTime
gooIfModifiedSince
        ]
    rangeHdr :: [Header]
rangeHdr =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ByteRange
a -> [(CI ByteString
hRange, ByteRanges -> ByteString
HT.renderByteRanges [ByteRange
a])]) forall a b. (a -> b) -> a -> b
$
        GetObjectOptions -> Maybe ByteRange
gooRange GetObjectOptions
goo

-- | Data type returned by 'getObject' representing the object being
-- retrieved. Use the @gor*@ functions to access its contents.
data GetObjectResponse = GetObjectResponse
  { -- | ObjectInfo of the object being retrieved.
    GetObjectResponse -> ObjectInfo
gorObjectInfo :: ObjectInfo,
    -- | A conduit of the bytes of the object.
    GetObjectResponse -> ConduitM () ByteString Minio ()
gorObjectStream :: C.ConduitM () ByteString Minio ()
  }

-- | A data-type for events that can occur in the object storage
-- server. Reference:
-- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types
data Event
  = ObjectCreated
  | ObjectCreatedPut
  | ObjectCreatedPost
  | ObjectCreatedCopy
  | ObjectCreatedMultipartUpload
  | ObjectRemoved
  | ObjectRemovedDelete
  | ObjectRemovedDeleteMarkerCreated
  | ReducedRedundancyLostObject
  deriving stock (Event -> Event -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, Int -> Event -> String -> String
[Event] -> String -> String
Event -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Event] -> String -> String
$cshowList :: [Event] -> String -> String
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> String -> String
$cshowsPrec :: Int -> Event -> String -> String
Show)

instance ToText Event where
  toText :: Event -> Bucket
toText Event
ObjectCreated = Bucket
"s3:ObjectCreated:*"
  toText Event
ObjectCreatedPut = Bucket
"s3:ObjectCreated:Put"
  toText Event
ObjectCreatedPost = Bucket
"s3:ObjectCreated:Post"
  toText Event
ObjectCreatedCopy = Bucket
"s3:ObjectCreated:Copy"
  toText Event
ObjectCreatedMultipartUpload = Bucket
"s3:ObjectCreated:MultipartUpload"
  toText Event
ObjectRemoved = Bucket
"s3:ObjectRemoved:*"
  toText Event
ObjectRemovedDelete = Bucket
"s3:ObjectRemoved:Delete"
  toText Event
ObjectRemovedDeleteMarkerCreated = Bucket
"s3:ObjectRemoved:DeleteMarkerCreated"
  toText Event
ReducedRedundancyLostObject = Bucket
"s3:ReducedRedundancyLostObject"

textToEvent :: Text -> Maybe Event
textToEvent :: Bucket -> Maybe Event
textToEvent Bucket
t = case Bucket
t of
  Bucket
"s3:ObjectCreated:*" -> forall a. a -> Maybe a
Just Event
ObjectCreated
  Bucket
"s3:ObjectCreated:Put" -> forall a. a -> Maybe a
Just Event
ObjectCreatedPut
  Bucket
"s3:ObjectCreated:Post" -> forall a. a -> Maybe a
Just Event
ObjectCreatedPost
  Bucket
"s3:ObjectCreated:Copy" -> forall a. a -> Maybe a
Just Event
ObjectCreatedCopy
  Bucket
"s3:ObjectCreated:MultipartUpload" -> forall a. a -> Maybe a
Just Event
ObjectCreatedMultipartUpload
  Bucket
"s3:ObjectRemoved:*" -> forall a. a -> Maybe a
Just Event
ObjectRemoved
  Bucket
"s3:ObjectRemoved:Delete" -> forall a. a -> Maybe a
Just Event
ObjectRemovedDelete
  Bucket
"s3:ObjectRemoved:DeleteMarkerCreated" -> forall a. a -> Maybe a
Just Event
ObjectRemovedDeleteMarkerCreated
  Bucket
"s3:ReducedRedundancyLostObject" -> forall a. a -> Maybe a
Just Event
ReducedRedundancyLostObject
  Bucket
_ -> forall a. Maybe a
Nothing

-- | Filter data type - part of notification configuration
newtype Filter = Filter
  { Filter -> FilterKey
fFilter :: FilterKey
  }
  deriving stock (Int -> Filter -> String -> String
[Filter] -> String -> String
Filter -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Filter] -> String -> String
$cshowList :: [Filter] -> String -> String
show :: Filter -> String
$cshow :: Filter -> String
showsPrec :: Int -> Filter -> String -> String
$cshowsPrec :: Int -> Filter -> String -> String
Show, Filter -> Filter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Filter -> Filter -> Bool
$c/= :: Filter -> Filter -> Bool
== :: Filter -> Filter -> Bool
$c== :: Filter -> Filter -> Bool
Eq)

-- | defaultFilter is empty, used to create a notification
-- configuration.
defaultFilter :: Filter
defaultFilter :: Filter
defaultFilter = FilterKey -> Filter
Filter FilterKey
defaultFilterKey

-- | FilterKey contains FilterRules, and is part of a Filter.
newtype FilterKey = FilterKey
  { FilterKey -> FilterRules
fkKey :: FilterRules
  }
  deriving stock (Int -> FilterKey -> String -> String
[FilterKey] -> String -> String
FilterKey -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FilterKey] -> String -> String
$cshowList :: [FilterKey] -> String -> String
show :: FilterKey -> String
$cshow :: FilterKey -> String
showsPrec :: Int -> FilterKey -> String -> String
$cshowsPrec :: Int -> FilterKey -> String -> String
Show, FilterKey -> FilterKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterKey -> FilterKey -> Bool
$c/= :: FilterKey -> FilterKey -> Bool
== :: FilterKey -> FilterKey -> Bool
$c== :: FilterKey -> FilterKey -> Bool
Eq)

-- | defaultFilterKey is empty, used to create notification
-- configuration.
defaultFilterKey :: FilterKey
defaultFilterKey :: FilterKey
defaultFilterKey = FilterRules -> FilterKey
FilterKey FilterRules
defaultFilterRules

-- | FilterRules represents a collection of `FilterRule`s.
newtype FilterRules = FilterRules
  { FilterRules -> [FilterRule]
frFilterRules :: [FilterRule]
  }
  deriving stock (Int -> FilterRules -> String -> String
[FilterRules] -> String -> String
FilterRules -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FilterRules] -> String -> String
$cshowList :: [FilterRules] -> String -> String
show :: FilterRules -> String
$cshow :: FilterRules -> String
showsPrec :: Int -> FilterRules -> String -> String
$cshowsPrec :: Int -> FilterRules -> String -> String
Show, FilterRules -> FilterRules -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterRules -> FilterRules -> Bool
$c/= :: FilterRules -> FilterRules -> Bool
== :: FilterRules -> FilterRules -> Bool
$c== :: FilterRules -> FilterRules -> Bool
Eq)

-- | defaultFilterRules is empty, used to create notification
-- configuration.
defaultFilterRules :: FilterRules
defaultFilterRules :: FilterRules
defaultFilterRules = [FilterRule] -> FilterRules
FilterRules []

-- | A filter rule that can act based on the suffix or prefix of an
-- object. As an example, let's create two filter rules:
--
--    > let suffixRule = FilterRule "suffix" ".jpg"
--    > let prefixRule = FilterRule "prefix" "images/"
--
-- The @suffixRule@ restricts the notification to be triggered only
-- for objects having a suffix of ".jpg", and the @prefixRule@
-- restricts it to objects having a prefix of "images/".
data FilterRule = FilterRule
  { FilterRule -> Bucket
frName :: Text,
    FilterRule -> Bucket
frValue :: Text
  }
  deriving stock (Int -> FilterRule -> String -> String
[FilterRule] -> String -> String
FilterRule -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FilterRule] -> String -> String
$cshowList :: [FilterRule] -> String -> String
show :: FilterRule -> String
$cshow :: FilterRule -> String
showsPrec :: Int -> FilterRule -> String -> String
$cshowsPrec :: Int -> FilterRule -> String -> String
Show, FilterRule -> FilterRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterRule -> FilterRule -> Bool
$c/= :: FilterRule -> FilterRule -> Bool
== :: FilterRule -> FilterRule -> Bool
$c== :: FilterRule -> FilterRule -> Bool
Eq)

-- | Arn is an alias of Text
type Arn = Text

-- | A data-type representing the configuration for a particular
-- notification system. It could represent a Queue, Topic or Lambda
-- Function configuration.
data NotificationConfig = NotificationConfig
  { NotificationConfig -> Bucket
ncId :: Text,
    NotificationConfig -> Bucket
ncArn :: Arn,
    NotificationConfig -> [Event]
ncEvents :: [Event],
    NotificationConfig -> Filter
ncFilter :: Filter
  }
  deriving stock (Int -> NotificationConfig -> String -> String
[NotificationConfig] -> String -> String
NotificationConfig -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [NotificationConfig] -> String -> String
$cshowList :: [NotificationConfig] -> String -> String
show :: NotificationConfig -> String
$cshow :: NotificationConfig -> String
showsPrec :: Int -> NotificationConfig -> String -> String
$cshowsPrec :: Int -> NotificationConfig -> String -> String
Show, NotificationConfig -> NotificationConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotificationConfig -> NotificationConfig -> Bool
$c/= :: NotificationConfig -> NotificationConfig -> Bool
== :: NotificationConfig -> NotificationConfig -> Bool
$c== :: NotificationConfig -> NotificationConfig -> Bool
Eq)

-- | A data-type to represent bucket notification configuration. It is
-- a collection of queue, topic or lambda function configurations. The
-- structure of the types follow closely the XML representation
-- described at
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html>
data Notification = Notification
  { Notification -> [NotificationConfig]
nQueueConfigurations :: [NotificationConfig],
    Notification -> [NotificationConfig]
nTopicConfigurations :: [NotificationConfig],
    Notification -> [NotificationConfig]
nCloudFunctionConfigurations :: [NotificationConfig]
  }
  deriving stock (Int -> Notification -> String -> String
[Notification] -> String -> String
Notification -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Notification] -> String -> String
$cshowList :: [Notification] -> String -> String
show :: Notification -> String
$cshow :: Notification -> String
showsPrec :: Int -> Notification -> String -> String
$cshowsPrec :: Int -> Notification -> String -> String
Show, Notification -> Notification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Notification -> Notification -> Bool
$c/= :: Notification -> Notification -> Bool
== :: Notification -> Notification -> Bool
$c== :: Notification -> Notification -> Bool
Eq)

-- | The default notification configuration is empty.
defaultNotification :: Notification
defaultNotification :: Notification
defaultNotification = [NotificationConfig]
-> [NotificationConfig] -> [NotificationConfig] -> Notification
Notification [] [] []

--------------------------------------------------------------------------
-- Select API Related Types
--------------------------------------------------------------------------

-- | SelectRequest represents the Select API call. Use the
-- `selectRequest` function to create a value of this type.
data SelectRequest = SelectRequest
  { SelectRequest -> Bucket
srExpression :: Text,
    SelectRequest -> ExpressionType
srExpressionType :: ExpressionType,
    SelectRequest -> InputSerialization
srInputSerialization :: InputSerialization,
    SelectRequest -> OutputSerialization
srOutputSerialization :: OutputSerialization,
    SelectRequest -> Maybe Bool
srRequestProgressEnabled :: Maybe Bool
  }
  deriving stock (Int -> SelectRequest -> String -> String
[SelectRequest] -> String -> String
SelectRequest -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SelectRequest] -> String -> String
$cshowList :: [SelectRequest] -> String -> String
show :: SelectRequest -> String
$cshow :: SelectRequest -> String
showsPrec :: Int -> SelectRequest -> String -> String
$cshowsPrec :: Int -> SelectRequest -> String -> String
Show, SelectRequest -> SelectRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectRequest -> SelectRequest -> Bool
$c/= :: SelectRequest -> SelectRequest -> Bool
== :: SelectRequest -> SelectRequest -> Bool
$c== :: SelectRequest -> SelectRequest -> Bool
Eq)

data ExpressionType = SQL
  deriving stock (Int -> ExpressionType -> String -> String
[ExpressionType] -> String -> String
ExpressionType -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ExpressionType] -> String -> String
$cshowList :: [ExpressionType] -> String -> String
show :: ExpressionType -> String
$cshow :: ExpressionType -> String
showsPrec :: Int -> ExpressionType -> String -> String
$cshowsPrec :: Int -> ExpressionType -> String -> String
Show, ExpressionType -> ExpressionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpressionType -> ExpressionType -> Bool
$c/= :: ExpressionType -> ExpressionType -> Bool
== :: ExpressionType -> ExpressionType -> Bool
$c== :: ExpressionType -> ExpressionType -> Bool
Eq)

-- | InputSerialization represents format information of the input
-- object being queried. Use one of the smart constructors such as
-- `defaultCsvInput` as a starting value, and add compression info
-- using `setInputCompressionType`
data InputSerialization = InputSerialization
  { InputSerialization -> Maybe CompressionType
isCompressionType :: Maybe CompressionType,
    InputSerialization -> InputFormatInfo
isFormatInfo :: InputFormatInfo
  }
  deriving stock (Int -> InputSerialization -> String -> String
[InputSerialization] -> String -> String
InputSerialization -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [InputSerialization] -> String -> String
$cshowList :: [InputSerialization] -> String -> String
show :: InputSerialization -> String
$cshow :: InputSerialization -> String
showsPrec :: Int -> InputSerialization -> String -> String
$cshowsPrec :: Int -> InputSerialization -> String -> String
Show, InputSerialization -> InputSerialization -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputSerialization -> InputSerialization -> Bool
$c/= :: InputSerialization -> InputSerialization -> Bool
== :: InputSerialization -> InputSerialization -> Bool
$c== :: InputSerialization -> InputSerialization -> Bool
Eq)

-- | Data type representing the compression setting in a Select
-- request.
data CompressionType
  = CompressionTypeNone
  | CompressionTypeGzip
  | CompressionTypeBzip2
  deriving stock (Int -> CompressionType -> String -> String
[CompressionType] -> String -> String
CompressionType -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CompressionType] -> String -> String
$cshowList :: [CompressionType] -> String -> String
show :: CompressionType -> String
$cshow :: CompressionType -> String
showsPrec :: Int -> CompressionType -> String -> String
$cshowsPrec :: Int -> CompressionType -> String -> String
Show, CompressionType -> CompressionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressionType -> CompressionType -> Bool
$c/= :: CompressionType -> CompressionType -> Bool
== :: CompressionType -> CompressionType -> Bool
$c== :: CompressionType -> CompressionType -> Bool
Eq)

-- | Data type representing input object format information in a
-- Select request.
data InputFormatInfo
  = InputFormatCSV CSVInputProp
  | InputFormatJSON JSONInputProp
  | InputFormatParquet
  deriving stock (Int -> InputFormatInfo -> String -> String
[InputFormatInfo] -> String -> String
InputFormatInfo -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [InputFormatInfo] -> String -> String
$cshowList :: [InputFormatInfo] -> String -> String
show :: InputFormatInfo -> String
$cshow :: InputFormatInfo -> String
showsPrec :: Int -> InputFormatInfo -> String -> String
$cshowsPrec :: Int -> InputFormatInfo -> String -> String
Show, InputFormatInfo -> InputFormatInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputFormatInfo -> InputFormatInfo -> Bool
$c/= :: InputFormatInfo -> InputFormatInfo -> Bool
== :: InputFormatInfo -> InputFormatInfo -> Bool
$c== :: InputFormatInfo -> InputFormatInfo -> Bool
Eq)

-- | defaultCsvInput returns InputSerialization with default CSV
-- format, and without any compression setting.
defaultCsvInput :: InputSerialization
defaultCsvInput :: InputSerialization
defaultCsvInput = Maybe CompressionType -> InputFormatInfo -> InputSerialization
InputSerialization forall a. Maybe a
Nothing (CSVProp -> InputFormatInfo
InputFormatCSV CSVProp
defaultCSVProp)

-- | linesJsonInput returns InputSerialization with JSON line based
-- format with no compression setting.
linesJsonInput :: InputSerialization
linesJsonInput :: InputSerialization
linesJsonInput =
  Maybe CompressionType -> InputFormatInfo -> InputSerialization
InputSerialization
    forall a. Maybe a
Nothing
    (JSONInputProp -> InputFormatInfo
InputFormatJSON forall a b. (a -> b) -> a -> b
$ JSONType -> JSONInputProp
JSONInputProp JSONType
JSONTypeLines)

-- | documentJsonInput returns InputSerialization with JSON document
-- based format with no compression setting.
documentJsonInput :: InputSerialization
documentJsonInput :: InputSerialization
documentJsonInput =
  Maybe CompressionType -> InputFormatInfo -> InputSerialization
InputSerialization
    forall a. Maybe a
Nothing
    (JSONInputProp -> InputFormatInfo
InputFormatJSON forall a b. (a -> b) -> a -> b
$ JSONType -> JSONInputProp
JSONInputProp JSONType
JSONTypeDocument)

-- | defaultParquetInput returns InputSerialization with Parquet
-- format, and no compression setting.
defaultParquetInput :: InputSerialization
defaultParquetInput :: InputSerialization
defaultParquetInput = Maybe CompressionType -> InputFormatInfo -> InputSerialization
InputSerialization forall a. Maybe a
Nothing InputFormatInfo
InputFormatParquet

-- | setInputCompressionType sets the compression type for the input
-- of the SelectRequest
setInputCompressionType ::
  CompressionType ->
  SelectRequest ->
  SelectRequest
setInputCompressionType :: CompressionType -> SelectRequest -> SelectRequest
setInputCompressionType CompressionType
c SelectRequest
i =
  let is :: InputSerialization
is = SelectRequest -> InputSerialization
srInputSerialization SelectRequest
i
      is' :: InputSerialization
is' = InputSerialization
is {isCompressionType :: Maybe CompressionType
isCompressionType = forall a. a -> Maybe a
Just CompressionType
c}
   in SelectRequest
i {srInputSerialization :: InputSerialization
srInputSerialization = InputSerialization
is'}

-- | defaultCsvOutput returns OutputSerialization with default CSV
-- format.
defaultCsvOutput :: OutputSerialization
defaultCsvOutput :: OutputSerialization
defaultCsvOutput = CSVProp -> OutputSerialization
OutputSerializationCSV CSVProp
defaultCSVProp

-- | defaultJsonInput returns OutputSerialization with default JSON
-- format.
defaultJsonOutput :: OutputSerialization
defaultJsonOutput :: OutputSerialization
defaultJsonOutput = JSONOutputProp -> OutputSerialization
OutputSerializationJSON (Maybe Bucket -> JSONOutputProp
JSONOutputProp forall a. Maybe a
Nothing)

-- | selectRequest is used to build a `SelectRequest`
-- value. @selectRequest query inputSer outputSer@ represents a
-- SelectRequest with the SQL query text given by @query@, the input
-- serialization settings (compression format and format information)
-- @inputSer@ and the output serialization settings @outputSer@.
selectRequest ::
  Text ->
  InputSerialization ->
  OutputSerialization ->
  SelectRequest
selectRequest :: Bucket
-> InputSerialization -> OutputSerialization -> SelectRequest
selectRequest Bucket
sqlQuery InputSerialization
inputSer OutputSerialization
outputSer =
  SelectRequest
    { srExpression :: Bucket
srExpression = Bucket
sqlQuery,
      srExpressionType :: ExpressionType
srExpressionType = ExpressionType
SQL,
      srInputSerialization :: InputSerialization
srInputSerialization = InputSerialization
inputSer,
      srOutputSerialization :: OutputSerialization
srOutputSerialization = OutputSerialization
outputSer,
      srRequestProgressEnabled :: Maybe Bool
srRequestProgressEnabled = forall a. Maybe a
Nothing
    }

-- | setRequestProgressEnabled sets the flag for turning on progress
-- messages when the Select response is being streamed back to the
-- client.
setRequestProgressEnabled :: Bool -> SelectRequest -> SelectRequest
setRequestProgressEnabled :: Bool -> SelectRequest -> SelectRequest
setRequestProgressEnabled Bool
enabled SelectRequest
sr =
  SelectRequest
sr {srRequestProgressEnabled :: Maybe Bool
srRequestProgressEnabled = forall a. a -> Maybe a
Just Bool
enabled}

type CSVInputProp = CSVProp

-- | CSVProp represents CSV format properties. It is built up using
-- the Monoid instance.
newtype CSVProp = CSVProp (H.HashMap Text Text)
  deriving stock (Int -> CSVProp -> String -> String
[CSVProp] -> String -> String
CSVProp -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CSVProp] -> String -> String
$cshowList :: [CSVProp] -> String -> String
show :: CSVProp -> String
$cshow :: CSVProp -> String
showsPrec :: Int -> CSVProp -> String -> String
$cshowsPrec :: Int -> CSVProp -> String -> String
Show, CSVProp -> CSVProp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSVProp -> CSVProp -> Bool
$c/= :: CSVProp -> CSVProp -> Bool
== :: CSVProp -> CSVProp -> Bool
$c== :: CSVProp -> CSVProp -> Bool
Eq)

instance Semigroup CSVProp where
  (CSVProp HashMap Bucket Bucket
a) <> :: CSVProp -> CSVProp -> CSVProp
<> (CSVProp HashMap Bucket Bucket
b) = HashMap Bucket Bucket -> CSVProp
CSVProp (HashMap Bucket Bucket
b forall a. Semigroup a => a -> a -> a
<> HashMap Bucket Bucket
a)

instance Monoid CSVProp where
  mempty :: CSVProp
mempty = HashMap Bucket Bucket -> CSVProp
CSVProp forall a. Monoid a => a
mempty

csvPropsList :: CSVProp -> [(Text, Text)]
csvPropsList :: CSVProp -> [(Bucket, Bucket)]
csvPropsList (CSVProp HashMap Bucket Bucket
h) = forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
H.toList HashMap Bucket Bucket
h

defaultCSVProp :: CSVProp
defaultCSVProp :: CSVProp
defaultCSVProp = forall a. Monoid a => a
mempty

-- | Specify the CSV record delimiter property.
recordDelimiter :: Text -> CSVProp
recordDelimiter :: Bucket -> CSVProp
recordDelimiter = HashMap Bucket Bucket -> CSVProp
CSVProp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Bucket
"RecordDelimiter"

-- | Specify the CSV field delimiter property.
fieldDelimiter :: Text -> CSVProp
fieldDelimiter :: Bucket -> CSVProp
fieldDelimiter = HashMap Bucket Bucket -> CSVProp
CSVProp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Bucket
"FieldDelimiter"

-- | Specify the CSV quote character property.
quoteCharacter :: Text -> CSVProp
quoteCharacter :: Bucket -> CSVProp
quoteCharacter = HashMap Bucket Bucket -> CSVProp
CSVProp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Bucket
"QuoteCharacter"

-- | Specify the CSV quote-escape character property.
quoteEscapeCharacter :: Text -> CSVProp
quoteEscapeCharacter :: Bucket -> CSVProp
quoteEscapeCharacter = HashMap Bucket Bucket -> CSVProp
CSVProp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Bucket
"QuoteEscapeCharacter"

-- | FileHeaderInfo specifies information about column headers for CSV
-- format.
data FileHeaderInfo
  = -- | No column headers are present
    FileHeaderNone
  | -- | Headers are present and they should be used
    FileHeaderUse
  | -- | Header are present, but should be ignored
    FileHeaderIgnore
  deriving stock (Int -> FileHeaderInfo -> String -> String
[FileHeaderInfo] -> String -> String
FileHeaderInfo -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FileHeaderInfo] -> String -> String
$cshowList :: [FileHeaderInfo] -> String -> String
show :: FileHeaderInfo -> String
$cshow :: FileHeaderInfo -> String
showsPrec :: Int -> FileHeaderInfo -> String -> String
$cshowsPrec :: Int -> FileHeaderInfo -> String -> String
Show, FileHeaderInfo -> FileHeaderInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileHeaderInfo -> FileHeaderInfo -> Bool
$c/= :: FileHeaderInfo -> FileHeaderInfo -> Bool
== :: FileHeaderInfo -> FileHeaderInfo -> Bool
$c== :: FileHeaderInfo -> FileHeaderInfo -> Bool
Eq)

-- | Specify the CSV file header info property.
fileHeaderInfo :: FileHeaderInfo -> CSVProp
fileHeaderInfo :: FileHeaderInfo -> CSVProp
fileHeaderInfo = HashMap Bucket Bucket -> CSVProp
CSVProp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Bucket
"FileHeaderInfo" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. IsString a => FileHeaderInfo -> a
toStr
  where
    toStr :: FileHeaderInfo -> a
toStr FileHeaderInfo
FileHeaderNone = a
"NONE"
    toStr FileHeaderInfo
FileHeaderUse = a
"USE"
    toStr FileHeaderInfo
FileHeaderIgnore = a
"IGNORE"

-- | Specify the CSV comment character property. Lines starting with
-- this character are ignored by the server.
commentCharacter :: Text -> CSVProp
commentCharacter :: Bucket -> CSVProp
commentCharacter = HashMap Bucket Bucket -> CSVProp
CSVProp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Bucket
"Comments"

-- | Allow quoted record delimiters inside a row using this property.
allowQuotedRecordDelimiter :: CSVProp
allowQuotedRecordDelimiter :: CSVProp
allowQuotedRecordDelimiter = HashMap Bucket Bucket -> CSVProp
CSVProp forall a b. (a -> b) -> a -> b
$ forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Bucket
"AllowQuotedRecordDelimiter" Bucket
"TRUE"

-- | Set the CSV format properties in the InputSerialization.
setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization
setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization
setInputCSVProps CSVProp
p InputSerialization
is = InputSerialization
is {isFormatInfo :: InputFormatInfo
isFormatInfo = CSVProp -> InputFormatInfo
InputFormatCSV CSVProp
p}

-- | Set the CSV format properties in the OutputSerialization.
outputCSVFromProps :: CSVProp -> OutputSerialization
outputCSVFromProps :: CSVProp -> OutputSerialization
outputCSVFromProps = CSVProp -> OutputSerialization
OutputSerializationCSV

newtype JSONInputProp = JSONInputProp {JSONInputProp -> JSONType
jsonipType :: JSONType}
  deriving stock (Int -> JSONInputProp -> String -> String
[JSONInputProp] -> String -> String
JSONInputProp -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [JSONInputProp] -> String -> String
$cshowList :: [JSONInputProp] -> String -> String
show :: JSONInputProp -> String
$cshow :: JSONInputProp -> String
showsPrec :: Int -> JSONInputProp -> String -> String
$cshowsPrec :: Int -> JSONInputProp -> String -> String
Show, JSONInputProp -> JSONInputProp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONInputProp -> JSONInputProp -> Bool
$c/= :: JSONInputProp -> JSONInputProp -> Bool
== :: JSONInputProp -> JSONInputProp -> Bool
$c== :: JSONInputProp -> JSONInputProp -> Bool
Eq)

data JSONType = JSONTypeDocument | JSONTypeLines
  deriving stock (Int -> JSONType -> String -> String
[JSONType] -> String -> String
JSONType -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [JSONType] -> String -> String
$cshowList :: [JSONType] -> String -> String
show :: JSONType -> String
$cshow :: JSONType -> String
showsPrec :: Int -> JSONType -> String -> String
$cshowsPrec :: Int -> JSONType -> String -> String
Show, JSONType -> JSONType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONType -> JSONType -> Bool
$c/= :: JSONType -> JSONType -> Bool
== :: JSONType -> JSONType -> Bool
$c== :: JSONType -> JSONType -> Bool
Eq)

-- | OutputSerialization represents output serialization settings for
-- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as
-- a starting point.
data OutputSerialization
  = OutputSerializationJSON JSONOutputProp
  | OutputSerializationCSV CSVOutputProp
  deriving stock (Int -> OutputSerialization -> String -> String
[OutputSerialization] -> String -> String
OutputSerialization -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [OutputSerialization] -> String -> String
$cshowList :: [OutputSerialization] -> String -> String
show :: OutputSerialization -> String
$cshow :: OutputSerialization -> String
showsPrec :: Int -> OutputSerialization -> String -> String
$cshowsPrec :: Int -> OutputSerialization -> String -> String
Show, OutputSerialization -> OutputSerialization -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputSerialization -> OutputSerialization -> Bool
$c/= :: OutputSerialization -> OutputSerialization -> Bool
== :: OutputSerialization -> OutputSerialization -> Bool
$c== :: OutputSerialization -> OutputSerialization -> Bool
Eq)

type CSVOutputProp = CSVProp

-- | quoteFields is an output serialization parameter
quoteFields :: QuoteFields -> CSVProp
quoteFields :: QuoteFields -> CSVProp
quoteFields QuoteFields
q = HashMap Bucket Bucket -> CSVProp
CSVProp forall a b. (a -> b) -> a -> b
$
  forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Bucket
"QuoteFields" forall a b. (a -> b) -> a -> b
$
    case QuoteFields
q of
      QuoteFields
QuoteFieldsAsNeeded -> Bucket
"ASNEEDED"
      QuoteFields
QuoteFieldsAlways -> Bucket
"ALWAYS"

-- | Represent the QuoteField setting.
data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
  deriving stock (Int -> QuoteFields -> String -> String
[QuoteFields] -> String -> String
QuoteFields -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [QuoteFields] -> String -> String
$cshowList :: [QuoteFields] -> String -> String
show :: QuoteFields -> String
$cshow :: QuoteFields -> String
showsPrec :: Int -> QuoteFields -> String -> String
$cshowsPrec :: Int -> QuoteFields -> String -> String
Show, QuoteFields -> QuoteFields -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuoteFields -> QuoteFields -> Bool
$c/= :: QuoteFields -> QuoteFields -> Bool
== :: QuoteFields -> QuoteFields -> Bool
$c== :: QuoteFields -> QuoteFields -> Bool
Eq)

newtype JSONOutputProp = JSONOutputProp {JSONOutputProp -> Maybe Bucket
jsonopRecordDelimiter :: Maybe Text}
  deriving stock (Int -> JSONOutputProp -> String -> String
[JSONOutputProp] -> String -> String
JSONOutputProp -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [JSONOutputProp] -> String -> String
$cshowList :: [JSONOutputProp] -> String -> String
show :: JSONOutputProp -> String
$cshow :: JSONOutputProp -> String
showsPrec :: Int -> JSONOutputProp -> String -> String
$cshowsPrec :: Int -> JSONOutputProp -> String -> String
Show, JSONOutputProp -> JSONOutputProp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONOutputProp -> JSONOutputProp -> Bool
$c/= :: JSONOutputProp -> JSONOutputProp -> Bool
== :: JSONOutputProp -> JSONOutputProp -> Bool
$c== :: JSONOutputProp -> JSONOutputProp -> Bool
Eq)

-- | Set the output record delimiter for JSON format
outputJSONFromRecordDelimiter :: Text -> OutputSerialization
outputJSONFromRecordDelimiter :: Bucket -> OutputSerialization
outputJSONFromRecordDelimiter Bucket
t =
  JSONOutputProp -> OutputSerialization
OutputSerializationJSON (Maybe Bucket -> JSONOutputProp
JSONOutputProp forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Bucket
t)

-- Response related types

-- | An EventMessage represents each kind of message received from the server.
data EventMessage
  = ProgressEventMessage Progress
  | StatsEventMessage Stats
  | RequestLevelErrorMessage
      Text
      -- ^ Error code
      Text
      -- ^ Error message
  | RecordPayloadEventMessage ByteString
  deriving stock (Int -> EventMessage -> String -> String
[EventMessage] -> String -> String
EventMessage -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [EventMessage] -> String -> String
$cshowList :: [EventMessage] -> String -> String
show :: EventMessage -> String
$cshow :: EventMessage -> String
showsPrec :: Int -> EventMessage -> String -> String
$cshowsPrec :: Int -> EventMessage -> String -> String
Show, EventMessage -> EventMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventMessage -> EventMessage -> Bool
$c/= :: EventMessage -> EventMessage -> Bool
== :: EventMessage -> EventMessage -> Bool
$c== :: EventMessage -> EventMessage -> Bool
Eq)

data MsgHeaderName
  = MessageType
  | EventType
  | ContentType
  | ErrorCode
  | ErrorMessage
  deriving stock (Int -> MsgHeaderName -> String -> String
[MsgHeaderName] -> String -> String
MsgHeaderName -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [MsgHeaderName] -> String -> String
$cshowList :: [MsgHeaderName] -> String -> String
show :: MsgHeaderName -> String
$cshow :: MsgHeaderName -> String
showsPrec :: Int -> MsgHeaderName -> String -> String
$cshowsPrec :: Int -> MsgHeaderName -> String -> String
Show, MsgHeaderName -> MsgHeaderName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgHeaderName -> MsgHeaderName -> Bool
$c/= :: MsgHeaderName -> MsgHeaderName -> Bool
== :: MsgHeaderName -> MsgHeaderName -> Bool
$c== :: MsgHeaderName -> MsgHeaderName -> Bool
Eq)

msgHeaderValueType :: Word8
msgHeaderValueType :: Word8
msgHeaderValueType = Word8
7

type MessageHeader = (MsgHeaderName, Text)

-- | Represent the progress event returned in the Select response.
data Progress = Progress
  { Progress -> Int64
pBytesScanned :: Int64,
    Progress -> Int64
pBytesProcessed :: Int64,
    Progress -> Int64
pBytesReturned :: Int64
  }
  deriving stock (Int -> Progress -> String -> String
[Progress] -> String -> String
Progress -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Progress] -> String -> String
$cshowList :: [Progress] -> String -> String
show :: Progress -> String
$cshow :: Progress -> String
showsPrec :: Int -> Progress -> String -> String
$cshowsPrec :: Int -> Progress -> String -> String
Show, Progress -> Progress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Progress -> Progress -> Bool
$c/= :: Progress -> Progress -> Bool
== :: Progress -> Progress -> Bool
$c== :: Progress -> Progress -> Bool
Eq)

-- | Represent the stats event returned at the end of the Select
-- response.
type Stats = Progress

--------------------------------------------------------------------------
-- Select API Related Types End
--------------------------------------------------------------------------

-- | Represents different kinds of payload that are used with S3 API
-- requests.
data Payload
  = PayloadBS ByteString
  | PayloadH Handle Int64 Int64 -- file handle, offset and length
  | PayloadC Int64 (C.ConduitT () ByteString (ResourceT IO) ()) -- length and byte source

defaultPayload :: Payload
defaultPayload :: Payload
defaultPayload = ByteString -> Payload
PayloadBS ByteString
""

data AdminReqInfo = AdminReqInfo
  { AdminReqInfo -> ByteString
ariMethod :: Method,
    AdminReqInfo -> Maybe ByteString
ariPayloadHash :: Maybe ByteString,
    AdminReqInfo -> Payload
ariPayload :: Payload,
    AdminReqInfo -> ByteString
ariPath :: ByteString,
    AdminReqInfo -> [Header]
ariHeaders :: [Header],
    AdminReqInfo -> Query
ariQueryParams :: Query
  }

data S3ReqInfo = S3ReqInfo
  { S3ReqInfo -> ByteString
riMethod :: Method,
    S3ReqInfo -> Maybe Bucket
riBucket :: Maybe Bucket,
    S3ReqInfo -> Maybe Bucket
riObject :: Maybe Object,
    S3ReqInfo -> Query
riQueryParams :: Query,
    S3ReqInfo -> [Header]
riHeaders :: [Header],
    S3ReqInfo -> Payload
riPayload :: Payload,
    S3ReqInfo -> Maybe ByteString
riPayloadHash :: Maybe ByteString,
    S3ReqInfo -> Maybe Bucket
riRegion :: Maybe Region,
    S3ReqInfo -> Bool
riNeedsLocation :: Bool,
    S3ReqInfo -> Maybe Int
riPresignExpirySecs :: Maybe UrlExpiry
  }

defaultS3ReqInfo :: S3ReqInfo
defaultS3ReqInfo :: S3ReqInfo
defaultS3ReqInfo =
  ByteString
-> Maybe Bucket
-> Maybe Bucket
-> Query
-> [Header]
-> Payload
-> Maybe ByteString
-> Maybe Bucket
-> Bool
-> Maybe Int
-> S3ReqInfo
S3ReqInfo
    ByteString
HT.methodGet
    forall a. Maybe a
Nothing
    forall a. Maybe a
Nothing
    []
    []
    Payload
defaultPayload
    forall a. Maybe a
Nothing
    forall a. Maybe a
Nothing
    Bool
True
    forall a. Maybe a
Nothing

getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
getS3Path :: Maybe Bucket -> Maybe Bucket -> ByteString
getS3Path Maybe Bucket
b Maybe Bucket
o =
  let segments :: [ByteString]
segments = forall a b. (a -> b) -> [a] -> [b]
map forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ Maybe Bucket
b forall a. a -> [a] -> [a]
: forall a. a -> a -> Bool -> a
bool [] [Maybe Bucket
o] (forall a. Maybe a -> Bool
isJust Maybe Bucket
b)
   in [ByteString] -> ByteString
B.concat [ByteString
"/", ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"/" [ByteString]
segments]

type RegionMap = H.HashMap Bucket Region

-- | The Minio Monad - all computations accessing object storage
-- happens in it.
newtype Minio a = Minio
  { forall a. Minio a -> ReaderT MinioConn (ResourceT IO) a
unMinio :: ReaderT MinioConn (ResourceT IO) a
  }
  deriving newtype
    ( forall a b. a -> Minio b -> Minio a
forall a b. (a -> b) -> Minio a -> Minio b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Minio b -> Minio a
$c<$ :: forall a b. a -> Minio b -> Minio a
fmap :: forall a b. (a -> b) -> Minio a -> Minio b
$cfmap :: forall a b. (a -> b) -> Minio a -> Minio b
Functor,
      Functor Minio
forall a. a -> Minio a
forall a b. Minio a -> Minio b -> Minio a
forall a b. Minio a -> Minio b -> Minio b
forall a b. Minio (a -> b) -> Minio a -> Minio b
forall a b c. (a -> b -> c) -> Minio a -> Minio b -> Minio c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Minio a -> Minio b -> Minio a
$c<* :: forall a b. Minio a -> Minio b -> Minio a
*> :: forall a b. Minio a -> Minio b -> Minio b
$c*> :: forall a b. Minio a -> Minio b -> Minio b
liftA2 :: forall a b c. (a -> b -> c) -> Minio a -> Minio b -> Minio c
$cliftA2 :: forall a b c. (a -> b -> c) -> Minio a -> Minio b -> Minio c
<*> :: forall a b. Minio (a -> b) -> Minio a -> Minio b
$c<*> :: forall a b. Minio (a -> b) -> Minio a -> Minio b
pure :: forall a. a -> Minio a
$cpure :: forall a. a -> Minio a
Applicative,
      Applicative Minio
forall a. a -> Minio a
forall a b. Minio a -> Minio b -> Minio b
forall a b. Minio a -> (a -> Minio b) -> Minio b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Minio a
$creturn :: forall a. a -> Minio a
>> :: forall a b. Minio a -> Minio b -> Minio b
$c>> :: forall a b. Minio a -> Minio b -> Minio b
>>= :: forall a b. Minio a -> (a -> Minio b) -> Minio b
$c>>= :: forall a b. Minio a -> (a -> Minio b) -> Minio b
Monad,
      Monad Minio
forall a. IO a -> Minio a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Minio a
$cliftIO :: forall a. IO a -> Minio a
MonadIO,
      MonadReader MinioConn,
      MonadIO Minio
forall a. ResourceT IO a -> Minio a
forall (m :: * -> *).
MonadIO m -> (forall a. ResourceT IO a -> m a) -> MonadResource m
liftResourceT :: forall a. ResourceT IO a -> Minio a
$cliftResourceT :: forall a. ResourceT IO a -> Minio a
MonadResource,
      MonadIO Minio
forall b. ((forall a. Minio a -> IO a) -> IO b) -> Minio b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
withRunInIO :: forall b. ((forall a. Minio a -> IO a) -> IO b) -> Minio b
$cwithRunInIO :: forall b. ((forall a. Minio a -> IO a) -> IO b) -> Minio b
MonadUnliftIO
    )

-- | MinioConn holds connection info and a connection pool to allow
-- for efficient resource re-use.
data MinioConn = MinioConn
  { MinioConn -> ConnectInfo
mcConnInfo :: ConnectInfo,
    MinioConn -> Manager
mcConnManager :: NC.Manager,
    MinioConn -> MVar (HashMap Bucket Bucket)
mcRegionMap :: MVar RegionMap
  }

class HasSvcNamespace env where
  getSvcNamespace :: env -> Text

instance HasSvcNamespace MinioConn where
  getSvcNamespace :: MinioConn -> Bucket
getSvcNamespace MinioConn
env =
    let host :: Bucket
host = ConnectInfo -> Bucket
connectHost forall a b. (a -> b) -> a -> b
$ MinioConn -> ConnectInfo
mcConnInfo MinioConn
env
     in ( if Bucket
host forall a. Eq a => a -> a -> Bool
== Bucket
"storage.googleapis.com"
            then Bucket
"http://doc.s3.amazonaws.com/2006-03-01"
            else Bucket
"http://s3.amazonaws.com/doc/2006-03-01/"
        )

-- | Takes connection information and returns a connection object to
-- be passed to 'runMinio'. The returned value can be kept in the
-- application environment and passed to `runMinioWith` whenever
-- object storage is accessed.
connect :: ConnectInfo -> IO MinioConn
connect :: ConnectInfo -> IO MinioConn
connect ConnectInfo
ci = do
  let settings :: ManagerSettings
settings
        | ConnectInfo -> Bool
connectIsSecure ConnectInfo
ci Bool -> Bool -> Bool
&& ConnectInfo -> Bool
connectDisableTLSCertValidation ConnectInfo
ci =
            let badTlsSettings :: TLSSettings
badTlsSettings = Bool -> Bool -> Bool -> TLSSettings
Conn.TLSSettingsSimple Bool
True Bool
False Bool
False
             in TLSSettings -> Maybe SockSettings -> ManagerSettings
TLS.mkManagerSettings TLSSettings
badTlsSettings forall a. Maybe a
Nothing
        | ConnectInfo -> Bool
connectIsSecure ConnectInfo
ci = ManagerSettings
NC.tlsManagerSettings
        | Bool
otherwise = ManagerSettings
defaultManagerSettings
  Manager
mgr <- ManagerSettings -> IO Manager
NC.newManager ManagerSettings
settings
  ConnectInfo -> Manager -> IO MinioConn
mkMinioConn ConnectInfo
ci Manager
mgr

-- | Run the computation accessing object storage using the given
-- `MinioConn`. This reuses connections, but otherwise it is similar
-- to `runMinio`.
runMinioWith :: MinioConn -> Minio a -> IO (Either MinioErr a)
runMinioWith :: forall a. MinioConn -> Minio a -> IO (Either MinioErr a)
runMinioWith MinioConn
conn Minio a
m = forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ forall a. MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
runMinioResWith MinioConn
conn Minio a
m

-- | Given `ConnectInfo` and a HTTP connection manager, create a
-- `MinioConn`.
mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
mkMinioConn :: ConnectInfo -> Manager -> IO MinioConn
mkMinioConn ConnectInfo
ci Manager
mgr = do
  MVar (HashMap Bucket Bucket)
rMapMVar <- forall a. a -> IO (MVar a)
M.newMVar forall k v. HashMap k v
H.empty
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Manager -> MVar (HashMap Bucket Bucket) -> MinioConn
MinioConn ConnectInfo
ci Manager
mgr MVar (HashMap Bucket Bucket)
rMapMVar

-- | Run the Minio action and return the result or an error.
runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
runMinio :: forall a. ConnectInfo -> Minio a -> IO (Either MinioErr a)
runMinio ConnectInfo
ci Minio a
m = do
  MinioConn
conn <- ConnectInfo -> IO MinioConn
connect ConnectInfo
ci
  forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ forall a. MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
runMinioResWith MinioConn
conn Minio a
m

-- | Similar to 'runMinioWith'. Allows applications to allocate/release
-- its resources along side MinIO's internal resources.
runMinioResWith :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
runMinioResWith :: forall a. MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
runMinioResWith MinioConn
conn Minio a
m =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT MinioConn
conn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Minio a -> ReaderT MinioConn (ResourceT IO) a
unMinio forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right Minio a
m
      forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
`U.catches` [ forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
U.Handler forall {b}. ServiceErr -> Minio (Either MinioErr b)
handlerServiceErr,
                    forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
U.Handler forall {b}. HttpException -> Minio (Either MinioErr b)
handlerHE,
                    forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
U.Handler forall {b}. IOException -> Minio (Either MinioErr b)
handlerFE,
                    forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
U.Handler forall {b}. MErrV -> Minio (Either MinioErr b)
handlerValidation
                  ]
  where
    handlerServiceErr :: ServiceErr -> Minio (Either MinioErr b)
handlerServiceErr = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceErr -> MinioErr
MErrService
    handlerHE :: HttpException -> Minio (Either MinioErr b)
handlerHE = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> MinioErr
MErrHTTP
    handlerFE :: IOException -> Minio (Either MinioErr b)
handlerFE = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> MinioErr
MErrIO
    handlerValidation :: MErrV -> Minio (Either MinioErr b)
handlerValidation = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. MErrV -> MinioErr
MErrValidation

-- | Similar to 'runMinio'. Allows applications to allocate/release
-- its resources along side MinIO's internal resources.
runMinioRes :: ConnectInfo -> Minio a -> ResourceT IO (Either MinioErr a)
runMinioRes :: forall a.
ConnectInfo -> Minio a -> ResourceT IO (Either MinioErr a)
runMinioRes ConnectInfo
ci Minio a
m = do
  MinioConn
conn <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ConnectInfo -> IO MinioConn
connect ConnectInfo
ci
  forall a. MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
runMinioResWith MinioConn
conn Minio a
m

-- | Format as per RFC 1123.
formatRFC1123 :: UTCTime -> T.Text
formatRFC1123 :: UTCTime -> Bucket
formatRFC1123 = String -> Bucket
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%a, %d %b %Y %X %Z"

lookupRegionCache :: Bucket -> Minio (Maybe Region)
lookupRegionCache :: Bucket -> Minio (Maybe Bucket)
lookupRegionCache Bucket
b = do
  MVar (HashMap Bucket Bucket)
rMVar <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> MVar (HashMap Bucket Bucket)
mcRegionMap
  HashMap Bucket Bucket
rMap <- forall (m :: * -> *) a. MonadIO m => MVar a -> m a
UM.readMVar MVar (HashMap Bucket Bucket)
rMVar
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Bucket
b HashMap Bucket Bucket
rMap

addToRegionCache :: Bucket -> Region -> Minio ()
addToRegionCache :: Bucket -> Bucket -> Minio ()
addToRegionCache Bucket
b Bucket
region = do
  MVar (HashMap Bucket Bucket)
rMVar <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> MVar (HashMap Bucket Bucket)
mcRegionMap
  forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
UM.modifyMVar_ MVar (HashMap Bucket Bucket)
rMVar forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Bucket
b Bucket
region

deleteFromRegionCache :: Bucket -> Minio ()
deleteFromRegionCache :: Bucket -> Minio ()
deleteFromRegionCache Bucket
b = do
  MVar (HashMap Bucket Bucket)
rMVar <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> MVar (HashMap Bucket Bucket)
mcRegionMap
  forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
UM.modifyMVar_ MVar (HashMap Bucket Bucket)
rMVar forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
H.delete Bucket
b