content: --
  -- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
  --
  -- Licensed under the Apache License, Version 2.0 (the "License");
  -- you may not use this file except in compliance with the License.
  -- You may obtain a copy of the License at
  --
  --     http://www.apache.org/licenses/LICENSE-2.0
  --
  -- Unless required by applicable law or agreed to in writing, software
  -- distributed under the License is distributed on an "AS IS" BASIS,
  -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  -- See the License for the specific language governing permissions and
  -- limitations under the License.
  --
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE StrictData #-}
  {-# LANGUAGE TypeFamilies #-}
  
  module Network.Minio.Data where
  
  import qualified Conduit as C
  import qualified Control.Concurrent.MVar as M
  import Control.Monad.Trans.Except (throwE)
  import Control.Monad.Trans.Resource
    ( MonadResource,
      MonadThrow (..),
      MonadUnliftIO,
      ResourceT,
      runResourceT,
    )
  import qualified Data.Aeson as A
  import qualified Data.ByteArray as BA
  import qualified Data.ByteString as B
  import qualified Data.ByteString.Lazy as LB
  import Data.Default.Class (def)
  import qualified Data.HashMap.Strict as H
  import qualified Data.Ini as Ini
  import qualified Data.List as List
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as TE
  import Data.Time (defaultTimeLocale, formatTime)
  import Lib.Prelude (UTCTime, throwIO)
  import qualified Network.Connection as Conn
  import Network.HTTP.Client (defaultManagerSettings)
  import qualified Network.HTTP.Client.TLS as TLS
  import qualified Network.HTTP.Conduit as NC
  import Network.HTTP.Types
    ( ByteRange,
      Header,
      Method,
      Query,
      hRange,
    )
  import qualified Network.HTTP.Types as HT
  import Network.Minio.Credentials
  import Network.Minio.Data.Crypto
    ( encodeToBase64,
      hashMD5ToBase64,
    )
  import Network.Minio.Data.Time (UrlExpiry)
  import Network.Minio.Errors
    ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials),
      MinioErr (..),
    )
  import Network.Minio.Utils
  import System.Directory (doesFileExist, getHomeDirectory)
  import qualified System.Environment as Env
  import System.FilePath.Posix (combine)
  import qualified UnliftIO as U
  import qualified UnliftIO.MVar as UM
  
  -- | max obj size is 5TiB
  maxObjectSize :: Int64
  maxObjectSize = 5 * 1024 * 1024 * oneMiB
  
  -- | minimum size of parts used in multipart operations.
  minPartSize :: Int64
  minPartSize = 64 * oneMiB
  
  oneMiB :: Int64
  oneMiB = 1024 * 1024
  
  -- | maximum number of parts that can be uploaded for a single object.
  maxMultipartParts :: Int64
  maxMultipartParts = 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 =
    H.fromList
      [ ("us-east-1", "s3.us-east-1.amazonaws.com"),
        ("us-east-2", "s3.us-east-2.amazonaws.com"),
        ("us-west-1", "s3.us-west-1.amazonaws.com"),
        ("us-west-2", "s3.us-west-2.amazonaws.com"),
        ("ca-central-1", "s3.ca-central-1.amazonaws.com"),
        ("ap-south-1", "s3.ap-south-1.amazonaws.com"),
        ("ap-south-2", "s3.ap-south-2.amazonaws.com"),
        ("ap-northeast-1", "s3.ap-northeast-1.amazonaws.com"),
        ("ap-northeast-2", "s3.ap-northeast-2.amazonaws.com"),
        ("ap-northeast-3", "s3.ap-northeast-3.amazonaws.com"),
        ("ap-southeast-1", "s3.ap-southeast-1.amazonaws.com"),
        ("ap-southeast-2", "s3.ap-southeast-2.amazonaws.com"),
        ("ap-southeast-3", "s3.ap-southeast-3.amazonaws.com"),
        ("eu-west-1", "s3.eu-west-1.amazonaws.com"),
        ("eu-west-2", "s3.eu-west-2.amazonaws.com"),
        ("eu-west-3", "s3.eu-west-3.amazonaws.com"),
        ("eu-central-1", "s3.eu-central-1.amazonaws.com"),
        ("eu-central-2", "s3.eu-central-2.amazonaws.com"),
        ("eu-south-1", "s3.eu-south-1.amazonaws.com"),
        ("eu-south-2", "s3.eu-south-2.amazonaws.com"),
        ("af-south-1", "s3.af-south-1.amazonaws.com"),
        ("ap-east-1", "s3.ap-east-1.amazonaws.com"),
        ("cn-north-1", "s3.cn-north-1.amazonaws.com.cn"),
        ("cn-northwest-1", "s3.cn-northwest-1.amazonaws.com.cn"),
        ("eu-north-1", "s3.eu-north-1.amazonaws.com"),
        ("me-south-1", "s3.me-south-1.amazonaws.com"),
        ("me-central-1", "s3.me-central-1.amazonaws.com"),
        ("us-gov-east-1", "s3.us-gov-east-1.amazonaws.com"),
        ("us-gov-west-1", "s3.us-gov-west-1.amazonaws.com"),
        ("sa-east-1", "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
    { connectHost :: Text,
      connectPort :: Int,
      connectCreds :: Creds,
      connectIsSecure :: Bool,
      connectRegion :: Region,
      connectAutoDiscoverRegion :: Bool,
      connectDisableTLSCertValidation :: Bool
    }
  
  getEndpoint :: ConnectInfo -> Endpoint
  getEndpoint ci = (encodeUtf8 $ connectHost ci, connectPort ci, connectIsSecure ci)
  
  instance IsString ConnectInfo where
    fromString str =
      let req = NC.parseRequest_ str
       in ConnectInfo
            { connectHost = TE.decodeUtf8 $ NC.host req,
              connectPort = NC.port req,
              connectCreds = CredsStatic $ CredentialValue mempty mempty mempty,
              connectIsSecure = NC.secure req,
              connectRegion = "",
              connectAutoDiscoverRegion = True,
              connectDisableTLSCertValidation = False
            }
  
  -- | A 'CredentialLoader' is an action that may return a 'CredentialValue'.
  -- Loaders may be chained together using 'findFirst'.
  --
  -- @since 1.7.0
  type CredentialLoader = IO (Maybe CredentialValue)
  
  -- | Combines the given list of loaders, by calling each one in
  -- order until a 'CredentialValue' is returned.
  findFirst :: [CredentialLoader] -> IO (Maybe CredentialValue)
  findFirst [] = return Nothing
  findFirst (f : fs) = do
    c <- f
    maybe (findFirst fs) (return . Just) c
  
  -- | This action returns a 'CredentialValue' populated from
  -- @~\/.aws\/credentials@
  fromAWSConfigFile :: CredentialLoader
  fromAWSConfigFile = do
    credsE <- runExceptT $ do
      homeDir <- lift getHomeDirectory
      let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials"
      fileExists <- lift $ doesFileExist awsCredsFile
      bool (throwE "FileNotFound") (return ()) fileExists
      ini <- ExceptT $ Ini.readIniFile awsCredsFile
      akey <-
        ExceptT $
          return $
            Ini.lookupValue "default" "aws_access_key_id" ini
      skey <-
        ExceptT $
          return $
            Ini.lookupValue "default" "aws_secret_access_key" ini
      return $ CredentialValue (coerce akey) (fromString $ T.unpack skey) Nothing
    return $ either (const Nothing) Just credsE
  
  -- | This action returns a 'CredentialValue` populated from @AWS_ACCESS_KEY_ID@
  -- and @AWS_SECRET_ACCESS_KEY@ environment variables.
  fromAWSEnv :: CredentialLoader
  fromAWSEnv = runMaybeT $ do
    akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
    skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
    return $ CredentialValue (fromString akey) (fromString skey) Nothing
  
  -- | This action returns a 'CredentialValue' populated from @MINIO_ACCESS_KEY@
  -- and @MINIO_SECRET_KEY@ environment variables.
  fromMinioEnv :: CredentialLoader
  fromMinioEnv = runMaybeT $ do
    akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
    skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
    return $ CredentialValue (fromString akey) (fromString skey) Nothing
  
  -- | setCredsFrom retrieves access credentials from the first action in the
  -- given list that succeeds and sets it in the 'ConnectInfo'.
  setCredsFrom :: [CredentialLoader] -> ConnectInfo -> IO ConnectInfo
  setCredsFrom ps ci = do
    pMay <- findFirst ps
    maybe
      (throwIO MErrVMissingCredentials)
      (return . (`setCreds` ci))
      pMay
  
  -- | setCreds sets the given `CredentialValue` in the `ConnectInfo`.
  setCreds :: CredentialValue -> ConnectInfo -> ConnectInfo
  setCreds cv connInfo =
    connInfo
      { connectCreds = CredsStatic cv
      }
  
  -- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
  -- credentials via the STS API on demand. It is automatically refreshed on
  -- expiry.
  setSTSCredential :: (STSCredentialProvider p) => p -> ConnectInfo -> IO ConnectInfo
  setSTSCredential p ci = do
    store <- initSTSCredential p
    return ci {connectCreds = CredsSTS store}
  
  -- | Set the S3 region parameter in the `ConnectInfo`
  setRegion :: Region -> ConnectInfo -> ConnectInfo
  setRegion r connInfo =
    connInfo
      { connectRegion = r,
        connectAutoDiscoverRegion = False
      }
  
  -- | Check if the connection to object storage server is secure
  -- (i.e. uses TLS)
  isConnectInfoSecure :: ConnectInfo -> Bool
  isConnectInfoSecure = 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 c = c {connectDisableTLSCertValidation = True}
  
  getHostAddr :: ConnectInfo -> ByteString
  getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort 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 =
    setRegion
      "us"
      "https://storage.googleapis.com"
  
  -- | Default AWS S3 ConnectInfo. Connects to "us-east-1". Credentials
  -- should be supplied before use.
  awsCI :: ConnectInfo
  awsCI = "https://s3.amazonaws.com"
  
  -- | <https://play.min.io MinIO Play Server>
  -- ConnectInfo. Credentials are already filled in.
  minioPlayCI :: ConnectInfo
  minioPlayCI =
    let playCreds = CredentialValue "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG" Nothing
     in setCreds playCreds $
          setRegion
            "us-east-1"
            "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 (Eq, Show)
  
  -- | Validates that the given ByteString is 32 bytes long and creates
  -- an encryption key.
  mkSSECKey :: (MonadThrow m) => ByteString -> m SSECKey
  mkSSECKey keyBytes
    | B.length keyBytes /= 32 =
        throwM MErrVInvalidEncryptionKeyLength
    | otherwise =
        return $ SSECKey $ BA.convert 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 sseArg =
    let sseHeader = "x-amz-server-side-encryption"
        sseKmsIdHeader = sseHeader <> "-aws-kms-key-id"
        sseKmsContextHeader = sseHeader <> "-context"
        ssecAlgo = sseHeader <> "-customer-algorithm"
        ssecKey = sseHeader <> "-customer-key"
        ssecKeyMD5 = ssecKey <> "-MD5"
     in case sseArg of
          SSE -> [(sseHeader, "AES256")]
          SSEKMS keyIdMay ctxMay ->
            [(sseHeader, "aws:kms")]
              ++ maybe [] (\k -> [(sseKmsIdHeader, k)]) keyIdMay
              ++ maybe [] (\k -> [(sseKmsContextHeader, LB.toStrict $ A.encode k)]) ctxMay
          SSEC (SSECKey sb) ->
            [ (ssecAlgo, "AES256"),
              (ssecKey, encodeToBase64 sb),
              (ssecKeyMD5, hashMD5ToBase64 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.
      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.
      pooContentEncoding :: Maybe Text,
      -- | Set presentational information for the object.
      pooContentDisposition :: Maybe Text,
      -- | Set to specify caching behavior for the object along the
      -- request/reply chain.
      pooCacheControl :: Maybe Text,
      -- | Set to describe the language(s) intended for the audience.
      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).
      pooStorageClass :: Maybe Text,
      -- | Set user defined metadata to store with the object.
      pooUserMetadata :: [(Text, Text)],
      -- | Set number of worker threads used to upload an object.
      pooNumThreads :: Maybe Word,
      -- | Set object encryption parameters for the request.
      pooSSE :: Maybe SSE
    }
  
  -- | Provide default `PutObjectOptions`.
  defaultPutObjectOptions :: PutObjectOptions
  defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing
  
  pooToHeaders :: PutObjectOptions -> [HT.Header]
  pooToHeaders poo =
    userMetadata
      ++ mapMaybe tupToMaybe (zip names values)
      ++ maybe [] toPutObjectHeaders (pooSSE poo)
    where
      tupToMaybe (k, Just v) = Just (k, v)
      tupToMaybe (_, Nothing) = Nothing
      userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo
      names =
        [ "content-type",
          "content-encoding",
          "content-disposition",
          "content-language",
          "cache-control",
          "x-amz-storage-class"
        ]
      values =
        map
          (fmap encodeUtf8 . (poo &))
          [ pooContentType,
            pooContentEncoding,
            pooContentDisposition,
            pooContentLanguage,
            pooCacheControl,
            pooStorageClass
          ]
  
  -- |
  -- BucketInfo returned for list buckets call
  data BucketInfo = BucketInfo
    { biName :: Bucket,
      biCreationDate :: UTCTime
    }
    deriving stock (Show, Eq)
  
  -- | A type alias to represent a part-number for multipart upload
  type PartNumber = Int16
  
  -- | Select part sizes - the logic is that the minimum part-size will
  -- be 64MiB.
  selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
  selectPartSizes size =
    uncurry (List.zip3 [1 ..]) $
      List.unzip $
        loop 0 size
    where
      ceil :: Double -> Int64
      ceil = ceiling
      partSize =
        max
          minPartSize
          ( ceil $
              fromIntegral size
                / fromIntegral maxMultipartParts
          )
      m = partSize
      loop st sz
        | st > sz = []
        | st + m >= sz = [(st, sz - st)]
        | otherwise = (st, m) : loop (st + m) sz
  
  -- | A type alias to represent an upload-id for multipart upload
  type UploadId = Text
  
  -- | A type to represent a part-number and etag.
  type PartTuple = (PartNumber, ETag)
  
  -- | Represents result from a listing of object parts of an ongoing
  -- multipart upload.
  data ListPartsResult = ListPartsResult
    { lprHasMore :: Bool,
      lprNextPart :: Maybe Int,
      lprParts :: [ObjectPartInfo]
    }
    deriving stock (Show, Eq)
  
  -- | Represents information about an object part in an ongoing
  -- multipart upload.
  data ObjectPartInfo = ObjectPartInfo
    { opiNumber :: PartNumber,
      opiETag :: ETag,
      opiSize :: Int64,
      opiModTime :: UTCTime
    }
    deriving stock (Show, Eq)
  
  -- | Represents result from a listing of incomplete uploads to a
  -- bucket.
  data ListUploadsResult = ListUploadsResult
    { lurHasMore :: Bool,
      lurNextKey :: Maybe Text,
      lurNextUpload :: Maybe Text,
      lurUploads :: [(Object, UploadId, UTCTime)],
      lurCPrefixes :: [Text]
    }
    deriving stock (Show, Eq)
  
  -- | Represents information about a multipart upload.
  data UploadInfo = UploadInfo
    { uiKey :: Object,
      uiUploadId :: UploadId,
      uiInitTime :: UTCTime,
      uiSize :: Int64
    }
    deriving stock (Show, Eq)
  
  -- | Represents result from a listing of objects in a bucket.
  data ListObjectsResult = ListObjectsResult
    { lorHasMore :: Bool,
      lorNextToken :: Maybe Text,
      lorObjects :: [ObjectInfo],
      lorCPrefixes :: [Text]
    }
    deriving stock (Show, Eq)
  
  -- | Represents result from a listing of objects version 1 in a bucket.
  data ListObjectsV1Result = ListObjectsV1Result
    { lorHasMore' :: Bool,
      lorNextMarker :: Maybe Text,
      lorObjects' :: [ObjectInfo],
      lorCPrefixes' :: [Text]
    }
    deriving stock (Show, Eq)
  
  -- | Represents information about an object.
  data ObjectInfo = ObjectInfo
    { -- | Object key
      oiObject :: Object,
      -- | Modification time of the object
      oiModTime :: UTCTime,
      -- | ETag of the object
      oiETag :: ETag,
      -- | Size of the object in bytes
      oiSize :: Int64,
      -- | A map of user-metadata
      -- pairs stored with an
      -- object (keys will not
      -- have the @X-Amz-Meta-@
      -- prefix).
      oiUserMetadata :: H.HashMap Text Text,
      -- | A map of metadata
      -- key-value pairs (not
      -- including the
      -- user-metadata pairs)
      oiMetadata :: H.HashMap Text Text
    }
    deriving stock (Show, Eq)
  
  -- | Represents source object in server-side copy object
  data SourceInfo = SourceInfo
    { -- | Bucket containing the source object
      srcBucket :: Text,
      -- | Source object key
      srcObject :: Text,
      -- | Source object
      -- byte-range
      -- (inclusive)
      srcRange :: Maybe (Int64, Int64),
      -- | ETag condition on source -
      -- object is copied only if the
      -- source object's ETag matches
      -- this value.
      srcIfMatch :: Maybe Text,
      -- | ETag not match condition
      -- on source - object is copied
      -- if ETag does not match this
      -- value.
      srcIfNoneMatch :: Maybe Text,
      -- | Copy source object only
      -- if the source has been
      -- modified since this time.
      srcIfModifiedSince :: Maybe UTCTime,
      -- | Copy source object only
      -- if the source has been
      -- un-modified since this
      -- given time.
      srcIfUnmodifiedSince :: Maybe UTCTime
    }
    deriving stock (Show, Eq)
  
  -- | Provide a default for `SourceInfo`
  defaultSourceInfo :: SourceInfo
  defaultSourceInfo = SourceInfo "" "" Nothing Nothing Nothing Nothing Nothing
  
  -- | Represents destination object in server-side copy object
  data DestinationInfo = DestinationInfo
    { -- | Destination bucket
      dstBucket :: Text,
      -- | Destination object key
      dstObject :: Text
    }
    deriving stock (Show, Eq)
  
  -- | Provide a default for `DestinationInfo`
  defaultDestinationInfo :: DestinationInfo
  defaultDestinationInfo = DestinationInfo "" ""
  
  -- | 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.
      gooRange :: Maybe ByteRange,
      -- | Set matching ETag condition, GetObject which matches the following
      -- ETag.
      gooIfMatch :: Maybe ETag,
      -- | Set matching ETag none condition, GetObject which does not match
      -- the following ETag.
      gooIfNoneMatch :: Maybe ETag,
      -- | Set object unmodified condition, GetObject unmodified since given time.
      gooIfUnmodifiedSince :: Maybe UTCTime,
      -- | Set object modified condition, GetObject modified since given time.
      gooIfModifiedSince :: Maybe UTCTime,
      -- | Specify SSE-C key
      gooSSECKey :: Maybe SSECKey
    }
  
  -- | Provide default  `GetObjectOptions`.
  defaultGetObjectOptions :: GetObjectOptions
  defaultGetObjectOptions =
    GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
  
  gooToHeaders :: GetObjectOptions -> [HT.Header]
  gooToHeaders goo =
    rangeHdr
      ++ zip names values
      ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
    where
      names =
        [ "If-Match",
          "If-None-Match",
          "If-Unmodified-Since",
          "If-Modified-Since"
        ]
      values =
        mapMaybe
          (fmap encodeUtf8 . (goo &))
          [ gooIfMatch,
            gooIfNoneMatch,
            fmap formatRFC1123 . gooIfUnmodifiedSince,
            fmap formatRFC1123 . gooIfModifiedSince
          ]
      rangeHdr =
        maybe [] (\a -> [(hRange, HT.renderByteRanges [a])]) $
          gooRange 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.
      gorObjectInfo :: ObjectInfo,
      -- | A conduit of the bytes of the object.
      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 (Eq, Show)
  
  instance ToText Event where
    toText ObjectCreated = "s3:ObjectCreated:*"
    toText ObjectCreatedPut = "s3:ObjectCreated:Put"
    toText ObjectCreatedPost = "s3:ObjectCreated:Post"
    toText ObjectCreatedCopy = "s3:ObjectCreated:Copy"
    toText ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
    toText ObjectRemoved = "s3:ObjectRemoved:*"
    toText ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
    toText ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
    toText ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
  
  textToEvent :: Text -> Maybe Event
  textToEvent t = case t of
    "s3:ObjectCreated:*" -> Just ObjectCreated
    "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
    "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
    "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
    "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
    "s3:ObjectRemoved:*" -> Just ObjectRemoved
    "s3:ObjectRemoved:Delete" -> Just ObjectRemovedDelete
    "s3:ObjectRemoved:DeleteMarkerCreated" -> Just ObjectRemovedDeleteMarkerCreated
    "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
    _ -> Nothing
  
  -- | Filter data type - part of notification configuration
  newtype Filter = Filter
    { fFilter :: FilterKey
    }
    deriving stock (Show, Eq)
  
  -- | defaultFilter is empty, used to create a notification
  -- configuration.
  defaultFilter :: Filter
  defaultFilter = Filter defaultFilterKey
  
  -- | FilterKey contains FilterRules, and is part of a Filter.
  newtype FilterKey = FilterKey
    { fkKey :: FilterRules
    }
    deriving stock (Show, Eq)
  
  -- | defaultFilterKey is empty, used to create notification
  -- configuration.
  defaultFilterKey :: FilterKey
  defaultFilterKey = FilterKey defaultFilterRules
  
  -- | FilterRules represents a collection of `FilterRule`s.
  newtype FilterRules = FilterRules
    { frFilterRules :: [FilterRule]
    }
    deriving stock (Show, Eq)
  
  -- | defaultFilterRules is empty, used to create notification
  -- configuration.
  defaultFilterRules :: FilterRules
  defaultFilterRules = 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
    { frName :: Text,
      frValue :: Text
    }
    deriving stock (Show, 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
    { ncId :: Text,
      ncArn :: Arn,
      ncEvents :: [Event],
      ncFilter :: Filter
    }
    deriving stock (Show, 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
    { nQueueConfigurations :: [NotificationConfig],
      nTopicConfigurations :: [NotificationConfig],
      nCloudFunctionConfigurations :: [NotificationConfig]
    }
    deriving stock (Show, Eq)
  
  -- | The default notification configuration is empty.
  defaultNotification :: Notification
  defaultNotification = 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
    { srExpression :: Text,
      srExpressionType :: ExpressionType,
      srInputSerialization :: InputSerialization,
      srOutputSerialization :: OutputSerialization,
      srRequestProgressEnabled :: Maybe Bool
    }
    deriving stock (Show, Eq)
  
  data ExpressionType = SQL
    deriving stock (Show, 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
    { isCompressionType :: Maybe CompressionType,
      isFormatInfo :: InputFormatInfo
    }
    deriving stock (Show, Eq)
  
  -- | Data type representing the compression setting in a Select
  -- request.
  data CompressionType
    = CompressionTypeNone
    | CompressionTypeGzip
    | CompressionTypeBzip2
    deriving stock (Show, Eq)
  
  -- | Data type representing input object format information in a
  -- Select request.
  data InputFormatInfo
    = InputFormatCSV CSVInputProp
    | InputFormatJSON JSONInputProp
    | InputFormatParquet
    deriving stock (Show, Eq)
  
  -- | defaultCsvInput returns InputSerialization with default CSV
  -- format, and without any compression setting.
  defaultCsvInput :: InputSerialization
  defaultCsvInput = InputSerialization Nothing (InputFormatCSV defaultCSVProp)
  
  -- | linesJsonInput returns InputSerialization with JSON line based
  -- format with no compression setting.
  linesJsonInput :: InputSerialization
  linesJsonInput =
    InputSerialization
      Nothing
      (InputFormatJSON $ JSONInputProp JSONTypeLines)
  
  -- | documentJsonInput returns InputSerialization with JSON document
  -- based format with no compression setting.
  documentJsonInput :: InputSerialization
  documentJsonInput =
    InputSerialization
      Nothing
      (InputFormatJSON $ JSONInputProp JSONTypeDocument)
  
  -- | defaultParquetInput returns InputSerialization with Parquet
  -- format, and no compression setting.
  defaultParquetInput :: InputSerialization
  defaultParquetInput = InputSerialization Nothing InputFormatParquet
  
  -- | setInputCompressionType sets the compression type for the input
  -- of the SelectRequest
  setInputCompressionType ::
    CompressionType ->
    SelectRequest ->
    SelectRequest
  setInputCompressionType c i =
    let is = srInputSerialization i
        is' = is {isCompressionType = Just c}
     in i {srInputSerialization = is'}
  
  -- | defaultCsvOutput returns OutputSerialization with default CSV
  -- format.
  defaultCsvOutput :: OutputSerialization
  defaultCsvOutput = OutputSerializationCSV defaultCSVProp
  
  -- | defaultJsonInput returns OutputSerialization with default JSON
  -- format.
  defaultJsonOutput :: OutputSerialization
  defaultJsonOutput = OutputSerializationJSON (JSONOutputProp 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 sqlQuery inputSer outputSer =
    SelectRequest
      { srExpression = sqlQuery,
        srExpressionType = SQL,
        srInputSerialization = inputSer,
        srOutputSerialization = outputSer,
        srRequestProgressEnabled = 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 enabled sr =
    sr {srRequestProgressEnabled = Just 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 (Show, Eq)
  
  instance Semigroup CSVProp where
    (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
  
  instance Monoid CSVProp where
    mempty = CSVProp mempty
  
  csvPropsList :: CSVProp -> [(Text, Text)]
  csvPropsList (CSVProp h) = sort $ H.toList h
  
  defaultCSVProp :: CSVProp
  defaultCSVProp = mempty
  
  -- | Specify the CSV record delimiter property.
  recordDelimiter :: Text -> CSVProp
  recordDelimiter = CSVProp . H.singleton "RecordDelimiter"
  
  -- | Specify the CSV field delimiter property.
  fieldDelimiter :: Text -> CSVProp
  fieldDelimiter = CSVProp . H.singleton "FieldDelimiter"
  
  -- | Specify the CSV quote character property.
  quoteCharacter :: Text -> CSVProp
  quoteCharacter = CSVProp . H.singleton "QuoteCharacter"
  
  -- | Specify the CSV quote-escape character property.
  quoteEscapeCharacter :: Text -> CSVProp
  quoteEscapeCharacter = CSVProp . H.singleton "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 (Show, Eq)
  
  -- | Specify the CSV file header info property.
  fileHeaderInfo :: FileHeaderInfo -> CSVProp
  fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toStr
    where
      toStr FileHeaderNone = "NONE"
      toStr FileHeaderUse = "USE"
      toStr FileHeaderIgnore = "IGNORE"
  
  -- | Specify the CSV comment character property. Lines starting with
  -- this character are ignored by the server.
  commentCharacter :: Text -> CSVProp
  commentCharacter = CSVProp . H.singleton "Comments"
  
  -- | Allow quoted record delimiters inside a row using this property.
  allowQuotedRecordDelimiter :: CSVProp
  allowQuotedRecordDelimiter = CSVProp $ H.singleton "AllowQuotedRecordDelimiter" "TRUE"
  
  -- | Set the CSV format properties in the InputSerialization.
  setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization
  setInputCSVProps p is = is {isFormatInfo = InputFormatCSV p}
  
  -- | Set the CSV format properties in the OutputSerialization.
  outputCSVFromProps :: CSVProp -> OutputSerialization
  outputCSVFromProps = OutputSerializationCSV
  
  newtype JSONInputProp = JSONInputProp {jsonipType :: JSONType}
    deriving stock (Show, Eq)
  
  data JSONType = JSONTypeDocument | JSONTypeLines
    deriving stock (Show, 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 (Show, Eq)
  
  type CSVOutputProp = CSVProp
  
  -- | quoteFields is an output serialization parameter
  quoteFields :: QuoteFields -> CSVProp
  quoteFields q = CSVProp $
    H.singleton "QuoteFields" $
      case q of
        QuoteFieldsAsNeeded -> "ASNEEDED"
        QuoteFieldsAlways -> "ALWAYS"
  
  -- | Represent the QuoteField setting.
  data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
    deriving stock (Show, Eq)
  
  newtype JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
    deriving stock (Show, Eq)
  
  -- | Set the output record delimiter for JSON format
  outputJSONFromRecordDelimiter :: Text -> OutputSerialization
  outputJSONFromRecordDelimiter t =
    OutputSerializationJSON (JSONOutputProp $ Just t)
  
  -- Response related types
  
  -- | An EventMessage represents each kind of message received from the server.
  data EventMessage
    = ProgressEventMessage Progress
    | StatsEventMessage Stats
    | RequestLevelErrorMessage
        Text
        -- ^ Error code
        Text
        -- ^ Error message
    | RecordPayloadEventMessage ByteString
    deriving stock (Show, Eq)
  
  data MsgHeaderName
    = MessageType
    | EventType
    | ContentType
    | ErrorCode
    | ErrorMessage
    deriving stock (Show, Eq)
  
  msgHeaderValueType :: Word8
  msgHeaderValueType = 7
  
  type MessageHeader = (MsgHeaderName, Text)
  
  -- | Represent the progress event returned in the Select response.
  data Progress = Progress
    { pBytesScanned :: Int64,
      pBytesProcessed :: Int64,
      pBytesReturned :: Int64
    }
    deriving stock (Show, 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 = PayloadBS ""
  
  data AdminReqInfo = AdminReqInfo
    { ariMethod :: Method,
      ariPayloadHash :: Maybe ByteString,
      ariPayload :: Payload,
      ariPath :: ByteString,
      ariHeaders :: [Header],
      ariQueryParams :: Query
    }
  
  data S3ReqInfo = S3ReqInfo
    { riMethod :: Method,
      riBucket :: Maybe Bucket,
      riObject :: Maybe Object,
      riQueryParams :: Query,
      riHeaders :: [Header],
      riPayload :: Payload,
      riPayloadHash :: Maybe ByteString,
      riRegion :: Maybe Region,
      riNeedsLocation :: Bool,
      riPresignExpirySecs :: Maybe UrlExpiry
    }
  
  defaultS3ReqInfo :: S3ReqInfo
  defaultS3ReqInfo =
    S3ReqInfo
      HT.methodGet
      Nothing
      Nothing
      []
      []
      defaultPayload
      Nothing
      Nothing
      True
      Nothing
  
  getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
  getS3Path b o =
    let segments = map encodeUtf8 $ catMaybes $ b : bool [] [o] (isJust b)
     in B.concat ["/", B.intercalate "/" segments]
  
  type RegionMap = H.HashMap Bucket Region
  
  -- | The Minio Monad - all computations accessing object storage
  -- happens in it.
  newtype Minio a = Minio
    { unMinio :: ReaderT MinioConn (ResourceT IO) a
    }
    deriving newtype
      ( Functor,
        Applicative,
        Monad,
        MonadIO,
        MonadReader MinioConn,
        MonadResource,
        MonadUnliftIO
      )
  
  -- | MinioConn holds connection info and a connection pool to allow
  -- for efficient resource re-use.
  data MinioConn = MinioConn
    { mcConnInfo :: ConnectInfo,
      mcConnManager :: NC.Manager,
      mcRegionMap :: MVar RegionMap
    }
  
  class HasSvcNamespace env where
    getSvcNamespace :: env -> Text
  
  instance HasSvcNamespace MinioConn where
    getSvcNamespace env =
      let host = connectHost $ mcConnInfo env
       in ( if host == "storage.googleapis.com"
              then "http://doc.s3.amazonaws.com/2006-03-01"
              else "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 ci = do
    let settings
          | connectIsSecure ci && connectDisableTLSCertValidation ci =
              let badTlsSettings =
                    case def of
                      tlsSettings@Conn.TLSSettingsSimple {} ->
                        tlsSettings {Conn.settingDisableCertificateValidation = True}
                      _ -> def
               in TLS.mkManagerSettings badTlsSettings Nothing
          | connectIsSecure ci = NC.tlsManagerSettings
          | otherwise = defaultManagerSettings
    mgr <- NC.newManager settings
    mkMinioConn ci 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 conn m = runResourceT $ runMinioResWith conn m
  
  -- | Given `ConnectInfo` and a HTTP connection manager, create a
  -- `MinioConn`.
  mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
  mkMinioConn ci mgr = do
    rMapMVar <- M.newMVar H.empty
    return $ MinioConn ci mgr rMapMVar
  
  -- | Run the Minio action and return the result or an error.
  runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
  runMinio ci m = do
    conn <- connect ci
    runResourceT $ runMinioResWith conn 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 conn m =
    flip runReaderT conn . unMinio $
      fmap Right m
        `U.catches` [ U.Handler handlerServiceErr,
                      U.Handler handlerHE,
                      U.Handler handlerFE,
                      U.Handler handlerValidation
                    ]
    where
      handlerServiceErr = return . Left . MErrService
      handlerHE = return . Left . MErrHTTP
      handlerFE = return . Left . MErrIO
      handlerValidation = return . Left . 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 ci m = do
    conn <- liftIO $ connect ci
    runMinioResWith conn m
  
  -- | Format as per RFC 1123.
  formatRFC1123 :: UTCTime -> T.Text
  formatRFC1123 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
  
  lookupRegionCache :: Bucket -> Minio (Maybe Region)
  lookupRegionCache b = do
    rMVar <- asks mcRegionMap
    rMap <- UM.readMVar rMVar
    return $ H.lookup b rMap
  
  addToRegionCache :: Bucket -> Region -> Minio ()
  addToRegionCache b region = do
    rMVar <- asks mcRegionMap
    UM.modifyMVar_ rMVar $ return . H.insert b region
  
  deleteFromRegionCache :: Bucket -> Minio ()
  deleteFromRegionCache b = do
    rMVar <- asks mcRegionMap
    UM.modifyMVar_ rMVar $ return . H.delete b
  