--
-- MinIO Haskell SDK, (C) 2017, 2018 MinIO, Inc.
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# 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 Data.CaseInsensitive (mk)
import qualified Data.HashMap.Strict as H
import qualified Data.Ini as Ini
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.Data.Crypto
  ( encodeToBase64,
    hashMD5ToBase64,
  )
import Network.Minio.Data.Time (UrlExpiry)
import Network.Minio.Errors
  ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials),
    MinioErr (..),
  )
import System.Directory (doesFileExist, getHomeDirectory)
import qualified System.Environment as Env
import System.FilePath.Posix (combine)
import Text.XML (Name (Name))
import qualified UnliftIO as U

-- | max obj size is 5TiB
maxObjectSize :: Int64
maxObjectSize :: Int64
maxObjectSize = Int64
5 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1024 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1024 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
oneMiB

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

oneMiB :: Int64
oneMiB :: Int64
oneMiB = Int64
1024 Int64 -> Int64 -> Int64
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 Text Text
awsRegionMap =
  [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
    [ (Text
"us-east-1", Text
"s3.us-east-1.amazonaws.com"),
      (Text
"us-east-2", Text
"s3.us-east-2.amazonaws.com"),
      (Text
"us-west-1", Text
"s3.us-west-1.amazonaws.com"),
      (Text
"us-west-2", Text
"s3.us-west-2.amazonaws.com"),
      (Text
"ca-central-1", Text
"s3.ca-central-1.amazonaws.com"),
      (Text
"ap-south-1", Text
"s3.ap-south-1.amazonaws.com"),
      (Text
"ap-northeast-1", Text
"s3.ap-northeast-1.amazonaws.com"),
      (Text
"ap-northeast-2", Text
"s3.ap-northeast-2.amazonaws.com"),
      (Text
"ap-southeast-1", Text
"s3.ap-southeast-1.amazonaws.com"),
      (Text
"ap-southeast-2", Text
"s3.ap-southeast-2.amazonaws.com"),
      (Text
"eu-west-1", Text
"s3.eu-west-1.amazonaws.com"),
      (Text
"eu-west-2", Text
"s3.eu-west-2.amazonaws.com"),
      (Text
"eu-central-1", Text
"s3.eu-central-1.amazonaws.com"),
      (Text
"sa-east-1", Text
"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 -> Text
connectHost :: Text,
    ConnectInfo -> Int
connectPort :: Int,
    ConnectInfo -> Text
connectAccessKey :: Text,
    ConnectInfo -> Text
connectSecretKey :: Text,
    ConnectInfo -> Bool
connectIsSecure :: Bool,
    ConnectInfo -> Text
connectRegion :: Region,
    ConnectInfo -> Bool
connectAutoDiscoverRegion :: Bool,
    ConnectInfo -> Bool
connectDisableTLSCertValidation :: Bool
  }
  deriving stock (ConnectInfo -> ConnectInfo -> Bool
(ConnectInfo -> ConnectInfo -> Bool)
-> (ConnectInfo -> ConnectInfo -> Bool) -> Eq ConnectInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectInfo -> ConnectInfo -> Bool
$c/= :: ConnectInfo -> ConnectInfo -> Bool
== :: ConnectInfo -> ConnectInfo -> Bool
$c== :: ConnectInfo -> ConnectInfo -> Bool
Eq, Int -> ConnectInfo -> ShowS
[ConnectInfo] -> ShowS
ConnectInfo -> String
(Int -> ConnectInfo -> ShowS)
-> (ConnectInfo -> String)
-> ([ConnectInfo] -> ShowS)
-> Show ConnectInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectInfo] -> ShowS
$cshowList :: [ConnectInfo] -> ShowS
show :: ConnectInfo -> String
$cshow :: ConnectInfo -> String
showsPrec :: Int -> ConnectInfo -> ShowS
$cshowsPrec :: Int -> ConnectInfo -> ShowS
Show)

instance IsString ConnectInfo where
  fromString :: String -> ConnectInfo
fromString String
str =
    let req :: Request
req = String -> Request
NC.parseRequest_ String
str
     in ConnectInfo :: Text
-> Int
-> Text
-> Text
-> Bool
-> Text
-> Bool
-> Bool
-> ConnectInfo
ConnectInfo
          { connectHost :: Text
connectHost = ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
NC.host Request
req,
            connectPort :: Int
connectPort = Request -> Int
NC.port Request
req,
            connectAccessKey :: Text
connectAccessKey = Text
"",
            connectSecretKey :: Text
connectSecretKey = Text
"",
            connectIsSecure :: Bool
connectIsSecure = Request -> Bool
NC.secure Request
req,
            connectRegion :: Text
connectRegion = Text
"",
            connectAutoDiscoverRegion :: Bool
connectAutoDiscoverRegion = Bool
True,
            connectDisableTLSCertValidation :: Bool
connectDisableTLSCertValidation = Bool
False
          }

-- | Contains access key and secret key to access object storage.
data Credentials = Credentials
  { Credentials -> Text
cAccessKey :: Text,
    Credentials -> Text
cSecretKey :: Text
  }
  deriving stock (Credentials -> Credentials -> Bool
(Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Bool) -> Eq Credentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Credentials -> Credentials -> Bool
$c/= :: Credentials -> Credentials -> Bool
== :: Credentials -> Credentials -> Bool
$c== :: Credentials -> Credentials -> Bool
Eq, Int -> Credentials -> ShowS
[Credentials] -> ShowS
Credentials -> String
(Int -> Credentials -> ShowS)
-> (Credentials -> String)
-> ([Credentials] -> ShowS)
-> Show Credentials
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Credentials] -> ShowS
$cshowList :: [Credentials] -> ShowS
show :: Credentials -> String
$cshow :: Credentials -> String
showsPrec :: Int -> Credentials -> ShowS
$cshowsPrec :: Int -> Credentials -> ShowS
Show)

-- | A Provider is an action that may return Credentials. Providers
-- may be chained together using 'findFirst'.
type Provider = IO (Maybe Credentials)

-- | Combines the given list of providers, by calling each one in
-- order until Credentials are found.
findFirst :: [Provider] -> Provider
findFirst :: [Provider] -> Provider
findFirst [] = Maybe Credentials -> Provider
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Credentials
forall a. Maybe a
Nothing
findFirst (Provider
f : [Provider]
fs) = do
  Maybe Credentials
c <- Provider
f
  Provider
-> (Credentials -> Provider) -> Maybe Credentials -> Provider
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Provider] -> Provider
findFirst [Provider]
fs) (Maybe Credentials -> Provider
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Credentials -> Provider)
-> (Credentials -> Maybe Credentials) -> Credentials -> Provider
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credentials -> Maybe Credentials
forall a. a -> Maybe a
Just) Maybe Credentials
c

-- | This Provider loads `Credentials` from @~\/.aws\/credentials@
fromAWSConfigFile :: Provider
fromAWSConfigFile :: Provider
fromAWSConfigFile = do
  Either String Credentials
credsE <- ExceptT String IO Credentials -> IO (Either String Credentials)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO Credentials -> IO (Either String Credentials))
-> ExceptT String IO Credentials -> IO (Either String Credentials)
forall a b. (a -> b) -> a -> b
$ do
    String
homeDir <- IO String -> ExceptT String IO String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO String
getHomeDirectory
    let awsCredsFile :: String
awsCredsFile = String
homeDir String -> ShowS
`combine` String
".aws" String -> ShowS
`combine` String
"credentials"
    Bool
fileExists <- IO Bool -> ExceptT String IO Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Bool -> ExceptT String IO Bool)
-> IO Bool -> ExceptT String IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
awsCredsFile
    ExceptT String IO ()
-> ExceptT String IO () -> Bool -> ExceptT String IO ()
forall a. a -> a -> Bool -> a
bool (String -> ExceptT String IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"FileNotFound") (() -> ExceptT String IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Bool
fileExists
    Ini
ini <- IO (Either String Ini) -> ExceptT String IO Ini
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String Ini) -> ExceptT String IO Ini)
-> IO (Either String Ini) -> ExceptT String IO Ini
forall a b. (a -> b) -> a -> b
$ String -> IO (Either String Ini)
Ini.readIniFile String
awsCredsFile
    Text
akey <-
      IO (Either String Text) -> ExceptT String IO Text
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String Text) -> ExceptT String IO Text)
-> IO (Either String Text) -> ExceptT String IO Text
forall a b. (a -> b) -> a -> b
$
        Either String Text -> IO (Either String Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Text -> IO (Either String Text))
