summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/UUID.hs8
-rw-r--r--Command/ConfigList.hs2
-rw-r--r--Command/Map.hs3
-rw-r--r--Common/Annex.hs2
-rw-r--r--Crypto.hs8
-rw-r--r--Logs/Location.hs2
-rw-r--r--Logs/Presence.hs54
-rw-r--r--Logs/Trust.hs14
-rw-r--r--Logs/UUIDBased.hs17
-rw-r--r--Remote.hs10
-rw-r--r--Remote/Bup.hs10
-rw-r--r--Remote/Helper/Special.hs2
-rw-r--r--Remote/S3real.hs2
-rw-r--r--Types/Crypto.hs8
-rw-r--r--Types/TrustLevel.hs10
-rw-r--r--Types/UUID.hs15
-rw-r--r--Upgrade/V1.hs2
-rw-r--r--git-annex-shell.hs4
18 files changed, 75 insertions, 98 deletions
diff --git a/Annex/UUID.hs b/Annex/UUID.hs
index 90189bc47..d3d674dcc 100644
--- a/Annex/UUID.hs
+++ b/Annex/UUID.hs
@@ -30,7 +30,7 @@ configkey = "annex.uuid"
{- Generates a UUID. There is a library for this, but it's not packaged,
- so use the command line tool. -}
genUUID :: IO UUID
-genUUID = pOpen ReadFromPipe command params $ liftM read . hGetLine
+genUUID = pOpen ReadFromPipe command params $ liftM toUUID . hGetLine
where
command = SysConfig.uuid
params = if command == "uuid"
@@ -56,12 +56,12 @@ getRepoUUID r = do
return u
else return c
where
- cached g = read $ Git.configGet g cachekey ""
+ cached g = toUUID $ Git.configGet g cachekey ""
updatecache g u = when (g /= r) $ storeUUID cachekey u
cachekey = "remote." ++ fromMaybe "" (Git.repoRemoteName r) ++ ".annex-uuid"
getUncachedUUID :: Git.Repo -> UUID
-getUncachedUUID r = read $ Git.configGet r configkey ""
+getUncachedUUID r = toUUID $ Git.configGet r configkey ""
{- Make sure that the repo has an annex.uuid setting. -}
prepUUID :: Annex ()
@@ -69,4 +69,4 @@ prepUUID = whenM ((==) NoUUID <$> getUUID) $
storeUUID configkey =<< liftIO genUUID
storeUUID :: String -> UUID -> Annex ()
-storeUUID configfield uuid = setConfig configfield (show uuid)
+storeUUID configfield = setConfig configfield . fromUUID
diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs
index fadcbb843..dcf4d1509 100644
--- a/Command/ConfigList.hs
+++ b/Command/ConfigList.hs
@@ -21,5 +21,5 @@ seek = [withNothing start]
start :: CommandStart
start = do
u <- getUUID
- liftIO $ putStrLn $ "annex.uuid=" ++ show u
+ liftIO $ putStrLn $ "annex.uuid=" ++ fromUUID u
stop
diff --git a/Command/Map.hs b/Command/Map.hs
index 803324e99..11808ed63 100644
--- a/Command/Map.hs
+++ b/Command/Map.hs
@@ -62,7 +62,8 @@ drawMap rs umap ts = Dot.graph $ repos ++ trusted ++ others
others = map (unreachable . uuidnode) $
filter (`notElem` ruuids) (M.keys umap)
trusted = map (trustworthy . uuidnode) ts
- uuidnode u = Dot.graphNode (show u) $ M.findWithDefault "" u umap
+ uuidnode u = Dot.graphNode (fromUUID u) $
+ M.findWithDefault "" u umap
hostname :: Git.Repo -> String
hostname r
diff --git a/Common/Annex.hs b/Common/Annex.hs
index 43f1ea0af..f802ec253 100644
--- a/Common/Annex.hs
+++ b/Common/Annex.hs
@@ -1,6 +1,7 @@
module Common.Annex (
module Common,
module Types,
+ module Types.UUID,
module Annex,
module Locations,
module Messages,
@@ -8,6 +9,7 @@ module Common.Annex (
import Common
import Types
+import Types.UUID (toUUID, fromUUID)
import Annex (gitRepo)
import Locations
import Messages
diff --git a/Crypto.hs b/Crypto.hs
index ced7c144c..b3acb30a6 100644
--- a/Crypto.hs
+++ b/Crypto.hs
@@ -102,14 +102,18 @@ describeCipher (EncryptedCipher _ (KeyIds ks)) =
{- Stores an EncryptedCipher in a remote's configuration. -}
storeCipher :: RemoteConfig -> EncryptedCipher -> RemoteConfig
storeCipher c (EncryptedCipher t ks) =
- M.insert "cipher" (toB64 t) $ M.insert "cipherkeys" (show ks) c
+ M.insert "cipher" (toB64 t) $ M.insert "cipherkeys" (showkeys ks) c
+ where
+ showkeys (KeyIds l) = join "," l
{- Extracts an EncryptedCipher from a remote's configuration. -}
extractCipher :: RemoteConfig -> Maybe EncryptedCipher
extractCipher c =
case (M.lookup "cipher" c, M.lookup "cipherkeys" c) of
- (Just t, Just ks) -> Just $ EncryptedCipher (fromB64 t) (read ks)
+ (Just t, Just ks) -> Just $ EncryptedCipher (fromB64 t) (readkeys ks)
_ -> Nothing
+ where
+ readkeys = KeyIds . split ","
{- Encrypts a Cipher to the specified KeyIds. -}
encryptCipher :: Cipher -> KeyIds -> IO EncryptedCipher
diff --git a/Logs/Location.hs b/Logs/Location.hs
index 602c46f31..ff874a596 100644
--- a/Logs/Location.hs
+++ b/Logs/Location.hs
@@ -37,7 +37,7 @@ logChange repo _ NoUUID _ = error $
{- Returns a list of repository UUIDs that, according to the log, have
- the value of a key. -}
keyLocations :: Key -> Annex [UUID]
-keyLocations key = map read <$> (currentLog . logFile) key
+keyLocations key = map toUUID <$> (currentLog . logFile) key
{- Finds all keys that have location log information.
- (There may be duplicate keys in the list.) -}
diff --git a/Logs/Presence.hs b/Logs/Presence.hs
index 7211eba03..f5e4f1ea9 100644
--- a/Logs/Presence.hs
+++ b/Logs/Presence.hs
@@ -16,6 +16,7 @@ module Logs.Presence (
addLog,
readLog,
parseLog,
+ showLog,
logNow,
compactLog,
currentLog,
@@ -36,41 +37,9 @@ data LogLine = LogLine {
info :: String
} deriving (Eq)
-data LogStatus = InfoPresent | InfoMissing | Undefined
+data LogStatus = InfoPresent | InfoMissing
deriving (Eq)
-instance Show LogStatus where
- show InfoPresent = "1"
- show InfoMissing = "0"
- show Undefined = "undefined"
-
-instance Read LogStatus where
- readsPrec _ "1" = [(InfoPresent, "")]
- readsPrec _ "0" = [(InfoMissing, "")]
- readsPrec _ _ = [(Undefined, "")]
-
-instance Show LogLine where
- show (LogLine d s i) = unwords [show d, show s, i]
-
-instance Read LogLine where
- -- This parser is robust in that even unparsable log lines are
- -- read without an exception being thrown.
- -- Such lines have a status of Undefined.
- readsPrec _ string =
- if length w >= 3
- then maybe bad good pdate
- else bad
- where
- w = words string
- s = read $ w !! 1
- i = w !! 2
- pdate :: Maybe UTCTime
- pdate = parseTime defaultTimeLocale "%s%Qs" $ head w
-
- good v = ret $ LogLine (utcTimeToPOSIXSeconds v) s i
- bad = ret $ LogLine 0 Undefined ""
- ret v = [(v, "")]
-
addLog :: FilePath -> LogLine -> Annex ()
addLog file line = Annex.Branch.change file $ \s ->
showLog $ compactLog (line : parseLog s)
@@ -80,15 +49,26 @@ addLog file line = Annex.Branch.change file $ \s ->
readLog :: FilePath -> Annex [LogLine]
readLog file = parseLog <$> Annex.Branch.get file
+{- Parses a log file. Unparseable lines are ignored. -}
parseLog :: String -> [LogLine]
-parseLog = filter parsable . map read . lines
+parseLog = mapMaybe (parseline . words) . lines
where
- -- some lines may be unparseable, avoid them
- parsable l = status l /= Undefined
+ parseline (a:b:c:_) = do
+ d <- parseTime defaultTimeLocale "%s%Qs" a
+ s <- parsestatus b
+ Just $ LogLine (utcTimeToPOSIXSeconds d) s c
+ parseline _ = Nothing
+ parsestatus "1" = Just InfoPresent
+ parsestatus "0" = Just InfoMissing
+ parsestatus _ = Nothing
{- Generates a log file. -}
showLog :: [LogLine] -> String
-showLog = unlines . map show
+showLog = unlines . map genline
+ where
+ genline (LogLine d s i) = unwords [show d, genstatus s, i]
+ genstatus InfoPresent = "1"
+ genstatus InfoMissing = "0"
{- Generates a new LogLine with the current date. -}
logNow :: LogStatus -> String -> Annex LogLine
diff --git a/Logs/Trust.hs b/Logs/Trust.hs
index 53a1bca2c..8c4507dcb 100644
--- a/Logs/Trust.hs
+++ b/Logs/Trust.hs
@@ -45,18 +45,26 @@ trustMap = do
parseTrust :: String -> Maybe TrustLevel
parseTrust s
- | length w > 0 = readMaybe $ head w
+ | length w > 0 = Just $ parse $ head w
-- back-compat; the trust.log used to only list trusted repos
- | otherwise = Just Trusted
+ | otherwise = Just $ Trusted
where
w = words s
+ parse "1" = Trusted
+ parse "0" = UnTrusted
+ parse _ = SemiTrusted
+
+showTrust :: TrustLevel -> String
+showTrust SemiTrusted = "?"
+showTrust UnTrusted = "0"
+showTrust Trusted = "1"
{- Changes the trust level for a uuid in the trustLog. -}
trustSet :: UUID -> TrustLevel -> Annex ()
trustSet uuid@(UUID _) level = do
ts <- liftIO $ getPOSIXTime
Annex.Branch.change trustLog $
- showLog show . changeLog ts uuid level . parseLog parseTrust
+ showLog showTrust . changeLog ts uuid level . parseLog parseTrust
Annex.changeState $ \s -> s { Annex.trustmap = Nothing }
trustSet NoUUID _ = error "unknown UUID; cannot modify trust level"
diff --git a/Logs/UUIDBased.hs b/Logs/UUIDBased.hs
index 7184709fe..9609d7321 100644
--- a/Logs/UUIDBased.hs
+++ b/Logs/UUIDBased.hs
@@ -50,28 +50,27 @@ showLog :: (a -> String) -> Log a -> String
showLog shower = unlines . map showpair . M.toList
where
showpair (k, LogEntry (Date p) v) =
- unwords [show k, shower v, tskey ++ show p]
+ unwords [fromUUID k, shower v, tskey ++ show p]
showpair (k, LogEntry Unknown v) =
- unwords [show k, shower v]
+ unwords [fromUUID k, shower v]
parseLog :: (String -> Maybe a) -> String -> Log a
-parseLog parser = M.fromListWith best . catMaybes . map pair . lines
+parseLog parser = M.fromListWith best . catMaybes . map parse . lines
where
- pair line
+ parse line
| null ws = Nothing
- | otherwise = case parser $ unwords info of
- Nothing -> Nothing
- Just v -> Just (read u, LogEntry c v)
+ | otherwise = parser (unwords info) >>= makepair
where
+ makepair v = Just (toUUID u, LogEntry ts v)
ws = words line
u = head ws
end = last ws
- c
+ ts
| tskey `isPrefixOf` end =
pdate $ tail $ dropWhile (/= '=') end
| otherwise = Unknown
info
- | c == Unknown = drop 1 ws
+ | ts == Unknown = drop 1 ws
| otherwise = drop 1 $ init ws
pdate s = case parseTime defaultTimeLocale "%s%Qs" s of
Nothing -> Unknown
diff --git a/Remote.hs b/Remote.hs
index 1591512ef..6d55cee24 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -100,7 +100,7 @@ byName' n = do
then return $ Left $ "there is no git remote named \"" ++ n ++ "\""
else return $ Right $ head match
where
- matching r = n == name r || read n == uuid r
+ matching r = n == name r || toUUID n == uuid r
{- 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
@@ -116,7 +116,7 @@ nameToUUID n = byName' n >>= go
case M.lookup n $ transform swap m of
Just u -> return $ Just u
Nothing -> return $ byuuid m
- byuuid m = M.lookup (read n) $ transform double m
+ byuuid m = M.lookup (toUUID n) $ transform double m
transform a = M.fromList . map a . M.toList
swap (a, b) = (b, a)
double (a, _) = (a, a)
@@ -142,8 +142,8 @@ prettyPrintUUIDs desc uuids = do
remoteMap = M.fromList . map (\r -> (uuid r, name r)) <$> genList
findlog m u = M.findWithDefault "" u m
prettify m here u
- | not (null d) = show u ++ " -- " ++ d
- | otherwise = show u
+ | not (null d) = fromUUID u ++ " -- " ++ d
+ | otherwise = fromUUID u
where
ishere = here == u
n = findlog m u
@@ -152,7 +152,7 @@ prettyPrintUUIDs desc uuids = do
| ishere = addname n "here"
| otherwise = n
jsonify m here u = toJSObject
- [ ("uuid", toJSON $ show u)
+ [ ("uuid", toJSON $ fromUUID u)
, ("description", toJSON $ findlog m u)
, ("here", toJSON $ here == u)
]
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index b613225b8..3e621ce56 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -161,13 +161,15 @@ storeBupUUID u buprepo = do
then do
showAction "storing uuid"
onBupRemote r boolSystem "git"
- [Params $ "config annex.uuid " ++ show u]
+ [Params $ "config annex.uuid " ++ v]
>>! error "ssh failed"
else liftIO $ do
r' <- Git.configRead r
let olduuid = Git.configGet r' "annex.uuid" ""
- when (olduuid == "") $
- Git.run r' "config" [Param "annex.uuid", Param $ show u]
+ when (olduuid == "") $ Git.run r' "config"
+ [Param "annex.uuid", Param v]
+ where
+ v = fromUUID u
onBupRemote :: Git.Repo -> (FilePath -> [CommandParam] -> IO a) -> FilePath -> [CommandParam] -> Annex a
onBupRemote r a command params = do
@@ -192,7 +194,7 @@ getBupUUID r u
| otherwise = liftIO $ do
ret <- try $ Git.configRead r
case ret of
- Right r' -> return (read $ Git.configGet r' "annex.uuid" "", r')
+ Right r' -> return (toUUID $ Git.configGet r' "annex.uuid" "", r')
Left _ -> return (NoUUID, r)
{- Converts a bup remote path spec into a Git.Repo. There are some
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 8a9a01a22..38f24eb37 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -32,7 +32,7 @@ gitConfigSpecialRemote u c k v = do
g <- gitRepo
liftIO $ do
Git.run g "config" [Param (configsetting $ "annex-"++k), Param v]
- Git.run g "config" [Param (configsetting "annex-uuid"), Param $ show u]
+ Git.run g "config" [Param (configsetting "annex-uuid"), Param $ fromUUID u]
where
remotename = fromJust (M.lookup "name" c)
configsetting s = "remote." ++ remotename ++ "." ++ s
diff --git a/Remote/S3real.hs b/Remote/S3real.hs
index 1f5b2bd59..1281c2786 100644
--- a/Remote/S3real.hs
+++ b/Remote/S3real.hs
@@ -64,7 +64,7 @@ s3Setup :: UUID -> RemoteConfig -> Annex RemoteConfig
s3Setup u c = handlehost $ M.lookup "host" c
where
remotename = fromJust (M.lookup "name" c)
- defbucket = remotename ++ "-" ++ show u
+ defbucket = remotename ++ "-" ++ fromUUID u
defaults = M.fromList
[ ("datacenter", "US")
, ("storageclass", "STANDARD")
diff --git a/Types/Crypto.hs b/Types/Crypto.hs
index a39a016b8..a9d3dddc5 100644
--- a/Types/Crypto.hs
+++ b/Types/Crypto.hs
@@ -7,17 +7,9 @@
module Types.Crypto where
-import Data.String.Utils
-
-- XXX ideally, this would be a locked memory region
newtype Cipher = Cipher String
data EncryptedCipher = EncryptedCipher String KeyIds
newtype KeyIds = KeyIds [String]
-
-instance Show KeyIds where
- show (KeyIds ks) = join "," ks
-
-instance Read KeyIds where
- readsPrec _ s = [(KeyIds (split "," s), "")]
diff --git a/Types/TrustLevel.hs b/Types/TrustLevel.hs
index 058ce4595..ddb8e45e4 100644
--- a/Types/TrustLevel.hs
+++ b/Types/TrustLevel.hs
@@ -17,14 +17,4 @@ import Types.UUID
data TrustLevel = SemiTrusted | UnTrusted | Trusted
deriving Eq
-instance Show TrustLevel where
- show SemiTrusted = "?"
- show UnTrusted = "0"
- show Trusted = "1"
-
-instance Read TrustLevel where
- readsPrec _ "1" = [(Trusted, "")]
- readsPrec _ "0" = [(UnTrusted, "")]
- readsPrec _ _ = [(SemiTrusted, "")]
-
type TrustMap = M.Map UUID TrustLevel
diff --git a/Types/UUID.hs b/Types/UUID.hs
index f7232d0b9..767cd0dfe 100644
--- a/Types/UUID.hs
+++ b/Types/UUID.hs
@@ -9,13 +9,12 @@ module Types.UUID where
-- A UUID is either an arbitrary opaque string, or UUID info may be missing.
data UUID = NoUUID | UUID String
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Show)
-instance Show UUID where
- show (UUID u) = u
- show NoUUID = ""
+fromUUID :: UUID -> String
+fromUUID (UUID u) = u
+fromUUID NoUUID = ""
-instance Read UUID where
- readsPrec _ s
- | null s = [(NoUUID, "")]
- | otherwise = [(UUID s, "")]
+toUUID :: String -> UUID
+toUUID [] = NoUUID
+toUUID s = UUID s
diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs
index 331328e81..be9a977ad 100644
--- a/Upgrade/V1.hs
+++ b/Upgrade/V1.hs
@@ -178,7 +178,7 @@ fileKey1 file = readKey1 $
replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file
writeLog1 :: FilePath -> [LogLine] -> IO ()
-writeLog1 file ls = viaTmp writeFile file (unlines $ map show ls)
+writeLog1 file ls = viaTmp writeFile file (showLog ls)
readLog1 :: FilePath -> IO [LogLine]
readLog1 file = catch (parseLog <$> readFileStrict file) (const $ return [])
diff --git a/git-annex-shell.hs b/git-annex-shell.hs
index de3160953..12cc65e4d 100644
--- a/git-annex-shell.hs
+++ b/git-annex-shell.hs
@@ -45,9 +45,9 @@ options = commonOptions ++
where
check expected = do
u <- getUUID
- when (u /= read expected) $ error $
+ when (u /= toUUID expected) $ error $
"expected repository UUID " ++ expected
- ++ " but found UUID " ++ show u
+ ++ " but found UUID " ++ fromUUID u
header :: String
header = "Usage: git-annex-shell [-c] command [parameters ...] [option ..]"
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 10:11:27 +0000