diff options
Diffstat (limited to 'Remote/Glacier.hs')
| -rw-r--r-- | Remote/Glacier.hs | 28 |
1 files changed, 18 insertions, 10 deletions
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index c1a53347d..300e682a7 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -25,6 +25,7 @@ import Creds import Utility.Metered import qualified Annex import Annex.Content +import Annex.UUID import System.Process @@ -39,10 +40,10 @@ remote = RemoteType { setup = glacierSetup } -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote +gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost where - new cst = encryptableRemote c + new cst = Just $ encryptableRemote c (storeEncrypted this) (retrieveEncrypted this) this @@ -58,6 +59,8 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost hasKey = checkPresent this, hasKeyCheap = False, whereisKey = Nothing, + remoteFsck = Nothing, + repairRepo = Nothing, config = c, repo = r, gitconfig = gc, @@ -67,13 +70,18 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost remotetype = remote } -glacierSetup :: UUID -> RemoteConfig -> Annex RemoteConfig -glacierSetup u c = do +glacierSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) +glacierSetup mu c = do + u <- maybe (liftIO genUUID) return mu + glacierSetup' u c +glacierSetup' :: UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) +glacierSetup' u c = do c' <- encryptionSetup c let fullconfig = c' `M.union` defaults genVault fullconfig u gitConfigSpecialRemote u fullconfig "glacier" "true" - setRemoteCredPair fullconfig (AWS.creds u) + c'' <- setRemoteCredPair fullconfig (AWS.creds u) + return (c'', u) where remotename = fromJust (M.lookup "name" c) defvault = remotename ++ "-" ++ fromUUID u @@ -92,10 +100,10 @@ store r k _f p storeHelper r k $ streamMeteredFile src meterupdate storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool -storeEncrypted r (cipher, enck) k p = sendAnnex k (void $ remove r enck) $ \src -> do +storeEncrypted r (cipher, enck) k p = sendAnnex k (void $ remove r enck) $ \src -> metered (Just p) k $ \meterupdate -> storeHelper r enck $ \h -> - encrypt (getGpgOpts r) cipher (feedFile src) + encrypt (getGpgEncParams r) cipher (feedFile src) (readBytes $ meteredWrite meterupdate h) retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool @@ -203,7 +211,7 @@ checkPresent r k = do ] glacierAction :: Remote -> [CommandParam] -> Annex Bool -glacierAction r params = runGlacier (config r) (uuid r) params +glacierAction r = runGlacier (config r) (uuid r) runGlacier :: RemoteConfig -> UUID -> [CommandParam] -> Annex Bool runGlacier c u params = go =<< glacierEnv c u @@ -216,7 +224,7 @@ glacierParams :: RemoteConfig -> [CommandParam] -> [CommandParam] glacierParams c params = datacenter:params where datacenter = Param $ "--region=" ++ - (fromJust $ M.lookup "datacenter" c) + fromJust (M.lookup "datacenter" c) glacierEnv :: RemoteConfig -> UUID -> Annex (Maybe [(String, String)]) glacierEnv c u = go =<< getRemoteCredPairFor "glacier" c creds @@ -276,7 +284,7 @@ jobList r keys = go =<< glacierEnv (config r) (uuid r) enckeys <- forM keys $ \k -> maybe k snd <$> cipherKey (config r) k let keymap = M.fromList $ zip enckeys keys - let convert = catMaybes . map (`M.lookup` keymap) + let convert = mapMaybe (`M.lookup` keymap) return (convert succeeded, convert failed) parse c [] = c |