-> Either String Text -> IO (Either String Text)
forall a b. (a -> b) -> a -> b
$
          Text -> Text -> Ini -> Either String Text
Ini.lookupValue Text
"default" Text
"aws_access_key_id" Ini
ini
    Text
skey <-
      IO (Either String Text) -> ExceptT String IO Text
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String Text) -> ExceptT String IO Text)
-> IO (Either String Text) -> ExceptT String IO Text
forall a b. (a -> b) -> a -> b
$
        Either String Text -> IO (Either String Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Text -> IO (Either String Text))
-> Either String Text -> IO (Either String Text)
forall a b. (a -> b) -> a -> b
$
          Text -> Text -> Ini -> Either String Text
Ini.lookupValue Text
"default" Text
"aws_secret_access_key" Ini
ini
    Credentials -> ExceptT String IO Credentials
forall (m :: * -> *) a. Monad m => a -> m a
return (Credentials -> ExceptT String IO Credentials)
-> Credentials -> ExceptT String IO Credentials
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Credentials
Credentials Text
akey Text
skey
  Maybe Credentials -> Provider
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Credentials -> Provider) -> Maybe Credentials -> Provider
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Credentials)
-> (Credentials -> Maybe Credentials)
-> Either String Credentials
-> Maybe Credentials
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Credentials -> String -> Maybe Credentials
forall a b. a -> b -> a
const Maybe Credentials
forall a. Maybe a
Nothing) Credentials -> Maybe Credentials
forall a. a -> Maybe a
Just Either String Credentials
credsE

-- | This Provider loads `Credentials` from @AWS_ACCESS_KEY_ID@ and
-- @AWS_SECRET_ACCESS_KEY@ environment variables.
fromAWSEnv :: Provider
fromAWSEnv :: Provider
fromAWSEnv = MaybeT IO Credentials -> Provider
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO Credentials -> Provider)
-> MaybeT IO Credentials -> Provider
forall a b. (a -> b) -> a -> b
$ do
  String
akey <- IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe String) -> MaybeT IO String)
-> IO (Maybe String) -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
Env.lookupEnv String
"AWS_ACCESS_KEY_ID"
  String
skey <- IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe String) -> MaybeT IO String)
-> IO (Maybe String) -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
Env.lookupEnv String
"AWS_SECRET_ACCESS_KEY"
  Credentials -> MaybeT IO Credentials
forall (m :: * -> *) a. Monad m => a -> m a
return (Credentials -> MaybeT IO Credentials)
-> Credentials -> MaybeT IO Credentials
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Credentials
Credentials (String -> Text
T.pack String
akey) (String -> Text
T.pack String
skey)

-- | This Provider loads `Credentials` from @MINIO_ACCESS_KEY@ and
-- @MINIO_SECRET_KEY@ environment variables.
fromMinioEnv :: Provider
fromMinioEnv :: Provider
fromMinioEnv = MaybeT IO Credentials -> Provider
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO Credentials -> Provider)
-> MaybeT IO Credentials -> Provider
forall a b. (a -> b) -> a -> b
$ do
  String
akey <- IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe String) -> MaybeT IO String)
-> IO (Maybe String) -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
Env.lookupEnv String
"MINIO_ACCESS_KEY"
  String
skey <- IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe String) -> MaybeT IO String)
-> IO (Maybe String) -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
Env.lookupEnv String
"MINIO_SECRET_KEY"
  Credentials -> MaybeT IO Credentials
forall (m :: * -> *) a. Monad m => a -> m a
return (Credentials -> MaybeT IO Credentials)
-> Credentials -> MaybeT IO Credentials
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Credentials
Credentials (String -> Text
T.pack String
akey) (String -> Text
T.pack String
skey)

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

-- | setCreds sets the given `Credentials` in the `ConnectInfo`.
setCreds :: Credentials -> ConnectInfo -> ConnectInfo
setCreds :: Credentials -> ConnectInfo -> ConnectInfo
setCreds (Credentials Text
accessKey Text
secretKey) ConnectInfo
connInfo =
  ConnectInfo
connInfo
    { connectAccessKey :: Text
connectAccessKey = Text
accessKey,
      connectSecretKey :: Text
connectSecretKey = Text
secretKey
    }

-- | Set the S3 region parameter in the `ConnectInfo`
setRegion :: Region -> ConnectInfo -> ConnectInfo
setRegion :: Text -> ConnectInfo -> ConnectInfo
setRegion Text
r ConnectInfo
connInfo =
  ConnectInfo
connInfo
    { connectRegion :: Text
connectRegion = Text
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 =
  if Int
port Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
80 Bool -> Bool -> Bool
|| Int
port Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
443
    then Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
host
    else
      Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$
        [Text] -> Text
T.concat [Text
host, Text
":", Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
port]
  where
    port :: Int
port = ConnectInfo -> Int
connectPort ConnectInfo
ci
    host :: Text
host = ConnectInfo -> Text
connectHost 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 =
  Text -> ConnectInfo -> ConnectInfo
setRegion
    Text
"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 :: Credentials
playCreds = Text -> Text -> Credentials
Credentials Text
"Q3AM3UQ867SPQQA43P2F" Text
"zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
   in Credentials -> ConnectInfo -> ConnectInfo
setCreds Credentials
playCreds (ConnectInfo -> ConnectInfo) -> ConnectInfo -> ConnectInfo
forall a b. (a -> b) -> a -> b
$
        Text -> ConnectInfo -> ConnectInfo
setRegion
          Text
"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
(SSECKey -> SSECKey -> Bool)
-> (SSECKey -> SSECKey -> Bool) -> Eq SSECKey
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 -> ShowS
[SSECKey] -> ShowS
SSECKey -> String
(Int -> SSECKey -> ShowS)
-> (SSECKey -> String) -> ([SSECKey] -> ShowS) -> Show SSECKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SSECKey] -> ShowS
$cshowList :: [SSECKey] -> ShowS
show :: SSECKey -> String
$cshow :: SSECKey -> String
showsPrec :: Int -> SSECKey -> ShowS
$cshowsPrec :: Int -> SSECKey -> ShowS
Show)

-- | Validates that the given ByteString is 32 bytes long and creates
-- an encryption key.
mkSSECKey :: MonadThrow m => ByteString -> m SSECKey
mkSSECKey :: ByteString -> m SSECKey
mkSSECKey ByteString
keyBytes
  | ByteString -> Int
B.length ByteString
keyBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 =
      MErrV -> m SSECKey
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM MErrV
MErrVInvalidEncryptionKeyLength
  | Bool
otherwise =
      SSECKey -> m SSECKey
forall (m :: * -> *) a. Monad m => a -> m a
return (SSECKey -> m SSECKey) -> SSECKey -> m SSECKey
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> SSECKey
SSECKey (ScrubbedBytes -> SSECKey) -> ScrubbedBytes -> SSECKey
forall a b. (a -> b) -> a -> b
$ ByteString -> ScrubbedBytes
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 CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"-aws-kms-key-id"
      sseKmsContextHeader :: CI ByteString
sseKmsContextHeader = CI ByteString
sseHeader CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"-context"
      ssecAlgo :: CI ByteString
ssecAlgo = CI ByteString
sseHeader CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"-customer-algorithm"
      ssecKey :: CI ByteString
ssecKey = CI ByteString
sseHeader CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"-customer-key"
      ssecKeyMD5 :: CI ByteString
ssecKeyMD5 = CI ByteString
ssecKey CI ByteString -> CI ByteString -> CI ByteString
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")]
            [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
-> (ByteString -> [Header]) -> Maybe ByteString -> [Header]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ByteString
k -> [(CI ByteString
sseKmsIdHeader, ByteString
k)]) Maybe ByteString
keyIdMay
            [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header] -> (a -> [Header]) -> Maybe a -> [Header]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\a
