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.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings, TupleSections #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
|
||||||
module Remote.Helper.AWS where
|
module Remote.Helper.AWS where
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import Creds
|
import Creds
|
||||||
|
|
||||||
import qualified Aws
|
|
||||||
import qualified Aws.S3 as S3
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Text.Encoding (encodeUtf8)
|
import Data.Text.Encoding (encodeUtf8)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.IORef
|
|
||||||
|
|
||||||
creds :: UUID -> CredPairStorage
|
creds :: UUID -> CredPairStorage
|
||||||
creds u = CredPairStorage
|
creds u = CredPairStorage
|
||||||
|
@ -28,13 +26,6 @@ creds u = CredPairStorage
|
||||||
, credPairRemoteKey = Just "s3creds"
|
, 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
|
data Service = S3 | Glacier
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
|
||||||
|
@ -82,7 +73,3 @@ s3HostName r = encodeUtf8 $ T.concat ["s3-", r, ".amazonaws.com"]
|
||||||
|
|
||||||
s3DefaultHost :: String
|
s3DefaultHost :: String
|
||||||
s3DefaultHost = "s3.amazonaws.com"
|
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 TypeFamilies #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
module Remote.S3 (remote, iaHost, configIA, iaItemUrl) where
|
module Remote.S3 (remote, iaHost, configIA, iaItemUrl) where
|
||||||
|
@ -26,6 +27,7 @@ import Network.HTTP.Types
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
import Control.Monad.Catch
|
import Control.Monad.Catch
|
||||||
import Data.Conduit
|
import Data.Conduit
|
||||||
|
import Data.IORef
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
|
@ -308,7 +310,7 @@ genBucket c u = do
|
||||||
showAction $ "creating bucket in " ++ datacenter
|
showAction $ "creating bucket in " ++ datacenter
|
||||||
void $ sendS3Handle h $
|
void $ sendS3Handle h $
|
||||||
S3.PutBucket (bucket $ hinfo h) Nothing $
|
S3.PutBucket (bucket $ hinfo h) Nothing $
|
||||||
AWS.mkLocationConstraint $
|
mkLocationConstraint $
|
||||||
T.pack datacenter
|
T.pack datacenter
|
||||||
writeUUIDFile c u h
|
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 :: RemoteConfig -> UUID -> S3Info -> (S3Handle -> Annex a) -> Annex a
|
||||||
withS3Handle c u info a = do
|
withS3Handle c u info a = do
|
||||||
creds <- getRemoteCredPairFor "S3" c (AWS.creds u)
|
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)
|
let awscfg = AWS.Configuration AWS.Timestamp awscreds (AWS.defaultLog AWS.Error)
|
||||||
bracketIO (newManager httpcfg) closeManager $ \mgr ->
|
bracketIO (newManager httpcfg) closeManager $ \mgr ->
|
||||||
a $ S3Handle mgr awscfg s3cfg info
|
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
|
iaKeyUrl r k = "http://archive.org/download/" ++ b ++ "/" ++ getBucketObject (config r) k
|
||||||
where
|
where
|
||||||
b = fromMaybe "" $ getBucketName $ config r
|
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
|
* When possible, build with the haskell torrent library for parsing
|
||||||
torrent files. As a fallback, can instead use btshowmetainfo from
|
torrent files. As a fallback, can instead use btshowmetainfo from
|
||||||
bittornado | bittorrent.
|
bittornado | bittorrent.
|
||||||
|
* Fix build with -f-S3.
|
||||||
|
|
||||||
-- Joey Hess <id@joeyh.name> Fri, 05 Dec 2014 13:42:08 -0400
|
-- 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[@]}"
|
cabal configure "${_features[@]}"
|
||||||
|
|
||||||
make
|
make
|
||||||
|
|
||||||
|
> [[fixed|done]] --[[Joey]]
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue