partially completed switch away from having NoUUID in the UUID type

Not sure if this is any better, or even doesn't introduce a lot of bugs.

Annex/UUID.hs

@@ -15,7 +15,7 @@ module Annex.UUID (
 	getUUID,
 	getRepoUUID,
 	getUncachedUUID,
-	prepUUID,
+	ensureUUID,
 	genUUID,
 	removeRepoUUID,
 	storeUUID,
@@ -25,32 +25,25 @@ import Common.Annex
 import qualified Git
 import qualified Git.Config
 import Config
-
-import qualified Data.UUID as U
-import System.Random
+import Types.UUID
 
 configkey :: ConfigKey
 configkey = annexConfig "uuid"
 
-{- Generates a random UUID, that does not include the MAC address. -}
-genUUID :: IO UUID
-genUUID = UUID . show <$> (randomIO :: IO U.UUID)
-
 {- Get current repository's UUID. -}
-getUUID :: Annex UUID
+getUUID :: Annex (Maybe UUID)
 getUUID = getRepoUUID =<< gitRepo
 
 {- Looks up a repo's UUID, caching it in .git/config if it's not already. -}
-getRepoUUID :: Git.Repo -> Annex UUID
+getRepoUUID :: Git.Repo -> Annex (Maybe UUID)
 getRepoUUID r = do
 	c <- toUUID <$> getConfig cachekey ""
-	let u = getUncachedUUID r
-	
-	if c /= u && u /= NoUUID
-		then do
+	case getUncachedUUID r of
+		v@(Just u)
+			| c /= v -> do
 				updatecache u
-			return u
-		else return c
+				return v
+		_ -> return c
   where
 	updatecache u = do
 		g <- gitRepo
@@ -60,15 +53,21 @@ getRepoUUID r = do
 removeRepoUUID :: Annex ()
 removeRepoUUID = unsetConfig configkey
 
-getUncachedUUID :: Git.Repo -> UUID
+getUncachedUUID :: Git.Repo -> Maybe UUID
 getUncachedUUID = toUUID . Git.Config.get key ""
   where
 	(ConfigKey key) = configkey
 
 {- Make sure that the repo has an annex.uuid setting. -}
-prepUUID :: Annex ()
-prepUUID = whenM ((==) NoUUID <$> getUUID) $
-	storeUUID configkey =<< liftIO genUUID
+ensureUUID :: Annex UUID
+ensureUUID = do
+	mu <- getUUID
+	case mu of
+		Just u -> return u
+		Nothing -> do
+			u <- liftIO genUUID
+			storeUUID configkey u
+			return u
 
 storeUUID :: ConfigKey -> UUID -> Annex ()
 storeUUID configfield = setConfig configfield . fromUUID

Init.hs

@@ -41,13 +41,12 @@ genDescription Nothing = do
 
 initialize :: Maybe String -> Annex ()
 initialize mdescription = do
-	prepUUID
+	u <- ensureUUID
 	setVersion defaultVersion
 	checkCrippledFileSystem
 	Annex.Branch.create
 	gitPreCommitHookWrite
 	createInodeSentinalFile
-	u <- getUUID
 	describeUUID u =<< genDescription mdescription
 
 uninitialize :: Annex ()

Logs/Group.hs

@@ -36,7 +36,7 @@ lookupGroups u = (fromMaybe S.empty . M.lookup u) . groupsByUUID <$> groupMap
 
 {- Applies a set modifier to change the groups for a uuid in the groupLog. -}
 groupChange :: UUID -> (S.Set Group -> S.Set Group) -> Annex ()
-groupChange uuid@(UUID _) modifier = do
+groupChange uuid modifier = do
 	curr <- lookupGroups uuid
 	ts <- liftIO getPOSIXTime
 	Annex.Branch.change groupLog $
@@ -44,7 +44,6 @@ groupChange uuid@(UUID _) modifier = do
 			changeLog ts uuid (modifier curr) .
 				parseLog (Just . S.fromList . words)
 	Annex.changeState $ \s -> s { Annex.groupmap = Nothing }
-groupChange NoUUID _ = error "unknown UUID; cannot modify"
 
 groupSet :: UUID -> S.Set Group -> Annex ()
 groupSet u g = groupChange u (const g)

Logs/Location.hs

@@ -31,20 +31,17 @@ import Annex.UUID
 
 {- Log a change in the presence of a key's value in current repository. -}
 logStatus :: Key -> LogStatus -> Annex ()
-logStatus key status = do
-	u <- getUUID
-	logChange key u status
+logStatus key status = maybe noop (\u -> logChange key u status) =<< getUUID
 
 {- Log a change in the presence of a key's value in a repository. -}
 logChange :: Key -> UUID -> LogStatus -> Annex ()
-logChange key (UUID u) s = addLog (logFile key) =<< logNow s u
-logChange _ NoUUID _ = noop
+logChange key u s = addLog (logFile key) =<< logNow s (fromUUID u)
 
 {- Returns a list of repository UUIDs that, according to the log, have
  - the value of a key.
  -}
 loggedLocations :: Key -> Annex [UUID]
-loggedLocations key = map toUUID <$> (currentLog . logFile) key
+loggedLocations key = mapMaybe toUUID <$> (currentLog . logFile) key
 
 {- Finds all keys that have location log information.
  - (There may be duplicate keys in the list.) -}

Logs/Transfer.hs

@@ -259,7 +259,7 @@ parseTransferFile file
 	| otherwise = case drop (length bits - 3) bits of
 		[direction, u, key] -> Transfer
 			<$> readLcDirection direction
-			<*> pure (toUUID u)
+			<*> toUUID u
 			<*> fileKey key
 		_ -> Nothing
   where

Logs/Trust.hs

@@ -43,14 +43,13 @@ trustGet level = M.keys . M.filter (== level) <$> trustMap
 
 {- Changes the trust level for a uuid in the trustLog. -}
 trustSet :: UUID -> TrustLevel -> Annex ()
-trustSet uuid@(UUID _) level = do
+trustSet uuid level = do
 	ts <- liftIO getPOSIXTime
 	Annex.Branch.change trustLog $
 		showLog showTrustLog .
 			changeLog ts uuid level .
 				parseLog (Just . parseTrustLog)
 	Annex.changeState $ \s -> s { Annex.trustmap = Nothing }
-trustSet NoUUID _ = error "unknown UUID; cannot modify"
 
 {- Returns the TrustLevel of a given repo UUID. -}
 lookupTrust :: UUID -> Annex TrustLevel
@@ -89,9 +88,11 @@ trustMapLoad = do
 	Annex.changeState $ \s -> s { Annex.trustmap = Just m }
 	return m
   where
-	configuredtrust r = (\l -> Just (Types.Remote.uuid r, l))
+	configuredtrust r = case Types.Remote.uuid r of
+		Just u -> (\l -> Just (u, l))
 			=<< readTrustLevel 
 			=<< remoteAnnexTrustLevel (Types.Remote.gitconfig r)
+		Nothing -> Nothing
 
 {- Does not include forcetrust or git config values, just those from the
  - log file. -}

Logs/UUID.hs

@@ -40,36 +40,7 @@ describeUUID :: UUID -> String -> Annex ()
 describeUUID uuid desc = do
 	ts <- liftIO getPOSIXTime
 	Annex.Branch.change uuidLog $
-		showLog id . changeLog ts uuid desc . fixBadUUID . parseLog Just
-
-{- Temporarily here to fix badly formatted uuid logs generated by
- - versions 3.20111105 and 3.20111025. 
- -
- - Those logs contain entries with the UUID and description flipped.
- - Due to parsing, if the description is multiword, only the first
- - will be taken to be the UUID. So, if the UUID of an entry does
- - not look like a UUID, and the last word of the description does,
- - flip them back.
- -}
-fixBadUUID :: Log String -> Log String
-fixBadUUID = M.fromList . map fixup . M.toList
-  where
-	fixup (k, v)
-		| isbad = (fixeduuid, LogEntry (Date $ newertime v) fixedvalue)
-		| otherwise = (k, v)
-	  where
-		kuuid = fromUUID k
-		isbad = not (isuuid kuuid) && isuuid lastword
-		ws = words $ value v
-		lastword = Prelude.last ws
-		fixeduuid = toUUID lastword
-		fixedvalue = unwords $ kuuid: Prelude.init ws
-	-- For the fixed line to take precidence, it should be
-	-- slightly newer, but only slightly.
-	newertime (LogEntry (Date d) _) = d + minimumPOSIXTimeSlice
-	newertime (LogEntry Unknown _) = minimumPOSIXTimeSlice
-	minimumPOSIXTimeSlice = 0.000001
-	isuuid s = length s == 36 && length (split "-" s) == 5
+		showLog id . changeLog ts uuid desc . parseLog Just
 
 {- Records the uuid in the log, if it's not already there. -}
 recordUUID :: UUID -> Annex ()
@@ -90,9 +61,10 @@ uuidMap = maybe uuidMapLoad return =<< Annex.getState Annex.uuidmap
  - it may not have been described and so otherwise would not appear. -}
 uuidMapLoad :: Annex UUIDMap
 uuidMapLoad = do
-	m <- (simpleMap . parseLog Just) <$> Annex.Branch.get uuidLog
-	u <- Annex.UUID.getUUID
-	let m' = M.insertWith' preferold u "" m
+	m <- (simpleMap . parseLog Just)
+		<$> Annex.Branch.get uuidLog
+	m' <- maybe m (\u -> M.insertWith' preferold u "" m)
+		<$> Annex.UUID.getUUID
 	Annex.changeState $ \s -> s { Annex.uuidmap = Just m' }
 	return m'
   where

Logs/UUIDBased.hs

@@ -64,11 +64,12 @@ parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . lines
   where
 	parse line
 		| null ws = Nothing
-		| otherwise = parser u (unwords info) >>= makepair
+		| otherwise = case toUUID $ Prelude.head ws of
+			Just u -> parser u (unwords info) >>= makepair u
+			Nothing -> Nothing
 	  where
-		makepair v = Just (u, LogEntry ts v)
+		makepair u v = Just (u, LogEntry ts v)
 		ws = words line
-		u = toUUID $ Prelude.head ws
 		t = Prelude.last ws
 		ts
 			| tskey `isPrefixOf` t =
@@ -105,10 +106,13 @@ prop_TimeStamp_sane :: Bool
 prop_TimeStamp_sane = Unknown < Date 1
 
 prop_addLog_sane :: Bool
-prop_addLog_sane = newWins && newestWins
+prop_addLog_sane = isJust mu && newWins && newestWins
   where
-	newWins = addLog (UUID "foo") (LogEntry (Date 1) "new") l == l2
-	newestWins = addLog (UUID "foo") (LogEntry (Date 1) "newest") l2 /= l2
+	newWins = addLog (u) (LogEntry (Date 1) "new") l == l2
+	newestWins = addLog (u) (LogEntry (Date 1) "newest") l2 /= l2
 
-	l = M.fromList [(UUID "foo", LogEntry (Date 0) "old")]
-	l2 = M.fromList [(UUID "foo", LogEntry (Date 1) "new")]
+	l = M.fromList [(u, LogEntry (Date 0) "old")]
+	l2 = M.fromList [(u, LogEntry (Date 1) "new")]
+
+	mu = toUUID "foo"
+	u = fromMaybe (error "failed to make uuid") mu

Logs/Web.hs

@@ -22,7 +22,8 @@ type URLString = String
 
 -- Dummy uuid for the whole web. Do not alter.
 webUUID :: UUID
-webUUID = UUID "00000000-0000-0000-0000-000000000001"
+webUUID = fromMaybe (error "failed to construct webUUID") 
+	(toUUID "00000000-0000-0000-0000-000000000001")
 
 urlLog :: Key -> FilePath
 urlLog key = hashDirLower key </> keyFile key ++ ".log.web"

Remote.hs

@@ -56,8 +56,9 @@ import Remote.List
 
 {- Map from UUIDs of Remotes to a calculated value. -}
 remoteMap :: (Remote -> a) -> Annex (M.Map UUID a)
-remoteMap c = M.fromList . map (\r -> (uuid r, c r)) .
-	filter (\r -> uuid r /= NoUUID) <$> remoteList
+remoteMap c = M.fromList . mapMaybe topair <$> remoteList
+  where
+	topair r = maybe Nothing (\u -> Just (u, c r)) (uuid r)
 
 {- Map of UUIDs of remotes and their descriptions.
  - The names of Remotes are added to suppliment any description that has
@@ -82,7 +83,7 @@ byName' n = handle . filter matching <$> remoteList
   where
 	handle [] = Left $ "there is no available git remote named \"" ++ n ++ "\""
 	handle (match:_)
-		| uuid match == NoUUID = Left $ "cannot determine uuid for " ++ name match
+		| isNothing (uuid match) = Left $ "cannot determine uuid for " ++ name match
 		| otherwise = Right match
 	matching r = n == name r || toUUID n == uuid r
 
@@ -90,19 +91,21 @@ byName' n = handle . filter matching <$> remoteList
  - and returns its UUID. Finds even remotes that are not configured in
  - .git/config. -}
 nameToUUID :: String -> Annex UUID
-nameToUUID "." = getUUID -- special case for current repo
-nameToUUID "here" = getUUID
+nameToUUID "." = ensureUUID -- special case for current repo
+nameToUUID "here" = ensureUUID
 nameToUUID "" = error "no remote specified"
 nameToUUID n = byName' n >>= go
   where
-	go (Right r) = return $ uuid r
+	go (Right r) = return $ fromMaybe (error $ "cannot determine uuid for " ++ name r) (uuid r)
 	go (Left e) = fromMaybe (error e) <$> bydescription
 	bydescription = do
 		m <- uuidMap
 		case M.lookup n $ transform swap m of
 			Just u -> return $ Just u
 			Nothing -> return $ byuuid m
-	byuuid m = M.lookup (toUUID n) $ transform double m
+	byuuid m = case toUUID n of
+		Just u -> M.lookup u $ transform double m
+		Nothing -> Nothing
 	transform a = M.fromList . map a . M.toList
 	double (a, _) = (a, a)
 
@@ -112,7 +115,7 @@ nameToUUID n = byName' n >>= go
  - of the UUIDs. -}
 prettyPrintUUIDs :: String -> [UUID] -> Annex String
 prettyPrintUUIDs desc uuids = do
-	hereu <- getUUID
+	hereu <- ensureUUID
 	m <- uuidDescriptions
 	maybeShowJSON [(desc, map (jsonify m hereu) uuids)]
 	return $ unwords $ map (\u -> "\t" ++ prettify m hereu u ++ "\n") uuids
@@ -137,7 +140,7 @@ prettyPrintUUIDs desc uuids = do
 {- List of remote names and/or descriptions, for human display.  -}
 prettyListUUIDs :: [UUID] -> Annex [String]
 prettyListUUIDs uuids = do
-	hereu <- getUUID
+	hereu <- ensureUUID
 	m <- uuidDescriptions
 	return $ map (\u -> prettify m hereu u) uuids
   where

Remote/Bup.hs

@@ -39,17 +39,17 @@ remote = RemoteType {
 	setup = bupSetup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
-gen r u c gc = do
+gen :: Git.Repo -> Maybe UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r mu c gc = do
 	bupr <- liftIO $ bup2GitRemote buprepo
 	cst <- remoteCost gc $
 		if bupLocal buprepo
 			then semiCheapRemoteCost
 			else expensiveRemoteCost
-	(u', bupr') <- getBupUUID bupr u
+	(mu', bupr') <- getBupUUID bupr mu
 	
 	let new = Remote
-		{ uuid = u'
+		{ uuid = mu'
 		, cost = cst
 		, name = Git.repoDescribe r
 		, storeKey = store new buprepo
@@ -223,20 +223,20 @@ onBupRemote r a command params = do
  - local bup repositories to see if they are available, and getting their
  - uuid (which may be different from the stored uuid for the bup remote).
  -
- - If a bup repository is not available, returns NoUUID.
+ - If a bup repository is not available, returns Nothing.
  - This will cause checkPresent to indicate nothing from the bup remote
  - is known to be present.
  -
  - Also, returns a version of the repo with config read, if it is local.
  -}
-getBupUUID :: Git.Repo -> UUID -> Annex (UUID, Git.Repo)
+getBupUUID :: Git.Repo -> Maybe UUID -> Annex (Maybe UUID, Git.Repo)
 getBupUUID r u
 	| Git.repoIsUrl r = return (u, r)
 	| otherwise = liftIO $ do
 		ret <- tryIO $ Git.Config.read r
 		case ret of
 			Right r' -> return (toUUID $ Git.Config.get "annex.uuid" "" r', r')
-			Left _ -> return (NoUUID, r)
+			Left _ -> return (Nothing, r)
 
 {- Converts a bup remote path spec into a Git.Repo. There are some
  - differences in path representation between git and bup. -}

Remote/Directory.hs

@@ -33,15 +33,15 @@ remote = RemoteType {
 	setup = directorySetup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
-gen r u c gc = do
+gen :: Git.Repo -> (Maybe UUID) -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r mu c gc = do
 	cst <- remoteCost gc cheapRemoteCost
 	let chunksize = chunkSize c
 	return $ encryptableRemote c
 		(storeEncrypted dir chunksize)
 		(retrieveEncrypted dir chunksize)
 		Remote {
-			uuid = u,
+			uuid = mu,
 			cost = cst,
 			name = Git.repoDescribe r,
 			storeKey = store dir chunksize,

Remote/Git.hs

@@ -76,24 +76,24 @@ configRead :: Git.Repo -> Annex Git.Repo
 configRead r = do
 	g <- fromRepo id
 	let c = extractRemoteGitConfig g (Git.repoDescribe r)
-	u <- getRepoUUID r
-	case (repoCheap r, remoteAnnexIgnore c, u) of
+	mu <- getRepoUUID r
+	case (repoCheap r, remoteAnnexIgnore c, mu) of
 		(_, True, _) -> return r
 		(True, _, _) -> tryGitConfigRead r
-		(False, _, NoUUID) -> tryGitConfigRead r
+		(False, _, Nothing) -> tryGitConfigRead r
 		_ -> return r
 
 repoCheap :: Git.Repo -> Bool
 repoCheap = not . Git.repoIsUrl
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
-gen r u _ gc = go <$> remoteCost gc defcst
+gen :: Git.Repo -> Maybe UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r mu _ gc = go <$> remoteCost gc defcst
   where
 	defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
 	go cst = new
 	  where
 		new = Remote 
-			{ uuid = u
+			{ uuid = mu
 			, cost = cst
 			, name = Git.repoDescribe r
 			, storeKey = copyToRemote new
@@ -165,7 +165,7 @@ tryGitConfigRead r
  			fileEncoding h
 			val <- hGetContentsStrict h
 			r' <- Git.Config.store val r
-			when (getUncachedUUID r' == NoUUID && not (null val)) $ do
+			when (isNothing (getUncachedUUID r') && not (null val)) $ do
 				warningIO $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r
 				warningIO $ "Instead, got: " ++ show val
 				warningIO $ "This is unexpected; please check the network transport!"
@@ -271,7 +271,7 @@ copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
 copyFromRemote r key file dest
 	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do
 		let params = rsyncParams r
-		u <- getUUID
+		u <- ensureUUID
 		-- run copy from perspective of remote
 		liftIO $ onLocal (repo r) $ do
 			ensureInitialized
@@ -302,7 +302,7 @@ copyFromRemote r key file dest
 	 - transferinfo, so stderr is dropped and failure ignored.
 	 -}
 	feedprogressback a = do
-		u <- getUUID
+		u <- ensureUUID
 		let fields = (Fields.remoteUUID, fromUUID u)
 			: maybe [] (\f -> [(Fields.associatedFile, f)]) file
 		Just (cmd, params) <- git_annex_shell (repo r) "transferinfo" 
@@ -352,7 +352,7 @@ copyToRemote r key file p
 	copylocal Nothing = return False
 	copylocal (Just (object, checksuccess)) = do
 		let params = rsyncParams r
-		u <- getUUID
+		u <- ensureUUID
 		-- run copy from perspective of remote
 		liftIO $ onLocal (repo r) $ ifM (Annex.Content.inAnnex key)
 			( return False
@@ -404,7 +404,7 @@ rsyncOrCopyFile rsyncparams src dest p =
  - to either receive or send the key's content. -}
 rsyncParamsRemote :: Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]
 rsyncParamsRemote r direction key file afile = do
-	u <- getUUID
+	u <- ensureUUID
 	direct <- isDirect
 	let fields = (Fields.remoteUUID, fromUUID u)
 		: (Fields.direct, if direct then "1" else "")

Remote/Glacier.hs

@@ -38,8 +38,8 @@ remote = RemoteType {
 	setup = glacierSetup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
-gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
+gen :: Git.Repo -> Maybe UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r mu c gc = new <$> remoteCost gc veryExpensiveRemoteCost
   where
 	new cst = encryptableRemote c
 		(storeEncrypted this)
@@ -47,7 +47,7 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
 		this
 	  where
 		this = Remote {
-			uuid = u,
+			uuid = mu,
 			cost = cst,
 			name = Git.repoDescribe r,
 			storeKey = store this,
@@ -205,8 +205,8 @@ checkPresent r k = do
 glacierAction :: Remote -> [CommandParam] -> Annex Bool
 glacierAction r params = runGlacier (config r) (uuid r) params
 
-runGlacier :: RemoteConfig -> UUID -> [CommandParam] -> Annex Bool
-runGlacier c u params = go =<< glacierEnv c u
+runGlacier :: RemoteConfig -> Maybe UUID -> [CommandParam] -> Annex Bool
+runGlacier c mu params = go =<< glacierEnv c mu
   where
 	go Nothing = return False
 	go (Just e) = liftIO $
@@ -218,8 +218,9 @@ glacierParams c params = datacenter:params
 	datacenter = Param $ "--region=" ++
 		(fromJust $ M.lookup "datacenter" c)
 
-glacierEnv :: RemoteConfig -> UUID -> Annex (Maybe [(String, String)])
-glacierEnv c u = go =<< getRemoteCredPairFor "glacier" c creds
+glacierEnv :: RemoteConfig -> Maybe UUID -> Annex (Maybe [(String, String)])
+glacierEnv _ Nothing = return Nothing
+glacierEnv c (Just u) = go =<< getRemoteCredPairFor "glacier" c creds
   where
 	go Nothing = return Nothing
 	go (Just (user, pass)) = do
@@ -239,7 +240,7 @@ archive r k = fileprefix ++ key2file k
 
 -- glacier vault create will succeed even if the vault already exists.
 genVault :: RemoteConfig -> UUID -> Annex ()
-genVault c u = unlessM (runGlacier c u params) $
+genVault c u = unlessM (runGlacier c (Just u) params) $
 	error "Failed creating glacier vault."
   where
 	params = 

Remote/Helper/Ssh.hs

@@ -32,20 +32,20 @@ git_annex_shell :: Git.Repo -> String -> [CommandParam] -> [(Field, String)] ->
 git_annex_shell r command params fields
 	| not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts ++ fieldopts)
 	| Git.repoIsSsh r = do
-		uuid <- getRepoUUID r
-		sshparams <- sshToRepo r [Param $ sshcmd uuid ]
+		mu <- getRepoUUID r
+		sshparams <- sshToRepo r [Param $ sshcmd mu ]
 		return $ Just ("ssh", sshparams)
 	| otherwise = return Nothing
   where
 	dir = Git.repoPath r
 	shellcmd = "git-annex-shell"
 	shellopts = Param command : File dir : params
-	sshcmd uuid = unwords $
+	sshcmd mu = unwords $
 		shellcmd : map shellEscape (toCommand shellopts) ++
-		uuidcheck uuid ++
+		uuidcheck mu ++
 		map shellEscape (toCommand fieldopts)
-	uuidcheck NoUUID = []
-	uuidcheck (UUID u) = ["--uuid", u]
+	uuidcheck (Just u) = ["--uuid", fromUUID u]
+	uuidcheck Nothing = []
 	fieldopts
 		| null fields = []
 		| otherwise = fieldsep : map fieldopt fields ++ [fieldsep]

Remote/Hook.hs

@@ -29,14 +29,14 @@ remote = RemoteType {
 	setup = hookSetup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
-gen r u c gc = do
+gen :: Git.Repo -> Maybe UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r mu c gc = do
 	cst <- remoteCost gc expensiveRemoteCost
 	return $ encryptableRemote c
 		(storeEncrypted hooktype)
 		(retrieveEncrypted hooktype)
 		Remote {
-			uuid = u,
+			uuid = mu,
 			cost = cst,
 			name = Git.repoDescribe r,
 			storeKey = store hooktype,

Remote/List.hs

@@ -80,11 +80,11 @@ remoteListRefresh = do
 {- Generates a Remote. -}
 remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex Remote
 remoteGen m t r = do
-	u <- getRepoUUID r
+	mu <- getRepoUUID r
 	g <- fromRepo id
 	let gc = extractRemoteGitConfig g (Git.repoDescribe r)
-	let c = fromMaybe M.empty $ M.lookup u m
-	addHooks <$> generate t r u c gc
+	let c = fromMaybe M.empty $ maybe Nothing (\u -> M.lookup u m) mu
+	addHooks <$> generate t r mu c gc
 
 {- Updates a local git Remote, re-reading its git config. -}
 updateRemote :: Remote -> Annex Remote

Remote/Rsync.hs

@@ -39,14 +39,14 @@ remote = RemoteType {
 	setup = rsyncSetup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
-gen r u c gc = do
+gen :: Git.Repo -> Maybe UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r mu c gc = do
 	cst <- remoteCost gc expensiveRemoteCost
 	return $ encryptableRemote c
 		(storeEncrypted o)
 		(retrieveEncrypted o)
 		Remote
-			{ uuid = u
+			{ uuid = mu
 			, cost = cst
 			, name = Git.repoDescribe r
 			, storeKey = store o

Remote/S3.hs

@@ -37,8 +37,8 @@ remote = RemoteType {
 	setup = s3Setup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
-gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
+gen :: Git.Repo -> Maybe UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r mu c gc = new <$> remoteCost gc expensiveRemoteCost
   where
 	new cst = encryptableRemote c
 		(storeEncrypted this)
@@ -46,7 +46,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 		this
 	  where
 		this = Remote {
-			uuid = u,
+			uuid = mu,
 			cost = cst,
 			name = Git.repoDescribe r,
 			storeKey = store this,
@@ -206,7 +206,9 @@ s3Bool (Left e) = s3Warning e
 s3Action :: Remote -> a -> ((AWSConnection, String) -> Annex a) -> Annex a
 s3Action r noconn action = do
 	let bucket = M.lookup "bucket" $ config r
-	conn <- s3Connection (config r) (uuid r)
+	conn <- case uuid r of
+		Nothing -> return Nothing
+		Just u -> s3Connection (config r) u
 	case (bucket, conn) of
 		(Just b, Just c) -> action (c, b)
 		_ -> return noconn

Remote/Web.hs

@@ -35,10 +35,10 @@ list = do
 	r <- liftIO $ Git.Construct.remoteNamed "web" Git.Construct.fromUnknown
 	return [r]
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> Maybe UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
 gen r _ _ gc = 
 	return Remote {
-		uuid = webUUID,
+		uuid = Just webUUID,
 		cost = expensiveRemoteCost,
 		name = Git.repoDescribe r,
 		storeKey = uploadKey,

Remote/WebDAV.hs

@@ -50,8 +50,8 @@ remote = RemoteType {
 	setup = webdavSetup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
-gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
+gen :: Git.Repo -> (Maybe UUID) -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r mu c gc = new <$> remoteCost gc expensiveRemoteCost
   where
 	new cst = encryptableRemote c
 		(storeEncrypted this)
@@ -59,7 +59,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 		this
 	  where
 		this = Remote {
-			uuid = u,
+			uuid = mu,
 			cost = cst,
 			name = Git.repoDescribe r,
 			storeKey = store this,
@@ -205,7 +205,9 @@ withStoredFiles r k baseurl user pass onerr a
 
 davAction :: Remote -> a -> ((DavUrl, DavUser, DavPass) -> Annex a) -> Annex a
 davAction r unconfigured action = do
-	mcreds <- getCreds (config r) (uuid r)
+	mcreds <- case uuid r of
+		Nothing -> return Nothing
+		Just u -> getCreds (config r) u
 	case (mcreds, M.lookup "url" $ config r) of
 		(Just (user, pass), Just url) ->
 			action (url, toDavUser user, toDavPass pass)

Types.hs

@@ -9,7 +9,7 @@ module Types (
 	Annex,
 	Backend,
 	Key,
-	UUID(..),
+	UUID,
 	GitConfig(..),
 	RemoteGitConfig(..),
 	Remote,

Types/Remote.hs

@@ -28,7 +28,7 @@ data RemoteTypeA a = RemoteType {
 	-- enumerates remotes of this type
 	enumerate :: a [Git.Repo],
 	-- generates a remote of this type
-	generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (RemoteA a),
+	generate :: Git.Repo -> (Maybe UUID) -> RemoteConfig -> RemoteGitConfig -> a (RemoteA a),
 	-- initializes or changes a remote
 	setup :: UUID -> RemoteConfig -> a RemoteConfig
 }
@@ -41,8 +41,9 @@ type AssociatedFile = Maybe FilePath
 
 {- An individual remote. -}
 data RemoteA a = Remote {
-	-- each Remote has a unique uuid
-	uuid :: UUID,
+	-- each available Remote has a unique uuid
+	-- remotes may be unavailable or not fully set up and have Nothing
+	uuid :: Maybe UUID,
 	-- each Remote has a human visible name
 	name :: String,
 	-- Remotes have a use cost; higher is more expensive

Types/UUID.hs

@@ -1,24 +1,36 @@
 {- git-annex UUID type
  -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011,2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Types.UUID where
+module Types.UUID (
+	UUID,
+	UUIDMap,
+	fromUUID,
+	toUUID,
+	genUUID
+) where
 
 import qualified Data.Map as M
+import qualified Data.UUID as U
+import System.Random
+import Control.Applicative
 
--- A UUID is either an arbitrary opaque string, or UUID info may be missing.
-data UUID = NoUUID | UUID String
+-- A UUID an arbitrary opaque string, which cannot be empty.
+data UUID = UUID String
 	deriving (Eq, Ord, Show, Read)
 
+type UUIDMap = M.Map UUID String
+
 fromUUID :: UUID -> String
 fromUUID (UUID u) = u
-fromUUID NoUUID = ""
 
-toUUID :: String -> UUID
-toUUID [] = NoUUID
-toUUID s = UUID s
+toUUID :: String -> Maybe UUID
+toUUID [] = Nothing
+toUUID s = Just (UUID s)
 
-type UUIDMap = M.Map UUID String
+{- Generates a random UUID, that does not include the MAC address. -}
+genUUID :: IO UUID
+genUUID = UUID . show <$> (randomIO :: IO U.UUID)