allow enabling existing S3 repos
This commit is contained in:
Joey Hess
parent
17708dd173
commit
c2c577f34f
5 changed files with 93 additions and 33 deletions
|
|
@ -58,7 +58,7 @@ addRemote a = do
|
|||
{- Inits a rsync special remote, and returns its name. -}
|
||||
makeRsyncRemote :: String -> String -> Annex String
|
||||
makeRsyncRemote name location = makeRemote name location $
|
||||
const $ void $ makeSpecialRemote name Rsync.remote config
|
||||
const $ makeSpecialRemote name Rsync.remote config
|
||||
where
|
||||
config = M.fromList
|
||||
[ ("encryption", "shared")
|
||||
|
|
@ -66,14 +66,13 @@ makeRsyncRemote name location = makeRemote name location $
|
|||
, ("type", "rsync")
|
||||
]
|
||||
|
||||
{- Inits a special remote, and returns its name. -}
|
||||
makeSpecialRemote :: String -> RemoteType -> R.RemoteConfig -> Annex String
|
||||
{- Inits a special remote. -}
|
||||
makeSpecialRemote :: String -> RemoteType -> R.RemoteConfig -> Annex ()
|
||||
makeSpecialRemote name remotetype config = do
|
||||
(u, c) <- Command.InitRemote.findByName name
|
||||
c' <- R.setup remotetype u $ M.union config c
|
||||
describeUUID u name
|
||||
configSet u c'
|
||||
return name
|
||||
|
||||
{- Returns the name of the git remote it created. If there's already a
|
||||
- remote at the location, returns its name. -}
|
||||
|
|
|
|||
|
|
@ -65,6 +65,7 @@ repoList onlyconfigured
|
|||
Just c -> case M.lookup "type" c of
|
||||
Just "rsync" -> u `enableswith` EnableRsyncR
|
||||
Just "directory" -> u `enableswith` EnableDirectoryR
|
||||
Just "S3" -> u `enableswith` EnableS3R
|
||||
_ -> Nothing
|
||||
u `enableswith` r = Just (u, Just $ r u)
|
||||
list l = runAnnex [] $ do
|
||||
|
|
|
|||
|
|
@ -18,12 +18,28 @@ import Assistant.WebApp.SideBar
|
|||
import Assistant.ThreadedMonad
|
||||
import Utility.Yesod
|
||||
import qualified Remote.S3 as S3
|
||||
import Logs.Remote
|
||||
import Remote (prettyListUUIDs)
|
||||
import Types.Remote (RemoteConfig)
|
||||
|
||||
import Yesod
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as M
|
||||
|
||||
s3Configurator :: Widget -> Handler RepHtml
|
||||
s3Configurator a = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Add an Amazon S3 repository"
|
||||
a
|
||||
|
||||
data StorageClass = StandardRedundancy | ReducedRedundancy
|
||||
deriving (Eq, Enum, Bounded)
|
||||
|
||||
instance Show StorageClass where
|
||||
show StandardRedundancy = "STANDARD"
|
||||
show ReducedRedundancy = "REDUCED_REDUNDANCY"
|
||||
|
||||
data S3Input = S3Input
|
||||
{ accessKeyID :: Text
|
||||
, secretAccessKey :: Text
|
||||
|
|
@ -32,17 +48,14 @@ data S3Input = S3Input
|
|||
, storageClass :: StorageClass
|
||||
, repoName :: Text
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data StorageClass = StandardRedundancy | ReducedRedundancy
|
||||
deriving (Eq, Enum, Bounded)
|
||||
data S3Creds = S3Creds Text Text
|
||||
|
||||
instance Show StorageClass where
|
||||
show StandardRedundancy = "STANDARD"
|
||||
show ReducedRedundancy = "REDUCED_REDUNDANCY"
|
||||
extractCreds :: S3Input -> S3Creds
|
||||
extractCreds i = S3Creds (accessKeyID i) (secretAccessKey i)
|
||||
|
||||
s3AForm :: AForm WebApp WebApp S3Input
|
||||
s3AForm = S3Input
|
||||
s3InputAForm :: AForm WebApp WebApp S3Input
|
||||
s3InputAForm = S3Input
|
||||
<$> areq textField "Access Key ID" Nothing
|
||||
<*> areq passwordField "Secret Access Key" Nothing
|
||||
<*> areq textField "Datacenter" (Just "US")
|
||||
|
|
@ -55,41 +68,57 @@ s3AForm = S3Input
|
|||
, ("Reduced redundancy (costs less)", ReducedRedundancy)
|
||||
]
|
||||
|
||||
s3CredsAForm :: AForm WebApp WebApp S3Creds
|
||||
s3CredsAForm = S3Creds
|
||||
<$> areq textField "Access Key ID" Nothing
|
||||
<*> areq passwordField "Secret Access Key" Nothing
|
||||
|
||||
getAddS3R :: Handler RepHtml
|
||||
getAddS3R = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Add an Amazon S3 repository"
|
||||
getAddS3R = s3Configurator $ do
|
||||
((result, form), enctype) <- lift $
|
||||
runFormGet $ renderBootstrap s3AForm
|
||||
runFormGet $ renderBootstrap s3InputAForm
|
||||
case result of
|
||||
FormSuccess s3input -> lift $ do
|
||||
let name = T.unpack $ repoName s3input
|
||||
name' <- runAnnex name $
|
||||
fromRepo $ uniqueRemoteName name 0
|
||||
makeS3Remote s3input name'
|
||||
makeS3Remote (extractCreds s3input) name $ M.fromList
|
||||
[ ("encryption", "shared")
|
||||
, ("type", "S3")
|
||||
, ("datacenter", T.unpack $ datacenter s3input)
|
||||
, ("storageclass", show $ storageClass s3input)
|
||||
]
|
||||
_ -> showform form enctype
|
||||
where
|
||||
showform form enctype = do
|
||||
let authtoken = webAppFormAuthToken
|
||||
$(widgetFile "configurators/adds3")
|
||||
|
||||
makeS3Remote :: S3Input -> String -> Handler ()
|
||||
makeS3Remote s3input name = do
|
||||
getEnableS3R :: UUID -> Handler RepHtml
|
||||
getEnableS3R uuid = s3Configurator $ do
|
||||
((result, form), enctype) <- lift $
|
||||
runFormGet $ renderBootstrap s3CredsAForm
|
||||
case result of
|
||||
FormSuccess s3creds -> lift $ do
|
||||
m <- runAnnex M.empty readRemoteLog
|
||||
let name = fromJust $ M.lookup "name" $
|
||||
fromJust $ M.lookup uuid m
|
||||
makeS3Remote s3creds name M.empty
|
||||
_ -> showform form enctype
|
||||
where
|
||||
showform form enctype = do
|
||||
let authtoken = webAppFormAuthToken
|
||||
description <- lift $ runAnnex "" $
|
||||
T.pack . concat <$> prettyListUUIDs [uuid]
|
||||
$(widgetFile "configurators/enables3")
|
||||
|
||||
makeS3Remote :: S3Creds -> String -> RemoteConfig -> Handler ()
|
||||
makeS3Remote (S3Creds ak sk) name config = do
|
||||
webapp <- getYesod
|
||||
let st = fromJust $ threadState webapp
|
||||
remotename <- runAnnex name $ fromRepo $ uniqueRemoteName name 0
|
||||
liftIO $ do
|
||||
S3.s3SetCredsEnv
|
||||
( T.unpack $ accessKeyID s3input
|
||||
, T.unpack $ secretAccessKey s3input
|
||||
)
|
||||
r <- runThreadState st $ addRemote $
|
||||
S3.s3SetCredsEnv ( T.unpack ak, T.unpack sk)
|
||||
r <- runThreadState st $ addRemote $ do
|
||||
makeSpecialRemote name S3.remote config
|
||||
return remotename
|
||||
syncNewRemote st (daemonStatus webapp) (scanRemotes webapp) r
|
||||
redirect RepositoriesR
|
||||
where
|
||||
config = M.fromList
|
||||
[ ("encryption", "shared")
|
||||
, ("type", "S3")
|
||||
, ("datacenter", T.unpack $ datacenter s3input)
|
||||
, ("storageclass", show $ storageClass s3input)
|
||||
]
|
||||
|
|
|
|||
|
|
@ -24,6 +24,7 @@
|
|||
|
||||
/config/repository/enable/rsync/#UUID EnableRsyncR GET
|
||||
/config/repository/enable/directory/#UUID EnableDirectoryR GET
|
||||
/config/repository/enable/S3/#UUID EnableS3R GET
|
||||
|
||||
/transfers/#NotificationId TransfersR GET
|
||||
/sidebar/#NotificationId SideBarR GET
|
||||
|
|
|
|||
30
templates/configurators/enables3.hamlet
Normal file
30
templates/configurators/enables3.hamlet
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
<div .span9 .hero-unit>
|
||||
<h2>
|
||||
Enabling #{description}
|
||||
<p>
|
||||
To use this Amazon S3 repository, you need an Access Key ID, and a #
|
||||
Secret Access Key. These access keys will be stored in a file that #
|
||||
only you can access.
|
||||
<p>
|
||||
If this repository uses your Amazon S3 account, you can #
|
||||
<a href="https://portal.aws.amazon.com/gp/aws/securityCredentials#id_block">
|
||||
look up your access keys. #
|
||||
If this repository uses someone else's Amazon S3 account, they #
|
||||
can generate access keys for you, using their #
|
||||
<a href="https://console.aws.amazon.com/iam/home">
|
||||
IAM Management Console.
|
||||
<p>
|
||||
<form .form-horizontal enctype=#{enctype}>
|
||||
<fieldset>
|
||||
^{form}
|
||||
^{authtoken}
|
||||
<div .form-actions>
|
||||
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
|
||||
Enable S3 repository
|
||||
<div .modal .fade #workingmodal>
|
||||
<div .modal-header>
|
||||
<h3>
|
||||
Enabling repository ...
|
||||
<div .modal-body>
|
||||
<p>
|
||||
Enabling this Amazon S3 repository. This could take a minute.
|
||||
Loading…
Add table
Reference in a new issue