S3: Support signature=v4
To use S3 Signature Version 4. Some S3 services seem to require v4, while others may only support v2, which remains the default. I'm also not sure if v4 works correctly in all cases, there is this upstream bug report: https://github.com/aristidb/aws/issues/262 I've only tested it against the default S3 endpoint.
This commit is contained in:
parent
bb88a01910
commit
1532d67c3e
6 changed files with 65 additions and 1 deletions
23
Remote/S3.hs
23
Remote/S3.hs
|
@ -99,6 +99,8 @@ remote = specialRemoteType $ RemoteType
|
|||
(FieldDesc "port to connect to")
|
||||
, optionalStringParser requeststyleField
|
||||
(FieldDesc "for path-style requests, set to \"path\"")
|
||||
, signatureVersionParser signatureField
|
||||
(FieldDesc "S3 signature version")
|
||||
, optionalStringParser mungekeysField HiddenField
|
||||
, optionalStringParser AWS.s3credsField HiddenField
|
||||
]
|
||||
|
@ -148,6 +150,22 @@ protocolField = Accepted "protocol"
|
|||
requeststyleField :: RemoteConfigField
|
||||
requeststyleField = Accepted "requeststyle"
|
||||
|
||||
signatureField :: RemoteConfigField
|
||||
signatureField = Accepted "signature"
|
||||
|
||||
newtype SignatureVersion = SignatureVersion Int
|
||||
|
||||
signatureVersionParser :: RemoteConfigField -> FieldDesc -> RemoteConfigFieldParser
|
||||
signatureVersionParser f fd =
|
||||
genParser go f defver fd
|
||||
(Just (ValueDesc "v2 or v4"))
|
||||
where
|
||||
go "v2" = Just (SignatureVersion 2)
|
||||
go "v4" = Just (SignatureVersion 4)
|
||||
go _ = Nothing
|
||||
|
||||
defver = SignatureVersion 2
|
||||
|
||||
portField :: RemoteConfigField
|
||||
portField = Accepted "port"
|
||||
|
||||
|
@ -877,7 +895,10 @@ s3Configuration c = cfg
|
|||
Nothing
|
||||
| port == 443 -> AWS.HTTPS
|
||||
| otherwise -> AWS.HTTP
|
||||
cfg = S3.s3 proto endpoint False
|
||||
cfg = case getRemoteConfigValue signatureField c of
|
||||
Just (SignatureVersion 4) ->
|
||||
S3.s3v4 proto endpoint False S3.SignWithEffort
|
||||
_ -> S3.s3 proto endpoint False
|
||||
|
||||
data S3Info = S3Info
|
||||
{ bucket :: S3.Bucket
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue