summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Remote/S3real.hs98
1 files changed, 48 insertions, 50 deletions
diff --git a/Remote/S3real.hs b/Remote/S3real.hs
index fe68a7f5b..5d8435932 100644
--- a/Remote/S3real.hs
+++ b/Remote/S3real.hs
@@ -62,30 +62,6 @@ gen' r u c cst =
config = c
}
-s3ConnectionRequired :: RemoteConfig -> Annex AWSConnection
-s3ConnectionRequired c = do
- conn <- s3Connection c
- case conn of
- Nothing -> error "Cannot connect to S3"
- Just conn' -> return conn'
-
-s3Connection :: RemoteConfig -> Annex (Maybe AWSConnection)
-s3Connection c = do
- ak <- getEnvKey "AWS_ACCESS_KEY_ID"
- sk <- getEnvKey "AWS_SECRET_ACCESS_KEY"
- if (null ak || null sk)
- then do
- warning "Set both AWS_ACCESS_KEY_ID and AWS_SECRET_ACCESS_KEY to use S3"
- return Nothing
- else return $ Just $ AWSConnection host port ak sk
- where
- host = fromJust $ (M.lookup "host" c)
- port = let s = fromJust $ (M.lookup "port" c) in
- case reads s of
- [(p, _)] -> p
- _ -> error $ "bad S3 port value: " ++ s
- getEnvKey s = liftIO $ catch (getEnv s) (const $ return "")
-
s3Setup :: UUID -> RemoteConfig -> Annex RemoteConfig
s3Setup u c = do
-- verify configuration is sane
@@ -121,30 +97,6 @@ s3Setup u c = do
, ("bucket", bucket)
]
-s3Action :: Remote Annex -> a -> ((AWSConnection, String) -> Annex a) -> Annex a
-s3Action r noconn action = do
- when (config r == Nothing) $
- error $ "Missing configuration for special remote " ++ name r
- let bucket = M.lookup "bucket" $ fromJust $ config r
- conn <- s3Connection (fromJust $ config r)
- case (bucket, conn) of
- (Just b, Just c) -> action (c, b)
- _ -> return noconn
-
-bucketKey :: String -> Key -> L.ByteString -> S3Object
-bucketKey bucket k content = S3Object bucket (show k) "" [] content
-
-checkPresent :: Remote Annex -> Key -> Annex (Either IOException Bool)
-checkPresent r k = s3Action r noconn $ \(conn, bucket) -> do
- showNote ("checking " ++ name r ++ "...")
- res <- liftIO $ getObjectInfo conn $ bucketKey bucket k L.empty
- case res of
- Right _ -> return $ Right True
- Left (AWSError _ _) -> return $ Right False
- Left e -> return $ Left (s3Error e)
- where
- noconn = Left $ error "S3 not configured"
-
store :: Remote Annex -> Key -> Annex Bool
store r k = s3Action r False $ \(conn, bucket) -> do
content <- lazyKeyContent k
@@ -195,9 +147,18 @@ retrieveEncrypted r (cipher, enck) f = s3Action r False $ \(conn, bucket) -> do
remove :: Remote Annex -> Key -> Annex Bool
remove r k = s3Action r False $ \(conn, bucket) -> do
res <- liftIO $ deleteObject conn $ bucketKey bucket k L.empty
+ s3Bool res
+
+checkPresent :: Remote Annex -> Key -> Annex (Either IOException Bool)
+checkPresent r k = s3Action r noconn $ \(conn, bucket) -> do
+ showNote ("checking " ++ name r ++ "...")
+ res <- liftIO $ getObjectInfo conn $ bucketKey bucket k L.empty
case res of
- Right _ -> return True
- Left e -> s3Warning e
+ Right _ -> return $ Right True
+ Left (AWSError _ _) -> return $ Right False
+ Left e -> return $ Left (s3Error e)
+ where
+ noconn = Left $ error "S3 not configured"
s3Warning :: ReqError -> Annex Bool
s3Warning e = do
@@ -212,3 +173,40 @@ s3Bool res = do
case res of
Right _ -> return True
Left e -> s3Warning e
+
+s3ConnectionRequired :: RemoteConfig -> Annex AWSConnection
+s3ConnectionRequired c = do
+ conn <- s3Connection c
+ case conn of
+ Nothing -> error "Cannot connect to S3"
+ Just conn' -> return conn'
+
+s3Connection :: RemoteConfig -> Annex (Maybe AWSConnection)
+s3Connection c = do
+ ak <- getEnvKey "AWS_ACCESS_KEY_ID"
+ sk <- getEnvKey "AWS_SECRET_ACCESS_KEY"
+ if (null ak || null sk)
+ then do
+ warning "Set both AWS_ACCESS_KEY_ID and AWS_SECRET_ACCESS_KEY to use S3"
+ return Nothing
+ else return $ Just $ AWSConnection host port ak sk
+ where
+ host = fromJust $ (M.lookup "host" c)
+ port = let s = fromJust $ (M.lookup "port" c) in
+ case reads s of
+ [(p, _)] -> p
+ _ -> error $ "bad S3 port value: " ++ s
+ getEnvKey s = liftIO $ catch (getEnv s) (const $ return "")
+
+s3Action :: Remote Annex -> a -> ((AWSConnection, String) -> Annex a) -> Annex a
+s3Action r noconn action = do
+ when (config r == Nothing) $
+ error $ "Missing configuration for special remote " ++ name r
+ let bucket = M.lookup "bucket" $ fromJust $ config r
+ conn <- s3Connection (fromJust $ config r)
+ case (bucket, conn) of
+ (Just b, Just c) -> action (c, b)
+ _ -> return noconn
+
+bucketKey :: String -> Key -> L.ByteString -> S3Object
+bucketKey bucket k content = S3Object bucket (show k) "" [] content