Fetch.hs

-- Fetch.hs: hOpenPGP key tool fetch subcommand
-- Copyright © 2013-2026  Clint Adams
--
-- vim: softtabstop=4:shiftwidth=4:expandtab
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as
-- published by the Free Software Foundation, either version 3 of the
-- License, or (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

module HOpenPGP.Tools.Hokey.Fetch
    ( doFetch
    ) where

import Codec.Encryption.OpenPGP.KeySelection (parseFingerprint)
import Codec.Encryption.OpenPGP.Serialize ()
import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
import qualified Data.ByteString as B
import qualified Data.Text as T
import System.IO
    ( hPutStrLn
    , stderr
    )

import HOpenPGP.Tools.Common.HKP (rearmorKeys)
import qualified HOpenPGP.Tools.Common.HKP as HKP
import qualified HOpenPGP.Tools.Common.WKD as WKD
import HOpenPGP.Tools.Hokey.Options
    ( FetchMethod (..)
    , FetchOptions (..)
    )

doFetch :: FetchOptions -> IO ()
doFetch o = do
    ekeys <-
        runExceptT $
            case fetchMethod o of
                HKP -> do
                    fp <- ExceptT . return . parseFingerprint . T.pack $ fetchQuery o
                    HKP.fetchKeys (keyServer o) (fetchValidation o) fp
                WKD -> WKD.fetchKeys (fetchValidation o) (T.pack (fetchQuery o))
    case ekeys of
        Left e -> hPutStrLn stderr $ "error fetching keys: " ++ e
        Right ks -> B.putStr $ rearmorKeys ks