Fix build with -f-S3.
This commit is contained in:
parent
ded1b8f853
commit
27fb7e514d
4 changed files with 20 additions and 17 deletions
|
@ -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
|
||||
|
|
17
Remote/S3.hs
17
Remote/S3.hs
|
@ -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
1
debian/changelog
vendored
|
@ -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
|
||||
|
||||
|
|
|
@ -35,3 +35,5 @@ I'm installing dependencies with cabal but have disabled S3 support
|
|||
cabal configure "${_features[@]}"
|
||||
|
||||
make
|
||||
|
||||
> [[fixed|done]] --[[Joey]]
|
||||
|
|
Loading…
Reference in a new issue