@@ -1,5 +1,5 @@
11--
2−-- Minio Haskell SDK, (C) 2017 Minio, Inc.
2+-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
33--
44-- Licensed under the Apache License, Version 2.0 (the "License");
55-- you may not use this file except in compliance with the License.
@@ -13,141 +13,276 @@
1313-- See the License for the specific language governing permissions and
1414-- limitations under the License.
1515--
16+{-# LANGUAGE CPP #-}
17+{-# LANGUAGE GADTs #-}
18+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
19+{-# LANGUAGE StrictData #-}
20+{-# LANGUAGE TypeFamilies #-}
1621
17−{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
1822module Network.Minio.Data where
1923
20−import Control.Monad.Base
21−import qualified Control.Monad.Catch as MC
22−import Control.Monad.Trans.Control
23−import Control.Monad.Trans.Resource
24−
24+import qualified Conduit as C
25+import qualified Control.Concurrent.MVar as M
26+import Control.Monad.Trans.Except (throwE)
27+import Control.Monad.Trans.Resource
28+ ( MonadResource,
29+ MonadThrow (..),
30+ MonadUnliftIO,
31+ ResourceT,
32+ runResourceT,
33+ )
34+import qualified Data.Aeson as A
35+import qualified Data.ByteArray as BA
2536import qualified Data.ByteString as B
26−import Data.Default (Default(..))
27−import qualified Data.Map as Map
37+import qualified Data.ByteString.Lazy as LB
38+import Data.Default.Class (def)
39+import qualified Data.HashMap.Strict as H
40+import qualified Data.Ini as Ini
41+import qualified Data.List as List
2842import qualified Data.Text as T
29−import Data.Time (formatTime, defaultTimeLocale)
30−import Network.HTTP.Client (defaultManagerSettings)
43+import qualified Data.Text.Encoding as TE
44+import Data.Time (defaultTimeLocale, formatTime)
45+import Lib.Prelude (UTCTime, throwIO)
46+import qualified Network.Connection as Conn
47+import Network.HTTP.Client (defaultManagerSettings)
48+import qualified Network.HTTP.Client.TLS as TLS
3149import qualified Network.HTTP.Conduit as NC
32−import Network.HTTP.Types (Method, Header, Query)
50+import Network.HTTP.Types
51+ ( ByteRange,
52+ Header,
53+ Method,
54+ Query,
55+ hRange,
56+ )
3357import qualified Network.HTTP.Types as HT
34−import Network.Minio.Errors
35−import Text.XML
58+import Network.Minio.Credentials
59+import Network.Minio.Data.Crypto
60+ ( encodeToBase64,
61+ hashMD5ToBase64,
62+ )
63+import Network.Minio.Data.Time (UrlExpiry)
64+import Network.Minio.Errors
65+ ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials),
66+ MinioErr (..),
67+ )
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
74+
75+-- | max obj size is 5TiB
76+maxObjectSize :: Int64
77+maxObjectSize = 5 * 1024 * 1024 * oneMiB
3678
37−import GHC.Show (Show(..))
79+-- | minimum size of parts used in multipart operations.
80+minPartSize :: Int64
81+minPartSize = 64 * oneMiB
3882
39−import Lib.Prelude
83+oneMiB :: Int64
84+oneMiB = 1024 * 1024
4085
86+-- | maximum number of parts that can be uploaded for a single object.
87+maxMultipartParts :: Int64
88+maxMultipartParts = 10000
4189
4290-- TODO: Add a type which provides typed constants for region. this
4391-- type should have a IsString instance to infer the appropriate
4492-- constant.
93+
4594-- | awsRegionMap - library constant
46−awsRegionMap :: Map.Map Text Text
47−awsRegionMap = Map.fromList [
48− ("us-east-1", "s3.amazonaws.com")
49− , ("us-east-2", "s3-us-east-2.amazonaws.com")
50− , ("us-west-1", "s3-us-west-1.amazonaws.com")
51− , ("us-east-2", "s3-us-west-2.amazonaws.com")
52− , ("ca-central-1", "s3-ca-central-1.amazonaws.com")
53− , ("ap-south-1", "s3-ap-south-1.amazonaws.com")
54− , ("ap-northeast-1", "s3-ap-northeast-1.amazonaws.com")
55− , ("ap-northeast-2", "s3-ap-northeast-2.amazonaws.com")
56− , ("ap-southeast-1", "s3-ap-southeast-1.amazonaws.com")
57− , ("ap-southeast-2", "s3-ap-southeast-2.amazonaws.com")
58− , ("eu-west-1", "s3-eu-west-1.amazonaws.com")
59− , ("eu-west-2", "s3-eu-west-2.amazonaws.com")
60− , ("eu-central-1", "s3-eu-central-1.amazonaws.com")
61− , ("sa-east-1", "s3-sa-east-1.amazonaws.com")
62− ]
63−
64−-- | Connection Info data type. To create a 'ConnectInfo' value, use one
65−-- of the provided smart constructors or override fields of the
66−-- Default instance.
67−data ConnectInfo = ConnectInfo {
68− connectHost :: Text
69− , connectPort :: Int
70− , connectAccessKey :: Text
71− , connectSecretKey :: Text
72− , connectIsSecure :: Bool
73− , connectRegion :: Region
74− , connectAutoDiscoverRegion :: Bool
75− } deriving (Eq, Show)
76−
77−-- | Connects to a Minio server located at @localhost:9000@ with access
78−-- key /minio/ and secret key /minio123/. It is over __HTTP__ by
79−-- default.
80−instance Default ConnectInfo where
81− def = ConnectInfo "localhost" 9000 "minio" "minio123" False "us-east-1" True
82−
83−-- | Default AWS ConnectInfo. Connects to "us-east-1". Credentials
84−-- should be supplied before use, for e.g.:
95+awsRegionMap :: H.HashMap Text Text
96+awsRegionMap =
97+ H.fromList
98+ [ ("us-east-1", "s3.us-east-1.amazonaws.com"),
99+ ("us-east-2", "s3.us-east-2.amazonaws.com"),
100+ ("us-west-1", "s3.us-west-1.amazonaws.com"),
101+ ("us-west-2", "s3.us-west-2.amazonaws.com"),
102+ ("ca-central-1", "s3.ca-central-1.amazonaws.com"),
103+ ("ap-south-1", "s3.ap-south-1.amazonaws.com"),
104+ ("ap-south-2", "s3.ap-south-2.amazonaws.com"),
105+ ("ap-northeast-1", "s3.ap-northeast-1.amazonaws.com"),
106+ ("ap-northeast-2", "s3.ap-northeast-2.amazonaws.com"),
107+ ("ap-northeast-3", "s3.ap-northeast-3.amazonaws.com"),
108+ ("ap-southeast-1", "s3.ap-southeast-1.amazonaws.com"),
109+ ("ap-southeast-2", "s3.ap-southeast-2.amazonaws.com"),
110+ ("ap-southeast-3", "s3.ap-southeast-3.amazonaws.com"),
111+ ("eu-west-1", "s3.eu-west-1.amazonaws.com"),
112+ ("eu-west-2", "s3.eu-west-2.amazonaws.com"),
113+ ("eu-west-3", "s3.eu-west-3.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"),
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")
128+ ]
129+
130+-- | Connection Info data type. To create a 'ConnectInfo' value,
131+-- enable the @OverloadedStrings@ language extension and use the
132+-- `IsString` instance to provide a URL, for example:
85133--
86−-- > awsCI {
87−-- > connectAccessKey = "my-access-key"
88−-- > , connectSecretKey = "my-secret-key"
89−-- > }
90−awsCI :: ConnectInfo
91−awsCI = def {
92− connectHost = "s3.amazonaws.com"
93− , connectPort = 443
94− , connectAccessKey = ""
95− , connectSecretKey = ""
96− , connectIsSecure = True
134+-- > let c :: ConnectInfo = "https://play.min.io"
135+data ConnectInfo = ConnectInfo
136+ { connectHost :: Text,
137+ connectPort :: Int,
138+ connectCreds :: Creds,
139+ connectIsSecure :: Bool,
140+ connectRegion :: Region,
141+ connectAutoDiscoverRegion :: Bool,
142+ connectDisableTLSCertValidation :: Bool
97143 }
98144
99−-- | AWS ConnectInfo with a specified region. It can optionally
100−-- disable the automatic discovery of a bucket's region via the
101−-- Boolean argument.
102−--
103−-- > awsWithRegionCI "us-west-1" False {
104−-- > connectAccessKey = "my-access-key"
105−-- > , connectSecretKey = "my-secret-key"
106−-- > }
145+getEndpoint :: ConnectInfo -> Endpoint
146+getEndpoint ci = (encodeUtf8 $ connectHost ci, connectPort ci, connectIsSecure ci)
147+
148+instance IsString ConnectInfo where
149+ fromString str =
150+ let req = NC.parseRequest_ str
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,
156+ connectRegion = "",
157+ connectAutoDiscoverRegion = True,
158+ connectDisableTLSCertValidation = False
159+ }
160+
161+-- | A 'CredentialLoader' is an action that may return a 'CredentialValue'.
162+-- Loaders may be chained together using 'findFirst'.
107163--
108−-- This restricts all operations to the "us-west-1" region and does
109−-- not perform any bucket location requests.
110−awsWithRegionCI :: Region -> Bool -> ConnectInfo
111−awsWithRegionCI region autoDiscoverRegion =
112− let host = maybe "s3.amazonaws.com" identity $
113− Map.lookup region awsRegionMap
114− in awsCI {
115− connectHost = host
116− , connectRegion = region
117− , connectAutoDiscoverRegion = autoDiscoverRegion
164+-- @since 1.7.0
165+type CredentialLoader = IO (Maybe CredentialValue)
166+
167+-- | Combines the given list of loaders, by calling each one in
168+-- order until a 'CredentialValue' is returned.
169+findFirst :: [CredentialLoader] -> IO (Maybe CredentialValue)
170+findFirst [] = return Nothing
171+findFirst (f : fs) = do
172+ c <- f
173+ maybe (findFirst fs) (return . Just) c
174+
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
185+ akey <-
186+ ExceptT $
187+ return $
188+ Ini.lookupValue "default" "aws_access_key_id" ini
189+ skey <-
190+ ExceptT $
191+ return $
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
195+
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
203+
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
211+
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
217+ maybe
218+ (throwIO MErrVMissingCredentials)
219+ (return . (`setCreds` ci))
220+ pMay
221+
222+-- | setCreds sets the given `CredentialValue` in the `ConnectInfo`.
223+setCreds :: CredentialValue -> ConnectInfo -> ConnectInfo
224+setCreds cv connInfo =
225+ connInfo
226+ { connectCreds = CredsStatic cv
118227 }
119228
229+-- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
230+-- credentials via the STS API on demand. It is automatically refreshed on
231+-- expiry.
232+setSTSCredential :: (STSCredentialProvider p) => p -> ConnectInfo -> IO ConnectInfo
233+setSTSCredential p ci = do
234+ store <- initSTSCredential p
235+ return ci {connectCreds = CredsSTS store}
120236
121−-- | <https://play.minio.io:9000 Minio Play Server>
122−-- ConnectInfo. Credentials are already filled in.
123−minioPlayCI :: ConnectInfo
124−minioPlayCI = def {
125− connectHost = "play.minio.io"
126− , connectPort = 9000
127− , connectAccessKey = "Q3AM3UQ867SPQQA43P2F"
128− , connectSecretKey = "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
129− , connectIsSecure = True
130− , connectAutoDiscoverRegion = False
131− }
237+-- | Set the S3 region parameter in the `ConnectInfo`
238+setRegion :: Region -> ConnectInfo -> ConnectInfo
239+setRegion r connInfo =
240+ connInfo
241+ { connectRegion = r,
242+ connectAutoDiscoverRegion = False
243+ }
132244
133−-- | ConnectInfo for Minio server. Takes hostname, port and a Boolean
134−-- to enable TLS.
135−--
136−-- > minioCI "minio.example.com" 9000 True {
137−-- > connectAccessKey = "my-access-key"
138−-- > , connectSecretKey = "my-secret-key"
139−-- > }
245+-- | Check if the connection to object storage server is secure
246+-- (i.e. uses TLS)
247+isConnectInfoSecure :: ConnectInfo -> Bool
248+isConnectInfoSecure = connectIsSecure
249+
250+-- | Disable TLS certificate validation completely! This makes TLS
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}
256+
257+getHostAddr :: ConnectInfo -> ByteString
258+getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort ci)
259+
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
140264--
141−-- This connects to a Minio server at the given hostname and port over
142−-- HTTPS.
143−minioCI :: Text -> Int -> Bool -> ConnectInfo
144−minioCI host port isSecure = def {
145− connectHost = host
146− , connectPort = port
147− , connectRegion = "us-east-1"
148− , connectIsSecure = isSecure
149− , connectAutoDiscoverRegion = False
150− }
265+-- Credentials should be supplied before use.
266+gcsCI :: ConnectInfo
267+gcsCI =
268+ setRegion
269+ "us"
270+ "https://storage.googleapis.com"
271+
272+-- | Default AWS S3 ConnectInfo. Connects to "us-east-1". Credentials
273+-- should be supplied before use.
274+awsCI :: ConnectInfo
275+awsCI = "https://s3.amazonaws.com"
276+
277+-- | <https://play.min.io MinIO Play Server>
278+-- ConnectInfo. Credentials are already filled in.
279+minioPlayCI :: ConnectInfo
280+minioPlayCI =
281+ let playCreds = CredentialValue "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG" Nothing
282+ in setCreds playCreds $
283+ setRegion
284+ "us-east-1"
285+ "https://play.min.io"
151286
152287-- |
153288-- Represents a bucket in the object store
@@ -157,25 +292,156 @@ type Bucket = Text
157292-- Represents an object name
158293type Object = Text
159294
160−-- |
161−-- Represents a region
162−-- TODO: This could be a Sum Type with all defined regions for AWS.
295+-- | Represents a region
163296type Region = Text
164297
165−-- | A type alias to represent an Entity-Tag returned by S3-compatible
166−-- APIs.
298+-- | A type alias to represent an Entity-Tag returned by S3-compatible APIs.
167299type ETag = Text
168300
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)
305+
306+-- | Validates that the given ByteString is 32 bytes long and creates
307+-- an encryption key.
308+mkSSECKey :: (MonadThrow m) => ByteString -> m SSECKey
309+mkSSECKey keyBytes
310+ | B.length keyBytes /= 32 =
311+ throwM MErrVInvalidEncryptionKeyLength
312+ | otherwise =
313+ return $ SSECKey $ BA.convert keyBytes
314+
315+-- | Data type to represent Server-Side-Encryption settings
316+data SSE where
317+ -- | Specifies SSE S3 encryption - server manages encryption keys
318+ SSE :: SSE
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
329+
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"
338+ in case sseArg of
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)
348+ ]
349+
350+-- | Data type for options in PutObject call. Start with the empty
351+-- `defaultPutObjectOptions` and use various the various poo*
352+-- accessors.
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.
376+ pooSSE :: Maybe SSE
377+ }
378+
379+-- | Provide default `PutObjectOptions`.
380+defaultPutObjectOptions :: PutObjectOptions
381+defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing
382+
383+pooToHeaders :: PutObjectOptions -> [HT.Header]
384+pooToHeaders poo =
385+ userMetadata
386+ ++ mapMaybe tupToMaybe (zip names values)
387+ ++ maybe [] toPutObjectHeaders (pooSSE poo)
388+ where
389+ tupToMaybe (k, Just v) = Just (k, v)
390+ tupToMaybe (_, Nothing) = Nothing
391+ userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo
392+ names =
393+ [ "content-type",
394+ "content-encoding",
395+ "content-disposition",
396+ "content-language",
397+ "cache-control",
398+ "x-amz-storage-class"
399+ ]
400+ values =
401+ map
402+ (fmap encodeUtf8 . (poo &))
403+ [ pooContentType,
404+ pooContentEncoding,
405+ pooContentDisposition,
406+ pooContentLanguage,
407+ pooCacheControl,
408+ pooStorageClass
409+ ]
410+
169411-- |
170412-- BucketInfo returned for list buckets call
171−data BucketInfo = BucketInfo {
172− biName :: Bucket
173− , biCreationDate :: UTCTime
174− } deriving (Show, Eq)
413+data BucketInfo = BucketInfo
414+ { biName :: Bucket,
415+ biCreationDate :: UTCTime
416+ }
417+ deriving stock (Show, Eq)
175418
176419-- | A type alias to represent a part-number for multipart upload
177420type PartNumber = Int16
178421
422+-- | Select part sizes - the logic is that the minimum part-size will
423+-- be 64MiB.
424+selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
425+selectPartSizes size =
426+ uncurry (List.zip3 [1 ..]) $
427+ List.unzip $
428+ loop 0 size
429+ where
430+ ceil :: Double -> Int64
431+ ceil = ceiling
432+ partSize =
433+ max
434+ minPartSize
435+ ( ceil $
436+ fromIntegral size
437+ / fromIntegral maxMultipartParts
438+ )
439+ m = partSize
440+ loop st sz
441+ | st > sz = []
442+ | st + m >= sz = [(st, sz - st)]
443+ | otherwise = (st, m) : loop (st + m) sz
444+
179445-- | A type alias to represent an upload-id for multipart upload
180446type UploadId = Text
181447
@@ -184,163 +450,264 @@ type PartTuple = (PartNumber, ETag)
184450
185451-- | Represents result from a listing of object parts of an ongoing
186452-- multipart upload.
187−data ListPartsResult = ListPartsResult {
188− lprHasMore :: Bool
189− , lprNextPart :: Maybe Int
190− , lprParts :: [ObjectPartInfo]
191− } deriving (Show, Eq)
192−
453+data ListPartsResult = ListPartsResult
454+ { lprHasMore :: Bool,
455+ lprNextPart :: Maybe Int,
456+ lprParts :: [ObjectPartInfo]
457+ }
458+ deriving stock (Show, Eq)
193459
194460-- | Represents information about an object part in an ongoing
195461-- multipart upload.
196−data ObjectPartInfo = ObjectPartInfo {
197− opiNumber :: PartNumber
198− , opiETag :: ETag
199− , opiSize :: Int64
200− , opiModTime :: UTCTime
201− } deriving (Show, Eq)
462+data ObjectPartInfo = ObjectPartInfo
463+ { opiNumber :: PartNumber,
464+ opiETag :: ETag,
465+ opiSize :: Int64,
466+ opiModTime :: UTCTime
467+ }
468+ deriving stock (Show, Eq)
202469
203470-- | Represents result from a listing of incomplete uploads to a
204471-- bucket.
205−data ListUploadsResult = ListUploadsResult {
206− lurHasMore :: Bool
207− , lurNextKey :: Maybe Text
208− , lurNextUpload :: Maybe Text
209− , lurUploads :: [(Object, UploadId, UTCTime)]
210− , lurCPrefixes :: [Text]
211− } deriving (Show, Eq)
472+data ListUploadsResult = ListUploadsResult
473+ { lurHasMore :: Bool,
474+ lurNextKey :: Maybe Text,
475+ lurNextUpload :: Maybe Text,
476+ lurUploads :: [(Object, UploadId, UTCTime)],
477+ lurCPrefixes :: [Text]
478+ }
479+ deriving stock (Show, Eq)
212480
213481-- | Represents information about a multipart upload.
214−data UploadInfo = UploadInfo {
215− uiKey :: Object
216− , uiUploadId :: UploadId
217− , uiInitTime :: UTCTime
218− , uiSize :: Int64
219− } deriving (Show, Eq)
482+data UploadInfo = UploadInfo
483+ { uiKey :: Object,
484+ uiUploadId :: UploadId,
485+ uiInitTime :: UTCTime,
486+ uiSize :: Int64
487+ }
488+ deriving stock (Show, Eq)
220489
221490-- | Represents result from a listing of objects in a bucket.
222−data ListObjectsResult = ListObjectsResult {
223− lorHasMore :: Bool
224− , lorNextToken :: Maybe Text
225− , lorObjects :: [ObjectInfo]
226− , lorCPrefixes :: [Text]
227− } deriving (Show, Eq)
491+data ListObjectsResult = ListObjectsResult
492+ { lorHasMore :: Bool,
493+ lorNextToken :: Maybe Text,
494+ lorObjects :: [ObjectInfo],
495+ lorCPrefixes :: [Text]
496+ }
497+ deriving stock (Show, Eq)
228498
229499-- | Represents result from a listing of objects version 1 in a bucket.
230−data ListObjectsV1Result = ListObjectsV1Result {
231− lorHasMore' :: Bool
232− , lorNextMarker :: Maybe Text
233− , lorObjects' :: [ObjectInfo]
234− , lorCPrefixes' :: [Text]
235− } deriving (Show, Eq)
500+data ListObjectsV1Result = ListObjectsV1Result
501+ { lorHasMore' :: Bool,
502+ lorNextMarker :: Maybe Text,
503+ lorObjects' :: [ObjectInfo],
504+ lorCPrefixes' :: [Text]
505+ }
506+ deriving stock (Show, Eq)
236507
237508-- | Represents information about an object.
238−data ObjectInfo = ObjectInfo {
239− oiObject :: Object
240− , oiModTime :: UTCTime
241− , oiETag :: ETag
242− , oiSize :: Int64
243− } deriving (Show, Eq)
244−
245−data CopyPartSource = CopyPartSource {
246− -- | formatted like "\/sourceBucket\/sourceObject"
247− cpSource :: Text
248− -- | (0, 9) means first ten bytes of the source object
249− , cpSourceRange :: Maybe (Int64, Int64)
250− , cpSourceIfMatch :: Maybe Text
251− , cpSourceIfNoneMatch :: Maybe Text
252− , cpSourceIfUnmodifiedSince :: Maybe UTCTime
253− , cpSourceIfModifiedSince :: Maybe UTCTime
254− } deriving (Show, Eq)
255−
256−instance Default CopyPartSource where
257− def = CopyPartSource "" def def def def def
258−
259−cpsToHeaders :: CopyPartSource -> [HT.Header]
260−cpsToHeaders cps = ("x-amz-copy-source", encodeUtf8 $ cpSource cps) :
261− rangeHdr ++ zip names values
262− where
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
272− . (:[])
273− . uncurry HT.ByteRangeFromTo
274− <$> map (both fromIntegral) (maybeToList $ cpSourceRange cps)
275−
276−-- | Extract the source bucket and source object name. TODO: validate
277−-- the bucket and object name extracted.
278−cpsToObject :: CopyPartSource -> Maybe (Bucket, Object)
279−cpsToObject cps = do
280− [_, bucket, object] <- Just splits
281− return (bucket, object)
509+data ObjectInfo = ObjectInfo
510+ { -- | Object key
511+ oiObject :: Object,
512+ -- | Modification time of the object
513+ oiModTime :: UTCTime,
514+ -- | ETag of the object
515+ oiETag :: ETag,
516+ -- | Size of the object in bytes
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-@
522+ -- prefix).
523+ oiUserMetadata :: H.HashMap Text Text,
524+ -- | A map of metadata
525+ -- key-value pairs (not
526+ -- including the
527+ -- user-metadata pairs)
528+ oiMetadata :: H.HashMap Text Text
529+ }
530+ deriving stock (Show, Eq)
531+
532+-- | Represents source object in server-side copy object
533+data SourceInfo = SourceInfo
534+ { -- | Bucket containing the source object
535+ srcBucket :: Text,
536+ -- | Source object key
537+ srcObject :: Text,
538+ -- | Source object
539+ -- byte-range
540+ -- (inclusive)
541+ srcRange :: Maybe (Int64, Int64),
542+ -- | ETag condition on source -
543+ -- object is copied only if the
544+ -- source object's ETag matches
545+ -- this value.
546+ srcIfMatch :: Maybe Text,
547+ -- | ETag not match condition
548+ -- on source - object is copied
549+ -- if ETag does not match this
550+ -- value.
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
559+ -- given time.
560+ srcIfUnmodifiedSince :: Maybe UTCTime
561+ }
562+ deriving stock (Show, Eq)
563+
564+-- | Provide a default for `SourceInfo`
565+defaultSourceInfo :: SourceInfo
566+defaultSourceInfo = SourceInfo "" "" Nothing Nothing Nothing Nothing Nothing
567+
568+-- | Represents destination object in server-side copy object
569+data DestinationInfo = DestinationInfo
570+ { -- | Destination bucket
571+ dstBucket :: Text,
572+ -- | Destination object key
573+ dstObject :: Text
574+ }
575+ deriving stock (Show, Eq)
576+
577+-- | Provide a default for `DestinationInfo`
578+defaultDestinationInfo :: DestinationInfo
579+defaultDestinationInfo = DestinationInfo "" ""
580+
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,
586+ -- [ByteRangeFromTo 0 9] means first ten bytes of the source object.
587+ gooRange :: Maybe ByteRange,
588+ -- | Set matching ETag condition, GetObject which matches the following
589+ -- ETag.
590+ gooIfMatch :: Maybe ETag,
591+ -- | Set matching ETag none condition, GetObject which does not match
592+ -- the following ETag.
593+ gooIfNoneMatch :: Maybe ETag,
594+ -- | Set object unmodified condition, GetObject unmodified since given time.
595+ gooIfUnmodifiedSince :: Maybe UTCTime,
596+ -- | Set object modified condition, GetObject modified since given time.
597+ gooIfModifiedSince :: Maybe UTCTime,
598+ -- | Specify SSE-C key
599+ gooSSECKey :: Maybe SSECKey
600+ }
601+
602+-- | Provide default `GetObjectOptions`.
603+defaultGetObjectOptions :: GetObjectOptions
604+defaultGetObjectOptions =
605+ GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
606+
607+gooToHeaders :: GetObjectOptions -> [HT.Header]
608+gooToHeaders goo =
609+ rangeHdr
610+ ++ zip names values
611+ ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
282612 where
283− splits = T.splitOn "/" $ cpSource cps
613+ names =
614+ [ "If-Match",
615+ "If-None-Match",
616+ "If-Unmodified-Since",
617+ "If-Modified-Since"
618+ ]
619+ values =
620+ mapMaybe
621+ (fmap encodeUtf8 . (goo &))
622+ [ gooIfMatch,
623+ gooIfNoneMatch,
624+ fmap formatRFC1123 . gooIfUnmodifiedSince,
625+ fmap formatRFC1123 . gooIfModifiedSince
626+ ]
627+ rangeHdr =
628+ maybe [] (\a -> [(hRange, HT.renderByteRanges [a])]) $
629+ gooRange goo
630+
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 ()
638+ }
284639
285640-- | A data-type for events that can occur in the object storage
286641-- server. Reference:
287642-- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types
288−data Event = ObjectCreated
289− | ObjectCreatedPut
290− | ObjectCreatedPost
291− | ObjectCreatedCopy
292− | ObjectCreatedMultipartUpload
293− | ObjectRemoved
294− | ObjectRemovedDelete
295− | ObjectRemovedDeleteMarkerCreated
296− | ReducedRedundancyLostObject
297− deriving (Eq)
298−
299−instance Show Event where
300− show ObjectCreated = "s3:ObjectCreated:*"
301− show ObjectCreatedPut = "s3:ObjectCreated:Put"
302− show ObjectCreatedPost = "s3:ObjectCreated:Post"
303− show ObjectCreatedCopy = "s3:ObjectCreated:Copy"
304− show ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
305− show ObjectRemoved = "s3:ObjectRemoved:*"
306− show ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
307− show ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
308− show ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
643+data Event
644+ = ObjectCreated
645+ | ObjectCreatedPut
646+ | ObjectCreatedPost
647+ | ObjectCreatedCopy
648+ | ObjectCreatedMultipartUpload
649+ | ObjectRemoved
650+ | ObjectRemovedDelete
651+ | ObjectRemovedDeleteMarkerCreated
652+ | ReducedRedundancyLostObject
653+ deriving stock (Eq, Show)
654+
655+instance ToText Event where
656+ toText ObjectCreated = "s3:ObjectCreated:*"
657+ toText ObjectCreatedPut = "s3:ObjectCreated:Put"
658+ toText ObjectCreatedPost = "s3:ObjectCreated:Post"
659+ toText ObjectCreatedCopy = "s3:ObjectCreated:Copy"
660+ toText ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
661+ toText ObjectRemoved = "s3:ObjectRemoved:*"
662+ toText ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
663+ toText ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
664+ toText ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
309665
310666textToEvent :: Text -> Maybe Event
311667textToEvent t = case t of
312− "s3:ObjectCreated:*" -> Just ObjectCreated
313− "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
314− "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
315− "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
316− "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
317− "s3:ObjectRemoved:*" -> Just ObjectRemoved
318− "s3:ObjectRemoved:Delete" -> Just ObjectRemovedDelete
668+ "s3:ObjectCreated:*" -> Just ObjectCreated
669+ "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
670+ "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
671+ "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
672+ "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
673+ "s3:ObjectRemoved:*" -> Just ObjectRemoved
674+ "s3:ObjectRemoved:Delete" -> Just ObjectRemovedDelete
319675 "s3:ObjectRemoved:DeleteMarkerCreated" -> Just ObjectRemovedDeleteMarkerCreated
320− "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
321− _ -> Nothing
322−
676+ "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
677+ _ -> Nothing
323678
324−data Filter = Filter
679+-- | Filter data type - part of notification configuration
680+newtype Filter = Filter
325681 { fFilter :: FilterKey
326− } deriving (Show, Eq)
682+ }
683+ deriving stock (Show, Eq)
327684
328−instance Default Filter where
329− def = Filter def
685+-- | defaultFilter is empty, used to create a notification
686+-- configuration.
687+defaultFilter :: Filter
688+defaultFilter = Filter defaultFilterKey
330689
331−data FilterKey = FilterKey
690+-- | FilterKey contains FilterRules, and is part of a Filter.
691+newtype FilterKey = FilterKey
332692 { fkKey :: FilterRules
333− } deriving (Show, Eq)
693+ }
694+ deriving stock (Show, Eq)
334695
335−instance Default FilterKey where
336− def = FilterKey def
696+-- | defaultFilterKey is empty, used to create notification
697+-- configuration.
698+defaultFilterKey :: FilterKey
699+defaultFilterKey = FilterKey defaultFilterRules
337700
338−data FilterRules = FilterRules
701+-- | FilterRules represents a collection of `FilterRule`s.
702+newtype FilterRules = FilterRules
339703 { frFilterRules :: [FilterRule]
340− } deriving (Show, Eq)
704+ }
705+ deriving stock (Show, Eq)
341706
342−instance Default FilterRules where
343− def = FilterRules []
707+-- | defaultFilterRules is empty, used to create notification
708+-- configuration.
709+defaultFilterRules :: FilterRules
710+defaultFilterRules = FilterRules []
344711
345712-- | A filter rule that can act based on the suffix or prefix of an
346713-- object. As an example, let's create two filter rules:
@@ -348,25 +715,28 @@ instance Default FilterRules where
348715-- > let suffixRule = FilterRule "suffix" ".jpg"
349716-- > let prefixRule = FilterRule "prefix" "images/"
350717--
351−-- The `suffixRule` restricts the notification to be triggered only
352−-- for objects having a suffix of ".jpg", and the `prefixRule`
718+-- The @suffixRule@ restricts the notification to be triggered only
719+-- for objects having a suffix of ".jpg", and the @prefixRule@
353720-- restricts it to objects having a prefix of "images/".
354721data FilterRule = FilterRule
355− { frName :: Text
356− , frValue :: Text
357− } deriving (Show, Eq)
722+ { frName :: Text,
723+ frValue :: Text
724+ }
725+ deriving stock (Show, Eq)
358726
727+-- | Arn is an alias of Text
359728type Arn = Text
360729
361730-- | A data-type representing the configuration for a particular
362731-- notification system. It could represent a Queue, Topic or Lambda
363732-- Function configuration.
364733data NotificationConfig = NotificationConfig
365− { ncId :: Text
366− , ncArn :: Arn
367− , ncEvents :: [Event]
368− , ncFilter :: Filter
369− } deriving (Show, Eq)
734+ { ncId :: Text,
735+ ncArn :: Arn,
736+ ncEvents :: [Event],
737+ ncFilter :: Filter
738+ }
739+ deriving stock (Show, Eq)
370740
371741-- | A data-type to represent bucket notification configuration. It is
372742-- a collection of queue, topic or lambda function configurations. The
@@ -374,110 +744,448 @@ data NotificationConfig = NotificationConfig
374744-- described at
375745-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html>
376746data Notification = Notification
377− { nQueueConfigurations :: [NotificationConfig]
378− , nTopicConfigurations :: [NotificationConfig]
379− , nCloudFunctionConfigurations :: [NotificationConfig]
380− } deriving (Eq, Show)
747+ { nQueueConfigurations :: [NotificationConfig],
748+ nTopicConfigurations :: [NotificationConfig],
749+ nCloudFunctionConfigurations :: [NotificationConfig]
750+ }
751+ deriving stock (Show, Eq)
752+
753+-- | The default notification configuration is empty.
754+defaultNotification :: Notification
755+defaultNotification = Notification [] [] []
756+
757+--------------------------------------------------------------------------
758+-- Select API Related Types
759+--------------------------------------------------------------------------
760+
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
769+ }
770+ deriving stock (Show, Eq)
771+
772+data ExpressionType = SQL
773+ deriving stock (Show, Eq)
774+
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
782+ }
783+ deriving stock (Show, Eq)
784+
785+-- | Data type representing the compression setting in a Select
786+-- request.
787+data CompressionType
788+ = CompressionTypeNone
789+ | CompressionTypeGzip
790+ | CompressionTypeBzip2
791+ deriving stock (Show, Eq)
792+
793+-- | Data type representing input object format information in a
794+-- Select request.
795+data InputFormatInfo
796+ = InputFormatCSV CSVInputProp
797+ | InputFormatJSON JSONInputProp
798+ | InputFormatParquet
799+ deriving stock (Show, Eq)
800+
801+-- | defaultCsvInput returns InputSerialization with default CSV
802+-- format, and without any compression setting.
803+defaultCsvInput :: InputSerialization
804+defaultCsvInput = InputSerialization Nothing (InputFormatCSV defaultCSVProp)
805+
806+-- | linesJsonInput returns InputSerialization with JSON line based
807+-- format with no compression setting.
808+linesJsonInput :: InputSerialization
809+linesJsonInput =
810+ InputSerialization
811+ Nothing
812+ (InputFormatJSON $ JSONInputProp JSONTypeLines)
813+
814+-- | documentJsonInput returns InputSerialization with JSON document
815+-- based format with no compression setting.
816+documentJsonInput :: InputSerialization
817+documentJsonInput =
818+ InputSerialization
819+ Nothing
820+ (InputFormatJSON $ JSONInputProp JSONTypeDocument)
821+
822+-- | defaultParquetInput returns InputSerialization with Parquet
823+-- format, and no compression setting.
824+defaultParquetInput :: InputSerialization
825+defaultParquetInput = InputSerialization Nothing InputFormatParquet
826+
827+-- | setInputCompressionType sets the compression type for the input
828+-- of the SelectRequest
829+setInputCompressionType ::
830+ CompressionType ->
831+ SelectRequest ->
832+ SelectRequest
833+setInputCompressionType c i =
834+ let is = srInputSerialization i
835+ is' = is {isCompressionType = Just c}
836+ in i {srInputSerialization = is'}
837+
838+-- | defaultCsvOutput returns OutputSerialization with default CSV
839+-- format.
840+defaultCsvOutput :: OutputSerialization
841+defaultCsvOutput = OutputSerializationCSV defaultCSVProp
842+
843+-- | defaultJsonInput returns OutputSerialization with default JSON
844+-- format.
845+defaultJsonOutput :: OutputSerialization
846+defaultJsonOutput = OutputSerializationJSON (JSONOutputProp Nothing)
847+
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@.
853+selectRequest ::
854+ Text ->
855+ InputSerialization ->
856+ OutputSerialization ->
857+ SelectRequest
858+selectRequest sqlQuery inputSer outputSer =
859+ SelectRequest
860+ { srExpression = sqlQuery,
861+ srExpressionType = SQL,
862+ srInputSerialization = inputSer,
863+ srOutputSerialization = outputSer,
864+ srRequestProgressEnabled = Nothing
865+ }
866+
867+-- | setRequestProgressEnabled sets the flag for turning on progress
868+-- messages when the Select response is being streamed back to the
869+-- client.
870+setRequestProgressEnabled :: Bool -> SelectRequest -> SelectRequest
871+setRequestProgressEnabled enabled sr =
872+ sr {srRequestProgressEnabled = Just enabled}
873+
874+type CSVInputProp = CSVProp
875+
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)
880+
881+instance Semigroup CSVProp where
882+ (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
883+
884+instance Monoid CSVProp where
885+ mempty = CSVProp mempty
886+
887+csvPropsList :: CSVProp -> [(Text, Text)]
888+csvPropsList (CSVProp h) = sort $ H.toList h
889+
890+defaultCSVProp :: CSVProp
891+defaultCSVProp = mempty
892+
893+-- | Specify the CSV record delimiter property.
894+recordDelimiter :: Text -> CSVProp
895+recordDelimiter = CSVProp . H.singleton "RecordDelimiter"
896+
897+-- | Specify the CSV field delimiter property.
898+fieldDelimiter :: Text -> CSVProp
899+fieldDelimiter = CSVProp . H.singleton "FieldDelimiter"
900+
901+-- | Specify the CSV quote character property.
902+quoteCharacter :: Text -> CSVProp
903+quoteCharacter = CSVProp . H.singleton "QuoteCharacter"
904+
905+-- | Specify the CSV quote-escape character property.
906+quoteEscapeCharacter :: Text -> CSVProp
907+quoteEscapeCharacter = CSVProp . H.singleton "QuoteEscapeCharacter"
908+
909+-- | FileHeaderInfo specifies information about column headers for CSV
910+-- format.
911+data FileHeaderInfo
912+ = -- | No column headers are present
913+ FileHeaderNone
914+ | -- | Headers are present and they should be used
915+ FileHeaderUse
916+ | -- | Header are present, but should be ignored
917+ FileHeaderIgnore
918+ deriving stock (Show, Eq)
919+
920+-- | Specify the CSV file header info property.
921+fileHeaderInfo :: FileHeaderInfo -> CSVProp
922+fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toStr
923+ where
924+ toStr FileHeaderNone = "NONE"
925+ toStr FileHeaderUse = "USE"
926+ toStr FileHeaderIgnore = "IGNORE"
927+
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"
381932
382−instance Default Notification where
383− def = Notification [] [] []
933+-- | Allow quoted record delimiters inside a row using this property.
934+allowQuotedRecordDelimiter :: CSVProp
935+allowQuotedRecordDelimiter = CSVProp $ H.singleton "AllowQuotedRecordDelimiter" "TRUE"
936+
937+-- | Set the CSV format properties in the InputSerialization.
938+setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization
939+setInputCSVProps p is = is {isFormatInfo = InputFormatCSV p}
940+
941+-- | Set the CSV format properties in the OutputSerialization.
942+outputCSVFromProps :: CSVProp -> OutputSerialization
943+outputCSVFromProps = OutputSerializationCSV
944+
945+newtype JSONInputProp = JSONInputProp {jsonipType :: JSONType}
946+ deriving stock (Show, Eq)
947+
948+data JSONType = JSONTypeDocument | JSONTypeLines
949+ deriving stock (Show, Eq)
950+
951+-- | OutputSerialization represents output serialization settings for
952+-- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as
953+-- a starting point.
954+data OutputSerialization
955+ = OutputSerializationJSON JSONOutputProp
956+ | OutputSerializationCSV CSVOutputProp
957+ deriving stock (Show, Eq)
958+
959+type CSVOutputProp = CSVProp
960+
961+-- | quoteFields is an output serialization parameter
962+quoteFields :: QuoteFields -> CSVProp
963+quoteFields q = CSVProp $
964+ H.singleton "QuoteFields" $
965+ case q of
966+ QuoteFieldsAsNeeded -> "ASNEEDED"
967+ QuoteFieldsAlways -> "ALWAYS"
968+
969+-- | Represent the QuoteField setting.
970+data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
971+ deriving stock (Show, Eq)
972+
973+newtype JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
974+ deriving stock (Show, Eq)
975+
976+-- | Set the output record delimiter for JSON format
977+outputJSONFromRecordDelimiter :: Text -> OutputSerialization
978+outputJSONFromRecordDelimiter t =
979+ OutputSerializationJSON (JSONOutputProp $ Just t)
980+
981+-- Response related types
982+
983+-- | An EventMessage represents each kind of message received from the server.
984+data EventMessage
985+ = ProgressEventMessage Progress
986+ | StatsEventMessage Stats
987+ | RequestLevelErrorMessage
988+ Text
989+ -- ^ Error code
990+ Text
991+ -- ^ Error message
992+ | RecordPayloadEventMessage ByteString
993+ deriving stock (Show, Eq)
994+
995+data MsgHeaderName
996+ = MessageType
997+ | EventType
998+ | ContentType
999+ | ErrorCode
1000+ | ErrorMessage
1001+ deriving stock (Show, Eq)
1002+
1003+msgHeaderValueType :: Word8
1004+msgHeaderValueType = 7
1005+
1006+type MessageHeader = (MsgHeaderName, Text)
1007+
1008+-- | Represent the progress event returned in the Select response.
1009+data Progress = Progress
1010+ { pBytesScanned :: Int64,
1011+ pBytesProcessed :: Int64,
1012+ pBytesReturned :: Int64
1013+ }
1014+ deriving stock (Show, Eq)
1015+
1016+-- | Represent the stats event returned at the end of the Select
1017+-- response.
1018+type Stats = Progress
1019+
1020+--------------------------------------------------------------------------
1021+-- Select API Related Types End
1022+--------------------------------------------------------------------------
3841023
3851024-- | Represents different kinds of payload that are used with S3 API
3861025-- requests.
387−data Payload = PayloadBS ByteString
388− | PayloadH Handle
389− Int64 -- offset
390− Int64 -- size
391−
392−instance Default Payload where
393− def = PayloadBS ""
394−
395−data RequestInfo = RequestInfo {
396− riMethod :: Method
397− , riBucket :: Maybe Bucket
398− , riObject :: Maybe Object
399− , riQueryParams :: Query
400− , riHeaders :: [Header]
401− , riPayload :: Payload
402− , riPayloadHash :: Maybe ByteString
403− , riRegion :: Maybe Region
404− , riNeedsLocation :: Bool
1026+data Payload
1027+ = PayloadBS ByteString
1028+ | PayloadH Handle Int64 Int64 -- file handle, offset and length
1029+ | PayloadC Int64 (C.ConduitT () ByteString (ResourceT IO) ()) -- length and byte source
1030+
1031+defaultPayload :: Payload
1032+defaultPayload = PayloadBS ""
1033+
1034+data AdminReqInfo = AdminReqInfo
1035+ { ariMethod :: Method,
1036+ ariPayloadHash :: Maybe ByteString,
1037+ ariPayload :: Payload,
1038+ ariPath :: ByteString,
1039+ ariHeaders :: [Header],
1040+ ariQueryParams :: Query
4051041 }
4061042
407−instance Default RequestInfo where
408− def = RequestInfo HT.methodGet def def def def def Nothing def True
1043+data S3ReqInfo = S3ReqInfo
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
1054+ }
4091055
410−getPathFromRI :: RequestInfo -> ByteString
411−getPathFromRI ri =
412− let
413− b = riBucket ri
414− o = riObject ri
415− segments = map toS $ catMaybes $ b : bool [] [o] (isJust b)
416− in
417− B.concat ["/", B.intercalate "/" segments]
1056+defaultS3ReqInfo :: S3ReqInfo
1057+defaultS3ReqInfo =
1058+ S3ReqInfo
1059+ HT.methodGet
1060+ Nothing
1061+ Nothing
1062+ []
1063+ []
1064+ defaultPayload
1065+ Nothing
1066+ Nothing
1067+ True
1068+ Nothing
4181069
419−-- | Time to expire for a presigned URL. It interpreted as a number of
420−-- seconds. The maximum duration that can be specified is 7 days.
421−type UrlExpiry = Int
1070+getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
1071+getS3Path b o =
1072+ let segments = map encodeUtf8 $ catMaybes $ b : bool [] [o] (isJust b)
1073+ in B.concat ["/", B.intercalate "/" segments]
4221074
423−type RegionMap = Map.Map Bucket Region
1075+type RegionMap = H.HashMap Bucket Region
4241076
425−newtype Minio a = Minio {
426− unMinio :: ReaderT MinioConn (StateT RegionMap (ResourceT IO)) a
1077+-- | The Minio Monad - all computations accessing object storage
1078+-- happens in it.
1079+newtype Minio a = Minio
1080+ { unMinio :: ReaderT MinioConn (ResourceT IO) a
4271081 }
428− deriving (
429− Functor
430− , Applicative
431− , Monad
432− , MonadIO
433− , MonadReader MinioConn
434− , MonadState RegionMap
435− , MonadThrow
436− , MonadCatch
437− , MonadBase IO
438− , MonadResource
1082+ deriving newtype
1083+ ( Functor,
1084+ Applicative,
1085+ Monad,
1086+ MonadIO,
1087+ MonadReader MinioConn,
1088+ MonadResource,
1089+ MonadUnliftIO
4391090 )
4401091
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
445−
446−-- | MinioConn holds connection info and a connection pool
447−data MinioConn = MinioConn {
448− mcConnInfo :: ConnectInfo
449− , mcConnManager :: NC.Manager
1092+-- | MinioConn holds connection info and a connection pool to allow
1093+-- for efficient resource re-use.
1094+data MinioConn = MinioConn
1095+ { mcConnInfo :: ConnectInfo,
1096+ mcConnManager :: NC.Manager,
1097+ mcRegionMap :: MVar RegionMap
4501098 }
4511099
1100+class HasSvcNamespace env where
1101+ getSvcNamespace :: env -> Text
1102+
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/"
1109+ )
1110+
4521111-- | 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.
4541115connect :: ConnectInfo -> IO MinioConn
4551116connect ci = do
456− let settings = bool defaultManagerSettings NC.tlsManagerSettings $
457− connectIsSecure ci
1117+ let settings
1118+ | connectIsSecure ci && connectDisableTLSCertValidation ci =
1119+ let badTlsSettings =
1120+ case def of
1121+ tlsSettings@Conn.TLSSettingsSimple {} ->
1122+ tlsSettings {Conn.settingDisableCertificateValidation = True}
1123+ _ -> def
1124+ in TLS.mkManagerSettings badTlsSettings Nothing
1125+ | connectIsSecure ci = NC.tlsManagerSettings
1126+ | otherwise = defaultManagerSettings
4581127 mgr <- NC.newManager settings
459− return $ MinioConn ci mgr
1128+ mkMinioConn ci mgr
1129+
1130+-- | Run the computation accessing object storage using the given
1131+-- `MinioConn`. This reuses connections, but otherwise it is similar
1132+-- to `runMinio`.
1133+runMinioWith :: MinioConn -> Minio a -> IO (Either MinioErr a)
1134+runMinioWith conn m = runResourceT $ runMinioResWith conn m
1135+
1136+-- | Given `ConnectInfo` and a HTTP connection manager, create a
1137+-- `MinioConn`.
1138+mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
1139+mkMinioConn ci mgr = do
1140+ rMapMVar <- M.newMVar H.empty
1141+ return $ MinioConn ci mgr rMapMVar
4601142
4611143-- | Run the Minio action and return the result or an error.
4621144runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
4631145runMinio ci m = do
464− conn <- liftIO $ connect ci
465− runResourceT . flip evalStateT Map.empty . flip runReaderT conn . unMinio $
466− fmap Right m `MC.catches`
467− [ MC.Handler handlerServiceErr
468− , MC.Handler handlerHE
469− , MC.Handler handlerFE
470− , MC.Handler handlerValidation
471− ]
1146+ conn <- connect ci
1147+ runResourceT $ runMinioResWith conn m
1148+
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 =
1153+ flip runReaderT conn . unMinio $
1154+ fmap Right m
1155+ `U.catches` [ U.Handler handlerServiceErr,
1156+ U.Handler handlerHE,
1157+ U.Handler handlerFE,
1158+ U.Handler handlerValidation
1159+ ]
4721160 where
4731161 handlerServiceErr = return . Left . MErrService
4741162 handlerHE = return . Left . MErrHTTP
4751163 handlerFE = return . Left . MErrIO
4761164 handlerValidation = return . Left . MErrValidation
4771165
478−s3Name :: Text -> Name
479−s3Name s = Name s (Just "http://s3.amazonaws.com/doc/2006-03-01/") Nothing
1166+-- | Similar to 'runMinio'. Allows applications to allocate/release
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
4801172
4811173-- | Format as per RFC 1123.
4821174formatRFC1123 :: UTCTime -> T.Text
4831175formatRFC1123 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
1176+
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
1182+
1183+addToRegionCache :: Bucket -> Region -> Minio ()
1184+addToRegionCache b region = do
1185+ rMVar <- asks mcRegionMap
1186+ UM.modifyMVar_ rMVar $ return . H.insert b region
1187+
1188+deleteFromRegionCache :: Bucket -> Minio ()
1189+deleteFromRegionCache b = do
1190+ rMVar <- asks mcRegionMap
1191+ UM.modifyMVar_ rMVar $ return . H.delete b