diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 39ec366539..4c2fc3a078 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -44,14 +44,14 @@ start params = notBareRepo $ do where ws = words params name = head ws - config = Remote.keyValToMap $ tail ws + config = Remote.keyValToConfig $ tail ws -perform :: RemoteClass.RemoteType Annex -> UUID -> M.Map String String -> CommandPerform +perform :: RemoteClass.RemoteType Annex -> UUID -> RemoteClass.RemoteConfig -> CommandPerform perform t u c = do c' <- RemoteClass.setup t u c return $ Just $ cleanup u c' -cleanup :: UUID -> M.Map String String -> CommandCleanup +cleanup :: UUID -> RemoteClass.RemoteConfig -> CommandCleanup cleanup u c = do Remote.configSet u c g <- Annex.gitRepo @@ -65,7 +65,7 @@ cleanup u c = do return True {- Look up existing remote's UUID and config by name, or generate a new one -} -findByName :: String -> Annex (UUID, M.Map String String) +findByName :: String -> Annex (UUID, RemoteClass.RemoteConfig) findByName name = do m <- Remote.readRemoteLog case findByName' name m of @@ -74,7 +74,7 @@ findByName name = do uuid <- liftIO $ genUUID return $ (uuid, M.insert nameKey name M.empty) -findByName' :: String -> M.Map UUID (M.Map String String) -> Maybe (UUID, M.Map String String) +findByName' :: String -> M.Map UUID RemoteClass.RemoteConfig -> Maybe (UUID, RemoteClass.RemoteConfig) findByName' n m = if null matches then Nothing else Just $ head matches where matches = filter (matching . snd) $ M.toList m @@ -85,7 +85,7 @@ findByName' n m = if null matches then Nothing else Just $ head matches | otherwise -> False {- find the specified remote type -} -findType :: M.Map String String -> Annex (RemoteClass.RemoteType Annex) +findType :: RemoteClass.RemoteConfig -> Annex (RemoteClass.RemoteType Annex) findType config = case M.lookup typeKey config of Nothing -> error "Specify the type of remote with type=" diff --git a/Remote.hs b/Remote.hs index bb661c5a90..8d2ab0399a 100644 --- a/Remote.hs +++ b/Remote.hs @@ -25,7 +25,7 @@ module Remote ( remoteLog, readRemoteLog, configSet, - keyValToMap + keyValToConfig ) where import Control.Monad.State (liftIO) @@ -137,17 +137,17 @@ remoteLog = do return $ gitStateDir g ++ "remote.log" {- Adds or updates a remote's config in the log. -} -configSet :: UUID -> M.Map String String -> Annex () +configSet :: UUID -> RemoteConfig -> Annex () configSet u c = do m <- readRemoteLog l <- remoteLog liftIO $ safeWriteFile l $ unlines $ sort $ map toline $ M.toList $ M.insert u c m where - toline (u', c') = u' ++ " " ++ (unwords $ mapToKeyVal c') + toline (u', c') = u' ++ " " ++ (unwords $ configToKeyVal c') {- Map of remotes by uuid containing key/value config maps. -} -readRemoteLog :: Annex (M.Map UUID (M.Map String String)) +readRemoteLog :: Annex (M.Map UUID RemoteConfig) readRemoteLog = do l <- remoteLog s <- liftIO $ catch (readFile l) ignoreerror @@ -155,7 +155,7 @@ readRemoteLog = do where ignoreerror _ = return "" -remoteLogParse :: String -> M.Map UUID (M.Map String String) +remoteLogParse :: String -> M.Map UUID RemoteConfig remoteLogParse s = M.fromList $ catMaybes $ map parseline $ filter (not . null) $ lines s where @@ -165,18 +165,18 @@ remoteLogParse s = where w = words l u = w !! 0 - c = keyValToMap $ tail w + c = keyValToConfig $ tail w -{- Given Strings like "key=value", generates a Map. -} -keyValToMap :: [String] -> M.Map String String -keyValToMap ws = M.fromList $ map (/=/) ws +{- Given Strings like "key=value", generates a RemoteConfig. -} +keyValToConfig :: [String] -> RemoteConfig +keyValToConfig ws = M.fromList $ map (/=/) ws where (/=/) s = (k, v) where k = takeWhile (/= '=') s v = drop (1 + length k) s -mapToKeyVal :: M.Map String String -> [String] -mapToKeyVal m = map toword $ sort $ M.toList m +configToKeyVal :: M.Map String String -> [String] +configToKeyVal m = map toword $ sort $ M.toList m where toword (k, v) = k ++ "=" ++ v diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 916afeb406..66c78970c9 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -39,7 +39,7 @@ remote = RemoteType { setup = bupSetup } -gen :: Git.Repo -> UUID -> Maybe (M.Map String String) -> Annex (Remote Annex) +gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex) gen r u c = do buprepo <- getConfig r "buprepo" (error "missing buprepo") cst <- remoteCost r (if bupLocal buprepo then semiCheapRemoteCost else expensiveRemoteCost) @@ -60,7 +60,7 @@ gen r u c = do config = c } -bupSetup :: UUID -> M.Map String String -> Annex (M.Map String String) +bupSetup :: UUID -> RemoteConfig -> Annex RemoteConfig bupSetup u c = do -- verify configuration is sane let buprepo = case M.lookup "buprepo" c of diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 0d3478b79d..2313f79a05 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -35,7 +35,7 @@ remote = RemoteType { setup = directorySetup } -gen :: Git.Repo -> UUID -> Maybe (M.Map String String) -> Annex (Remote Annex) +gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex) gen r u _ = do dir <- getConfig r "directory" (error "missing directory") cst <- remoteCost r cheapRemoteCost @@ -51,7 +51,7 @@ gen r u _ = do config = Nothing } -directorySetup :: UUID -> M.Map String String -> Annex (M.Map String String) +directorySetup :: UUID -> RemoteConfig -> Annex RemoteConfig directorySetup u c = do -- verify configuration is sane let dir = case M.lookup "directory" c of diff --git a/Remote/Git.hs b/Remote/Git.hs index 7724df79af..bab452a331 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -40,7 +40,7 @@ list = do g <- Annex.gitRepo return $ Git.remotes g -gen :: Git.Repo -> UUID -> Maybe (M.Map String String) -> Annex (Remote Annex) +gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex) gen r u _ = do {- It's assumed to be cheap to read the config of non-URL remotes, - so this is done each time git-annex is run. Conversely, diff --git a/Remote/S3real.hs b/Remote/S3real.hs index bb82d54e0e..af4e48048a 100644 --- a/Remote/S3real.hs +++ b/Remote/S3real.hs @@ -37,7 +37,7 @@ remote = RemoteType { setup = s3Setup } -gen :: Git.Repo -> UUID -> Maybe (M.Map String String) -> Annex (Remote Annex) +gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex) gen r u c = do cst <- remoteCost r expensiveRemoteCost return $ this cst @@ -54,14 +54,14 @@ gen r u c = do config = c } -s3ConnectionRequired :: M.Map String String -> Annex AWSConnection +s3ConnectionRequired :: RemoteConfig -> Annex AWSConnection s3ConnectionRequired c = do conn <- s3Connection c case conn of Nothing -> error "Cannot connect to S3" Just conn' -> return conn' -s3Connection :: M.Map String String -> Annex (Maybe AWSConnection) +s3Connection :: RemoteConfig -> Annex (Maybe AWSConnection) s3Connection c = do ak <- getEnvKey "AWS_ACCESS_KEY_ID" sk <- getEnvKey "AWS_SECRET_ACCESS_KEY" @@ -78,7 +78,7 @@ s3Connection c = do _ -> error $ "bad S3 port value: " ++ s getEnvKey s = liftIO $ catch (getEnv s) (const $ return "") -s3Setup :: UUID -> M.Map String String -> Annex (M.Map String String) +s3Setup :: UUID -> RemoteConfig -> Annex RemoteConfig s3Setup u c = do -- verify configuration is sane case M.lookup "encryption" c of diff --git a/Remote/Special.hs b/Remote/Special.hs index b5d5a137fe..53ac2c6eed 100644 --- a/Remote/Special.hs +++ b/Remote/Special.hs @@ -13,6 +13,7 @@ import Data.String.Utils import Control.Monad.State (liftIO) import Types +import RemoteClass import qualified GitRepo as Git import qualified Annex import UUID @@ -32,7 +33,7 @@ findSpecialRemotes s = do match k _ = startswith "remote." k && endswith (".annex-"++s) k {- Sets up configuration for a special remote in .git/config. -} -gitConfigSpecialRemote :: UUID -> M.Map String String -> String -> String -> Annex () +gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex () gitConfigSpecialRemote u c k v = do g <- Annex.gitRepo liftIO $ do diff --git a/RemoteClass.hs b/RemoteClass.hs index 8055c16b06..f954e4ff8f 100644 --- a/RemoteClass.hs +++ b/RemoteClass.hs @@ -15,6 +15,8 @@ import Data.Map as M import qualified GitRepo as Git import Key +type RemoteConfig = M.Map String String + {- There are different types of remotes. -} data RemoteType a = RemoteType { -- human visible type name @@ -22,9 +24,9 @@ data RemoteType a = RemoteType { -- enumerates remotes of this type enumerate :: a [Git.Repo], -- generates a remote of this type - generate :: Git.Repo -> String -> Maybe (M.Map String String) -> a (Remote a), + generate :: Git.Repo -> String -> Maybe RemoteConfig -> a (Remote a), -- initializes or changes a remote - setup :: String -> M.Map String String -> a (M.Map String String) + setup :: String -> RemoteConfig -> a RemoteConfig } {- An individual remote. -} @@ -48,7 +50,7 @@ data Remote a = Remote { -- operation. hasKeyCheap :: Bool, -- a Remote can have a persistent configuration store - config :: Maybe (M.Map String String) + config :: Maybe RemoteConfig } instance Show (Remote a) where