diff options
Diffstat (limited to 'Command/TransferKey.hs')
-rw-r--r-- | Command/TransferKey.hs | 68 |
1 files changed, 39 insertions, 29 deletions
diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 14e788893..04dbc1799 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -15,41 +15,51 @@ import Annex.Transfer import qualified Remote import Types.Remote -cmd :: [Command] -cmd = [withOptions transferKeyOptions $ - noCommit $ command "transferkey" paramKey seek SectionPlumbing - "transfers a key from or to a remote"] - -transferKeyOptions :: [Option] -transferKeyOptions = fileOption : fromToOptions - -fileOption :: Option -fileOption = fieldOption [] "file" paramFile "the associated file" - -seek :: CommandSeek -seek ps = do - to <- getOptionField toOption Remote.byNameWithUUID - from <- getOptionField fromOption Remote.byNameWithUUID - file <- getOptionField fileOption return - withKeys (start to from file) ps - -start :: Maybe Remote -> Maybe Remote -> AssociatedFile -> Key -> CommandStart -start to from file key = - case (from, to) of - (Nothing, Just dest) -> next $ toPerform dest key file - (Just src, Nothing) -> next $ fromPerform src key file - _ -> error "specify either --from or --to" - -toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform -toPerform remote key file = go Upload file $ +cmd :: Command +cmd = noCommit $ + command "transferkey" SectionPlumbing + "transfers a key from or to a remote" + paramKey (seek <--< optParser) + +data TransferKeyOptions = TransferKeyOptions + { keyOptions :: CmdParams + , fromToOptions :: FromToOptions + , fileOption :: AssociatedFile + } + +optParser :: CmdParamsDesc -> Parser TransferKeyOptions +optParser desc = TransferKeyOptions + <$> cmdParams desc + <*> parseFromToOptions + <*> optional (strOption + ( long "file" <> metavar paramFile + <> help "the associated file" + )) + +instance DeferredParseClass TransferKeyOptions where + finishParse v = TransferKeyOptions + <$> pure (keyOptions v) + <*> finishParse (fromToOptions v) + <*> pure (fileOption v) + +seek :: TransferKeyOptions -> CommandSeek +seek o = withKeys (start o) (keyOptions o) + +start :: TransferKeyOptions -> Key -> CommandStart +start o key = case fromToOptions o of + ToRemote dest -> next $ toPerform key (fileOption o) =<< getParsed dest + FromRemote src -> next $ fromPerform key (fileOption o) =<< getParsed src + +toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform +toPerform key file remote = go Upload file $ upload (uuid remote) key file forwardRetry noObserver $ \p -> do ok <- Remote.storeKey remote key file p when ok $ Remote.logStatus remote key InfoPresent return ok -fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform -fromPerform remote key file = go Upload file $ +fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform +fromPerform key file remote = go Upload file $ download (uuid remote) key file forwardRetry noObserver $ \p -> getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p |