diff options
Diffstat (limited to 'Command/TransferKey.hs')
| -rw-r--r-- | Command/TransferKey.hs | 63 |
1 files changed, 36 insertions, 27 deletions
diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index de4568f3a..04dbc1799 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -16,41 +16,50 @@ import qualified Remote import Types.Remote cmd :: Command -cmd = withOptions transferKeyOptions $ noCommit $ +cmd = noCommit $ command "transferkey" SectionPlumbing "transfers a key from or to a remote" - paramKey (withParams seek) - -transferKeyOptions :: [Option] -transferKeyOptions = fileOption : fromToOptions - -fileOption :: Option -fileOption = fieldOption [] "file" paramFile "the associated file" - -seek :: CmdParams -> 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 $ + 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 |