Fix build with -f-S3.

This commit is contained in:
Joey Hess 2014-12-19 16:53:25 -04:00
parent ded1b8f853
commit 27fb7e514d
4 changed files with 20 additions and 17 deletions

View file

@ -5,21 +5,19 @@
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings, TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Remote.Helper.AWS where
import Common.Annex
import Creds
import qualified Aws
import qualified Aws.S3 as S3
import qualified Data.Map as M
import qualified Data.ByteString as B
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Text (Text)
import Data.IORef
creds :: UUID -> CredPairStorage
creds u = CredPairStorage
@ -28,13 +26,6 @@ creds u = CredPairStorage
, credPairRemoteKey = Just "s3creds"
}
genCredentials :: CredPair -> IO Aws.Credentials
genCredentials (keyid, secret) = Aws.Credentials
<$> pure (encodeUtf8 (T.pack keyid))
<*> pure (encodeUtf8 (T.pack secret))
<*> newIORef []
<*> pure Nothing
data Service = S3 | Glacier
deriving (Eq)
@ -82,7 +73,3 @@ s3HostName r = encodeUtf8 $ T.concat ["s3-", r, ".amazonaws.com"]
s3DefaultHost :: String
s3DefaultHost = "s3.amazonaws.com"
mkLocationConstraint :: Region -> S3.LocationConstraint
mkLocationConstraint "US" = S3.locationUsClassic
mkLocationConstraint r = r

View file

@ -6,6 +6,7 @@
-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Remote.S3 (remote, iaHost, configIA, iaItemUrl) where
@ -26,6 +27,7 @@ import Network.HTTP.Types
import Control.Monad.Trans.Resource
import Control.Monad.Catch
import Data.Conduit
import Data.IORef
import Common.Annex
import Types.Remote
@ -308,7 +310,7 @@ genBucket c u = do
showAction $ "creating bucket in " ++ datacenter
void $ sendS3Handle h $
S3.PutBucket (bucket $ hinfo h) Nothing $
AWS.mkLocationConstraint $
mkLocationConstraint $
T.pack datacenter
writeUUIDFile c u h
@ -391,7 +393,7 @@ sendS3Handle' h = AWS.pureAws (hawscfg h) (hs3cfg h) (hmanager h)
withS3Handle :: RemoteConfig -> UUID -> S3Info -> (S3Handle -> Annex a) -> Annex a
withS3Handle c u info a = do
creds <- getRemoteCredPairFor "S3" c (AWS.creds u)
awscreds <- liftIO $ AWS.genCredentials $ fromMaybe nocreds creds
awscreds <- liftIO $ genCredentials $ fromMaybe nocreds creds
let awscfg = AWS.Configuration AWS.Timestamp awscreds (AWS.defaultLog AWS.Error)
bracketIO (newManager httpcfg) closeManager $ \mgr ->
a $ S3Handle mgr awscfg s3cfg info
@ -505,3 +507,14 @@ iaKeyUrl :: Remote -> Key -> URLString
iaKeyUrl r k = "http://archive.org/download/" ++ b ++ "/" ++ getBucketObject (config r) k
where
b = fromMaybe "" $ getBucketName $ config r
genCredentials :: CredPair -> IO AWS.Credentials
genCredentials (keyid, secret) = AWS.Credentials
<$> pure (T.encodeUtf8 (T.pack keyid))
<*> pure (T.encodeUtf8 (T.pack secret))
<*> newIORef []
<*> pure Nothing
mkLocationConstraint :: AWS.Region -> S3.LocationConstraint
mkLocationConstraint "US" = S3.locationUsClassic
mkLocationConstraint r = r

1
debian/changelog vendored
View file

@ -17,6 +17,7 @@ git-annex (5.20141204) UNRELEASED; urgency=medium
* When possible, build with the haskell torrent library for parsing
torrent files. As a fallback, can instead use btshowmetainfo from
bittornado | bittorrent.
* Fix build with -f-S3.
-- Joey Hess <id@joeyh.name> Fri, 05 Dec 2014 13:42:08 -0400

View file

@ -35,3 +35,5 @@ I'm installing dependencies with cabal but have disabled S3 support
cabal configure "${_features[@]}"
make
> [[fixed|done]] --[[Joey]]