k -> [(CI ByteString
sseKmsContextHeader, ByteString -> ByteString
LB.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
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, ScrubbedBytes -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
encodeToBase64 ScrubbedBytes
sb),
            (CI ByteString
ssecKeyMD5, ScrubbedBytes -> ByteString
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 Text
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 Text
pooContentEncoding :: Maybe Text,
    -- | Set presentational information for the object.
    PutObjectOptions -> Maybe Text
pooContentDisposition :: Maybe Text,
    -- | Set to specify caching behavior for the object along the
    -- request/reply chain.
    PutObjectOptions -> Maybe Text
pooCacheControl :: Maybe Text,
    -- | Set to describe the language(s) intended for the audience.
    PutObjectOptions -> Maybe Text
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 Text
pooStorageClass :: Maybe Text,
    -- | Set user defined metadata to store with the object.
    PutObjectOptions -> [(Text, Text)]
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 Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [(Text, Text)]
-> Maybe Word
-> Maybe SSE
-> PutObjectOptions
PutObjectOptions Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing [] Maybe Word
forall a. Maybe a
Nothing Maybe SSE
forall a. Maybe a
Nothing

-- | If the given header name has the @X-Amz-Meta-@ prefix, it is
-- stripped and a Just is returned.
userMetadataHeaderNameMaybe :: Text -> Maybe Text
userMetadataHeaderNameMaybe :: Text -> Maybe Text
userMetadataHeaderNameMaybe Text
k =
  let prefix :: Text
prefix = Text -> Text
T.toCaseFold Text
"X-Amz-Meta-"
      n :: Int
n = Text -> Int
T.length Text
prefix
   in if Text -> Text
T.toCaseFold (Int -> Text -> Text
T.take Int
n Text
k) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
prefix
        then Text -> Maybe Text
forall a. a -> Maybe a
Just (Int -> Text -> Text
T.drop Int
n Text
k)
        else Maybe Text
forall a. Maybe a
Nothing

addXAmzMetaPrefix :: Text -> Text
addXAmzMetaPrefix :: Text -> Text
addXAmzMetaPrefix Text
s
  | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Text -> Maybe Text
userMetadataHeaderNameMaybe Text
s) = Text
s
  | Bool
otherwise = Text
"X-Amz-Meta-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s

mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]
mkHeaderFromMetadata :: [(Text, Text)] -> [Header]
mkHeaderFromMetadata = ((Text, Text) -> Header) -> [(Text, Text)] -> [Header]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
x, Text
y) -> (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
addXAmzMetaPrefix Text
x, Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
y))

pooToHeaders :: PutObjectOptions -> [HT.Header]
pooToHeaders :: PutObjectOptions -> [Header]
pooToHeaders PutObjectOptions
poo =
  [Header]
userMetadata
    [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ ((CI ByteString, Maybe ByteString) -> Maybe Header)
-> [(CI ByteString, Maybe ByteString)] -> [Header]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (CI ByteString, Maybe ByteString) -> Maybe Header
forall a b. (a, Maybe b) -> Maybe (a, b)
tupToMaybe ([CI ByteString]
-> [Maybe ByteString] -> [(CI ByteString, Maybe ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CI ByteString]
names [Maybe ByteString]
values)
    [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header] -> (SSE -> [Header]) -> Maybe SSE -> [Header]
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) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
k, b
v)
    tupToMaybe (a
_, Maybe b
Nothing) = Maybe (a, b)
forall a. Maybe a
Nothing
    userMetadata :: [Header]
userMetadata = [(Text, Text)] -> [Header]
mkHeaderFromMetadata ([(Text, Text)] -> [Header]) -> [(Text, Text)] -> [Header]
forall a b. (a -> b) -> a -> b
$ PutObjectOptions -> [(Text, Text)]
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 =
      ((PutObjectOptions -> Maybe Text) -> Maybe ByteString)
-> [PutObjectOptions -> Maybe Text] -> [Maybe ByteString]
forall a b. (a -> b) -> [a] -> [b]
map
        ((Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Maybe Text -> Maybe ByteString)
-> ((PutObjectOptions -> Maybe Text) -> Maybe Text)
-> (PutObjectOptions -> Maybe Text)
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PutObjectOptions
poo PutObjectOptions -> (PutObjectOptions -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
&))
        [ PutObjectOptions -> Maybe Text
pooContentType,
          PutObjectOptions -> Maybe Text
pooContentEncoding,
          PutObjectOptions -> Maybe Text
pooContentDisposition,
          PutObjectOptions -> Maybe Text
pooContentLanguage,
          PutObjectOptions -> Maybe Text
pooCacheControl,
          PutObjectOptions -> Maybe Text
pooStorageClass
        ]

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

-- | 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 -> ShowS
[ListPartsResult] -> ShowS
ListPartsResult -> String
(Int -> ListPartsResult -> ShowS)
-> (ListPartsResult -> String)
-> ([ListPartsResult] -> ShowS)
-> Show ListPartsResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPartsResult] -> ShowS
$cshowList :: [ListPartsResult] -> ShowS
show :: ListPartsResult -> String
$cshow :: ListPartsResult -> String
showsPrec :: Int -> ListPartsResult -> ShowS
$cshowsPrec :: Int -> ListPartsResult -> ShowS
Show, ListPartsResult -> ListPartsResult -> Bool
(ListPartsResult -> ListPartsResult -> Bool)
-> (ListPartsResult -> ListPartsResult -> Bool)
-> Eq ListPartsResult
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 -> Text
opiETag :: ETag,
    ObjectPartInfo -> Int64
opiSize :: Int64,
    ObjectPartInfo -> UTCTime
opiModTime :: UTCTime
  }
  deriving stock (Int -> ObjectPartInfo -> ShowS
[ObjectPartInfo] -> ShowS
ObjectPartInfo -> String
(Int -> ObjectPartInfo -> ShowS)
-> (ObjectPartInfo -> String)
-> ([ObjectPartInfo] -> ShowS)
-> Show ObjectPartInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObjectPartInfo] -> ShowS
$cshowList :: [ObjectPartInfo] -> ShowS
show :: ObjectPartInfo -> String
$cshow :: ObjectPartInfo -> String
showsPrec :: Int -> ObjectPartInfo -> ShowS
$cshowsPrec :: Int -> ObjectPartInfo -> ShowS
Show, ObjectPartInfo -> ObjectPartInfo -> Bool
(ObjectPartInfo -> ObjectPartInfo -> Bool)
-> (ObjectPartInfo -> ObjectPartInfo -> Bool) -> Eq ObjectPartInfo
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 Text
lurNextKey :: Maybe Text,
    ListUploadsResult -> Maybe Text
lurNextUpload :: Maybe Text,
    ListUploadsResult -> [(Text, Text, UTCTime)]
lurUploads :: [(Object, UploadId, UTCTime)],
    ListUploadsResult -> [Text]
lurCPrefixes :: [Text]
  }
  deriving stock (Int -> ListUploadsResult -> ShowS
[ListUploadsResult] -> ShowS
ListUploadsResult -> String
(Int -> ListUploadsResult -> ShowS)
-> (ListUploadsResult -> String)
-> ([ListUploadsResult] -> ShowS)
-> Show ListUploadsResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListUploadsResult] -> ShowS
$cshowList :: [ListUploadsResult] -> ShowS
show :: ListUploadsResult -> String
$cshow :: ListUploadsResult -> String
showsPrec :: Int -> ListUploadsResult -> ShowS
$cshowsPrec :: Int -> ListUploadsResult -> ShowS
Show, ListUploadsResult -> ListUploadsResult -> Bool
(ListUploadsResult -> ListUploadsResult -> Bool)
-> (ListUploadsResult -> ListUploadsResult -> Bool)
-> Eq ListUploadsResult
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 -> Text
uiKey :: Object,
    UploadInfo -> Text
uiUploadId :: UploadId,
    UploadInfo -> UTCTime
uiInitTime :: UTCTime,
    UploadInfo -> Int64
uiSize :: Int64
  }
  deriving stock (Int -> UploadInfo -> ShowS
[UploadInfo] -> ShowS
UploadInfo -> String
(Int -> UploadInfo -> ShowS)
-> (UploadInfo -> String)
-> ([UploadInfo] -> ShowS)
-> Show UploadInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UploadInfo] -> ShowS
$cshowList :: [UploadInfo] -> ShowS
show :: UploadInfo -> String
$cshow :: UploadInfo -> String
showsPrec :: Int -> UploadInfo -> ShowS
$cshowsPrec :: Int -> UploadInfo -> ShowS
Show, UploadInfo -> UploadInfo -> Bool
(UploadInfo -> UploadInfo -> Bool)
-> (UploadInfo -> UploadInfo -> Bool) -> Eq UploadInfo
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 Text
lorNextToken :: Maybe Text,
    ListObjectsResult -> [ObjectInfo]
lorObjects :: [ObjectInfo],
    ListObjectsResult -> [Text]
