git-annex/Command/Expire.hs
Joey Hess 365dbc89dc
expire, trust et al, dead, describe: Support --json and --json-error-messages
For expire, the normal output is unchanged, but the --json output includes the uuid
in machine parseable form. Which could be very useful for this somewhat obscure
command. That needed ActionItemUUID to be implemented, which seemed like a lot
of work, but then ---

I had been going to skip implementing them for trust, untrust, dead, semitrust,
and describe, but putting the uuid in the json is useful information, it tells
what uuid git-annex picked given the input. It was not hard to support
these once ActionItemUUID was implemented.

Sponsored-By: the NIH-funded NICEMAN (ReproNim TR&D3) project
2023-05-05 15:33:30 -04:00

117 lines
3.4 KiB
Haskell

{- git-annex command
-
- Copyright 2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.Expire where
import Command
import Logs.Activity
import Logs.UUID
import Logs.MapLog
import Logs.Trust
import Annex.UUID
import Annex.VectorClock
import qualified Remote
import Utility.HumanTime
import Control.Monad.Fail as Fail (MonadFail(..))
import Data.Time.Clock.POSIX
import qualified Data.Map as M
cmd :: Command
cmd = withAnnexOptions [jsonOptions] $
command "expire" SectionMaintenance
"expire inactive repositories"
paramExpire (seek <$$> optParser)
paramExpire :: String
paramExpire = (paramRepeating $ paramOptional paramRemote ++ ":" ++ paramTime)
data ExpireOptions = ExpireOptions
{ expireParams :: CmdParams
, activityOption :: Maybe Activity
, noActOption :: Bool
}
optParser :: CmdParamsDesc -> Parser ExpireOptions
optParser desc = ExpireOptions
<$> cmdParams desc
<*> optional (option (str >>= parseActivity)
( long "activity" <> metavar paramName
<> help "specify activity that prevents expiry"
))
<*> switch
( long "no-act"
<> help "don't really do anything"
)
seek :: ExpireOptions -> CommandSeek
seek o = do
expire <- parseExpire (expireParams o)
actlog <- lastActivities (activityOption o)
u <- getUUID
us <- filter (/= u) . M.keys <$> uuidDescMap
descs <- uuidDescMap
commandActions $ map (start expire (noActOption o) actlog descs) us
start :: Expire -> Bool -> Log Activity -> UUIDDescMap -> UUID -> CommandStart
start (Expire expire) noact actlog descs u =
case lastact of
Just ent | notexpired ent -> checktrust (== DeadTrusted) $
starting "unexpire" ai si $ do
showNote . UnquotedString =<< whenactive
unless noact $
trustSet u SemiTrusted
next $ return True
_ -> checktrust (/= DeadTrusted) $
starting "expire" ai si $ do
showNote . UnquotedString =<< whenactive
unless noact $
trustSet u DeadTrusted
next $ return True
where
lastact = changed <$> M.lookup u actlog
whenactive = case lastact of
Just (VectorClock c) -> do
d <- liftIO $ durationSince $ posixSecondsToUTCTime c
return $ "last active: " ++ fromDuration d ++ " ago"
_ -> return "no activity"
desc = fromUUID u ++ " " ++ fromUUIDDesc (fromMaybe mempty (M.lookup u descs))
ai = ActionItemUUID u (UnquotedString desc)
si = SeekInput []
notexpired ent = case ent of
Unknown -> False
VectorClock c -> case lookupexpire of
Just (Just expiretime) -> c >= expiretime
_ -> True
lookupexpire = headMaybe $ catMaybes $
map (`M.lookup` expire) [Just u, Nothing]
checktrust want = stopUnless (want <$> lookupTrust u)
data Expire = Expire (M.Map (Maybe UUID) (Maybe POSIXTime))
parseExpire :: [String] -> Annex Expire
parseExpire [] = giveup "Specify an expire time."
parseExpire ps = do
now <- liftIO getPOSIXTime
Expire . M.fromList <$> mapM (parse now) ps
where
parse now s = case separate (== ':') s of
(t, []) -> return (Nothing, parsetime now t)
(n, t) -> do
r <- Remote.nameToUUID n
return (Just r, parsetime now t)
parsetime _ "never" = Nothing
parsetime now s = case parseDuration s of
Right d -> Just (now - durationToPOSIXTime d)
Left e -> giveup $ "bad expire time: " ++ e
parseActivity :: MonadFail m => String -> m Activity
parseActivity s = case readish s of
Nothing -> Fail.fail $ "Unknown activity. Choose from: " ++
unwords (map show allActivities)
Just v -> return v