summaryrefslogtreecommitdiff
path: root/Remote/S3.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-08-08 20:51:22 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-08-08 20:51:22 -0400
commite32a2326d564ed39984e1e74bac481cbd53c5660 (patch)
tree1615611d5be8ebbf8af45c3fb05176de4d4157f1 /Remote/S3.hs
parentc7696d186f7d931cf196825e11c120b68968b4f8 (diff)
cleanup
Diffstat (limited to 'Remote/S3.hs')
-rw-r--r--Remote/S3.hs35
1 files changed, 21 insertions, 14 deletions
diff --git a/Remote/S3.hs b/Remote/S3.hs
index b9f03020e..4bc341e41 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -242,18 +242,17 @@ genBucket c u = do
where
go _ (Right True) = noop
go h _ = do
- v <- tryS3 $ sendS3Handle h (S3.getBucket bucket)
+ v <- tryS3 $ sendS3Handle h (S3.getBucket $ hBucket h)
case v of
Right _ -> noop
Left _ -> do
showAction $ "creating bucket in " ++ datacenter
void $ sendS3Handle h $
- S3.PutBucket bucket Nothing $
+ S3.PutBucket (hBucket h) Nothing $
AWS.mkLocationConstraint $
T.pack datacenter
writeUUIDFile c u h
- bucket = T.pack $ fromJust $ getBucketName c
datacenter = fromJust $ M.lookup "datacenter" c
{- Writes the UUID to an annex-uuid file within the bucket.
@@ -273,12 +272,11 @@ writeUUIDFile c u h = do
where
file = T.pack $ uuidFile c
uuidb = L.fromChunks [T.encodeUtf8 $ T.pack $ fromUUID u]
- bucket = T.pack $ fromJust $ getBucketName c
-- TODO: add headers from getXheaders
-- (See https://github.com/aristidb/aws/issues/119)
- mkobject = (S3.putObject bucket file $ RequestBodyLBS uuidb)
- { S3.poStorageClass = Just (getStorageClass c) }
+ mkobject = (S3.putObject (hBucket h) file $ RequestBodyLBS uuidb)
+ { S3.poStorageClass = Just (hStorageClass h) }
{- Checks if the UUID file exists in the bucket
- and has the specified UUID already. -}
@@ -288,12 +286,11 @@ checkUUIDFile c u h = tryNonAsync $ check <$> get
get = liftIO
. runResourceT
. either (pure . Left) (Right <$$> AWS.loadToMemory)
- =<< tryS3 (sendS3Handle h (S3.getObject bucket file))
+ =<< tryS3 (sendS3Handle h (S3.getObject (hBucket h) file))
check (Right (S3.GetObjectMemoryResponse _meta rsp)) =
responseStatus rsp == ok200 && responseBody rsp == uuidb
check (Left _S3Error) = False
- bucket = T.pack $ fromJust $ getBucketName c
file = T.pack $ uuidFile c
uuidb = L.fromChunks [T.encodeUtf8 $ T.pack $ fromUUID u]
@@ -312,7 +309,13 @@ s3Connection c u = go =<< getRemoteCredPairFor "S3" c (AWS.creds u)
[(p, _)] -> p
_ -> error $ "bad S3 port value: " ++ s
-data S3Handle = S3Handle Manager AWS.Configuration (S3.S3Configuration AWS.NormalQuery)
+data S3Handle = S3Handle
+ { hmanager :: Manager
+ , hawscfg :: AWS.Configuration
+ , hs3cfg :: S3.S3Configuration AWS.NormalQuery
+ , hBucket :: S3.Bucket
+ , hStorageClass :: S3.StorageClass
+ }
{- Sends a request to S3 and gets back the response.
-
@@ -325,21 +328,25 @@ sendS3Handle
=> S3Handle
-> req
-> Annex res
-sendS3Handle (S3Handle manager awscfg s3cfg) req = liftIO $
- runResourceT $ AWS.pureAws awscfg s3cfg manager req
+sendS3Handle h = liftIO . runResourceT . call
+ where
+ call = AWS.pureAws (hawscfg h) (hs3cfg h) (hmanager h)
withS3Handle :: RemoteConfig -> UUID -> (S3Handle -> Annex a) -> Annex a
withS3Handle c u a = do
creds <- getRemoteCredPairFor "S3" c (AWS.creds u)
awscreds <- liftIO $ AWS.genCredentials $ fromMaybe nocreds creds
+ bucket <- maybe nobucket (return . T.pack) (getBucketName c)
let awscfg = AWS.Configuration AWS.Timestamp awscreds (AWS.defaultLog AWS.Error)
bracketIO (newManager httpcfg) closeManager $ \mgr ->
- a $ S3Handle mgr awscfg s3cfg
+ a $ S3Handle mgr awscfg s3cfg bucket sc
where
s3cfg = s3Configuration c
httpcfg = defaultManagerSettings
{ managerResponseTimeout = Nothing }
+ sc = getStorageClass c
nocreds = error "Cannot use S3 without credentials configured"
+ nobucket = error "S3 bucket not configured"
s3Configuration :: RemoteConfig -> S3.S3Configuration AWS.NormalQuery
s3Configuration c = (S3.s3 proto endpoint False) { S3.s3Port = port }
@@ -371,8 +378,8 @@ getBucketName :: RemoteConfig -> Maybe BucketName
getBucketName = M.lookup "bucket"
getStorageClass :: RemoteConfig -> S3.StorageClass
-getStorageClass c = case fromJust $ M.lookup "storageclass" c of
- "REDUCED_REDUNDANCY" -> S3.ReducedRedundancy
+getStorageClass c = case M.lookup "storageclass" c of
+ Just "REDUCED_REDUNDANCY" -> S3.ReducedRedundancy
_ -> S3.Standard
getXheaders :: RemoteConfig -> [(String, String)]