lorCPrefixes :: [Text]
  }
  deriving stock (Int -> ListObjectsResult -> ShowS
[ListObjectsResult] -> ShowS
ListObjectsResult -> String
(Int -> ListObjectsResult -> ShowS)
-> (ListObjectsResult -> String)
-> ([ListObjectsResult] -> ShowS)
-> Show ListObjectsResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListObjectsResult] -> ShowS
$cshowList :: [ListObjectsResult] -> ShowS
show :: ListObjectsResult -> String
$cshow :: ListObjectsResult -> String
showsPrec :: Int -> ListObjectsResult -> ShowS
$cshowsPrec :: Int -> ListObjectsResult -> ShowS
Show, ListObjectsResult -> ListObjectsResult -> Bool
(ListObjectsResult -> ListObjectsResult -> Bool)
-> (ListObjectsResult -> ListObjectsResult -> Bool)
-> Eq ListObjectsResult
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 Text
lorNextMarker :: Maybe Text,
    ListObjectsV1Result -> [ObjectInfo]
lorObjects' :: [ObjectInfo],
    ListObjectsV1Result -> [Text]
lorCPrefixes' :: [Text]
  }
  deriving stock (Int -> ListObjectsV1Result -> ShowS
[ListObjectsV1Result] -> ShowS
ListObjectsV1Result -> String
(Int -> ListObjectsV1Result -> ShowS)
-> (ListObjectsV1Result -> String)
-> ([ListObjectsV1Result] -> ShowS)
-> Show ListObjectsV1Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListObjectsV1Result] -> ShowS
$cshowList :: [ListObjectsV1Result] -> ShowS
show :: ListObjectsV1Result -> String
$cshow :: ListObjectsV1Result -> String
showsPrec :: Int -> ListObjectsV1Result -> ShowS
$cshowsPrec :: Int -> ListObjectsV1Result -> ShowS
Show, ListObjectsV1Result -> ListObjectsV1Result -> Bool
(ListObjectsV1Result -> ListObjectsV1Result -> Bool)
-> (ListObjectsV1Result -> ListObjectsV1Result -> Bool)
-> Eq ListObjectsV1Result
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 -> Text
oiObject :: Object,
    -- | Modification time of the object
    ObjectInfo -> UTCTime
oiModTime :: UTCTime,
    -- | ETag of the object
    ObjectInfo -> Text
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 Text Text
oiUserMetadata :: H.HashMap Text Text,
    -- | A map of metadata
    -- key-value pairs (not
    -- including the
    -- user-metadata pairs)
    ObjectInfo -> HashMap Text Text
oiMetadata :: H.HashMap Text Text
  }
  deriving stock (Int -> ObjectInfo -> ShowS
[ObjectInfo] -> ShowS
ObjectInfo -> String
(Int -> ObjectInfo -> ShowS)
-> (ObjectInfo -> String)
-> ([ObjectInfo] -> ShowS)
-> Show ObjectInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObjectInfo] -> ShowS
$cshowList :: [ObjectInfo] -> ShowS
show :: ObjectInfo -> String
$cshow :: ObjectInfo -> String
showsPrec :: Int -> ObjectInfo -> ShowS
$cshowsPrec :: Int -> ObjectInfo -> ShowS
Show, ObjectInfo -> ObjectInfo -> Bool
(ObjectInfo -> ObjectInfo -> Bool)
-> (ObjectInfo -> ObjectInfo -> Bool) -> Eq ObjectInfo
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 -> Text
srcBucket :: Text,
    -- | Source object key
    SourceInfo -> Text
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 Text
srcIfMatch :: Maybe Text,
    -- | ETag not match condition
    -- on source - object is copied
    -- if ETag does not match this
    -- value.
    SourceInfo -> Maybe Text
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 -> ShowS
[SourceInfo] -> ShowS
SourceInfo -> String
(Int -> SourceInfo -> ShowS)
-> (SourceInfo -> String)
-> ([SourceInfo] -> ShowS)
-> Show SourceInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceInfo] -> ShowS
$cshowList :: [SourceInfo] -> ShowS
show :: SourceInfo -> String
$cshow :: SourceInfo -> String
showsPrec :: Int -> SourceInfo -> ShowS
$cshowsPrec :: Int -> SourceInfo -> ShowS
Show, SourceInfo -> SourceInfo -> Bool
(SourceInfo -> SourceInfo -> Bool)
-> (SourceInfo -> SourceInfo -> Bool) -> Eq SourceInfo
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 = Text
-> Text
-> Maybe (Int64, Int64)
-> Maybe Text
-> Maybe Text
-> Maybe UTCTime
-> Maybe UTCTime
-> SourceInfo
SourceInfo Text
"" Text
"" Maybe (Int64, Int64)
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing

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

-- | 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 Text
gooIfMatch :: Maybe ETag,
    -- | Set matching ETag none condition, GetObject which does not match
    -- the following ETag.
    GetObjectOptions -> Maybe Text
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 Text
-> Maybe Text
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe SSECKey
-> GetObjectOptions
GetObjectOptions Maybe ByteRange
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing Maybe SSECKey
forall a. Maybe a
Nothing

gooToHeaders :: GetObjectOptions -> [HT.Header]
gooToHeaders :: GetObjectOptions -> [Header]
gooToHeaders GetObjectOptions
goo =
  [Header]
rangeHdr
    [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [CI ByteString] -> [ByteString] -> [Header]
forall a b. [a] -> [b] -> [(a, b)]
zip [CI ByteString]
names [ByteString]
values
    [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header] -> (SSECKey -> [Header]) -> Maybe SSECKey -> [Header]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (SSE -> [Header]
toPutObjectHeaders (SSE -> [Header]) -> (SSECKey -> SSE) -> SSECKey -> [Header]
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 =
      ((GetObjectOptions -> Maybe Text) -> Maybe ByteString)
-> [GetObjectOptions -> Maybe Text] -> [ByteString]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
        ((Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Maybe Text -> Maybe ByteString)
-> ((GetObjectOptions -> Maybe Text) -> Maybe Text)
-> (GetObjectOptions -> Maybe Text)
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GetObjectOptions
goo GetObjectOptions -> (GetObjectOptions -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
&))
        [ GetObjectOptions -> Maybe Text
gooIfMatch,
          GetObjectOptions -> Maybe Text
gooIfNoneMatch,
          (UTCTime -> Text) -> Maybe UTCTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> Text
formatRFC1123 (Maybe UTCTime -> Maybe Text)
-> (GetObjectOptions -> Maybe UTCTime)
-> GetObjectOptions
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetObjectOptions -> Maybe UTCTime
gooIfUnmodifiedSince,
          (UTCTime -> Text) -> Maybe UTCTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> Text
formatRFC1123 (Maybe UTCTime -> Maybe Text)
-> (GetObjectOptions -> Maybe UTCTime)
-> GetObjectOptions
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetObjectOptions -> Maybe UTCTime
gooIfModifiedSince
        ]
    rangeHdr :: [Header]
rangeHdr =
      [Header] -> (ByteRange -> [Header]) -> Maybe ByteRange -> [Header]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ByteRange
a -> [(CI ByteString
hRange, ByteRanges -> ByteString
HT.renderByteRanges [ByteRange
a])]) (Maybe ByteRange -> [Header]) -> Maybe ByteRange -> [Header]
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
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
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 -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)

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

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

-- | Filter data type - part of notification configuration
newtype Filter = Filter
  { Filter -> FilterKey
fFilter :: FilterKey
  }
  deriving stock (Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
(Int -> Filter -> ShowS)
-> (Filter -> String) -> ([Filter] -> ShowS) -> Show Filter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Filter] -> ShowS
$cshowList :: [Filter] -> ShowS
show :: Filter -> String
$cshow :: Filter -> String
showsPrec :: Int -> Filter -> ShowS
$cshowsPrec :: Int -> Filter -> ShowS
Show, Filter -> Filter -> Bool
(Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool) -> Eq Filter
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 -> ShowS
[FilterKey] -> ShowS
FilterKey -> String
(Int -> FilterKey -> ShowS)
-> (FilterKey -> String)
-> ([FilterKey] -> ShowS)
-> Show FilterKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterKey] -> ShowS
$cshowList :: [FilterKey] -> ShowS
show :: FilterKey -> String
$cshow :: FilterKey -> String
showsPrec :: Int -> FilterKey -> ShowS
$cshowsPrec :: Int -> FilterKey -> ShowS
Show, FilterKey -> FilterKey -> Bool
(FilterKey -> FilterKey -> Bool)
-> (FilterKey -> FilterKey -> Bool) -> Eq FilterKey
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 -> ShowS
[FilterRules] -> ShowS
FilterRules -> String
(Int -> FilterRules -> ShowS)
-> (FilterRules -> String)
-> ([FilterRules] -> ShowS)
-> Show FilterRules
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterRules] -> ShowS
$cshowList :: [FilterRules] -> ShowS
show :: FilterRules -> String
$cshow :: FilterRules -> String
showsPrec :: Int -> FilterRules -> ShowS
$cshowsPrec :: Int -> FilterRules -> ShowS
Show, FilterRules -> FilterRules -> Bool
(FilterRules -> FilterRules -> Bool)
-> (FilterRules -> FilterRules -> Bool) -> Eq FilterRules
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 -> Text
frName :: Text,
    FilterRule -> Text
