@@ -1,5 +1,5 @@
2−-- Minio Haskell SDK, (C) 2017 Minio, Inc.
2+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
4-- Licensed under the Apache License, Version 2.0 (the "License");
4-- Licensed under the Apache License, Version 2.0 (the "License");
5-- you may not use this file except in compliance with the License.
5-- you may not use this file except in compliance with the License.
@@ -13,141 +13,276 @@
13-- See the License for the specific language governing permissions and
13-- See the License for the specific language governing permissions and
14-- limitations under the License.
14-- limitations under the License.
17+{-# LANGUAGE GADTs #-}
18+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
19+{-# LANGUAGE StrictData #-}
20+{-# LANGUAGE TypeFamilies #-}
17−{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
18module Network.Minio.Data where
22module Network.Minio.Data where
20−import Control.Monad.Base
24+import qualified Conduit as C
21−import qualified Control.Monad.Catch as MC
25+import qualified Control.Concurrent.MVar as M
22−import Control.Monad.Trans.Control
26+import Control.Monad.Trans.Except (throwE)
23−import Control.Monad.Trans.Resource
27+import Control.Monad.Trans.Resource
34+import qualified Data.Aeson as A
35+import qualified Data.ByteArray as BA
25import qualified Data.ByteString as B
36import qualified Data.ByteString as B
37+import qualified Data.ByteString.Lazy as LB
26−import Data.Default (Default(..))
38+import Data.Default.Class (def)
39+import qualified Data.HashMap.Strict as H
40+import qualified Data.Ini as Ini
27−import qualified Data.Map as Map
41+import qualified Data.List as List
28import qualified Data.Text as T
42import qualified Data.Text as T
43+import qualified Data.Text.Encoding as TE
29−import Data.Time (formatTime, defaultTimeLocale)
44+import Data.Time (defaultTimeLocale, formatTime)
45+import Lib.Prelude (UTCTime, throwIO)
46+import qualified Network.Connection as Conn
30−import Network.HTTP.Client (defaultManagerSettings)
47+import Network.HTTP.Client (defaultManagerSettings)
48+import qualified Network.HTTP.Client.TLS as TLS
31import qualified Network.HTTP.Conduit as NC
49import qualified Network.HTTP.Conduit as NC
32−import Network.HTTP.Types (Method, Header, Query)
50+import Network.HTTP.Types
33import qualified Network.HTTP.Types as HT
57import qualified Network.HTTP.Types as HT
58+import Network.Minio.Credentials
59+import Network.Minio.Data.Crypto
63+import Network.Minio.Data.Time (UrlExpiry)
34−import Network.Minio.Errors
64+import Network.Minio.Errors
35−import Text.XML
65+ ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials),
68+import Network.Minio.Utils
69+import System.Directory (doesFileExist, getHomeDirectory)
70+import qualified System.Environment as Env
71+import System.FilePath.Posix (combine)
72+import qualified UnliftIO as U
73+import qualified UnliftIO.MVar as UM
75+-- | max obj size is 5TiB
76+maxObjectSize :: Int64
77+maxObjectSize = 5 * 1024 * 1024 * oneMiB
37−import GHC.Show (Show(..))
79+-- | minimum size of parts used in multipart operations.
81+minPartSize = 64 * oneMiB
39−import Lib.Prelude
83+oneMiB :: Int64
86+-- | maximum number of parts that can be uploaded for a single object.
87+maxMultipartParts :: Int64
88+maxMultipartParts = 10000
42-- TODO: Add a type which provides typed constants for region. this
90-- TODO: Add a type which provides typed constants for region. this
43-- type should have a IsString instance to infer the appropriate
91-- type should have a IsString instance to infer the appropriate
44-- constant.
92-- constant.
45-- | awsRegionMap - library constant
94-- | awsRegionMap - library constant
46−awsRegionMap :: Map.Map Text Text
95+awsRegionMap :: H.HashMap Text Text
47−awsRegionMap = Map.fromList [
96+awsRegionMap =
48− ("us-east-1", "s3.amazonaws.com")
98+ [ ("us-east-1", "s3.us-east-1.amazonaws.com"),
49− , ("us-east-2", "s3-us-east-2.amazonaws.com")
99+ ("us-east-2", "s3.us-east-2.amazonaws.com"),
50− , ("us-west-1", "s3-us-west-1.amazonaws.com")
100+ ("us-west-1", "s3.us-west-1.amazonaws.com"),
51− , ("us-east-2", "s3-us-west-2.amazonaws.com")
101+ ("us-west-2", "s3.us-west-2.amazonaws.com"),
52− , ("ca-central-1", "s3-ca-central-1.amazonaws.com")
102+ ("ca-central-1", "s3.ca-central-1.amazonaws.com"),
53− , ("ap-south-1", "s3-ap-south-1.amazonaws.com")
103+ ("ap-south-1", "s3.ap-south-1.amazonaws.com"),
104+ ("ap-south-2", "s3.ap-south-2.amazonaws.com"),
54− , ("ap-northeast-1", "s3-ap-northeast-1.amazonaws.com")
105+ ("ap-northeast-1", "s3.ap-northeast-1.amazonaws.com"),
55− , ("ap-northeast-2", "s3-ap-northeast-2.amazonaws.com")
106+ ("ap-northeast-2", "s3.ap-northeast-2.amazonaws.com"),
107+ ("ap-northeast-3", "s3.ap-northeast-3.amazonaws.com"),
56− , ("ap-southeast-1", "s3-ap-southeast-1.amazonaws.com")
108+ ("ap-southeast-1", "s3.ap-southeast-1.amazonaws.com"),
57− , ("ap-southeast-2", "s3-ap-southeast-2.amazonaws.com")
109+ ("ap-southeast-2", "s3.ap-southeast-2.amazonaws.com"),
110+ ("ap-southeast-3", "s3.ap-southeast-3.amazonaws.com"),
58− , ("eu-west-1", "s3-eu-west-1.amazonaws.com")
111+ ("eu-west-1", "s3.eu-west-1.amazonaws.com"),
59− , ("eu-west-2", "s3-eu-west-2.amazonaws.com")
112+ ("eu-west-2", "s3.eu-west-2.amazonaws.com"),
113+ ("eu-west-3", "s3.eu-west-3.amazonaws.com"),
60− , ("eu-central-1", "s3-eu-central-1.amazonaws.com")
114+ ("eu-central-1", "s3.eu-central-1.amazonaws.com"),
115+ ("eu-central-2", "s3.eu-central-2.amazonaws.com"),
116+ ("eu-south-1", "s3.eu-south-1.amazonaws.com"),
61− , ("sa-east-1", "s3-sa-east-1.amazonaws.com")
117+ ("eu-south-2", "s3.eu-south-2.amazonaws.com"),
118+ ("af-south-1", "s3.af-south-1.amazonaws.com"),
119+ ("ap-east-1", "s3.ap-east-1.amazonaws.com"),
120+ ("cn-north-1", "s3.cn-north-1.amazonaws.com.cn"),
121+ ("cn-northwest-1", "s3.cn-northwest-1.amazonaws.com.cn"),
122+ ("eu-north-1", "s3.eu-north-1.amazonaws.com"),
123+ ("me-south-1", "s3.me-south-1.amazonaws.com"),
124+ ("me-central-1", "s3.me-central-1.amazonaws.com"),
125+ ("us-gov-east-1", "s3.us-gov-east-1.amazonaws.com"),
126+ ("us-gov-west-1", "s3.us-gov-west-1.amazonaws.com"),
127+ ("sa-east-1", "s3.sa-east-1.amazonaws.com")
64−-- | Connection Info data type. To create a 'ConnectInfo' value, use one
130+-- | Connection Info data type. To create a 'ConnectInfo' value,
65−-- of the provided smart constructors or override fields of the
131+-- enable the @OverloadedStrings@ language extension and use the
66−-- Default instance.
132+-- `IsString` instance to provide a URL, for example:
67−data ConnectInfo = ConnectInfo {
70− , connectAccessKey :: Text
71− , connectSecretKey :: Text
72− , connectIsSecure :: Bool
73− , connectRegion :: Region
74− , connectAutoDiscoverRegion :: Bool
75− } deriving (Eq, Show)
77−-- | Connects to a Minio server located at @localhost:9000@ with access
78−-- key /minio/ and secret key /minio123/. It is over __HTTP__ by
80−instance Default ConnectInfo where
81− def = ConnectInfo "localhost" 9000 "minio" "minio123" False "us-east-1" True
83−-- | Default AWS ConnectInfo. Connects to "us-east-1". Credentials
84−-- should be supplied before use, for e.g.:
86−-- > awsCI {
134+-- > let c :: ConnectInfo = "https://play.min.io"
87−-- > connectAccessKey = "my-access-key"
88−-- > , connectSecretKey = "my-secret-key"
90−awsCI :: ConnectInfo
135+data ConnectInfo = ConnectInfo
92− connectHost = "s3.amazonaws.com"
136+ { connectHost :: Text,
93− , connectPort = 443
137+ connectPort :: Int,
94− , connectAccessKey = ""
138+ connectCreds :: Creds,
95− , connectSecretKey = ""
96− , connectIsSecure = True
139+ connectIsSecure :: Bool,
140+ connectRegion :: Region,
141+ connectAutoDiscoverRegion :: Bool,
142+ connectDisableTLSCertValidation :: Bool
99−-- | AWS ConnectInfo with a specified region. It can optionally
145+getEndpoint :: ConnectInfo -> Endpoint
100−-- disable the automatic discovery of a bucket's region via the
146+getEndpoint ci = (encodeUtf8 $ connectHost ci, connectPort ci, connectIsSecure ci)
101−-- Boolean argument.
147+
102−--
148+instance IsString ConnectInfo where
103−-- > awsWithRegionCI "us-west-1" False {
149+ fromString str =
104−-- > connectAccessKey = "my-access-key"
150+ let req = NC.parseRequest_ str
105−-- > , connectSecretKey = "my-secret-key"
151+ in ConnectInfo
152+ { connectHost = TE.decodeUtf8 $ NC.host req,
153+ connectPort = NC.port req,
154+ connectCreds = CredsStatic $ CredentialValue mempty mempty mempty,
155+ connectIsSecure = NC.secure req,
157+ connectAutoDiscoverRegion = True,
158+ connectDisableTLSCertValidation = False
161+-- | A 'CredentialLoader' is an action that may return a 'CredentialValue'.
162+-- Loaders may be chained together using 'findFirst'.
108−-- This restricts all operations to the "us-west-1" region and does
164+-- @since 1.7.0
109−-- not perform any bucket location requests.
165+type CredentialLoader = IO (Maybe CredentialValue)
110−awsWithRegionCI :: Region -> Bool -> ConnectInfo
166+
111−awsWithRegionCI region autoDiscoverRegion =
167+-- | Combines the given list of loaders, by calling each one in
112− let host = maybe "s3.amazonaws.com" identity $
168+-- order until a 'CredentialValue' is returned.
113− Map.lookup region awsRegionMap
169+findFirst :: [CredentialLoader] -> IO (Maybe CredentialValue)
114− in awsCI {
170+findFirst [] = return Nothing
115− connectHost = host
171+findFirst (f : fs) = do
116− , connectRegion = region
172+ c <- f
117− , connectAutoDiscoverRegion = autoDiscoverRegion
173+ maybe (findFirst fs) (return . Just) c
175+-- | This action returns a 'CredentialValue' populated from
176+-- @~\/.aws\/credentials@
177+fromAWSConfigFile :: CredentialLoader
178+fromAWSConfigFile = do
179+ credsE <- runExceptT $ do
180+ homeDir <- lift getHomeDirectory
181+ let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials"
182+ fileExists <- lift $ doesFileExist awsCredsFile
183+ bool (throwE "FileNotFound") (return ()) fileExists
184+ ini <- ExceptT $ Ini.readIniFile awsCredsFile
188+ Ini.lookupValue "default" "aws_access_key_id" ini
192+ Ini.lookupValue "default" "aws_secret_access_key" ini
193+ return $ CredentialValue (coerce akey) (fromString $ T.unpack skey) Nothing
194+ return $ either (const Nothing) Just credsE
196+-- | This action returns a 'CredentialValue` populated from @AWS_ACCESS_KEY_ID@
197+-- and @AWS_SECRET_ACCESS_KEY@ environment variables.
198+fromAWSEnv :: CredentialLoader
199+fromAWSEnv = runMaybeT $ do
200+ akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
201+ skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
202+ return $ CredentialValue (fromString akey) (fromString skey) Nothing
204+-- | This action returns a 'CredentialValue' populated from @MINIO_ACCESS_KEY@
205+-- and @MINIO_SECRET_KEY@ environment variables.
206+fromMinioEnv :: CredentialLoader
207+fromMinioEnv = runMaybeT $ do
208+ akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
209+ skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
210+ return $ CredentialValue (fromString akey) (fromString skey) Nothing
212+-- | setCredsFrom retrieves access credentials from the first action in the
213+-- given list that succeeds and sets it in the 'ConnectInfo'.
214+setCredsFrom :: [CredentialLoader] -> ConnectInfo -> IO ConnectInfo
215+setCredsFrom ps ci = do
216+ pMay <- findFirst ps
218+ (throwIO MErrVMissingCredentials)
219+ (return . (`setCreds` ci))
222+-- | setCreds sets the given `CredentialValue` in the `ConnectInfo`.
223+setCreds :: CredentialValue -> ConnectInfo -> ConnectInfo
224+setCreds cv connInfo =
226+ { connectCreds = CredsStatic cv
229+-- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
230+-- credentials via the STS API on demand. It is automatically refreshed on
232+setSTSCredential :: (STSCredentialProvider p) => p -> ConnectInfo -> IO ConnectInfo
233+setSTSCredential p ci = do
234+ store <- initSTSCredential p
235+ return ci {connectCreds = CredsSTS store}
121−-- | <https://play.minio.io:9000 Minio Play Server>
237+-- | Set the S3 region parameter in the `ConnectInfo`
122−-- ConnectInfo. Credentials are already filled in.
238+setRegion :: Region -> ConnectInfo -> ConnectInfo
123−minioPlayCI :: ConnectInfo
239+setRegion r connInfo =
124−minioPlayCI = def {
240+ connInfo
125− connectHost = "play.minio.io"
241+ { connectRegion = r,
126− , connectPort = 9000
127− , connectAccessKey = "Q3AM3UQ867SPQQA43P2F"
128− , connectSecretKey = "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
129− , connectIsSecure = True
130− , connectAutoDiscoverRegion = False
242+ connectAutoDiscoverRegion = False
133−-- | ConnectInfo for Minio server. Takes hostname, port and a Boolean
245+-- | Check if the connection to object storage server is secure
134−-- to enable TLS.
246+-- (i.e. uses TLS)
135−--
247+isConnectInfoSecure :: ConnectInfo -> Bool
136−-- > minioCI "minio.example.com" 9000 True {
248+isConnectInfoSecure = connectIsSecure
137−-- > connectAccessKey = "my-access-key"
249+
138−-- > , connectSecretKey = "my-secret-key"
250+-- | Disable TLS certificate validation completely! This makes TLS
139−-- > }
251+-- insecure! Use only for testing with self-signed or temporary
252+-- certificates. Note that this option has no effect, if you provide
253+-- your own Manager in `mkMinioConn`.
254+disableTLSCertValidation :: ConnectInfo -> ConnectInfo
255+disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}
257+getHostAddr :: ConnectInfo -> ByteString
258+getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort ci)
260+-- | Default Google Compute Storage ConnectInfo. Works only for
261+-- "Simple Migration" use-case with interoperability mode enabled on
262+-- GCP console. For more information -
263+-- https://cloud.google.com/storage/docs/migrating
141−-- This connects to a Minio server at the given hostname and port over
265+-- Credentials should be supplied before use.
142−-- HTTPS.
266+gcsCI :: ConnectInfo
143−minioCI :: Text -> Int -> Bool -> ConnectInfo
267+gcsCI =
144−minioCI host port isSecure = def {
268+ setRegion
145− connectHost = host
269+ "us"
146− , connectPort = port
270+ "https://storage.googleapis.com"
272+-- | Default AWS S3 ConnectInfo. Connects to "us-east-1". Credentials
273+-- should be supplied before use.
275+awsCI = "https://s3.amazonaws.com"
277+-- | <https://play.min.io MinIO Play Server>
278+-- ConnectInfo. Credentials are already filled in.
279+minioPlayCI :: ConnectInfo
281+ let playCreds = CredentialValue "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG" Nothing
282+ in setCreds playCreds $
147− , connectRegion = "us-east-1"
284+ "us-east-1"
148− , connectIsSecure = isSecure
285+ "https://play.min.io"
149− , connectAutoDiscoverRegion = False
153-- Represents a bucket in the object store
288-- Represents a bucket in the object store
@@ -157,25 +292,156 @@ type Bucket = Text
157-- Represents an object name
292-- Represents an object name
158type Object = Text
293type Object = Text
161−-- Represents a region
295+-- | Represents a region
162−-- TODO: This could be a Sum Type with all defined regions for AWS.
163type Region = Text
296type Region = Text
165−-- | A type alias to represent an Entity-Tag returned by S3-compatible
298+-- | A type alias to represent an Entity-Tag returned by S3-compatible APIs.
167type ETag = Text
299type ETag = Text
301+-- | Data type to represent an object encryption key. Create one using
302+-- the `mkSSECKey` function.
303+newtype SSECKey = SSECKey BA.ScrubbedBytes
304+ deriving stock (Eq, Show)
306+-- | Validates that the given ByteString is 32 bytes long and creates
307+-- an encryption key.
308+mkSSECKey :: (MonadThrow m) => ByteString -> m SSECKey
310+ | B.length keyBytes /= 32 =
311+ throwM MErrVInvalidEncryptionKeyLength
313+ return $ SSECKey $ BA.convert keyBytes
315+-- | Data type to represent Server-Side-Encryption settings
317+ -- | Specifies SSE S3 encryption - server manages encryption keys
319+ -- | Specifies that KMS service should be used. The first argument
320+ -- to the constructor is the Key Id to be used by the server (if
321+ -- not specified, the default KMS key id is used). The second
322+ -- argument is the optional KMS context that must have a
323+ -- `A.ToJSON` instance - please refer to the AWS S3 documentation
324+ -- for detailed information.
325+ SSEKMS :: (A.ToJSON a) => Maybe ByteString -> Maybe a -> SSE
326+ -- | Specifies server-side encryption with customer provided
327+ -- key. The argument is the encryption key to be used.
328+ SSEC :: SSECKey -> SSE
330+toPutObjectHeaders :: SSE -> [HT.Header]
331+toPutObjectHeaders sseArg =
332+ let sseHeader = "x-amz-server-side-encryption"
333+ sseKmsIdHeader = sseHeader <> "-aws-kms-key-id"
334+ sseKmsContextHeader = sseHeader <> "-context"
335+ ssecAlgo = sseHeader <> "-customer-algorithm"
336+ ssecKey = sseHeader <> "-customer-key"
337+ ssecKeyMD5 = ssecKey <> "-MD5"
339+ SSE -> [(sseHeader, "AES256")]
340+ SSEKMS keyIdMay ctxMay ->
341+ [(sseHeader, "aws:kms")]
342+ ++ maybe [] (\k -> [(sseKmsIdHeader, k)]) keyIdMay
343+ ++ maybe [] (\k -> [(sseKmsContextHeader, LB.toStrict $ A.encode k)]) ctxMay
344+ SSEC (SSECKey sb) ->
345+ [ (ssecAlgo, "AES256"),
346+ (ssecKey, encodeToBase64 sb),
347+ (ssecKeyMD5, hashMD5ToBase64 sb)
350+-- | Data type for options in PutObject call. Start with the empty
351+-- `defaultPutObjectOptions` and use various the various poo*
353+data PutObjectOptions = PutObjectOptions
354+ { -- | Set a standard MIME type describing the format of the object.
355+ pooContentType :: Maybe Text,
356+ -- | Set what content encodings have been applied to the object and thus
357+ -- what decoding mechanisms must be applied to obtain the media-type
358+ -- referenced by the Content-Type header field.
359+ pooContentEncoding :: Maybe Text,
360+ -- | Set presentational information for the object.
361+ pooContentDisposition :: Maybe Text,
362+ -- | Set to specify caching behavior for the object along the
363+ -- request/reply chain.
364+ pooCacheControl :: Maybe Text,
365+ -- | Set to describe the language(s) intended for the audience.
366+ pooContentLanguage :: Maybe Text,
367+ -- | Set to @STANDARD@ or @REDUCED_REDUNDANCY@ depending on your
368+ -- performance needs, storage class is @STANDARD@ by default (i.e
369+ -- when Nothing is passed).
370+ pooStorageClass :: Maybe Text,
371+ -- | Set user defined metadata to store with the object.
372+ pooUserMetadata :: [(Text, Text)],
373+ -- | Set number of worker threads used to upload an object.
374+ pooNumThreads :: Maybe Word,
375+ -- | Set object encryption parameters for the request.
379+-- | Provide default `PutObjectOptions`.
380+defaultPutObjectOptions :: PutObjectOptions
381+defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing
383+pooToHeaders :: PutObjectOptions -> [HT.Header]
386+ ++ mapMaybe tupToMaybe (zip names values)
387+ ++ maybe [] toPutObjectHeaders (pooSSE poo)
389+ tupToMaybe (k, Just v) = Just (k, v)
390+ tupToMaybe (_, Nothing) = Nothing
391+ userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo
395+ "content-disposition",
398+ "x-amz-storage-class"
402+ (fmap encodeUtf8 . (poo &))
405+ pooContentDisposition,
170-- BucketInfo returned for list buckets call
412-- BucketInfo returned for list buckets call
171−data BucketInfo = BucketInfo {
413+data BucketInfo = BucketInfo
172− biName :: Bucket
414+ { biName :: Bucket,
173− , biCreationDate :: UTCTime
415+ biCreationDate :: UTCTime
174− } deriving (Show, Eq)
417+ deriving stock (Show, Eq)
176-- | A type alias to represent a part-number for multipart upload
419-- | A type alias to represent a part-number for multipart upload
177type PartNumber = Int16
420type PartNumber = Int16
422+-- | Select part sizes - the logic is that the minimum part-size will
424+selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
425+selectPartSizes size =
426+ uncurry (List.zip3 [1 ..]) $
430+ ceil :: Double -> Int64
437+ / fromIntegral maxMultipartParts
442+ | st + m >= sz = [(st, sz - st)]
443+ | otherwise = (st, m) : loop (st + m) sz
179-- | A type alias to represent an upload-id for multipart upload
445-- | A type alias to represent an upload-id for multipart upload
180type UploadId = Text
446type UploadId = Text
@@ -184,163 +450,264 @@ type PartTuple = (PartNumber, ETag)
185-- | Represents result from a listing of object parts of an ongoing
451-- | Represents result from a listing of object parts of an ongoing
186-- multipart upload.
452-- multipart upload.
187−data ListPartsResult = ListPartsResult {
453+data ListPartsResult = ListPartsResult
188− lprHasMore :: Bool
454+ { lprHasMore :: Bool,
189− , lprNextPart :: Maybe Int
455+ lprNextPart :: Maybe Int,
190− , lprParts :: [ObjectPartInfo]
456+ lprParts :: [ObjectPartInfo]
191− } deriving (Show, Eq)
458+ deriving stock (Show, Eq)
194-- | Represents information about an object part in an ongoing
460-- | Represents information about an object part in an ongoing
195-- multipart upload.
461-- multipart upload.
196−data ObjectPartInfo = ObjectPartInfo {
462+data ObjectPartInfo = ObjectPartInfo
197− opiNumber :: PartNumber
463+ { opiNumber :: PartNumber,
198− , opiETag :: ETag
464+ opiETag :: ETag,
199− , opiSize :: Int64
465+ opiSize :: Int64,
200− , opiModTime :: UTCTime
466+ opiModTime :: UTCTime
201− } deriving (Show, Eq)
468+ deriving stock (Show, Eq)
203-- | Represents result from a listing of incomplete uploads to a
470-- | Represents result from a listing of incomplete uploads to a
204-- bucket.
471-- bucket.
205−data ListUploadsResult = ListUploadsResult {
472+data ListUploadsResult = ListUploadsResult
206− lurHasMore :: Bool
473+ { lurHasMore :: Bool,
207− , lurNextKey :: Maybe Text
474+ lurNextKey :: Maybe Text,
208− , lurNextUpload :: Maybe Text
475+ lurNextUpload :: Maybe Text,
209− , lurUploads :: [(Object, UploadId, UTCTime)]
476+ lurUploads :: [(Object, UploadId, UTCTime)],
210− , lurCPrefixes :: [Text]
477+ lurCPrefixes :: [Text]
211− } deriving (Show, Eq)
479+ deriving stock (Show, Eq)
213-- | Represents information about a multipart upload.
481-- | Represents information about a multipart upload.
214−data UploadInfo = UploadInfo {
482+data UploadInfo = UploadInfo
215− uiKey :: Object
483+ { uiKey :: Object,
216− , uiUploadId :: UploadId
484+ uiUploadId :: UploadId,
217− , uiInitTime :: UTCTime
485+ uiInitTime :: UTCTime,
218− , uiSize :: Int64
486+ uiSize :: Int64
219− } deriving (Show, Eq)
488+ deriving stock (Show, Eq)
221-- | Represents result from a listing of objects in a bucket.
490-- | Represents result from a listing of objects in a bucket.
222−data ListObjectsResult = ListObjectsResult {
491+data ListObjectsResult = ListObjectsResult
223− lorHasMore :: Bool
492+ { lorHasMore :: Bool,
224− , lorNextToken :: Maybe Text
493+ lorNextToken :: Maybe Text,
225− , lorObjects :: [ObjectInfo]
494+ lorObjects :: [ObjectInfo],
226− , lorCPrefixes :: [Text]
495+ lorCPrefixes :: [Text]
227− } deriving (Show, Eq)
497+ deriving stock (Show, Eq)
229-- | Represents result from a listing of objects version 1 in a bucket.
499-- | Represents result from a listing of objects version 1 in a bucket.
230−data ListObjectsV1Result = ListObjectsV1Result {
500+data ListObjectsV1Result = ListObjectsV1Result
231− lorHasMore' :: Bool
501+ { lorHasMore' :: Bool,
232− , lorNextMarker :: Maybe Text
502+ lorNextMarker :: Maybe Text,
233− , lorObjects' :: [ObjectInfo]
503+ lorObjects' :: [ObjectInfo],
234− , lorCPrefixes' :: [Text]
504+ lorCPrefixes' :: [Text]
235− } deriving (Show, Eq)
506+ deriving stock (Show, Eq)
237-- | Represents information about an object.
508-- | Represents information about an object.
238−data ObjectInfo = ObjectInfo {
509+data ObjectInfo = ObjectInfo
239− oiObject :: Object
511+ oiObject :: Object,
512+ -- | Modification time of the object
240− , oiModTime :: UTCTime
513+ oiModTime :: UTCTime,
514+ -- | ETag of the object
241− , oiETag :: ETag
515+ oiETag :: ETag,
516+ -- | Size of the object in bytes
242− , oiSize :: Int64
517+ oiSize :: Int64,
518+ -- | A map of user-metadata
519+ -- pairs stored with an
520+ -- object (keys will not
521+ -- have the @X-Amz-Meta-@
523+ oiUserMetadata :: H.HashMap Text Text,
524+ -- | A map of metadata
525+ -- key-value pairs (not
527+ -- user-metadata pairs)
528+ oiMetadata :: H.HashMap Text Text
243− } deriving (Show, Eq)
530+ deriving stock (Show, Eq)
245−data CopyPartSource = CopyPartSource {
532+-- | Represents source object in server-side copy object
246− -- | formatted like "\/sourceBucket\/sourceObject"
533+data SourceInfo = SourceInfo
247− cpSource :: Text
534+ { -- | Bucket containing the source object
536+ -- | Source object key
541+ srcRange :: Maybe (Int64, Int64),
542+ -- | ETag condition on source -
543+ -- object is copied only if the
544+ -- source object's ETag matches
546+ srcIfMatch :: Maybe Text,
547+ -- | ETag not match condition
548+ -- on source - object is copied
549+ -- if ETag does not match this
551+ srcIfNoneMatch :: Maybe Text,
552+ -- | Copy source object only
553+ -- if the source has been
554+ -- modified since this time.
555+ srcIfModifiedSince :: Maybe UTCTime,
556+ -- | Copy source object only
557+ -- if the source has been
558+ -- un-modified since this
560+ srcIfUnmodifiedSince :: Maybe UTCTime
562+ deriving stock (Show, Eq)
564+-- | Provide a default for `SourceInfo`
565+defaultSourceInfo :: SourceInfo
566+defaultSourceInfo = SourceInfo "" "" Nothing Nothing Nothing Nothing Nothing
568+-- | Represents destination object in server-side copy object
569+data DestinationInfo = DestinationInfo
570+ { -- | Destination bucket
572+ -- | Destination object key
575+ deriving stock (Show, Eq)
577+-- | Provide a default for `DestinationInfo`
578+defaultDestinationInfo :: DestinationInfo
579+defaultDestinationInfo = DestinationInfo "" ""
581+-- | Data type for options when getting an object from the
582+-- service. Start with the empty `defaultGetObjectOptions` and modify
583+-- it using the goo* functions.
584+data GetObjectOptions = GetObjectOptions
585+ { -- | Set object's data of given offset begin and end,
248− -- | (0, 9) means first ten bytes of the source object
586+ -- [ByteRangeFromTo 0 9] means first ten bytes of the source object.
249− , cpSourceRange :: Maybe (Int64, Int64)
587+ gooRange :: Maybe ByteRange,
250− , cpSourceIfMatch :: Maybe Text
588+ -- | Set matching ETag condition, GetObject which matches the following
251− , cpSourceIfNoneMatch :: Maybe Text
589+ -- ETag.
252− , cpSourceIfUnmodifiedSince :: Maybe UTCTime
590+ gooIfMatch :: Maybe ETag,
253− , cpSourceIfModifiedSince :: Maybe UTCTime
591+ -- | Set matching ETag none condition, GetObject which does not match
254− } deriving (Show, Eq)
592+ -- the following ETag.
255−
593+ gooIfNoneMatch :: Maybe ETag,
256−instance Default CopyPartSource where
594+ -- | Set object unmodified condition, GetObject unmodified since given time.
257− def = CopyPartSource "" def def def def def
595+ gooIfUnmodifiedSince :: Maybe UTCTime,
258−
596+ -- | Set object modified condition, GetObject modified since given time.
259−cpsToHeaders :: CopyPartSource -> [HT.Header]
597+ gooIfModifiedSince :: Maybe UTCTime,
260−cpsToHeaders cps = ("x-amz-copy-source", encodeUtf8 $ cpSource cps) :
598+ -- | Specify SSE-C key
599+ gooSSECKey :: Maybe SSECKey
602+-- | Provide default `GetObjectOptions`.
603+defaultGetObjectOptions :: GetObjectOptions
604+defaultGetObjectOptions =
605+ GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
607+gooToHeaders :: GetObjectOptions -> [HT.Header]
261− rangeHdr ++ zip names values
610+ ++ zip names values
262− where
611+ ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
263− names = ["x-amz-copy-source-if-match", "x-amz-copy-source-if-none-match",
264− "x-amz-copy-source-if-unmodified-since",
265− "x-amz-copy-source-if-modified-since"]
266− values = mapMaybe (fmap encodeUtf8 . (cps &))
267− [cpSourceIfMatch, cpSourceIfNoneMatch,
268− fmap formatRFC1123 . cpSourceIfUnmodifiedSince,
269− fmap formatRFC1123 . cpSourceIfModifiedSince]
270− rangeHdr = ("x-amz-copy-source-range",)
271− . HT.renderByteRanges
273− . uncurry HT.ByteRangeFromTo
274− <$> map (both fromIntegral) (maybeToList $ cpSourceRange cps)
276−-- | Extract the source bucket and source object name. TODO: validate
277−-- the bucket and object name extracted.
278−cpsToObject :: CopyPartSource -> Maybe (Bucket, Object)
280− [_, bucket, object] <- Just splits
281− return (bucket, object)
283− splits = T.splitOn "/" $ cpSource cps
613+ names =
616+ "If-Unmodified-Since",
621+ (fmap encodeUtf8 . (goo &))
624+ fmap formatRFC1123 . gooIfUnmodifiedSince,
625+ fmap formatRFC1123 . gooIfModifiedSince
628+ maybe [] (\a -> [(hRange, HT.renderByteRanges [a])]) $
631+-- | Data type returned by 'getObject' representing the object being
632+-- retrieved. Use the @gor*@ functions to access its contents.
633+data GetObjectResponse = GetObjectResponse
634+ { -- | ObjectInfo of the object being retrieved.
635+ gorObjectInfo :: ObjectInfo,
636+ -- | A conduit of the bytes of the object.
637+ gorObjectStream :: C.ConduitM () ByteString Minio ()
285-- | A data-type for events that can occur in the object storage
640-- | A data-type for events that can occur in the object storage
286-- server. Reference:
641-- server. Reference:
287-- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types
642-- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types
288−data Event = ObjectCreated
644+ = ObjectCreated
289− | ObjectCreatedPut
645+ | ObjectCreatedPut
290− | ObjectCreatedPost
646+ | ObjectCreatedPost
291− | ObjectCreatedCopy
647+ | ObjectCreatedCopy
292− | ObjectCreatedMultipartUpload
648+ | ObjectCreatedMultipartUpload
293− | ObjectRemoved
649+ | ObjectRemoved
294− | ObjectRemovedDelete
650+ | ObjectRemovedDelete
295− | ObjectRemovedDeleteMarkerCreated
651+ | ObjectRemovedDeleteMarkerCreated
296− | ReducedRedundancyLostObject
652+ | ReducedRedundancyLostObject
297− deriving (Eq)
653+ deriving stock (Eq, Show)
299−instance Show Event where
655+instance ToText Event where
300− show ObjectCreated = "s3:ObjectCreated:*"
656+ toText ObjectCreated = "s3:ObjectCreated:*"
301− show ObjectCreatedPut = "s3:ObjectCreated:Put"
657+ toText ObjectCreatedPut = "s3:ObjectCreated:Put"
302− show ObjectCreatedPost = "s3:ObjectCreated:Post"
658+ toText ObjectCreatedPost = "s3:ObjectCreated:Post"
303− show ObjectCreatedCopy = "s3:ObjectCreated:Copy"
659+ toText ObjectCreatedCopy = "s3:ObjectCreated:Copy"
304− show ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
660+ toText ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
305− show ObjectRemoved = "s3:ObjectRemoved:*"
661+ toText ObjectRemoved = "s3:ObjectRemoved:*"
306− show ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
662+ toText ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
307− show ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
663+ toText ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
308− show ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
664+ toText ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
310textToEvent :: Text -> Maybe Event
666textToEvent :: Text -> Maybe Event
311textToEvent t = case t of
667textToEvent t = case t of
312− "s3:ObjectCreated:*" -> Just ObjectCreated
668+ "s3:ObjectCreated:*" -> Just ObjectCreated
313− "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
669+ "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
314− "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
670+ "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
315− "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
671+ "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
316− "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
672+ "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
317− "s3:ObjectRemoved:*" -> Just ObjectRemoved
673+ "s3:ObjectRemoved:*" -> Just ObjectRemoved
318− "s3:ObjectRemoved:Delete" -> Just ObjectRemovedDelete
674+ "s3:ObjectRemoved:Delete" -> Just ObjectRemovedDelete
319 "s3:ObjectRemoved:DeleteMarkerCreated" -> Just ObjectRemovedDeleteMarkerCreated
675 "s3:ObjectRemoved:DeleteMarkerCreated" -> Just ObjectRemovedDeleteMarkerCreated
320− "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
676+ "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
321− _ -> Nothing
677+ _ -> Nothing
679+-- | Filter data type - part of notification configuration
324−data Filter = Filter
680+newtype Filter = Filter
325 { fFilter :: FilterKey
681 { fFilter :: FilterKey
326− } deriving (Show, Eq)
683+ deriving stock (Show, Eq)
328−instance Default Filter where
685+-- | defaultFilter is empty, used to create a notification
329− def = Filter def
686+-- configuration.
687+defaultFilter :: Filter
688+defaultFilter = Filter defaultFilterKey
690+-- | FilterKey contains FilterRules, and is part of a Filter.
331−data FilterKey = FilterKey
691+newtype FilterKey = FilterKey
332 { fkKey :: FilterRules
692 { fkKey :: FilterRules
333− } deriving (Show, Eq)
694+ deriving stock (Show, Eq)
335−instance Default FilterKey where
696+-- | defaultFilterKey is empty, used to create notification
336− def = FilterKey def
697+-- configuration.
698+defaultFilterKey :: FilterKey
699+defaultFilterKey = FilterKey defaultFilterRules
701+-- | FilterRules represents a collection of `FilterRule`s.
338−data FilterRules = FilterRules
702+newtype FilterRules = FilterRules
339 { frFilterRules :: [FilterRule]
703 { frFilterRules :: [FilterRule]
340− } deriving (Show, Eq)
705+ deriving stock (Show, Eq)
342−instance Default FilterRules where
707+-- | defaultFilterRules is empty, used to create notification
709+defaultFilterRules :: FilterRules
343− def = FilterRules []
710+defaultFilterRules = FilterRules []
345-- | A filter rule that can act based on the suffix or prefix of an
712-- | A filter rule that can act based on the suffix or prefix of an
346-- object. As an example, let's create two filter rules:
713-- object. As an example, let's create two filter rules:
@@ -348,25 +715,28 @@ instance Default FilterRules where
348-- > let suffixRule = FilterRule "suffix" ".jpg"
715-- > let suffixRule = FilterRule "suffix" ".jpg"
349-- > let prefixRule = FilterRule "prefix" "images/"
716-- > let prefixRule = FilterRule "prefix" "images/"
351−-- The `suffixRule` restricts the notification to be triggered only
718+-- The @suffixRule@ restricts the notification to be triggered only
352−-- for objects having a suffix of ".jpg", and the `prefixRule`
719+-- for objects having a suffix of ".jpg", and the @prefixRule@
353-- restricts it to objects having a prefix of "images/".
720-- restricts it to objects having a prefix of "images/".
354data FilterRule = FilterRule
721data FilterRule = FilterRule
355− { frName :: Text
722+ { frName :: Text,
356− , frValue :: Text
723+ frValue :: Text
357− } deriving (Show, Eq)
725+ deriving stock (Show, Eq)
727+-- | Arn is an alias of Text
359type Arn = Text
728type Arn = Text
361-- | A data-type representing the configuration for a particular
730-- | A data-type representing the configuration for a particular
362-- notification system. It could represent a Queue, Topic or Lambda
731-- notification system. It could represent a Queue, Topic or Lambda
363-- Function configuration.
732-- Function configuration.
364data NotificationConfig = NotificationConfig
733data NotificationConfig = NotificationConfig
365− { ncId :: Text
734+ { ncId :: Text,
366− , ncArn :: Arn
735+ ncArn :: Arn,
367− , ncEvents :: [Event]
736+ ncEvents :: [Event],
368− , ncFilter :: Filter
737+ ncFilter :: Filter
369− } deriving (Show, Eq)
739+ deriving stock (Show, Eq)
371-- | A data-type to represent bucket notification configuration. It is
741-- | A data-type to represent bucket notification configuration. It is
372-- a collection of queue, topic or lambda function configurations. The
742-- a collection of queue, topic or lambda function configurations. The
@@ -374,110 +744,448 @@ data NotificationConfig = NotificationConfig
374-- described at
744-- described at
375-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html>
745-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html>
376data Notification = Notification
746data Notification = Notification
377− { nQueueConfigurations :: [NotificationConfig]
747+ { nQueueConfigurations :: [NotificationConfig],
378− , nTopicConfigurations :: [NotificationConfig]
748+ nTopicConfigurations :: [NotificationConfig],
379− , nCloudFunctionConfigurations :: [NotificationConfig]
749+ nCloudFunctionConfigurations :: [NotificationConfig]
751+ deriving stock (Show, Eq)
753+-- | The default notification configuration is empty.
754+defaultNotification :: Notification
755+defaultNotification = Notification [] [] []
757+--------------------------------------------------------------------------
758+-- Select API Related Types
759+--------------------------------------------------------------------------
761+-- | SelectRequest represents the Select API call. Use the
762+-- `selectRequest` function to create a value of this type.
763+data SelectRequest = SelectRequest
764+ { srExpression :: Text,
765+ srExpressionType :: ExpressionType,
766+ srInputSerialization :: InputSerialization,
767+ srOutputSerialization :: OutputSerialization,
768+ srRequestProgressEnabled :: Maybe Bool
380− } deriving (Eq, Show)
770+ deriving stock (Show, Eq)
772+data ExpressionType = SQL
773+ deriving stock (Show, Eq)
775+-- | InputSerialization represents format information of the input
776+-- object being queried. Use one of the smart constructors such as
777+-- `defaultCsvInput` as a starting value, and add compression info
778+-- using `setInputCompressionType`
779+data InputSerialization = InputSerialization
780+ { isCompressionType :: Maybe CompressionType,
781+ isFormatInfo :: InputFormatInfo
783+ deriving stock (Show, Eq)
785+-- | Data type representing the compression setting in a Select
788+ = CompressionTypeNone
789+ | CompressionTypeGzip
790+ | CompressionTypeBzip2
791+ deriving stock (Show, Eq)
793+-- | Data type representing input object format information in a
796+ = InputFormatCSV CSVInputProp
797+ | InputFormatJSON JSONInputProp
798+ | InputFormatParquet
799+ deriving stock (Show, Eq)
801+-- | defaultCsvInput returns InputSerialization with default CSV
802+-- format, and without any compression setting.
803+defaultCsvInput :: InputSerialization
804+defaultCsvInput = InputSerialization Nothing (InputFormatCSV defaultCSVProp)
806+-- | linesJsonInput returns InputSerialization with JSON line based
807+-- format with no compression setting.
808+linesJsonInput :: InputSerialization
812+ (InputFormatJSON $ JSONInputProp JSONTypeLines)
814+-- | documentJsonInput returns InputSerialization with JSON document
815+-- based format with no compression setting.
816+documentJsonInput :: InputSerialization
820+ (InputFormatJSON $ JSONInputProp JSONTypeDocument)
822+-- | defaultParquetInput returns InputSerialization with Parquet
823+-- format, and no compression setting.
824+defaultParquetInput :: InputSerialization
825+defaultParquetInput = InputSerialization Nothing InputFormatParquet
827+-- | setInputCompressionType sets the compression type for the input
828+-- of the SelectRequest
829+setInputCompressionType ::
833+setInputCompressionType c i =
834+ let is = srInputSerialization i
835+ is' = is {isCompressionType = Just c}
836+ in i {srInputSerialization = is'}
838+-- | defaultCsvOutput returns OutputSerialization with default CSV
840+defaultCsvOutput :: OutputSerialization
841+defaultCsvOutput = OutputSerializationCSV defaultCSVProp
843+-- | defaultJsonInput returns OutputSerialization with default JSON
845+defaultJsonOutput :: OutputSerialization
846+defaultJsonOutput = OutputSerializationJSON (JSONOutputProp Nothing)
848+-- | selectRequest is used to build a `SelectRequest`
849+-- value. @selectRequest query inputSer outputSer@ represents a
850+-- SelectRequest with the SQL query text given by @query@, the input
851+-- serialization settings (compression format and format information)
852+-- @inputSer@ and the output serialization settings @outputSer@.
855+ InputSerialization ->
856+ OutputSerialization ->
858+selectRequest sqlQuery inputSer outputSer =
860+ { srExpression = sqlQuery,
861+ srExpressionType = SQL,
862+ srInputSerialization = inputSer,
863+ srOutputSerialization = outputSer,
864+ srRequestProgressEnabled = Nothing
867+-- | setRequestProgressEnabled sets the flag for turning on progress
868+-- messages when the Select response is being streamed back to the
870+setRequestProgressEnabled :: Bool -> SelectRequest -> SelectRequest
871+setRequestProgressEnabled enabled sr =
872+ sr {srRequestProgressEnabled = Just enabled}
874+type CSVInputProp = CSVProp
876+-- | CSVProp represents CSV format properties. It is built up using
877+-- the Monoid instance.
878+newtype CSVProp = CSVProp (H.HashMap Text Text)
879+ deriving stock (Show, Eq)
881+instance Semigroup CSVProp where
882+ (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
884+instance Monoid CSVProp where
885+ mempty = CSVProp mempty
887+csvPropsList :: CSVProp -> [(Text, Text)]
888+csvPropsList (CSVProp h) = sort $ H.toList h
890+defaultCSVProp :: CSVProp
891+defaultCSVProp = mempty
893+-- | Specify the CSV record delimiter property.
894+recordDelimiter :: Text -> CSVProp
895+recordDelimiter = CSVProp . H.singleton "RecordDelimiter"
897+-- | Specify the CSV field delimiter property.
898+fieldDelimiter :: Text -> CSVProp
899+fieldDelimiter = CSVProp . H.singleton "FieldDelimiter"
901+-- | Specify the CSV quote character property.
902+quoteCharacter :: Text -> CSVProp
903+quoteCharacter = CSVProp . H.singleton "QuoteCharacter"
905+-- | Specify the CSV quote-escape character property.
906+quoteEscapeCharacter :: Text -> CSVProp
907+quoteEscapeCharacter = CSVProp . H.singleton "QuoteEscapeCharacter"
909+-- | FileHeaderInfo specifies information about column headers for CSV
912+ = -- | No column headers are present
914+ | -- | Headers are present and they should be used
916+ | -- | Header are present, but should be ignored
918+ deriving stock (Show, Eq)
920+-- | Specify the CSV file header info property.
921+fileHeaderInfo :: FileHeaderInfo -> CSVProp
922+fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toStr
924+ toStr FileHeaderNone = "NONE"
925+ toStr FileHeaderUse = "USE"
926+ toStr FileHeaderIgnore = "IGNORE"
928+-- | Specify the CSV comment character property. Lines starting with
929+-- this character are ignored by the server.
930+commentCharacter :: Text -> CSVProp
931+commentCharacter = CSVProp . H.singleton "Comments"
382−instance Default Notification where
933+-- | Allow quoted record delimiters inside a row using this property.
383− def = Notification [] [] []
934+allowQuotedRecordDelimiter :: CSVProp
935+allowQuotedRecordDelimiter = CSVProp $ H.singleton "AllowQuotedRecordDelimiter" "TRUE"
937+-- | Set the CSV format properties in the InputSerialization.
938+setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization
939+setInputCSVProps p is = is {isFormatInfo = InputFormatCSV p}
941+-- | Set the CSV format properties in the OutputSerialization.
942+outputCSVFromProps :: CSVProp -> OutputSerialization
943+outputCSVFromProps = OutputSerializationCSV
945+newtype JSONInputProp = JSONInputProp {jsonipType :: JSONType}
946+ deriving stock (Show, Eq)
948+data JSONType = JSONTypeDocument | JSONTypeLines
949+ deriving stock (Show, Eq)
951+-- | OutputSerialization represents output serialization settings for
952+-- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as
954+data OutputSerialization
955+ = OutputSerializationJSON JSONOutputProp
956+ | OutputSerializationCSV CSVOutputProp
957+ deriving stock (Show, Eq)
959+type CSVOutputProp = CSVProp
961+-- | quoteFields is an output serialization parameter
962+quoteFields :: QuoteFields -> CSVProp
963+quoteFields q = CSVProp $
964+ H.singleton "QuoteFields" $
966+ QuoteFieldsAsNeeded -> "ASNEEDED"
967+ QuoteFieldsAlways -> "ALWAYS"
969+-- | Represent the QuoteField setting.
970+data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
971+ deriving stock (Show, Eq)
973+newtype JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
974+ deriving stock (Show, Eq)
976+-- | Set the output record delimiter for JSON format
977+outputJSONFromRecordDelimiter :: Text -> OutputSerialization
978+outputJSONFromRecordDelimiter t =
979+ OutputSerializationJSON (JSONOutputProp $ Just t)
981+-- Response related types
983+-- | An EventMessage represents each kind of message received from the server.
985+ = ProgressEventMessage Progress
986+ | StatsEventMessage Stats
987+ | RequestLevelErrorMessage
992+ | RecordPayloadEventMessage ByteString
993+ deriving stock (Show, Eq)
1001+ deriving stock (Show, Eq)
1003+msgHeaderValueType :: Word8
1004+msgHeaderValueType = 7
1006+type MessageHeader = (MsgHeaderName, Text)
1008+-- | Represent the progress event returned in the Select response.
1009+data Progress = Progress
1010+ { pBytesScanned :: Int64,
1011+ pBytesProcessed :: Int64,
1012+ pBytesReturned :: Int64
1014+ deriving stock (Show, Eq)
1016+-- | Represent the stats event returned at the end of the Select
1018+type Stats = Progress
1020+--------------------------------------------------------------------------
1021+-- Select API Related Types End
1022+--------------------------------------------------------------------------
385-- | Represents different kinds of payload that are used with S3 API
1024-- | Represents different kinds of payload that are used with S3 API
386-- requests.
1025-- requests.
387−data Payload = PayloadBS ByteString
1027+ = PayloadBS ByteString
388− | PayloadH Handle
1028+ | PayloadH Handle Int64 Int64 -- file handle, offset and length
389− Int64 -- offset
1029+ | PayloadC Int64 (C.ConduitT () ByteString (ResourceT IO) ()) -- length and byte source
391−
1031+defaultPayload :: Payload
392−instance Default Payload where
393− def = PayloadBS ""
1032+defaultPayload = PayloadBS ""
395−data RequestInfo = RequestInfo {
1034+data AdminReqInfo = AdminReqInfo
396− riMethod :: Method
1035+ { ariMethod :: Method,
397− , riBucket :: Maybe Bucket
1036+ ariPayloadHash :: Maybe ByteString,
398− , riObject :: Maybe Object
1037+ ariPayload :: Payload,
399− , riQueryParams :: Query
1038+ ariPath :: ByteString,
400− , riHeaders :: [Header]
1039+ ariHeaders :: [Header],
401− , riPayload :: Payload
1040+ ariQueryParams :: Query
402− , riPayloadHash :: Maybe ByteString
403− , riRegion :: Maybe Region
404− , riNeedsLocation :: Bool
407−instance Default RequestInfo where
1043+data S3ReqInfo = S3ReqInfo
408− def = RequestInfo HT.methodGet def def def def def Nothing def True
1044+ { riMethod :: Method,
1045+ riBucket :: Maybe Bucket,
1046+ riObject :: Maybe Object,
1047+ riQueryParams :: Query,
1048+ riHeaders :: [Header],
1049+ riPayload :: Payload,
1050+ riPayloadHash :: Maybe ByteString,
1051+ riRegion :: Maybe Region,
1052+ riNeedsLocation :: Bool,
1053+ riPresignExpirySecs :: Maybe UrlExpiry
410−getPathFromRI :: RequestInfo -> ByteString
1056+defaultS3ReqInfo :: S3ReqInfo
411−getPathFromRI ri =
1057+defaultS3ReqInfo =
413− b = riBucket ri
1059+ HT.methodGet
414− o = riObject ri
1060+ Nothing
415− segments = map toS $ catMaybes $ b : bool [] [o] (isJust b)
1061+ Nothing
417− B.concat ["/", B.intercalate "/" segments]
1063+ []
419−-- | Time to expire for a presigned URL. It interpreted as a number of
1070+getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
420−-- seconds. The maximum duration that can be specified is 7 days.
1071+getS3Path b o =
421−type UrlExpiry = Int
1072+ let segments = map encodeUtf8 $ catMaybes $ b : bool [] [o] (isJust b)
1073+ in B.concat ["/", B.intercalate "/" segments]
423−type RegionMap = Map.Map Bucket Region
1075+type RegionMap = H.HashMap Bucket Region
1077+-- | The Minio Monad - all computations accessing object storage
425−newtype Minio a = Minio {
1079+newtype Minio a = Minio
426− unMinio :: ReaderT MinioConn (StateT RegionMap (ResourceT IO)) a
1080+ { unMinio :: ReaderT MinioConn (ResourceT IO) a
428− deriving (
1082+ deriving newtype
429− Functor
1083+ ( Functor,
430− , Applicative
1084+ Applicative,
432− , MonadIO
1086+ MonadIO,
433− , MonadReader MinioConn
1087+ MonadReader MinioConn,
434− , MonadState RegionMap
438− , MonadResource
1088+ MonadResource,
441−instance MonadBaseControl IO Minio where
442− type StM Minio a = (a, RegionMap)
443− liftBaseWith f = Minio $ liftBaseWith $ \q -> f (q . unMinio)
444− restoreM = Minio . restoreM
446−-- | MinioConn holds connection info and a connection pool
1092+-- | MinioConn holds connection info and a connection pool to allow
1093+-- for efficient resource re-use.
447−data MinioConn = MinioConn {
1094+data MinioConn = MinioConn
448− mcConnInfo :: ConnectInfo
1095+ { mcConnInfo :: ConnectInfo,
449− , mcConnManager :: NC.Manager
1096+ mcConnManager :: NC.Manager,
1097+ mcRegionMap :: MVar RegionMap
1100+class HasSvcNamespace env where
1101+ getSvcNamespace :: env -> Text
1103+instance HasSvcNamespace MinioConn where
1104+ getSvcNamespace env =
1105+ let host = connectHost $ mcConnInfo env
1106+ in ( if host == "storage.googleapis.com"
1107+ then "http://doc.s3.amazonaws.com/2006-03-01"
1108+ else "http://s3.amazonaws.com/doc/2006-03-01/"
452-- | Takes connection information and returns a connection object to
1111-- | Takes connection information and returns a connection object to
453−-- be passed to 'runMinio'
1112+-- be passed to 'runMinio'. The returned value can be kept in the
1113+-- application environment and passed to `runMinioWith` whenever
1114+-- object storage is accessed.
454connect :: ConnectInfo -> IO MinioConn
1115connect :: ConnectInfo -> IO MinioConn
455connect ci = do
1116connect ci = do
1118+ | connectIsSecure ci && connectDisableTLSCertValidation ci =
1119+ let badTlsSettings =
1121+ tlsSettings@Conn.TLSSettingsSimple {} ->
1122+ tlsSettings {Conn.settingDisableCertificateValidation = True}
1124+ in TLS.mkManagerSettings badTlsSettings Nothing
456− let settings = bool defaultManagerSettings NC.tlsManagerSettings $
1125+ | connectIsSecure ci = NC.tlsManagerSettings
457− connectIsSecure ci
1126+ | otherwise = defaultManagerSettings
458 mgr <- NC.newManager settings
1127 mgr <- NC.newManager settings
1130+-- | Run the computation accessing object storage using the given
1131+-- `MinioConn`. This reuses connections, but otherwise it is similar
1133+runMinioWith :: MinioConn -> Minio a -> IO (Either MinioErr a)
1134+runMinioWith conn m = runResourceT $ runMinioResWith conn m
1136+-- | Given `ConnectInfo` and a HTTP connection manager, create a
1138+mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
1139+mkMinioConn ci mgr = do
1140+ rMapMVar <- M.newMVar H.empty
459− return $ MinioConn ci mgr
1141+ return $ MinioConn ci mgr rMapMVar
461-- | Run the Minio action and return the result or an error.
1143-- | Run the Minio action and return the result or an error.
462runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
1144runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
463runMinio ci m = do
1145runMinio ci m = do
464− conn <- liftIO $ connect ci
1146+ conn <- connect ci
1147+ runResourceT $ runMinioResWith conn m
1149+-- | Similar to 'runMinioWith'. Allows applications to allocate/release
1150+-- its resources along side MinIO's internal resources.
1151+runMinioResWith :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
1152+runMinioResWith conn m =
465− runResourceT . flip evalStateT Map.empty . flip runReaderT conn . unMinio $
1153+ flip runReaderT conn . unMinio $
466− fmap Right m `MC.catches`
1154+ fmap Right m
467− [ MC.Handler handlerServiceErr
1155+ `U.catches` [ U.Handler handlerServiceErr,
468− , MC.Handler handlerHE
1156+ U.Handler handlerHE,
469− , MC.Handler handlerFE
1157+ U.Handler handlerFE,
470− , MC.Handler handlerValidation
1158+ U.Handler handlerValidation
473 handlerServiceErr = return . Left . MErrService
1161 handlerServiceErr = return . Left . MErrService
474 handlerHE = return . Left . MErrHTTP
1162 handlerHE = return . Left . MErrHTTP
475 handlerFE = return . Left . MErrIO
1163 handlerFE = return . Left . MErrIO
476 handlerValidation = return . Left . MErrValidation
1164 handlerValidation = return . Left . MErrValidation
478−s3Name :: Text -> Name
1166+-- | Similar to 'runMinio'. Allows applications to allocate/release
479−s3Name s = Name s (Just "http://s3.amazonaws.com/doc/2006-03-01/") Nothing
1167+-- its resources along side MinIO's internal resources.
1168+runMinioRes :: ConnectInfo -> Minio a -> ResourceT IO (Either MinioErr a)
1169+runMinioRes ci m = do
1170+ conn <- liftIO $ connect ci
1171+ runMinioResWith conn m
481-- | Format as per RFC 1123.
1173-- | Format as per RFC 1123.
482formatRFC1123 :: UTCTime -> T.Text
1174formatRFC1123 :: UTCTime -> T.Text
483formatRFC1123 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
1175formatRFC1123 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
1177+lookupRegionCache :: Bucket -> Minio (Maybe Region)
1178+lookupRegionCache b = do
1179+ rMVar <- asks mcRegionMap
1180+ rMap <- UM.readMVar rMVar
1181+ return $ H.lookup b rMap
1183+addToRegionCache :: Bucket -> Region -> Minio ()
1184+addToRegionCache b region = do
1185+ rMVar <- asks mcRegionMap
1186+ UM.modifyMVar_ rMVar $ return . H.insert b region
1188+deleteFromRegionCache :: Bucket -> Minio ()
1189+deleteFromRegionCache b = do
1190+ rMVar <- asks mcRegionMap
1191+ UM.modifyMVar_ rMVar $ return . H.delete b