haskell/minio-hs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Move region to RequestInfo

Browse Source 
Region is a request specific attribute, mostly applies to bucket
operations.
This commit is contained in:
Krishnan Parthasarathi 2017-01-09 14:12:10 +05:30 committed by Aditya Manthramurthy
parent 342d0bc8ff
commit 45d5f9e676
4 changed files with 12 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Network/Minio/API.hs
View File

@ -94,4 +94,4 @@ mkStreamRequest ri = do
requestInfo :: Method -> Maybe Bucket -> Maybe Object requestInfo :: Method -> Maybe Bucket -> Maybe Object
-> Query -> [Header] -> Payload -> Query -> [Header] -> Payload
-> RequestInfo -> RequestInfo
requestInfo m b o q h p = RequestInfo m b o q h p "" requestInfo m b o q h p = RequestInfo m b o q h p "" Nothing

8
src/Network/Minio/Data.hs
View File

@ -9,6 +9,7 @@ module Network.Minio.Data
, Location , Location
, BucketInfo(..) , BucketInfo(..)
, getPathFromRI , getPathFromRI
, getRegionFromRI
, Minio , Minio
, MinioErr(..) , MinioErr(..)
, runMinio , runMinio
@ -38,12 +39,11 @@ data ConnectInfo = ConnectInfo {
, connectAccessKey :: Text , connectAccessKey :: Text
, connectSecretKey :: Text , connectSecretKey :: Text
, connectIsSecure :: Bool , connectIsSecure :: Bool
, connectRegion :: Text
} deriving (Eq, Show) } deriving (Eq, Show)
defaultConnectInfo :: ConnectInfo defaultConnectInfo :: ConnectInfo
defaultConnectInfo = defaultConnectInfo =
ConnectInfo "localhost" 9000 "minio" "minio123" False "us-east-1" ConnectInfo "localhost" 9000 "minio" "minio123" False
type Bucket = Text type Bucket = Text
type Object = Text type Object = Text
@ -68,6 +68,7 @@ data RequestInfo = RequestInfo {
, headers :: [Header] , headers :: [Header]
, payload :: Payload , payload :: Payload
, payloadHash :: ByteString , payloadHash :: ByteString
, region :: Maybe Location
} }
@ -77,6 +78,9 @@ getPathFromRI ri = B.concat $ parts
objPart = maybe [] (\o -> ["/", encodeUtf8 o]) $ object ri objPart = maybe [] (\o -> ["/", encodeUtf8 o]) $ object ri
parts = maybe ["/"] (\b -> "/" : encodeUtf8 b : objPart) $ bucket ri parts = maybe ["/"] (\b -> "/" : encodeUtf8 b : objPart) $ bucket ri
getRegionFromRI :: RequestInfo -> Text
getRegionFromRI ri = maybe "us-east-1" identity (region ri)
data MinioErr = MErrMsg ByteString data MinioErr = MErrMsg ByteString
| MErrHttp HttpException | MErrHttp HttpException
| MErrXml ByteString | MErrXml ByteString

1
src/Network/Minio/S3API.hs
View File

@ -49,4 +49,3 @@ putBucket bucket location = do
let httpStatus = NC.responseStatus resp let httpStatus = NC.responseStatus resp
when (httpStatus /= HT.ok200) $ when (httpStatus /= HT.ok200) $
throwError $ MErrXml $ LBS.toStrict $ NC.responseBody resp throwError $ MErrXml $ LBS.toStrict $ NC.responseBody resp
return ()

10
src/Network/Minio/Sign/V4.hs
View File

@ -88,7 +88,7 @@ signV4AtTime ts ci ri =
authHeader = (mk "Authorization", authHeaderValue) authHeader = (mk "Authorization", authHeaderValue)
scope = getScope ts ci scope = getScope ts ri
authHeaderValue = B.concat [ authHeaderValue = B.concat [
"AWS4-HMAC-SHA256 Credential=", "AWS4-HMAC-SHA256 Credential=",
@ -105,7 +105,7 @@ signV4AtTime ts ci ri =
signingKey = hmacSHA256RawBS "aws4_request" signingKey = hmacSHA256RawBS "aws4_request"
. hmacSHA256RawBS "s3" . hmacSHA256RawBS "s3"
. hmacSHA256RawBS (encodeUtf8 $ connectRegion ci) . hmacSHA256RawBS (encodeUtf8 $ getRegionFromRI ri)
. hmacSHA256RawBS (awsDateFormatBS ts) . hmacSHA256RawBS (awsDateFormatBS ts)
$ (B.concat ["AWS4", encodeUtf8 $ connectSecretKey ci]) $ (B.concat ["AWS4", encodeUtf8 $ connectSecretKey ci])
@ -119,10 +119,10 @@ signV4AtTime ts ci ri =
canonicalRequest = getCanonicalRequest ri headersToSign canonicalRequest = getCanonicalRequest ri headersToSign
getScope :: UTCTime -> ConnectInfo -> ByteString getScope :: UTCTime -> RequestInfo -> ByteString
getScope ts ci = B.intercalate "/" $ [ getScope ts ri = B.intercalate "/" $ [
pack $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts, pack $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts,
encodeUtf8 $ connectRegion ci, "s3", "aws4_request" encodeUtf8 $ getRegionFromRI ri, "s3", "aws4_request"
] ]
getHeadersToSign :: [Header] -> [(ByteString, ByteString)] getHeadersToSign :: [Header] -> [(ByteString, ByteString)]