frValue :: Text
  }
  deriving stock (Int -> FilterRule -> ShowS
[FilterRule] -> ShowS
FilterRule -> String
(Int -> FilterRule -> ShowS)
-> (FilterRule -> String)
-> ([FilterRule] -> ShowS)
-> Show FilterRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterRule] -> ShowS
$cshowList :: [FilterRule] -> ShowS
show :: FilterRule -> String
$cshow :: FilterRule -> String
showsPrec :: Int -> FilterRule -> ShowS
$cshowsPrec :: Int -> FilterRule -> ShowS
Show, FilterRule -> FilterRule -> Bool
(FilterRule -> FilterRule -> Bool)
-> (FilterRule -> FilterRule -> Bool) -> Eq FilterRule
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 -> Text
ncId :: Text,
    NotificationConfig -> Text
ncArn :: Arn,
    NotificationConfig -> [Event]
ncEvents :: [Event],
    NotificationConfig -> Filter
ncFilter :: Filter
  }
  deriving stock (Int -> NotificationConfig -> ShowS
[NotificationConfig] -> ShowS
NotificationConfig -> String
(Int -> NotificationConfig -> ShowS)
-> (NotificationConfig -> String)
-> ([NotificationConfig] -> ShowS)
-> Show NotificationConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationConfig] -> ShowS
$cshowList :: [NotificationConfig] -> ShowS
show :: NotificationConfig -> String
$cshow :: NotificationConfig -> String
showsPrec :: Int -> NotificationConfig -> ShowS
$cshowsPrec :: Int -> NotificationConfig -> ShowS
Show, NotificationConfig -> NotificationConfig -> Bool
(NotificationConfig -> NotificationConfig -> Bool)
-> (NotificationConfig -> NotificationConfig -> Bool)
-> Eq NotificationConfig
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 -> ShowS
[Notification] -> ShowS
Notification -> String
(Int -> Notification -> ShowS)
-> (Notification -> String)
-> ([Notification] -> ShowS)
-> Show Notification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Notification] -> ShowS
$cshowList :: [Notification] -> ShowS
show :: Notification -> String
$cshow :: Notification -> String
showsPrec :: Int -> Notification -> ShowS
$cshowsPrec :: Int -> Notification -> ShowS
Show, Notification -> Notification -> Bool
(Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool) -> Eq Notification
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 -> Text
srExpression :: Text,
    SelectRequest -> ExpressionType
srExpressionType :: ExpressionType,
    SelectRequest -> InputSerialization
srInputSerialization :: InputSerialization,
    SelectRequest -> OutputSerialization
srOutputSerialization :: OutputSerialization,
    SelectRequest -> Maybe Bool
srRequestProgressEnabled :: Maybe Bool
  }
  deriving stock (Int -> SelectRequest -> ShowS
[SelectRequest] -> ShowS
SelectRequest -> String
(Int -> SelectRequest -> ShowS)
-> (SelectRequest -> String)
-> ([SelectRequest] -> ShowS)
-> Show SelectRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectRequest] -> ShowS
$cshowList :: [SelectRequest] -> ShowS
show :: SelectRequest -> String
$cshow :: SelectRequest -> String
showsPrec :: Int -> SelectRequest -> ShowS
$cshowsPrec :: Int -> SelectRequest -> ShowS
Show, SelectRequest -> SelectRequest -> Bool
(SelectRequest -> SelectRequest -> Bool)
-> (SelectRequest -> SelectRequest -> Bool) -> Eq SelectRequest
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 -> ShowS
[ExpressionType] -> ShowS
ExpressionType -> String
(Int -> ExpressionType -> ShowS)
-> (ExpressionType -> String)
-> ([ExpressionType] -> ShowS)
-> Show ExpressionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpressionType] -> ShowS
$cshowList :: [ExpressionType] -> ShowS
show :: ExpressionType -> String
$cshow :: ExpressionType -> String
showsPrec :: Int -> ExpressionType -> ShowS
$cshowsPrec :: Int -> ExpressionType -> ShowS
Show, ExpressionType -> ExpressionType -> Bool
(ExpressionType -> ExpressionType -> Bool)
-> (ExpressionType -> ExpressionType -> Bool) -> Eq ExpressionType
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 -> ShowS
[InputSerialization] -> ShowS
InputSerialization -> String
(Int -> InputSerialization -> ShowS)
-> (InputSerialization -> String)
-> ([InputSerialization] -> ShowS)
-> Show InputSerialization
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputSerialization] -> ShowS
$cshowList :: [InputSerialization] -> ShowS
show :: InputSerialization -> String
$cshow :: InputSerialization -> String
showsPrec :: Int -> InputSerialization -> ShowS
$cshowsPrec :: Int -> InputSerialization -> ShowS
Show, InputSerialization -> InputSerialization -> Bool
(InputSerialization -> InputSerialization -> Bool)
-> (InputSerialization -> InputSerialization -> Bool)
-> Eq InputSerialization
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 -> ShowS
[CompressionType] -> ShowS
CompressionType -> String
(Int -> CompressionType -> ShowS)
-> (CompressionType -> String)
-> ([CompressionType] -> ShowS)
-> Show CompressionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressionType] -> ShowS
$cshowList :: [CompressionType] -> ShowS
show :: CompressionType -> String
$cshow :: CompressionType -> String
showsPrec :: Int -> CompressionType -> ShowS
$cshowsPrec :: Int -> CompressionType -> ShowS
Show, CompressionType -> CompressionType -> Bool
(CompressionType -> CompressionType -> Bool)
-> (CompressionType -> CompressionType -> Bool)
-> Eq CompressionType
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 -> ShowS
[InputFormatInfo] -> ShowS
InputFormatInfo -> String
(Int -> InputFormatInfo -> ShowS)
-> (InputFormatInfo -> String)
-> ([InputFormatInfo] -> ShowS)
-> Show InputFormatInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputFormatInfo] -> ShowS
$cshowList :: [InputFormatInfo] -> ShowS
show :: InputFormatInfo -> String
$cshow :: InputFormatInfo -> String
showsPrec :: Int -> InputFormatInfo -> ShowS
$cshowsPrec :: Int -> InputFormatInfo -> ShowS
Show, InputFormatInfo -> InputFormatInfo -> Bool
(InputFormatInfo -> InputFormatInfo -> Bool)
-> (InputFormatInfo -> InputFormatInfo -> Bool)
-> Eq InputFormatInfo
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 Maybe CompressionType
forall a. Maybe a
Nothing (CSVInputProp -> InputFormatInfo
InputFormatCSV CSVInputProp
defaultCSVProp)

-- | linesJsonInput returns InputSerialization with JSON line based
-- format with no compression setting.
linesJsonInput :: InputSerialization
linesJsonInput :: InputSerialization
linesJsonInput =
  Maybe CompressionType -> InputFormatInfo -> InputSerialization
InputSerialization
    Maybe CompressionType
