diff options
-rw-r--r-- | Assistant/MakeRemote.hs | 11 | ||||
-rw-r--r-- | Command/List.hs | 2 | ||||
-rw-r--r-- | Git/GCrypt.hs | 2 | ||||
-rw-r--r-- | Remote.hs | 11 | ||||
-rw-r--r-- | Types/Remote.hs | 3 |
5 files changed, 17 insertions, 12 deletions
diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 8a93e359b..2619039c0 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -47,10 +47,10 @@ makeSshRemote forcersync sshdata mcost = do {- Generates a ssh or rsync url from a SshData. -} sshUrl :: Bool -> SshData -> String -sshUrl forcersync sshdata = T.unpack $ T.concat $ +sshUrl forcersync sshdata = addtrailingslash $ T.unpack $ T.concat $ if (forcersync || rsyncOnly sshdata) - then [u, h, T.pack ":", sshDirectory sshdata, T.pack "/"] - else [T.pack "ssh://", u, h, d, T.pack "/"] + then [u, h, T.pack ":", sshDirectory sshdata] + else [T.pack "ssh://", u, h, d] where u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata h = sshHostName sshdata @@ -58,7 +58,10 @@ sshUrl forcersync sshdata = T.unpack $ T.concat $ | T.pack "/" `T.isPrefixOf` sshDirectory sshdata = sshDirectory sshdata | T.pack "~/" `T.isPrefixOf` sshDirectory sshdata = T.concat [T.pack "/", sshDirectory sshdata] | otherwise = T.concat [T.pack "/~/", sshDirectory sshdata] - + addtrailingslash s + | "/" `isSuffixOf` s = s + | otherwise = s ++ "/" + {- Runs an action that returns a name of the remote, and finishes adding it. -} addRemote :: Annex RemoteName -> Annex Remote addRemote a = do diff --git a/Command/List.hs b/Command/List.hs index 56ec0cd03..fda8f3dc7 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -22,6 +22,7 @@ import Logs.UUID import Annex.UUID import qualified Option import qualified Annex +import Git.Remote def :: [Command] def = [noCommit $ withOptions [allrepos] $ command "list" paramPaths seek @@ -68,7 +69,6 @@ start l file (key, _) = do liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file stop -type RemoteName = String type Present = Bool header :: [(RemoteName, TrustLevel)] -> String diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs index f2f38dfa4..0da68bf24 100644 --- a/Git/GCrypt.hs +++ b/Git/GCrypt.hs @@ -15,6 +15,7 @@ import Git.Construct import qualified Git.Config as Config import qualified Git.Command as Command import Utility.Gpg +import Git.Remote urlPrefix :: String urlPrefix = "gcrypt::" @@ -66,7 +67,6 @@ probeRepo loc baserepo = do ExitFailure 1 -> NotDecryptable ExitFailure _ -> NotEncrypted -type RemoteName = String type GCryptId = String {- gcrypt gives each encrypted repository a uique gcrypt-id, @@ -56,6 +56,7 @@ import Logs.Trust import Logs.Location hiding (logStatus) import Remote.List import Config +import Git.Remote {- Map from UUIDs of Remotes to a calculated value. -} remoteMap :: (Remote -> a) -> Annex (M.Map UUID a) @@ -68,7 +69,7 @@ remoteMap c = M.fromList . map (\r -> (uuid r, c r)) . uuidDescriptions :: Annex (M.Map UUID String) uuidDescriptions = M.unionWith addName <$> uuidMap <*> remoteMap name -addName :: String -> String -> String +addName :: String -> RemoteName -> String addName desc n | desc == n = desc | null desc = n @@ -76,12 +77,12 @@ addName desc n {- When a name is specified, looks up the remote matching that name. - (Or it can be a UUID.) -} -byName :: Maybe String -> Annex (Maybe Remote) +byName :: Maybe RemoteName -> Annex (Maybe Remote) byName Nothing = return Nothing byName (Just n) = either error Just <$> byName' n {- Like byName, but the remote must have a configured UUID. -} -byNameWithUUID :: Maybe String -> Annex (Maybe Remote) +byNameWithUUID :: Maybe RemoteName -> Annex (Maybe Remote) byNameWithUUID = checkuuid <=< byName where checkuuid Nothing = return Nothing @@ -93,7 +94,7 @@ byNameWithUUID = checkuuid <=< byName else error e | otherwise = return $ Just r -byName' :: String -> Annex (Either String Remote) +byName' :: RemoteName -> Annex (Either String Remote) byName' "" = return $ Left "no remote specified" byName' n = handle . filter matching <$> remoteList where @@ -104,7 +105,7 @@ byName' n = handle . filter matching <$> remoteList {- Looks up a remote by name (or by UUID, or even by description), - and returns its UUID. Finds even remotes that are not configured in - .git/config. -} -nameToUUID :: String -> Annex UUID +nameToUUID :: RemoteName -> Annex UUID nameToUUID "." = getUUID -- special case for current repo nameToUUID "here" = getUUID nameToUUID "" = error "no remote specified" diff --git a/Types/Remote.hs b/Types/Remote.hs index 78008ce06..918566e8d 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -18,6 +18,7 @@ import Types.UUID import Types.GitConfig import Config.Cost import Utility.Metered +import Git.Remote type RemoteConfigKey = String type RemoteConfig = M.Map RemoteConfigKey String @@ -42,7 +43,7 @@ data RemoteA a = Remote { -- each Remote has a unique uuid uuid :: UUID, -- each Remote has a human visible name - name :: String, + name :: RemoteName, -- Remotes have a use cost; higher is more expensive cost :: Cost, -- Transfers a key to the remote. |