aa2382b · typeable/minio-hs

git.iko.soy/typeable/minio-hs

Use region specific endpoints for AWS S3 in presigned Urls (#164)

- Also update standard S3 endpoints - Unify code that determines if path style or virtual style must be used for regular and presigned requests Fixes #160

commitaa2382b2e9503a16d00e9c71f2f2d0ebb14186c4 authorAditya Manthramurthy <donatello@users.noreply.github.com> dateMon 8 Mar 2021, 16:35 (6 years ago) parentb8cc1e5

8 files changed+132−91

compare with master

unifiedsplit

minio-hs.cabal+1 src/Network/Minio/API.hs+83−33 src/Network/Minio/APICommon.hs+8 src/Network/Minio/Data.hs+18−19 src/Network/Minio/Data/Time.hs+5 src/Network/Minio/PresignedOperations.hs+16−37 src/Network/Minio/Sign/V4.hs+1−1 test/LiveServer.hs−1

minio-hs.cabal+1

@@ -77,6 +77,7 @@ common base-settings

7777 , http-types >= 0.12

7878 , ini

7979 , memory >= 0.14

80+ , network-uri

8081 , raw-strings-qq >= 1

8182 , resourcet >= 1.2

8283 , retry

src/Network/Minio/API.hs+83−33

@@ -19,6 +19,7 @@ module Network.Minio.API

1919 S3ReqInfo (..),

2020 runMinio,

2121 executeRequest,

22+ buildRequest,

2223 mkStreamRequest,

2324 getLocation,

2425 isValidBucketName,

@@ -40,6 +41,7 @@ import qualified Data.HashMap.Strict as H

4041import qualified Data.Text as T

4142import qualified Data.Time.Clock as Time

4243import Lib.Prelude

44+import qualified Network.HTTP.Client as NClient

4345import Network.HTTP.Conduit (Response)

4446import qualified Network.HTTP.Conduit as NC

4547import qualified Network.HTTP.Types as HT

@@ -78,6 +80,7 @@ discoverRegion ri = runMaybeT $ do

7880 return

7981 regionMay

8082

83+-- | Returns the region to be used for the request.

8184getRegion :: S3ReqInfo -> Minio (Maybe Region)

8285getRegion ri = do

8386 ci <- asks mcConnInfo

@@ -104,6 +107,42 @@ getRegionHost r = do

104107 (H.lookup r awsRegionMap)

105108 else return $ connectHost ci

106109

110+-- | Computes the appropriate host, path and region for the request.

111+--

112+-- For AWS, always use virtual bucket style, unless bucket has periods. For

113+-- MinIO and other non-AWS, default to path style.

114+getHostPathRegion :: S3ReqInfo -> Minio (Text, ByteString, Maybe Region)

115+getHostPathRegion ri = do

116+ ci <- asks mcConnInfo

117+ regionMay <- getRegion ri

118+ case riBucket ri of

119+ Nothing ->

120+ -- Implies a ListBuckets request.

121+ return (connectHost ci, "/", regionMay)

122+ Just bucket -> do

123+ regionHost <- case regionMay of

124+ Nothing -> return $ connectHost ci

125+ Just "" -> return $ connectHost ci

126+ Just r -> getRegionHost r

127+ let pathStyle =

128+ ( regionHost,

129+ getS3Path (riBucket ri) (riObject ri),

130+ regionMay

131+ )

132+ virtualStyle =

133+ ( ( bucket <> "." <> regionHost,

134+ encodeUtf8 $ "/" <> fromMaybe "" (riObject ri),

135+ regionMay

136+ )

137+ )

138+ if

139+ | isAWSConnectInfo ci ->

140+ return $

141+ if bucketHasPeriods bucket

142+ then pathStyle

143+ else virtualStyle

144+ | otherwise -> return pathStyle

145+

107146buildRequest :: S3ReqInfo -> Minio NC.Request

108147buildRequest ri = do

109148 maybe (return ()) checkBucketNameValidity $ riBucket ri

@@ -111,17 +150,15 @@ buildRequest ri = do

111150

112151 ci <- asks mcConnInfo

113152

114− regionMay <- getRegion ri

115−

116− regionHost <- maybe (return $ connectHost ci) getRegionHost regionMay

153+ (host, path, regionMay) <- getHostPathRegion ri

117154

118− let ri' =

155+ let ci' = ci {connectHost = host}

156+ hostHeader = (hHost, getHostAddr ci')

157+ ri' =

119158 ri

120159 { riHeaders = hostHeader : riHeaders ri,

121160 riRegion = regionMay

122161 }

123− ci' = ci {connectHost = regionHost}

124− hostHeader = (hHost, getHostAddr ci')

125162 -- Does not contain body and auth info.

126163 baseRequest =

127164 NC.defaultRequest

@@ -129,7 +166,7 @@ buildRequest ri = do

129166 NC.secure = connectIsSecure ci',

130167 NC.host = encodeUtf8 $ connectHost ci',

131168 NC.port = connectPort ci',

132− NC.path = getS3Path (riBucket ri') (riObject ri'),

169+ NC.path = path,

133170 NC.requestHeaders = riHeaders ri',

134171 NC.queryString = HT.renderQuery False $ riQueryParams ri'

135172 }

@@ -142,11 +179,13 @@ buildRequest ri = do

142179 (connectSecretKey ci')

143180 timeStamp

144181 (riRegion ri')

145− Nothing

182+ (riPresignExpirySecs ri')

146183 Nothing

147184

148185 -- Cases to handle:

149186 --

187+ -- 0. Handle presign URL case.

188+ --

150189 -- 1. Connection is secure: use unsigned payload

151190 --

152191 -- 2. Insecure connection, streaming signature is enabled via use of

@@ -155,33 +194,44 @@ buildRequest ri = do

155194 -- 3. Insecure connection, non-conduit payload: compute payload

156195 -- sha256hash, buffer request in memory and perform request.

157196

158− -- case 2 from above.

159197 if

160− | isStreamingPayload (riPayload ri')

161− && (not $ connectIsSecure ci') -> do

162− (pLen, pSrc) <- case riPayload ri of

163− PayloadC l src -> return (l, src)

164− _ -> throwIO MErrVUnexpectedPayload

165− let reqFn = signV4Stream pLen sp baseRequest

166− return $ reqFn pSrc

167− | otherwise -> do

168− -- case 1 described above.

169− sp' <-

170− if

171− | connectIsSecure ci' -> return sp

172− -- case 3 described above.

173− | otherwise -> do

174− pHash <- getPayloadSHA256Hash $ riPayload ri'

175− return $ sp {spPayloadHash = Just pHash}

198+ | isJust (riPresignExpirySecs ri') ->

199+ -- case 0 from above.

200+ do

201+ let signPairs = signV4 sp baseRequest

202+ qpToAdd = (fmap . fmap) Just signPairs

203+ existingQueryParams = HT.parseQuery (NC.queryString baseRequest)

204+ updatedQueryParams = existingQueryParams ++ qpToAdd

205+ return $ NClient.setQueryString updatedQueryParams baseRequest

206+ | isStreamingPayload (riPayload ri') && (not $ connectIsSecure ci') ->

207+ -- case 2 from above.

208+ do

209+ (pLen, pSrc) <- case riPayload ri of

210+ PayloadC l src -> return (l, src)

211+ _ -> throwIO MErrVUnexpectedPayload

212+ let reqFn = signV4Stream pLen sp baseRequest

213+ return $ reqFn pSrc

214+ | otherwise ->

215+ do

216+ sp' <-

217+ if

218+ | connectIsSecure ci' ->

219+ -- case 1 described above.

220+ return sp

221+ | otherwise ->

222+ -- case 3 described above.

223+ do

224+ pHash <- getPayloadSHA256Hash $ riPayload ri'

225+ return $ sp {spPayloadHash = Just pHash}

176226

177− let signHeaders = signV4 sp' baseRequest

178− return $

179− baseRequest

180− { NC.requestHeaders =

181− NC.requestHeaders baseRequest

182− ++ mkHeaderFromPairs signHeaders,

183− NC.requestBody = getRequestBody (riPayload ri')

184− }

227+ let signHeaders = signV4 sp' baseRequest

228+ return $

229+ baseRequest

230+ { NC.requestHeaders =

231+ NC.requestHeaders baseRequest

232+ ++ mkHeaderFromPairs signHeaders,

233+ NC.requestBody = getRequestBody (riPayload ri')

234+ }

185235

186236retryAPIRequest :: Minio a -> Minio a

187237retryAPIRequest apiCall = do

src/Network/Minio/APICommon.hs+8

@@ -20,6 +20,7 @@ import qualified Conduit as C

2020import qualified Data.ByteString as BS

2121import qualified Data.ByteString.Lazy as LB

2222import Data.Conduit.Binary (sourceHandleRange)

23+import qualified Data.Text as T

2324import Lib.Prelude

2425import qualified Network.HTTP.Conduit as NC

2526import qualified Network.HTTP.Types as HT

@@ -70,3 +71,10 @@ mkStreamingPayload payload =

7071isStreamingPayload :: Payload -> Bool

7172isStreamingPayload (PayloadC _ _) = True

7273isStreamingPayload _ = False

74+

75+-- | Checks if the connect info is for Amazon S3.

76+isAWSConnectInfo :: ConnectInfo -> Bool

77+isAWSConnectInfo ci = ".amazonaws.com" `T.isSuffixOf` connectHost ci

78+

79+bucketHasPeriods :: Bucket -> Bool

80+bucketHasPeriods b = isJust $ T.find (== '.') b

src/Network/Minio/Data.hs+18−19

@@ -49,6 +49,7 @@ import Network.HTTP.Types

4949 )

5050import qualified Network.HTTP.Types as HT

5151import Network.Minio.Data.Crypto

52+import Network.Minio.Data.Time

5253import Network.Minio.Errors

5354import System.Directory (doesFileExist, getHomeDirectory)

5455import qualified System.Environment as Env

@@ -79,20 +80,20 @@ maxMultipartParts = 10000

7980awsRegionMap :: H.HashMap Text Text

8081awsRegionMap =

8182 H.fromList

82− [ ("us-east-1", "s3.amazonaws.com"),

83− ("us-east-2", "s3-us-east-2.amazonaws.com"),

84− ("us-west-1", "s3-us-west-1.amazonaws.com"),

85− ("us-west-2", "s3-us-west-2.amazonaws.com"),

86− ("ca-central-1", "s3-ca-central-1.amazonaws.com"),

87− ("ap-south-1", "s3-ap-south-1.amazonaws.com"),

88− ("ap-northeast-1", "s3-ap-northeast-1.amazonaws.com"),

89− ("ap-northeast-2", "s3-ap-northeast-2.amazonaws.com"),

90− ("ap-southeast-1", "s3-ap-southeast-1.amazonaws.com"),

91− ("ap-southeast-2", "s3-ap-southeast-2.amazonaws.com"),

92− ("eu-west-1", "s3-eu-west-1.amazonaws.com"),

93− ("eu-west-2", "s3-eu-west-2.amazonaws.com"),

94− ("eu-central-1", "s3-eu-central-1.amazonaws.com"),

95− ("sa-east-1", "s3-sa-east-1.amazonaws.com")

83+ [ ("us-east-1", "s3.us-east-1.amazonaws.com"),

84+ ("us-east-2", "s3.us-east-2.amazonaws.com"),

85+ ("us-west-1", "s3.us-west-1.amazonaws.com"),

86+ ("us-west-2", "s3.us-west-2.amazonaws.com"),

87+ ("ca-central-1", "s3.ca-central-1.amazonaws.com"),

88+ ("ap-south-1", "s3.ap-south-1.amazonaws.com"),

89+ ("ap-northeast-1", "s3.ap-northeast-1.amazonaws.com"),

90+ ("ap-northeast-2", "s3.ap-northeast-2.amazonaws.com"),

91+ ("ap-southeast-1", "s3.ap-southeast-1.amazonaws.com"),

92+ ("ap-southeast-2", "s3.ap-southeast-2.amazonaws.com"),

93+ ("eu-west-1", "s3.eu-west-1.amazonaws.com"),

94+ ("eu-west-2", "s3.eu-west-2.amazonaws.com"),

95+ ("eu-central-1", "s3.eu-central-1.amazonaws.com"),

96+ ("sa-east-1", "s3.sa-east-1.amazonaws.com")

9697 ]

9798

9899-- | Connection Info data type. To create a 'ConnectInfo' value,

@@ -1022,7 +1023,8 @@ data S3ReqInfo = S3ReqInfo

10221023 riPayload :: Payload,

10231024 riPayloadHash :: Maybe ByteString,

10241025 riRegion :: Maybe Region,

1025− riNeedsLocation :: Bool

1026+ riNeedsLocation :: Bool,

1027+ riPresignExpirySecs :: Maybe UrlExpiry

10261028 }

10271029

10281030defaultS3ReqInfo :: S3ReqInfo

@@ -1037,16 +1039,13 @@ defaultS3ReqInfo =

10371039 Nothing

10381040 Nothing

10391041 True

1042+ Nothing

10401043

10411044getS3Path :: Maybe Bucket -> Maybe Object -> ByteString

10421045getS3Path b o =

10431046 let segments = map toUtf8 $ catMaybes $ b : bool [] [o] (isJust b)

10441047 in B.concat ["/", B.intercalate "/" segments]

10451048

1046−-- | Time to expire for a presigned URL. It interpreted as a number of

1047−-- seconds. The maximum duration that can be specified is 7 days.

1048−type UrlExpiry = Int

1049−

10501049type RegionMap = H.HashMap Bucket Region

10511050

10521051-- | The Minio Monad - all computations accessing object storage

src/Network/Minio/Data/Time.hs+5

@@ -21,6 +21,7 @@ module Network.Minio.Data.Time

2121 awsDateFormatBS,

2222 awsParseTime,

2323 iso8601TimeFormat,

24+ UrlExpiry,

2425 )

2526where

2627

@@ -28,6 +29,10 @@ import Data.ByteString.Char8 (pack)

2829import qualified Data.Time as Time

2930import Lib.Prelude

3031

32+-- | Time to expire for a presigned URL. It interpreted as a number of

33+-- seconds. The maximum duration that can be specified is 7 days.

34+type UrlExpiry = Int

35+

3136awsTimeFormat :: UTCTime -> [Char]

3237awsTimeFormat = Time.formatTime Time.defaultTimeLocale "%Y%m%dT%H%M%SZ"

3338

src/Network/Minio/PresignedOperations.hs+16−37

@@ -42,13 +42,14 @@ import qualified Data.HashMap.Strict as H

4242import qualified Data.Text as T

4343import qualified Data.Time as Time

4444import Lib.Prelude

45−import qualified Network.HTTP.Conduit as NC

45+import qualified Network.HTTP.Client as NClient

4646import qualified Network.HTTP.Types as HT

47−import Network.HTTP.Types.Header (hHost)

47+import Network.Minio.API (buildRequest)

4848import Network.Minio.Data

4949import Network.Minio.Data.Time

5050import Network.Minio.Errors

5151import Network.Minio.Sign.V4

52+import Network.URI (uriToString)

5253

5354-- | Generate a presigned URL. This function allows for advanced usage

5455-- - for simple cases prefer the `presigned*Url` functions.

@@ -72,44 +73,22 @@ makePresignedUrl expiry method bucket object region extraQuery extraHeaders = do

7273 throwIO $

7374 MErrVInvalidUrlExpiry expiry

7475

75− ci <- asks mcConnInfo

76−

77− let hostHeader = (hHost, getHostAddr ci)

78− req =

79− NC.defaultRequest

80− { NC.method = method,

81− NC.secure = connectIsSecure ci,

82− NC.host = encodeUtf8 $ connectHost ci,

83− NC.port = connectPort ci,

84− NC.path = getS3Path bucket object,

85− NC.requestHeaders = hostHeader : extraHeaders,

86− NC.queryString = HT.renderQuery True extraQuery

76+ let s3ri =

77+ defaultS3ReqInfo

78+ { riPresignExpirySecs = Just expiry,

79+ riMethod = method,

80+ riBucket = bucket,

81+ riObject = object,

82+ riRegion = region,

83+ riQueryParams = extraQuery,

84+ riHeaders = extraHeaders

8785 }

88− ts <- liftIO Time.getCurrentTime

8986

90− let sp =

91− SignParams

92− (connectAccessKey ci)

93− (connectSecretKey ci)

94− ts

95− region

96− (Just expiry)

97− Nothing

98− signPairs = signV4 sp req

99− qpToAdd = (fmap . fmap) Just signPairs

100− queryStr =

101− HT.renderQueryBuilder

102− True

103− ((HT.parseQuery $ NC.queryString req) ++ qpToAdd)

104− scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci

87+ req <- buildRequest s3ri

88+ let uri = NClient.getUri req

89+ uriString = uriToString identity uri ""

10590

106− return $

107− toStrictBS $

108− toLazyByteString $

109− scheme

110− <> byteString (getHostAddr ci)

111− <> byteString (getS3Path bucket object)

112− <> queryStr

91+ return $ toUtf8 uriString

11392

11493-- | Generate a URL with authentication signature to PUT (upload) an

11594-- object. Any extra headers if passed, are signed, and so they are

src/Network/Minio/Sign/V4.hs+1−1

@@ -65,7 +65,7 @@ data SignParams = SignParams

6565 spSecretKey :: Text,

6666 spTimeStamp :: UTCTime,

6767 spRegion :: Maybe Text,

68− spExpirySecs :: Maybe Int,

68+ spExpirySecs :: Maybe UrlExpiry,

6969 spPayloadHash :: Maybe ByteString

7070 }

7171 deriving (Show)

test/LiveServer.hs−1

@@ -34,7 +34,6 @@ import qualified Network.HTTP.Types as HT

3434import Network.Minio

3535import Network.Minio.Data

3636import Network.Minio.Data.Crypto

37−import Network.Minio.PutObject

3837import Network.Minio.S3API

3938import Network.Minio.Utils

4039import System.Directory (getTemporaryDirectory)