forall a. Maybe a
Nothing
    (JSONInputProp -> InputFormatInfo
InputFormatJSON (JSONInputProp -> InputFormatInfo)
-> JSONInputProp -> InputFormatInfo
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
    Maybe CompressionType
forall a. Maybe a
Nothing
    (JSONInputProp -> InputFormatInfo
InputFormatJSON (JSONInputProp -> InputFormatInfo)
-> JSONInputProp -> InputFormatInfo
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 Maybe CompressionType
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 = CompressionType -> Maybe CompressionType
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 = CSVInputProp -> OutputSerialization
OutputSerializationCSV CSVInputProp
defaultCSVProp

-- | defaultJsonInput returns OutputSerialization with default JSON
-- format.
defaultJsonOutput :: OutputSerialization
defaultJsonOutput :: OutputSerialization
defaultJsonOutput = JSONOutputProp -> OutputSerialization
OutputSerializationJSON (Maybe Text -> JSONOutputProp
JSONOutputProp Maybe Text
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 :: Text -> InputSerialization -> OutputSerialization -> SelectRequest
selectRequest Text
sqlQuery InputSerialization
inputSer OutputSerialization
outputSer =
  SelectRequest :: Text
-> ExpressionType
-> InputSerialization
-> OutputSerialization
-> Maybe Bool
-> SelectRequest
SelectRequest
    { srExpression :: Text
srExpression = Text
sqlQuery,
      srExpressionType :: ExpressionType
srExpressionType = ExpressionType
SQL,
      srInputSerialization :: InputSerialization
srInputSerialization = InputSerialization
inputSer,
      srOutputSerialization :: OutputSerialization
srOutputSerialization = OutputSerialization
outputSer,
      srRequestProgressEnabled :: Maybe Bool
srRequestProgressEnabled = Maybe Bool
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 = Bool -> Maybe Bool
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 -> CSVInputProp -> ShowS
[CSVInputProp] -> ShowS
CSVInputProp -> String
(Int -> CSVInputProp -> ShowS)
-> (CSVInputProp -> String)
-> ([CSVInputProp] -> ShowS)
-> Show CSVInputProp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSVInputProp] -> ShowS
$cshowList :: [CSVInputProp] -> ShowS
show :: CSVInputProp -> String
$cshow :: CSVInputProp -> String
showsPrec :: Int -> CSVInputProp -> ShowS
$cshowsPrec :: Int -> CSVInputProp -> ShowS
Show, CSVInputProp -> CSVInputProp -> Bool
(CSVInputProp -> CSVInputProp -> Bool)
-> (CSVInputProp -> CSVInputProp -> Bool) -> Eq CSVInputProp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSVInputProp -> CSVInputProp -> Bool
$c/= :: CSVInputProp -> CSVInputProp -> Bool
== :: CSVInputProp -> CSVInputProp -> Bool
$c== :: CSVInputProp -> CSVInputProp -> Bool
Eq)

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

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

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

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

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

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

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

-- | Specify the CSV quote-escape character property.
quoteEscapeCharacter :: Text -> CSVProp
quoteEscapeCharacter :: Text -> CSVInputProp
quoteEscapeCharacter = HashMap Text Text -> CSVInputProp
CSVProp (HashMap Text Text -> CSVInputProp)
-> (Text -> HashMap Text Text) -> Text -> CSVInputProp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> HashMap Text Text
forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Text
"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 -> ShowS
[FileHeaderInfo] -> ShowS
FileHeaderInfo -> String
(Int -> FileHeaderInfo -> ShowS)
-> (FileHeaderInfo -> String)
-> ([FileHeaderInfo] -> ShowS)
-> Show FileHeaderInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileHeaderInfo] -> ShowS
$cshowList :: [FileHeaderInfo] -> ShowS
show :: FileHeaderInfo -> String
$cshow :: FileHeaderInfo -> String
showsPrec :: Int -> FileHeaderInfo -> ShowS
$cshowsPrec :: Int -> FileHeaderInfo -> ShowS
Show, FileHeaderInfo -> FileHeaderInfo -> Bool
(FileHeaderInfo -> FileHeaderInfo -> Bool)
-> (FileHeaderInfo -> FileHeaderInfo -> Bool) -> Eq FileHeaderInfo
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 -> CSVInputProp
fileHeaderInfo = HashMap Text Text -> CSVInputProp
CSVProp (HashMap Text Text -> CSVInputProp)
-> (FileHeaderInfo -> HashMap Text Text)
-> FileHeaderInfo
-> CSVInputProp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> HashMap Text Text
forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Text
"FileHeaderInfo" (Text -> HashMap Text Text)
-> (FileHeaderInfo -> Text) -> FileHeaderInfo -> HashMap Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileHeaderInfo -> Text
forall p. IsString p => FileHeaderInfo -> p
toStr
  where
    toStr :: FileHeaderInfo -> p
toStr FileHeaderInfo
FileHeaderNone = p
"NONE"
    toStr FileHeaderInfo
FileHeaderUse = p
"USE"
    toStr FileHeaderInfo
FileHeaderIgnore = p
"IGNORE"

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

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

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

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

newtype JSONInputProp = JSONInputProp {JSONInputProp -> JSONType
jsonipType :: JSONType}
  deriving stock (Int -> JSONInputProp -> ShowS
[JSONInputProp] -> ShowS
JSONInputProp -> String
(Int -> JSONInputProp -> ShowS)
-> (JSONInputProp -> String)
-> ([JSONInputProp] -> ShowS)
-> Show JSONInputProp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONInputProp] -> ShowS
$cshowList :: [JSONInputProp] -> ShowS
show :: JSONInputProp -> String
$cshow :: JSONInputProp -> String
showsPrec :: Int -> JSONInputProp -> ShowS
$cshowsPrec :: Int -> JSONInputProp -> ShowS
Show, JSONInputProp -> JSONInputProp -> Bool
(JSONInputProp -> JSONInputProp -> Bool)
-> (JSONInputProp -> JSONInputProp -> Bool) -> Eq JSONInputProp
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 -> ShowS
[JSONType] -> ShowS
JSONType -> String
(Int -> JSONType -> ShowS)
-> (JSONType -> String) -> ([JSONType] -> ShowS) -> Show JSONType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONType] -> ShowS
$cshowList :: [JSONType] -> ShowS
show :: JSONType -> String
$cshow :: JSONType -> String
showsPrec :: Int -> JSONType -> ShowS
$cshowsPrec :: Int -> JSONType -> ShowS
Show, JSONType -> JSONType -> Bool
(JSONType -> JSONType -> Bool)
-> (JSONType -> JSONType -> Bool) -> Eq JSONType
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 -> ShowS
[OutputSerialization] -> ShowS
OutputSerialization -> String
(Int -> OutputSerialization -> ShowS)
-> (OutputSerialization -> String)
-> ([OutputSerialization] -> ShowS)
-> Show OutputSerialization
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputSerialization] -> ShowS
$cshowList :: [OutputSerialization] -> ShowS
show :: OutputSerialization -> String
$cshow :: OutputSerialization -> String
showsPrec :: Int -> OutputSerialization -> ShowS
$cshowsPrec :: Int -> OutputSerialization -> ShowS
Show, OutputSerialization -> OutputSerialization -> Bool
(OutputSerialization -> OutputSerialization -> Bool)
-> (OutputSerialization -> OutputSerialization -> Bool)
-> Eq OutputSerialization
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 -> CSVInputProp
quoteFields QuoteFields
q = HashMap Text Text -> CSVInputProp
CSVProp (HashMap Text Text -> CSVInputProp)
-> HashMap Text Text -> CSVInputProp
forall a b. (a -> b) -> a -> b
$
  Text -> Text -> HashMap Text Text
forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Text
"QuoteFields" (Text -> HashMap Text Text) -> Text -> HashMap Text Text
forall a b. (a -> b) -> a -> b
$
    case QuoteFields
q of
      QuoteFields
QuoteFieldsAsNeeded -> Text
"ASNEEDED"
      QuoteFields
QuoteFieldsAlways -> Text
"ALWAYS"

-- | Represent the QuoteField setting.
data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
  deriving stock (Int -> QuoteFields -> ShowS
[QuoteFields] -> ShowS
QuoteFields -> String
(Int -> QuoteFields -> ShowS)
-> (QuoteFields -> String)
-> ([QuoteFields] -> ShowS)
-> Show QuoteFields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuoteFields] -> ShowS
$cshowList :: [QuoteFields] -> ShowS
show :: QuoteFields -> String
$cshow :: QuoteFields -> String
showsPrec :: Int -> QuoteFields -> ShowS
$cshowsPrec :: Int -> QuoteFields -> ShowS
Show, QuoteFields -> QuoteFields -> Bool
(QuoteFields -> QuoteFields -> Bool)
-> (QuoteFields -> QuoteFields -> Bool) -> Eq QuoteFields
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 Text
jsonopRecordDelimiter :: Maybe Text}
  deriving stock (Int -> JSONOutputProp -> ShowS
[JSONOutputProp] -> ShowS
JSONOutputProp -> String
(Int -> JSONOutputProp -> ShowS)
-> (JSONOutputProp -> String)
-> ([JSONOutputProp] -> ShowS)
-> Show JSONOutputProp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONOutputProp] -> ShowS
$cshowList :: [JSONOutputProp] -> ShowS
show :: JSONOutputProp -> String
$cshow :: JSONOutputProp -> String
showsPrec :: Int -> JSONOutputProp -> ShowS
$cshowsPrec :: Int -> JSONOutputProp -> ShowS
Show, JSONOutputProp -> JSONOutputProp -> Bool
(JSONOutputProp -> JSONOutputProp -> Bool)
-> (JSONOutputProp -> JSONOutputProp -> Bool) -> Eq JSONOutputProp
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 :: Text -> OutputSerialization
outputJSONFromRecordDelimiter Text
t =
  JSONOutputProp -> OutputSerialization
