summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2017-03-10 13:12:24 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2017-03-10 13:35:31 -0400
commit8cb9381befed4174624edfc80e09185c9340b4f6 (patch)
treee5d2041ff38502b1f8a5ef9caa6515cccfcea555 /Command
parente230fd58b5f5d5d16f87e1bd5c0f2e553f2ae5a2 (diff)
AssociatedFile newtype
To prevent any further mistakes like 1a497cefb47557f0b4788c606f9071be422b2511 This commit was sponsored by Francois Marier on Patreon.
Diffstat (limited to 'Command')
-rw-r--r--Command/AddUrl.hs15
-rw-r--r--Command/Copy.hs4
-rw-r--r--Command/Drop.hs7
-rw-r--r--Command/DropUnused.hs4
-rw-r--r--Command/Fsck.hs49
-rw-r--r--Command/Get.hs7
-rw-r--r--Command/Info.hs9
-rw-r--r--Command/MetaData.hs4
-rw-r--r--Command/Migrate.hs5
-rw-r--r--Command/Mirror.hs10
-rw-r--r--Command/Move.hs4
-rw-r--r--Command/SendKey.hs2
-rw-r--r--Command/Sync.hs4
-rw-r--r--Command/TestRemote.hs11
-rw-r--r--Command/TransferInfo.hs4
-rw-r--r--Command/TransferKey.hs4
-rw-r--r--Command/TransferKeys.hs8
-rw-r--r--Command/Whereis.hs2
18 files changed, 89 insertions, 64 deletions
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index a89a25e83..866bfc463 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -171,7 +171,9 @@ downloadRemoteFile r relaxed uri file sz = checkCanAdd file $ do
-- so that the remote knows what url it
-- should use to download it.
setTempUrl urlkey loguri
- let downloader = \dest p -> fst <$> Remote.retrieveKeyFile r urlkey (Just file) dest p
+ let downloader = \dest p -> fst
+ <$> Remote.retrieveKeyFile r urlkey
+ (AssociatedFile (Just file)) dest p
ret <- downloadWith downloader urlkey (Remote.uuid r) loguri file
removeTempUrl urlkey
return ret
@@ -255,8 +257,8 @@ addUrlFileQuvi relaxed quviurl videourl file = checkCanAdd file $ do
checkDiskSpaceToGet sizedkey Nothing $ do
tmp <- fromRepo $ gitAnnexTmpObjectLocation key
showOutput
- ok <- Transfer.notifyTransfer Transfer.Download (Just file) $
- Transfer.download webUUID key (Just file) Transfer.forwardRetry $ \p -> do
+ ok <- Transfer.notifyTransfer Transfer.Download afile $
+ Transfer.download webUUID key afile Transfer.forwardRetry $ \p -> do
liftIO $ createDirectoryIfMissing True (parentDir tmp)
downloadUrl key p [videourl] tmp
if ok
@@ -265,6 +267,8 @@ addUrlFileQuvi relaxed quviurl videourl file = checkCanAdd file $ do
return (Just key)
else return Nothing
)
+ where
+ afile = AssociatedFile (Just file)
addUrlChecked :: Bool -> URLString -> UUID -> (Key -> Annex (Bool, Bool)) -> Key -> CommandPerform
addUrlChecked relaxed url u checkexistssize key
@@ -328,10 +332,11 @@ downloadWith downloader dummykey u url file =
, return Nothing
)
where
- runtransfer tmp = Transfer.notifyTransfer Transfer.Download (Just file) $
- Transfer.download u dummykey (Just file) Transfer.forwardRetry $ \p -> do
+ runtransfer tmp = Transfer.notifyTransfer Transfer.Download afile $
+ Transfer.download u dummykey afile Transfer.forwardRetry $ \p -> do
liftIO $ createDirectoryIfMissing True (parentDir tmp)
downloader tmp p
+ afile = AssociatedFile (Just file)
{- Adds the url size to the Key. -}
addSizeUrlKey :: Url.UrlInfo -> Key -> Key
diff --git a/Command/Copy.hs b/Command/Copy.hs
index 56278bde2..9b41b17d7 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -53,6 +53,6 @@ start o file key = stopUnless shouldCopy $
| otherwise = return True
want = case Command.Move.fromToOptions (moveOptions o) of
ToRemote dest -> (Remote.uuid <$> getParsed dest) >>=
- wantSend False (Just key) (Just file)
+ wantSend False (Just key) (AssociatedFile (Just file))
FromRemote _ ->
- wantGet False (Just key) (Just file)
+ wantGet False (Just key) (AssociatedFile (Just file))
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 129dce035..52b89b82c 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -65,7 +65,7 @@ seek o = allowConcurrentOutput $
start :: DropOptions -> FilePath -> Key -> CommandStart
start o file key = start' o key afile (mkActionItem afile)
where
- afile = Just file
+ afile = AssociatedFile (Just file)
start' :: DropOptions -> Key -> AssociatedFile -> ActionItem -> CommandStart
start' o key afile ai = do
@@ -85,7 +85,7 @@ start' o key afile ai = do
| otherwise = return True
startKeys :: DropOptions -> Key -> ActionItem -> CommandStart
-startKeys o key = start' o key Nothing
+startKeys o key = start' o key (AssociatedFile Nothing)
startLocal :: AssociatedFile -> ActionItem -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
startLocal afile ai numcopies key preverified = stopUnless (inAnnex key) $ do
@@ -202,7 +202,8 @@ requiredContent = do
{- In auto mode, only runs the action if there are enough
- copies on other semitrusted repositories. -}
checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> CommandStart) -> CommandStart
-checkDropAuto automode mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile
+checkDropAuto automode mremote (AssociatedFile afile) key a =
+ go =<< maybe getNumCopies getFileNumCopies afile
where
go numcopies
| automode = do
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index edc11ea45..840a8a472 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -46,9 +46,9 @@ perform :: Maybe Remote -> NumCopies -> Key -> CommandPerform
perform from numcopies key = case from of
Just r -> do
showAction $ "from " ++ Remote.name r
- Command.Drop.performRemote key Nothing numcopies r
+ Command.Drop.performRemote key (AssociatedFile Nothing) numcopies r
Nothing -> ifM (inAnnex key)
- ( Command.Drop.performLocal key Nothing numcopies []
+ ( Command.Drop.performLocal key (AssociatedFile Nothing) numcopies []
, next (return True)
)
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 231f93ce7..c291493b1 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -110,9 +110,10 @@ start from inc file key = do
numcopies <- getFileNumCopies file
case from of
Nothing -> go $ perform key file backend numcopies
- Just r -> go $ performRemote key (Just file) backend numcopies r
+ Just r -> go $ performRemote key afile backend numcopies r
where
- go = runFsck inc (mkActionItem (Just file)) key
+ go = runFsck inc (mkActionItem afile) key
+ afile = AssociatedFile (Just file)
perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool
perform key file backend numcopies = do
@@ -123,10 +124,12 @@ perform key file backend numcopies = do
, verifyLocationLog key keystatus file
, verifyAssociatedFiles key keystatus file
, verifyWorkTree key file
- , checkKeySize key keystatus (Just file)
- , checkBackend backend key keystatus (Just file)
- , checkKeyNumCopies key (Just file) numcopies
+ , checkKeySize key keystatus afile
+ , checkBackend backend key keystatus afile
+ , checkKeyNumCopies key afile numcopies
]
+ where
+ afile = AssociatedFile (Just file)
{- To fsck a remote, the content is retrieved to a tmp file,
- and checked locally. -}
@@ -148,7 +151,7 @@ performRemote key afile backend numcopies remote =
return False
dispatch (Right False) = go False Nothing
go present localcopy = check
- [ verifyLocationLogRemote key (maybe (key2file key) id afile) remote present
+ [ verifyLocationLogRemote key afile remote present
, withLocalCopy localcopy $ checkKeySizeRemote key remote afile
, withLocalCopy localcopy $ checkBackendRemote backend key remote afile
, checkKeyNumCopies key afile numcopies
@@ -167,7 +170,7 @@ performRemote key afile backend numcopies remote =
, ifM (Annex.getState Annex.fast)
( return Nothing
, Just . fst <$>
- Remote.retrieveKeyFile remote key Nothing tmp dummymeter
+ Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp dummymeter
)
)
, return (Just False)
@@ -181,16 +184,16 @@ startKey from inc key ai numcopies =
Just backend -> runFsck inc ai key $
case from of
Nothing -> performKey key backend numcopies
- Just r -> performRemote key Nothing backend numcopies r
+ Just r -> performRemote key (AssociatedFile Nothing) backend numcopies r
performKey :: Key -> Backend -> NumCopies -> Annex Bool
performKey key backend numcopies = do
keystatus <- getKeyStatus key
check
[ verifyLocationLog key keystatus (key2file key)
- , checkKeySize key keystatus Nothing
- , checkBackend backend key keystatus Nothing
- , checkKeyNumCopies key Nothing numcopies
+ , checkKeySize key keystatus (AssociatedFile Nothing)
+ , checkBackend backend key keystatus (AssociatedFile Nothing)
+ , checkKeyNumCopies key (AssociatedFile Nothing) numcopies
]
check :: [Annex Bool] -> Annex Bool
@@ -249,10 +252,12 @@ verifyLocationLog key keystatus desc = do
then return True
else verifyLocationLog' key desc present u (logChange key u)
-verifyLocationLogRemote :: Key -> String -> Remote -> Bool -> Annex Bool
-verifyLocationLogRemote key desc remote present =
+verifyLocationLogRemote :: Key -> AssociatedFile -> Remote -> Bool -> Annex Bool
+verifyLocationLogRemote key (AssociatedFile afile) remote present =
verifyLocationLog' key desc present (Remote.uuid remote)
(Remote.logStatus remote key)
+ where
+ desc = fromMaybe (key2file key) afile
verifyLocationLog' :: Key -> String -> Bool -> UUID -> (LogStatus -> Annex ()) -> Annex Bool
verifyLocationLog' key desc present u updatestatus = do
@@ -356,7 +361,7 @@ checkKeySizeRemote key remote afile localcopy =
checkKeySizeOr (badContentRemote remote localcopy) key localcopy afile
checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> AssociatedFile -> Annex Bool
-checkKeySizeOr bad key file afile = case keySize key of
+checkKeySizeOr bad key file (AssociatedFile afile) = case keySize key of
Nothing -> return True
Just size -> do
size' <- liftIO $ getFileSize file
@@ -396,7 +401,9 @@ checkBackend backend key keystatus afile = go =<< isDirect
( nocheck
, checkBackendOr badContent backend key content afile
)
- go True = maybe nocheck checkdirect afile
+ go True = case afile of
+ AssociatedFile Nothing -> nocheck
+ AssociatedFile (Just f) -> checkdirect f
checkdirect file = ifM (Direct.goodContent key file)
( checkBackendOr' (badContentDirect file) backend key file afile
(Direct.goodContent key file)
@@ -416,7 +423,7 @@ checkBackendOr bad backend key file afile =
-- in order to detect situations where the file is changed while being
-- verified (particularly in direct mode).
checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> FilePath -> AssociatedFile -> Annex Bool -> Annex Bool
-checkBackendOr' bad backend key file afile postcheck =
+checkBackendOr' bad backend key file (AssociatedFile afile) postcheck =
case Types.Backend.verifyKeyContent backend of
Nothing -> return True
Just verifier -> do
@@ -436,21 +443,23 @@ checkBackendOr' bad backend key file afile postcheck =
checkKeyNumCopies :: Key -> AssociatedFile -> NumCopies -> Annex Bool
checkKeyNumCopies key afile numcopies = do
- let file = fromMaybe (key2file key) afile
+ let (desc, hasafile) = case afile of
+ AssociatedFile Nothing -> (key2file key, False)
+ AssociatedFile (Just af) -> (af, True)
locs <- loggedLocations key
(untrustedlocations, otherlocations) <- trustPartition UnTrusted locs
(deadlocations, safelocations) <- trustPartition DeadTrusted otherlocations
let present = NumCopies (length safelocations)
if present < numcopies
- then ifM (pure (isNothing afile) <&&> checkDead key)
+ then ifM (pure (not hasafile) <&&> checkDead key)
( do
showLongNote $ "This key is dead, skipping."
return True
, do
untrusted <- Remote.prettyPrintUUIDs "untrusted" untrustedlocations
dead <- Remote.prettyPrintUUIDs "dead" deadlocations
- warning $ missingNote file present numcopies untrusted dead
- when (fromNumCopies present == 0 && isNothing afile) $
+ warning $ missingNote desc present numcopies untrusted dead
+ when (fromNumCopies present == 0 && not hasafile) $
showLongNote "(Avoid this check by running: git annex dead --key )"
return False
)
diff --git a/Command/Get.hs b/Command/Get.hs
index abf95e48a..fc6ff7374 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -51,14 +51,15 @@ seek o = allowConcurrentOutput $ do
start :: GetOptions -> Maybe Remote -> FilePath -> Key -> CommandStart
start o from file key = start' expensivecheck from key afile (mkActionItem afile)
where
- afile = Just file
+ afile = AssociatedFile (Just file)
expensivecheck
- | autoMode o = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)
+ | autoMode o = numCopiesCheck file key (<)
+ <||> wantGet False (Just key) afile
| otherwise = return True
startKeys :: Maybe Remote -> Key -> ActionItem -> CommandStart
startKeys from key ai = checkFailedTransferDirection ai Download $
- start' (return True) from key Nothing ai
+ start' (return True) from key (AssociatedFile Nothing) ai
start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> CommandStart
start' expensivecheck from key afile ai = stopUnless (not <$> inAnnex key) $
diff --git a/Command/Info.hs b/Command/Info.hs
index aaee08fe1..0867bf8ea 100644
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -39,6 +39,7 @@ import Logs.Transfer
import Types.Key
import Types.TrustLevel
import Types.FileMatcher
+import Types.ActionItem
import qualified Limit
import Messages.JSON (DualDisp(..), ObjectMap(..))
import Annex.BloomFilter
@@ -420,7 +421,9 @@ transfer_list = stat desc $ nojson $ lift $ do
desc = "transfers in progress"
line uuidmap t i = unwords
[ formatDirection (transferDirection t) ++ "ing"
- , fromMaybe (key2file $ transferKey t) (associatedFile i)
+ , actionItemDesc
+ (ActionItemAssociatedFile (associatedFile i))
+ (transferKey t)
, if transferDirection t == Upload then "to" else "from"
, maybe (fromUUID $ transferUUID t) Remote.name $
M.lookup (transferUUID t) uuidmap
@@ -428,9 +431,11 @@ transfer_list = stat desc $ nojson $ lift $ do
jsonify t i = object $ map (\(k, v) -> (T.pack k, v)) $
[ ("transfer", toJSON (formatDirection (transferDirection t)))
, ("key", toJSON (key2file (transferKey t)))
- , ("file", toJSON (associatedFile i))
+ , ("file", toJSON afile)
, ("remote", toJSON (fromUUID (transferUUID t)))
]
+ where
+ AssociatedFile afile = associatedFile i
disk_size :: Stat
disk_size = simpleStat "available local disk space" $
diff --git a/Command/MetaData.hs b/Command/MetaData.hs
index ebb9d0f17..617b291a1 100644
--- a/Command/MetaData.hs
+++ b/Command/MetaData.hs
@@ -86,7 +86,7 @@ seek o = case batchOption o of
start :: POSIXTime -> MetaDataOptions -> FilePath -> Key -> CommandStart
start now o file k = startKeys now o k (mkActionItem afile)
where
- afile = Just file
+ afile = AssociatedFile (Just file)
startKeys :: POSIXTime -> MetaDataOptions -> Key -> ActionItem -> CommandStart
startKeys now o k ai = case getSet o of
@@ -155,7 +155,7 @@ startBatch (i, (MetaData m)) = case i of
Left f -> do
mk <- lookupFile f
case mk of
- Just k -> go k (mkActionItem (Just f))
+ Just k -> go k (mkActionItem (AssociatedFile (Just f)))
Nothing -> giveup $ "not an annexed file: " ++ f
Right k -> go k (mkActionItem k)
where
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index 0ae6f7d80..8dfee9814 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -73,7 +73,7 @@ perform file oldkey oldbackend newbackend = go =<< genkey
go (Just (newkey, knowngoodcontent))
| knowngoodcontent = finish newkey
| otherwise = stopUnless checkcontent $ finish newkey
- checkcontent = Command.Fsck.checkBackend oldbackend oldkey Command.Fsck.KeyLocked $ Just file
+ checkcontent = Command.Fsck.checkBackend oldbackend oldkey Command.Fsck.KeyLocked afile
finish newkey = ifM (Command.ReKey.linkKey file oldkey newkey)
( do
copyMetaData oldkey newkey
@@ -86,7 +86,7 @@ perform file oldkey oldbackend newbackend = go =<< genkey
next $ Command.ReKey.cleanup file oldkey newkey
, error "failed"
)
- genkey = case maybe Nothing (\fm -> fm oldkey newbackend (Just file)) (fastMigrate oldbackend) of
+ genkey = case maybe Nothing (\fm -> fm oldkey newbackend afile) (fastMigrate oldbackend) of
Just newkey -> return $ Just (newkey, True)
Nothing -> do
content <- calcRepo $ gitAnnexLocation oldkey
@@ -99,3 +99,4 @@ perform file oldkey oldbackend newbackend = go =<< genkey
return $ case v of
Just (newkey, _) -> Just (newkey, False)
_ -> Nothing
+ afile = AssociatedFile (Just file)
diff --git a/Command/Mirror.hs b/Command/Mirror.hs
index d08555e79..7d33d80e9 100644
--- a/Command/Mirror.hs
+++ b/Command/Mirror.hs
@@ -43,16 +43,16 @@ instance DeferredParseClass MirrorOptions where
seek :: MirrorOptions -> CommandSeek
seek o = allowConcurrentOutput $
withKeyOptions (keyOptions o) False
- (startKey o Nothing)
+ (startKey o (AssociatedFile Nothing))
(withFilesInGit $ whenAnnexed $ start o)
(mirrorFiles o)
start :: MirrorOptions -> FilePath -> Key -> CommandStart
start o file k = startKey o afile k (mkActionItem afile)
where
- afile = Just file
+ afile = AssociatedFile (Just file)
-startKey :: MirrorOptions -> Maybe FilePath -> Key -> ActionItem -> CommandStart
+startKey :: MirrorOptions -> AssociatedFile -> Key -> ActionItem -> CommandStart
startKey o afile key ai = case fromToOptions o of
ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key)
( Command.Move.toStart False afile key ai =<< getParsed r
@@ -72,4 +72,6 @@ startKey o afile key ai = case fromToOptions o of
, stop
)
where
- getnumcopies = maybe getNumCopies getFileNumCopies afile
+ getnumcopies = case afile of
+ AssociatedFile Nothing -> getNumCopies
+ AssociatedFile (Just af) -> getFileNumCopies af
diff --git a/Command/Move.hs b/Command/Move.hs
index d74eea900..ca4febe76 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -53,10 +53,10 @@ seek o = allowConcurrentOutput $
start :: MoveOptions -> Bool -> FilePath -> Key -> CommandStart
start o move f k = start' o move afile k (mkActionItem afile)
where
- afile = Just f
+ afile = AssociatedFile (Just f)
startKey :: MoveOptions -> Bool -> Key -> ActionItem -> CommandStart
-startKey o move = start' o move Nothing
+startKey o move = start' o move (AssociatedFile Nothing)
start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart
start' o move afile key ai =
diff --git a/Command/SendKey.hs b/Command/SendKey.hs
index 302810374..670f0e437 100644
--- a/Command/SendKey.hs
+++ b/Command/SendKey.hs
@@ -46,7 +46,7 @@ start key = do
fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart
fieldTransfer direction key a = do
liftIO $ debugM "fieldTransfer" "transfer start"
- afile <- Fields.getField Fields.associatedFile
+ afile <- AssociatedFile <$> Fields.getField Fields.associatedFile
ok <- maybe (a $ const noop)
-- Using noRetry here because we're the sender.
(\u -> runner (Transfer direction (toUUID u) key) afile noRetry a)
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 0d5d46b2f..d4d45e2e4 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -519,8 +519,8 @@ seekSyncContent o rs = do
liftIO $ not <$> isEmptyMVar mvar
where
seekworktree mvar l bloomfeeder = seekHelper LsFiles.inRepo l >>=
- mapM_ (\f -> ifAnnexed f (go (Right bloomfeeder) mvar (Just f)) noop)
- seekkeys mvar bloom k _ = go (Left bloom) mvar Nothing k
+ mapM_ (\f -> ifAnnexed f (go (Right bloomfeeder) mvar (AssociatedFile (Just f))) noop)
+ seekkeys mvar bloom k _ = go (Left bloom) mvar (AssociatedFile Nothing) k
go ebloom mvar af k = commandAction $ do
whenM (syncFile ebloom rs af k) $
void $ liftIO $ tryPutMVar mvar ()
diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs
index c8a993666..8a21fdf35 100644
--- a/Command/TestRemote.hs
+++ b/Command/TestRemote.hs
@@ -155,8 +155,9 @@ test st r k =
Nothing -> return True
Just verifier -> verifier k (key2file k)
get = getViaTmp (RemoteVerify r) k $ \dest ->
- Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate
- store = Remote.storeKey r k Nothing nullMeterUpdate
+ Remote.retrieveKeyFile r k (AssociatedFile Nothing)
+ dest nullMeterUpdate
+ store = Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate
remove = Remote.removeKey r k
testUnavailable :: Annex.AnnexState -> Remote -> Key -> [TestTree]
@@ -164,15 +165,15 @@ testUnavailable st r k =
[ check (== Right False) "removeKey" $
Remote.removeKey r k
, check (== Right False) "storeKey" $
- Remote.storeKey r k Nothing nullMeterUpdate
+ Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate
, check (`notElem` [Right True, Right False]) "checkPresent" $
Remote.checkPresent r k
, check (== Right False) "retrieveKeyFile" $
getViaTmp (RemoteVerify r) k $ \dest ->
- Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate
+ Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate
, check (== Right False) "retrieveKeyFileCheap" $
getViaTmp (RemoteVerify r) k $ \dest -> unVerified $
- Remote.retrieveKeyFileCheap r k Nothing dest
+ Remote.retrieveKeyFileCheap r k (AssociatedFile Nothing) dest
]
where
check checkval desc a = testCase desc $ do
diff --git a/Command/TransferInfo.hs b/Command/TransferInfo.hs
index 1db633484..3f352a82e 100644
--- a/Command/TransferInfo.hs
+++ b/Command/TransferInfo.hs
@@ -41,7 +41,7 @@ start (k:[]) = do
case file2key k of
Nothing -> error "bad key"
(Just key) -> whenM (inAnnex key) $ do
- file <- Fields.getField Fields.associatedFile
+ afile <- AssociatedFile <$> Fields.getField Fields.associatedFile
u <- maybe (error "missing remoteuuid") toUUID
<$> Fields.getField Fields.remoteUUID
let t = Transfer
@@ -49,7 +49,7 @@ start (k:[]) = do
, transferUUID = u
, transferKey = key
}
- tinfo <- liftIO $ startTransferInfo file
+ tinfo <- liftIO $ startTransferInfo afile
(update, tfile, _) <- mkProgressUpdater t tinfo
liftIO $ mapM_ void
[ tryIO $ forever $ do
diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs
index 42a6a9e0d..aa6acbd55 100644
--- a/Command/TransferKey.hs
+++ b/Command/TransferKey.hs
@@ -30,10 +30,10 @@ optParser :: CmdParamsDesc -> Parser TransferKeyOptions
optParser desc = TransferKeyOptions
<$> cmdParams desc
<*> parseFromToOptions
- <*> optional (strOption
+ <*> (AssociatedFile <$> optional (strOption
( long "file" <> metavar paramFile
<> help "the associated file"
- ))
+ )))
instance DeferredParseClass TransferKeyOptions where
finishParse v = TransferKeyOptions
diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs
index d875f496d..855ca4670 100644
--- a/Command/TransferKeys.hs
+++ b/Command/TransferKeys.hs
@@ -116,10 +116,10 @@ instance TCSerialized Direction where
deserialize _ = Nothing
instance TCSerialized AssociatedFile where
- serialize (Just f) = f
- serialize Nothing = ""
- deserialize "" = Just Nothing
- deserialize f = Just $ Just f
+ serialize (AssociatedFile (Just f)) = f
+ serialize (AssociatedFile Nothing) = ""
+ deserialize "" = Just (AssociatedFile Nothing)
+ deserialize f = Just (AssociatedFile (Just f))
instance TCSerialized RemoteName where
serialize n = n
diff --git a/Command/Whereis.hs b/Command/Whereis.hs
index bcc11aaf7..a08b94422 100644
--- a/Command/Whereis.hs
+++ b/Command/Whereis.hs
@@ -49,7 +49,7 @@ seek o = do
start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart
start remotemap file key = startKeys remotemap key (mkActionItem afile)
where
- afile = Just file
+ afile = AssociatedFile (Just file)
startKeys :: M.Map UUID Remote -> Key -> ActionItem -> CommandStart
startKeys remotemap key ai = do