OutputSerializationJSON (Maybe Text -> JSONOutputProp
JSONOutputProp (Maybe Text -> JSONOutputProp) -> Maybe Text -> JSONOutputProp
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t)

-- Response related types

-- | An EventMessage represents each kind of message received from the server.
data EventMessage
  = ProgressEventMessage {EventMessage -> Progress
emProgress :: Progress}
  | StatsEventMessage {EventMessage -> Progress
emStats :: Stats}
  | RequestLevelErrorMessage
      { EventMessage -> Text
emErrorCode :: Text,
        EventMessage -> Text
emErrorMessage :: Text
      }
  | RecordPayloadEventMessage {EventMessage -> ByteString
emPayloadBytes :: ByteString}
  deriving stock (Int -> EventMessage -> ShowS
[EventMessage] -> ShowS
EventMessage -> String
(Int -> EventMessage -> ShowS)
-> (EventMessage -> String)
-> ([EventMessage] -> ShowS)
-> Show EventMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventMessage] -> ShowS
$cshowList :: [EventMessage] -> ShowS
show :: EventMessage -> String
$cshow :: EventMessage -> String
showsPrec :: Int -> EventMessage -> ShowS
$cshowsPrec :: Int -> EventMessage -> ShowS
Show, EventMessage -> EventMessage -> Bool
(EventMessage -> EventMessage -> Bool)
-> (EventMessage -> EventMessage -> Bool) -> Eq EventMessage
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 -> ShowS
[MsgHeaderName] -> ShowS
MsgHeaderName -> String
(Int -> MsgHeaderName -> ShowS)
-> (MsgHeaderName -> String)
-> ([MsgHeaderName] -> ShowS)
-> Show MsgHeaderName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgHeaderName] -> ShowS
$cshowList :: [MsgHeaderName] -> ShowS
show :: MsgHeaderName -> String
$cshow :: MsgHeaderName -> String
showsPrec :: Int -> MsgHeaderName -> ShowS
$cshowsPrec :: Int -> MsgHeaderName -> ShowS
Show, MsgHeaderName -> MsgHeaderName -> Bool
(MsgHeaderName -> MsgHeaderName -> Bool)
-> (MsgHeaderName -> MsgHeaderName -> Bool) -> Eq MsgHeaderName
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 -> ShowS
[Progress] -> ShowS
Progress -> String
(Int -> Progress -> ShowS)
-> (Progress -> String) -> ([Progress] -> ShowS) -> Show Progress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Progress] -> ShowS
$cshowList :: [Progress] -> ShowS
show :: Progress -> String
$cshow :: Progress -> String
showsPrec :: Int -> Progress -> ShowS
$cshowsPrec :: Int -> Progress -> ShowS
Show, Progress -> Progress -> Bool
(Progress -> Progress -> Bool)
-> (Progress -> Progress -> Bool) -> Eq Progress
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 Text
riBucket :: Maybe Bucket,
    S3ReqInfo -> Maybe Text
riObject :: Maybe Object,
    S3ReqInfo -> Query
riQueryParams :: Query,
    S3ReqInfo -> [Header]
riHeaders :: [Header],
    S3ReqInfo -> Payload
riPayload :: Payload,
    S3ReqInfo -> Maybe ByteString
riPayloadHash :: Maybe ByteString,
    S3ReqInfo -> Maybe Text
riRegion :: Maybe Region,
    S3ReqInfo -> Bool
riNeedsLocation :: Bool,
    S3ReqInfo -> Maybe Int
riPresignExpirySecs :: Maybe UrlExpiry
  }

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

getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
getS3Path :: Maybe Text -> Maybe Text -> ByteString
getS3Path Maybe Text
b Maybe Text
o =
  let segments :: [ByteString]
segments = (Text -> ByteString) -> [Text] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 ([Text] -> [ByteString]) -> [Text] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text] -> [Text]) -> [Maybe Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Maybe Text
b Maybe Text -> [Maybe Text] -> [Maybe Text]
forall a. a -> [a] -> [a]
: [Maybe Text] -> [Maybe Text] -> Bool -> [Maybe Text]
forall a. a -> a -> Bool -> a
bool [] [Maybe Text
o] (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
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
  { Minio a -> ReaderT MinioConn (ResourceT IO) a
unMinio :: ReaderT MinioConn (ResourceT IO) a
  }
  deriving newtype
    ( a -> Minio b -> Minio a
(a -> b) -> Minio a -> Minio b
(forall a b. (a -> b) -> Minio a -> Minio b)
-> (forall a b. a -> Minio b -> Minio a) -> Functor Minio
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
<$ :: a -> Minio b -> Minio a
$c<$ :: forall a b. a -> Minio b -> Minio a
fmap :: (a -> b) -> Minio a -> Minio b
$cfmap :: forall a b. (a -> b) -> Minio a -> Minio b
Functor,
      Functor Minio
a -> Minio a
Functor Minio
-> (forall a. a -> Minio a)
-> (forall a b. Minio (a -> b) -> Minio a -> Minio b)
-> (forall a b c. (a -> b -> c) -> Minio a -> Minio b -> Minio c)
-> (forall a b. Minio a -> Minio b -> Minio b)
-> (forall a b. Minio a -> Minio b -> Minio a)
-> Applicative Minio
Minio a -> Minio b -> Minio b
Minio a -> Minio b -> Minio a
Minio (a -> b) -> Minio a -> Minio b
(a -> b -> c) -> Minio a -> Minio b -> Minio c
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
<* :: Minio a -> Minio b -> Minio a
$c<* :: forall a b. Minio a -> Minio b -> Minio a
*> :: Minio a -> Minio b -> Minio b
$c*> :: forall a b. Minio a -> Minio b -> Minio b
liftA2 :: (a -> b -> c) -> Minio a -> Minio b -> Minio c
$cliftA2 :: forall a b c. (a -> b -> c) -> Minio a -> Minio b -> Minio c
<*> :: Minio (a -> b) -> Minio a -> Minio b
$c<*> :: forall a b. Minio (a -> b) -> Minio a -> Minio b
pure :: a -> Minio a
$cpure :: forall a. a -> Minio a
$cp1Applicative :: Functor Minio
Applicative,
      Applicative Minio
a -> Minio a
Applicative Minio
-> (forall a b. Minio a -> (a -> Minio b) -> Minio b)
-> (forall a b. Minio a -> Minio b -> Minio b)
-> (forall a. a -> Minio a)
-> Monad Minio
Minio a -> (a -> Minio b) -> Minio b
Minio a -> Minio b -> Minio b
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 :: a -> Minio a
$creturn :: forall a. a -> Minio a
>> :: Minio a -> Minio b -> Minio b
$c>> :: forall a b. Minio a -> Minio b -> Minio b
>>= :: Minio a -> (a -> Minio b) -> Minio b
$c>>= :: forall a b. Minio a -> (a -> Minio b) -> Minio b
$cp1Monad :: Applicative Minio
Monad,
      Monad Minio
Monad Minio -> (forall a. IO a -> Minio a) -> MonadIO Minio
IO a -> Minio a
forall a. IO a -> Minio a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Minio a
$cliftIO :: forall a. IO a -> Minio a
$cp1MonadIO :: Monad Minio
MonadIO,
      MonadReader MinioConn,
      MonadIO Minio
MonadIO Minio
-> (forall a. ResourceT IO a -> Minio a) -> MonadResource Minio
ResourceT IO a -> Minio a
forall a. ResourceT IO a -> Minio a
forall (m :: * -> *).
MonadIO m -> (forall a. ResourceT IO a -> m a) -> MonadResource m
liftResourceT :: ResourceT IO a -> Minio a
$cliftResourceT :: forall a. ResourceT IO a -> Minio a
$cp1MonadResource :: MonadIO Minio
MonadResource,
      MonadIO Minio
MonadIO Minio
-> (forall b. ((forall a. Minio a -> IO a) -> IO b) -> Minio b)
-> MonadUnliftIO Minio
((forall a. Minio a -> IO a) -> IO b) -> Minio b
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 a. Minio a -> IO a) -> IO b) -> Minio b
$cwithRunInIO :: forall b. ((forall a. Minio a -> IO a) -> IO b) -> Minio b
$cp1MonadUnliftIO :: MonadIO Minio
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 Text Text)
mcRegionMap :: MVar RegionMap
  }

class HasSvcNamespace env where
  getSvcNamespace :: env -> Text

instance HasSvcNamespace MinioConn where
  getSvcNamespace :: MinioConn -> Text
getSvcNamespace MinioConn
env =
    let host :: Text
host = ConnectInfo -> Text
connectHost (ConnectInfo -> Text) -> ConnectInfo -> Text
forall a b. (a -> b) -> a -> b
$ MinioConn -> ConnectInfo
mcConnInfo MinioConn
env
     in ( if Text
host Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"storage.googleapis.com"
            then Text
"http://doc.s3.amazonaws.com/2006-03-01"
            else Text
"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 Maybe SockSettings
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 :: MinioConn -> Minio a -> IO (Either MinioErr a)
runMinioWith MinioConn
conn Minio a
m = ResourceT IO (Either MinioErr a) -> IO (Either MinioErr a)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (Either MinioErr a) -> IO (Either MinioErr a))
-> ResourceT IO (Either MinioErr a) -> IO (Either MinioErr a)
forall a b. (a -> b) -> a -> b
$ MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
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 Text Text)
rMapMVar <- HashMap Text Text -> IO (MVar (HashMap Text Text))
forall a. a -> IO (MVar a)
M.newMVar HashMap Text Text
forall k v. HashMap k v
H.empty
  MinioConn -> IO MinioConn
forall (m :: * -> *) a. Monad m => a -> m a
return (MinioConn -> IO MinioConn) -> MinioConn -> IO MinioConn
forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Manager -> MVar (HashMap Text Text) -> MinioConn
MinioConn ConnectInfo
ci Manager
mgr MVar (HashMap Text Text)
rMapMVar

-- | Run the Minio action and return the result or an error.
runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
runMinio ConnectInfo
ci Minio a
m = do
  MinioConn
conn <- ConnectInfo -> IO MinioConn
connect ConnectInfo
ci
  ResourceT IO (Either MinioErr a) -> IO (Either MinioErr a)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (Either MinioErr a) -> IO (Either MinioErr a))
-> ResourceT IO (Either MinioErr a) -> IO (Either MinioErr a)
forall a b. (a -> b) -> a -> b
$ MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
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 :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
runMinioResWith MinioConn
conn Minio a
m =
  (ReaderT MinioConn (ResourceT IO) (Either MinioErr a)
 -> MinioConn -> ResourceT IO (Either MinioErr a))
-> MinioConn
-> ReaderT MinioConn (ResourceT IO) (Either MinioErr a)
-> ResourceT IO (Either MinioErr a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT MinioConn (ResourceT IO) (Either MinioErr a)
-> MinioConn -> ResourceT IO (Either MinioErr a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT MinioConn
conn (ReaderT MinioConn (ResourceT IO) (Either MinioErr a)
 -> ResourceT IO (Either MinioErr a))
-> (Minio (Either MinioErr a)
    -> ReaderT MinioConn (ResourceT IO) (Either MinioErr a))
-> Minio (Either MinioErr a)
-> ResourceT IO (Either MinioErr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Minio (Either MinioErr a)
-> ReaderT MinioConn (ResourceT IO) (Either MinioErr a)
forall a. Minio a -> ReaderT MinioConn (ResourceT IO) a
unMinio (Minio (Either MinioErr a) -> ResourceT IO (Either MinioErr a))
-> Minio (Either MinioErr a) -> ResourceT IO (Either MinioErr a)
forall a b. (a -> b) -> a -> b
$
    (a -> Either MinioErr a) -> Minio a -> Minio (Either MinioErr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either MinioErr a
forall a b. b -> Either a b
Right Minio a
m
      Minio (Either MinioErr a)
-> [Handler Minio (Either MinioErr a)] -> Minio (Either MinioErr a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
`U.catches` [ (ServiceErr -> Minio (Either MinioErr a))
-> Handler Minio (Either MinioErr a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
U.Handler ServiceErr -> Minio (Either MinioErr a)
forall b. ServiceErr -> Minio (Either MinioErr b)
handlerServiceErr,
                    (HttpException -> Minio (Either MinioErr a))
-> Handler Minio (Either MinioErr a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
U.Handler HttpException -> Minio (Either MinioErr a)
forall b. HttpException -> Minio (Either MinioErr b)
handlerHE,
                    (IOException -> Minio (Either MinioErr a))
-> Handler Minio (Either MinioErr a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
U.Handler IOException -> Minio (Either MinioErr a)
forall b. IOException -> Minio (Either MinioErr b)
handlerFE,
                    (MErrV -> Minio (Either MinioErr a))
-> Handler Minio (Either MinioErr a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
U.Handler MErrV -> Minio (Either MinioErr a)
forall b. MErrV -> Minio (Either MinioErr b)
handlerValidation
                  ]
  where
    handlerServiceErr :: ServiceErr -> Minio (Either MinioErr b)
handlerServiceErr = Either MinioErr b -> Minio (Either MinioErr b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MinioErr b -> Minio (Either MinioErr b))
-> (ServiceErr -> Either MinioErr b)
-> ServiceErr
-> Minio (Either MinioErr b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinioErr -> Either MinioErr b
forall a b. a -> Either a b
Left (MinioErr -> Either MinioErr b)
-> (ServiceErr -> MinioErr) -> ServiceErr -> Either MinioErr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceErr -> MinioErr
MErrService
    handlerHE :: HttpException -> Minio (Either MinioErr b)
handlerHE = Either MinioErr b -> Minio (Either MinioErr b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MinioErr b -> Minio (Either MinioErr b))
-> (HttpException -> Either MinioErr b)
-> HttpException
-> Minio (Either MinioErr b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinioErr -> Either MinioErr b
forall a b. a -> Either a b
Left (MinioErr -> Either MinioErr b)
-> (HttpException -> MinioErr)
-> HttpException
-> Either MinioErr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> MinioErr
MErrHTTP
    handlerFE :: IOException -> Minio (Either MinioErr b)
handlerFE = Either MinioErr b -> Minio (Either MinioErr b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MinioErr b -> Minio (Either MinioErr b))
-> (IOException -> Either MinioErr b)
-> IOException
-> Minio (Either MinioErr b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinioErr -> Either MinioErr b
forall a b. a -> Either a b
Left (MinioErr -> Either MinioErr b)
-> (IOException -> MinioErr) -> IOException -> Either MinioErr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> MinioErr
MErrIO
    handlerValidation :: MErrV -> Minio (Either MinioErr b)
handlerValidation = Either MinioErr b -> Minio (Either MinioErr b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MinioErr b -> Minio (Either MinioErr b))
-> (MErrV -> Either MinioErr b)
-> MErrV
-> Minio (Either MinioErr b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinioErr -> Either MinioErr b
forall a b. a -> Either a b
Left (MinioErr -> Either MinioErr b)
-> (MErrV -> MinioErr) -> MErrV -> Either MinioErr b
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 :: ConnectInfo -> Minio a -> ResourceT IO (Either MinioErr a)
runMinioRes ConnectInfo
ci Minio a
m = do
  MinioConn
conn <- IO MinioConn -> ResourceT IO MinioConn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MinioConn -> ResourceT IO MinioConn)
-> IO MinioConn -> ResourceT IO MinioConn
forall a b. (a -> b) -> a -> b
$ ConnectInfo -> IO MinioConn
connect ConnectInfo
ci
  MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
forall a. MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
runMinioResWith MinioConn
conn Minio a
m

s3Name :: Text -> Text -> Name
s3Name :: Text -> Text -> Name
s3Name Text
ns Text
s = Text -> Maybe Text -> Maybe Text -> Name
Name Text
s (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ns) Maybe Text
forall a. Maybe a
Nothing

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