diff --git a/HOpenPGP/Tools/Common.hs b/HOpenPGP/Tools/Common.hs
--- a/HOpenPGP/Tools/Common.hs
+++ b/HOpenPGP/Tools/Common.hs
@@ -1,5 +1,5 @@
 -- Common.hs: hOpenPGP-tools common functions
--- Copyright © 2012-2023  Clint Adams
+-- Copyright © 2012-2026  Clint Adams
 --
 -- vim: softtabstop=4:shiftwidth=4:expandtab
 --
@@ -86,7 +86,7 @@
   pretty name <+>
   pretty "(hopenpgp-tools)" <+>
   pretty (showVersion version) <>
-  hardline <> pretty "Copyright (C) 2012-2023  Clint Adams"
+  hardline <> pretty "Copyright (C) 2012-2026  Clint Adams"
 
 warranty :: String -> Doc ann
 {-# INLINE warranty #-}
@@ -105,53 +105,53 @@
 prependAuto :: Read a => String -> ReadM a
 prependAuto s = ReadM (local (s ++) (unReadM auto))
 
-keyMatchesFingerprint :: Bool -> TK -> TwentyOctetFingerprint -> Bool
+keyMatchesFingerprint :: Bool -> TKUnknown -> Fingerprint -> Bool
 keyMatchesFingerprint = keyMatchesPKPred fingerprint
 
-keyMatchesEightOctetKeyId :: Bool -> TK -> Either String EightOctetKeyId -> Bool -- FIXME: refactor this somehow
+keyMatchesEightOctetKeyId :: Bool -> TKUnknown -> Either String EightOctetKeyId -> Bool -- FIXME: refactor this somehow
 keyMatchesEightOctetKeyId = keyMatchesPKPred eightOctetKeyID
 
-keyMatchesExactUIDString :: Text -> TK -> Bool
-keyMatchesExactUIDString uidstr = elem uidstr . map fst . _tkUIDs
+keyMatchesExactUIDString :: Text -> TKUnknown -> Bool
+keyMatchesExactUIDString uidstr = elem uidstr . map fst . _tkuUIDs
 
-keyMatchesUIDSubString :: Text -> TK -> Bool
+keyMatchesUIDSubString :: Text -> TKUnknown -> Bool
 keyMatchesUIDSubString uidstr =
-  any (T.toLower uidstr `T.isInfixOf`) . map (T.toLower . fst) . _tkUIDs
+  any (T.toLower uidstr `T.isInfixOf`) . map (T.toLower . fst) . _tkuUIDs
 
-keyMatchesPKPred :: Eq a => (PKPayload -> a) -> Bool -> TK -> a -> Bool
-keyMatchesPKPred p False = (==) . p . fst . _tkKey
+keyMatchesPKPred :: Eq a => (SomePKPayload -> a) -> Bool -> TKUnknown -> a -> Bool
+keyMatchesPKPred p False = (==) . p . fst . _tkuKey
 keyMatchesPKPred p True = \tk v -> elem v (map p (tk ^.. biplate))
 
 -- The following should probably be moved elsewhere
-tkUsingPKP :: Reader PKPayload a -> Reader TK a
-tkUsingPKP = withReader (fst . _tkKey)
+tkUsingPKP :: Reader SomePKPayload a -> Reader TKUnknown a
+tkUsingPKP = withReader (fst . _tkuKey)
 
-pkpGetPKVersion :: PKPayload -> Integer
+pkpGetPKVersion :: SomePKPayload -> Integer
 pkpGetPKVersion t =
   if _keyVersion t == DeprecatedV3
     then 3
     else 4
 
-pkpGetPKAlgo :: PKPayload -> Integer
+pkpGetPKAlgo :: SomePKPayload -> Integer
 pkpGetPKAlgo = fromIntegral . fromFVal . _pkalgo
 
-pkpGetKeysize :: PKPayload -> Integer
+pkpGetKeysize :: SomePKPayload -> Integer
 pkpGetKeysize = fromIntegral . fromMaybe 0 . hush . pubkeySize . _pubkey
 
-pkpGetTimestamp :: PKPayload -> Integer
+pkpGetTimestamp :: SomePKPayload -> Integer
 pkpGetTimestamp = fromIntegral . _timestamp
 
-pkpGetFingerprint :: PKPayload -> TwentyOctetFingerprint
+pkpGetFingerprint :: SomePKPayload -> Fingerprint
 pkpGetFingerprint = fingerprint
 
-pkpGetEOKI :: PKPayload -> String
+pkpGetEOKI :: SomePKPayload -> String
 pkpGetEOKI = either (const "UNKNOWN") show . eightOctetKeyID
 
-tkGetUIDs :: TK -> [Text]
-tkGetUIDs = map fst . _tkUIDs
+tkGetUIDs :: TKUnknown -> [Text]
+tkGetUIDs = map fst . _tkuUIDs
 
-tkGetSubs :: TK -> [PKPayload]
-tkGetSubs = mapMaybe (grabPKP . fst) . _tkSubs
+tkGetSubs :: TKUnknown -> [SomePKPayload]
+tkGetSubs = mapMaybe (grabPKP . fst) . _tkuSubs
   where
     grabPKP (PublicSubkeyPkt p) = Just p
     grabPKP (SecretSubkeyPkt p _) = Just p
@@ -210,7 +210,7 @@
 spGetSCT :: Pkt -> Maybe Integer
 spGetSCT (SignaturePkt s) = fmap fromIntegral (sigCT s)
 
-pUsingPKP :: Reader (Maybe PKPayload) a -> Reader Pkt a
+pUsingPKP :: Reader (Maybe SomePKPayload) a -> Reader Pkt a
 pUsingPKP = withReader grabPayload
   where
     grabPayload (SecretKeyPkt p _) = Just p
diff --git a/HOpenPGP/Tools/HKP.hs b/HOpenPGP/Tools/HKP.hs
--- a/HOpenPGP/Tools/HKP.hs
+++ b/HOpenPGP/Tools/HKP.hs
@@ -1,5 +1,5 @@
 -- HKP.hs: hOpenPGP key tool
--- Copyright © 2016-2023  Clint Adams
+-- Copyright © 2016-2026  Clint Adams
 --
 -- vim: softtabstop=4:shiftwidth=4:expandtab
 --
@@ -15,6 +15,7 @@
 --
 -- 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/>.
+
 {-# LANGUAGE OverloadedStrings #-}
 
 module HOpenPGP.Tools.HKP
@@ -31,8 +32,8 @@
 import Codec.Encryption.OpenPGP.Fingerprint (fingerprint)
 import Codec.Encryption.OpenPGP.Types
   ( Block(..)
-  , TK(..)
-  , TwentyOctetFingerprint
+  , TKUnknown(..)
+  , Fingerprint
   )
 import Control.Applicative (liftA2)
 import Control.Arrow ((&&&))
@@ -74,8 +75,8 @@
 fetchKeys ::
      String
   -> FetchValidationMethod
-  -> TwentyOctetFingerprint
-  -> ExceptT String IO [TK]
+  -> Fingerprint
+  -> ExceptT String IO [TKUnknown]
 fetchKeys ks fvm q = do
   manager <- liftIO $ newManager tlsManagerSettings
   request <- liftIO $ parseUrlThrow (ks <> basereq)
@@ -85,7 +86,7 @@
     if responseStatus response == ok200
       then validateKeys (responseBody response)
       else throwE ("HTTP status: " ++ show (responseStatus response))
-  return $ map fst $ filter (fvp fvm . fst . _tkKey . snd) processedKeys
+  return $ map fst $ filter (fvp fvm . fst . _tkuKey . snd) processedKeys
   where
     fvp MatchPrimaryKeyFingerprint k = fingerprint k == q
     fvp MatchPrimaryOrAnySubkeyFingerprint k =
@@ -99,7 +100,7 @@
       , ("search", Just (BC8.pack ("0x" <> show (pretty q)))) -- FIXME: butter
       ]
 
-validateKeys :: BL.ByteString -> ExceptT String IO [(TK, TK)] -- FIXME: conduit fail
+validateKeys :: BL.ByteString -> ExceptT String IO [(TKUnknown, TKUnknown)] -- FIXME: conduit fail
 validateKeys larmors = do
   bytestrings <-
     ExceptT $ return $ fmap (mconcat . map armorToBS) (AA.decodeLazy larmors)
@@ -114,7 +115,7 @@
     armorToBS (Armor ArmorPublicKeyBlock _ bs) = bs
     armorToBS _ = mempty
 
-rearmorKeys :: [TK] -> B.ByteString
+rearmorKeys :: [TKUnknown] -> B.ByteString
 rearmorKeys keys =
   if null keys
     then mempty
diff --git a/HOpenPGP/Tools/Lexer.x b/HOpenPGP/Tools/Lexer.x
--- a/HOpenPGP/Tools/Lexer.x
+++ b/HOpenPGP/Tools/Lexer.x
@@ -17,7 +17,7 @@
 
 import Prelude hiding (lex)
 import Numeric (readHex)
-import Codec.Encryption.OpenPGP.Types (TwentyOctetFingerprint(..), EightOctetKeyId(..))
+import Codec.Encryption.OpenPGP.Types (Fingerprint(..), EightOctetKeyId(..))
 
 }
 
@@ -150,7 +150,7 @@
   | TokenTimestamp
   | TokenFingerprint
   | TokenKeyID
-  | TokenFpr TwentyOctetFingerprint
+  | TokenFpr Fingerprint
   | TokenLongID (Either String EightOctetKeyId)
   | TokenLength
   | TokenEvery
diff --git a/HOpenPGP/Tools/Parser.y b/HOpenPGP/Tools/Parser.y
--- a/HOpenPGP/Tools/Parser.y
+++ b/HOpenPGP/Tools/Parser.y
@@ -221,7 +221,7 @@
     (l,c) <- getPosn
     error (show l ++ ":" ++ show c ++ ": Parse error on Token: " ++ show t ++ "\n")
 
-parseTKExp :: String -> Either String (Reader TK Bool)
+parseTKExp :: String -> Either String (Reader TKUnknown Bool)
 parseTKExp s = runAlex s parseTK
 
 parsePExp :: String -> Either String (Reader Pkt Bool)
diff --git a/HOpenPGP/Tools/TKUtils.hs b/HOpenPGP/Tools/TKUtils.hs
--- a/HOpenPGP/Tools/TKUtils.hs
+++ b/HOpenPGP/Tools/TKUtils.hs
@@ -1,5 +1,5 @@
 -- TKUtils.hs: hOpenPGP-tools TK-related common functions
--- Copyright © 2013-2023  Clint Adams
+-- Copyright © 2013-2026  Clint Adams
 --
 -- vim: softtabstop=4:shiftwidth=4:expandtab
 --
@@ -15,6 +15,7 @@
 --
 -- 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.TKUtils
   ( processTK
   ) where
@@ -23,21 +24,21 @@
 import Codec.Encryption.OpenPGP.Signatures
   ( verifyAgainstKeys
   , verifySigWith
-  , verifyTKWith
+  , verifyUnknownTKWith
   )
 import Codec.Encryption.OpenPGP.Types
 import Control.Arrow (second)
 import Control.Error.Util (hush)
-import Control.Lens ((^.), _1)
+import Data.Bifunctor (first)
 import Data.List (sortOn)
 import Data.Maybe (listToMaybe, mapMaybe)
 import Data.Ord (Down(..))
 import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime)
 
 -- should this fail or should verifyTKWith fail if there are no self-sigs?
-processTK :: Maybe POSIXTime -> TK -> Either String TK
+processTK :: Maybe POSIXTime -> TKUnknown -> Either String TKUnknown
 processTK mpt key =
-  verifyTKWith
+  first show $ verifyUnknownTKWith
     (verifySigWith (verifyAgainstKeys [key]))
     (fmap posixSecondsToUTCTime mpt) .
   stripOlderSigs .
@@ -46,41 +47,46 @@
   where
     stripOtherSigs tk =
       tk
-        { _tkUIDs = map (second alleged) (_tkUIDs tk)
-        , _tkUAts = map (second alleged) (_tkUAts tk)
+        { _tkuUIDs = map (second alleged) (_tkuUIDs tk)
+        , _tkuUAts = map (second alleged) (_tkuUAts tk)
         }
     stripOlderSigs tk =
       tk
-        { _tkUIDs = map (second newest) (_tkUIDs tk)
-        , _tkUAts = map (second newest) (_tkUAts tk)
+        { _tkuUIDs = map (second newest) (_tkuUIDs tk)
+        , _tkuUAts = map (second newest) (_tkuUAts tk)
         }
     newest = take 1 . sortOn (Down . take 1 . sigcts) -- FIXME: this is terrible
-    sigcts (SigV4 _ _ _ xs _ _ _) =
-      map (\(SigSubPacket _ (SigCreationTime x)) -> x) $ filter isCT xs
-    pkp = key ^. tkKey . _1
+    sigcts (SigV4 _ _ _ xs _ _ _) = mapMaybe sigCreationTimeFromSubpacket xs
+    sigcts (SigV6 _ _ _ _ xs _ _ _) = mapMaybe sigCreationTimeFromSubpacket xs
+    sigcts _ = []
+    pkp = fst (_tkuKey key)
     alleged = filter (\x -> assI x || assIFP x)
-    isCT (SigSubPacket _ (SigCreationTime _)) = True
-    isCT _ = False
+    sigCreationTimeFromSubpacket (SigSubPacket _ (SigCreationTime x)) = Just x
+    sigCreationTimeFromSubpacket _ = Nothing
     sigissuer (SigVOther 2 _) = Nothing
     sigissuer SigV3 {} = Nothing
     sigissuer (SigV4 _ _ _ ys xs _ _) =
       listToMaybe . mapMaybe (getIssuer . _sspPayload) $ (ys ++ xs) -- FIXME: what should this be if there are multiple matches?
-    sigissuer (SigVOther _ _) = error "We're in the future." -- FIXME
+    sigissuer (SigV6 _ _ _ _ ys xs _ _) =
+      listToMaybe . mapMaybe (getIssuer . _sspPayload) $ (ys ++ xs) -- FIXME: what should this be if there are multiple matches?
+    sigissuer (SigVOther _ _) = Nothing
     sigissuerfp (SigV4 _ _ _ ys xs _ _) =
       listToMaybe . mapMaybe (getIssuerFP . _sspPayload) $ (ys ++ xs) -- FIXME: what should this be if there are multiple matches?
+    sigissuerfp (SigV6 _ _ _ _ ys xs _ _) =
+      listToMaybe . mapMaybe (getIssuerFP . _sspPayload) $ (ys ++ xs) -- FIXME: what should this be if there are multiple matches?
     sigissuerfp _ = Nothing
     eoki
-      | pkp ^. keyVersion == V4 = hush . eightOctetKeyID $ pkp
-      | pkp ^. keyVersion == DeprecatedV3 &&
-          elem (pkp ^. pkalgo) [RSA, DeprecatedRSASignOnly] =
+      | _keyVersion pkp == V4 = hush . eightOctetKeyID $ pkp
+      | _keyVersion pkp == DeprecatedV3 &&
+          elem (_pkalgo pkp) [RSA, DeprecatedRSASignOnly] =
         hush . eightOctetKeyID $ pkp
       | otherwise = Nothing
     fp
-      | pkp ^. keyVersion == V4 = Just . fingerprint $ pkp
+      | _keyVersion pkp == V4 = Just . fingerprint $ pkp
       | otherwise = Nothing
     getIssuer (Issuer i) = Just i
     getIssuer _ = Nothing
-    getIssuerFP (IssuerFingerprint 4 i) = Just i
+    getIssuerFP (IssuerFingerprint IssuerFingerprintV4 i) = Just i
     getIssuerFP _ = Nothing
     assI x = ((==) <$> sigissuer x <*> eoki) == Just True
     assIFP x = ((==) <$> sigissuerfp x <*> fp) == Just True
diff --git a/HOpenPGP/Tools/WKD.hs b/HOpenPGP/Tools/WKD.hs
new file mode 100644
--- /dev/null
+++ b/HOpenPGP/Tools/WKD.hs
@@ -0,0 +1,183 @@
+-- WKD.hs: hOpenPGP key tool
+-- Copyright © 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/>.
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module HOpenPGP.Tools.WKD
+  ( fetchKeys
+  , parseMailbox
+  ) where
+
+import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA
+import Codec.Encryption.OpenPGP.ASCIIArmor.Types
+  ( Armor(Armor)
+  , ArmorType(ArmorPublicKeyBlock)
+  )
+import Codec.Encryption.OpenPGP.Types (TKUnknown(..))
+import Control.Arrow ((&&&))
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.Except (ExceptT(..), throwE)
+import qualified Crypto.Hash as CH
+import qualified Crypto.Hash.Algorithms as CHA
+import Data.Binary (get)
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC8
+import qualified Data.ByteString.Lazy as BL
+import Data.Bits ((.&.), (.|.), shiftL, shiftR)
+import Data.Conduit ((.|), runConduitRes)
+import qualified Data.Conduit.Binary as CB
+import qualified Data.Conduit.List as CL
+import Data.Conduit.OpenPGP.Keyring (conduitToTKsDropping)
+import Data.Conduit.Serialization.Binary (conduitGet)
+import Data.Either (rights)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import Data.Time.Clock.POSIX (getPOSIXTime)
+import Data.Word (Word8)
+import HOpenPGP.Tools.HKP (FetchValidationMethod(..))
+import HOpenPGP.Tools.TKUtils (processTK)
+import Network.HTTP.Client
+  ( Manager
+  , Response(..)
+  , httpLbs
+  , newManager
+  , parseUrlThrow
+  , setQueryString
+  )
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Network.HTTP.Types.Status (ok200)
+
+fetchKeys ::
+     FetchValidationMethod
+  -> Text
+  -> ExceptT String IO [TKUnknown]
+fetchKeys fvm mailbox = do
+  parsedMailbox <- ExceptT . return $ parseMailbox mailbox
+  manager <- liftIO $ newManager tlsManagerSettings
+  response <- fetchWKD manager parsedMailbox
+  body <-
+    if responseStatus response == ok200
+      then return (responseBody response)
+      else throwE ("HTTP status: " ++ show (responseStatus response))
+  validateAndFilterKeys fvm parsedMailbox body
+
+parseMailbox :: Text -> Either String (Text, Text)
+parseMailbox rawMailbox =
+  let mailbox = T.strip rawMailbox
+      parts = T.splitOn "@" mailbox
+   in case parts of
+        [localPart, domain]
+          | T.null localPart -> Left "mailbox local part cannot be empty"
+          | T.null domain -> Left "mailbox domain cannot be empty"
+          | T.any (== ' ') mailbox -> Left "mailbox cannot contain spaces"
+          | otherwise -> Right (localPart, T.toLower domain)
+        _ -> Left "mailbox must contain exactly one @"
+
+fetchWKD ::
+     Manager
+  -> (Text, Text)
+  -> ExceptT String IO (Response BL.ByteString)
+fetchWKD manager (localPart, domain) = do
+  let localPartLower = T.toLower localPart
+      hu = BC8.unpack . zbase32 . sha1 . TE.encodeUtf8 $ localPartLower
+      advancedUrl =
+        "https://openpgpkey." <>
+        T.unpack domain <>
+        "/.well-known/openpgpkey/" <> T.unpack domain <> "/hu/" <> hu
+      directUrl =
+        "https://" <> T.unpack domain <> "/.well-known/openpgpkey/hu/" <> hu
+      mailboxParam = TE.encodeUtf8 localPartLower
+      withMailbox req = setQueryString [("l", Just mailboxParam)] req
+  advancedRequest <- liftIO $ parseUrlThrow advancedUrl
+  advancedResponse <- liftIO $ httpLbs (withMailbox advancedRequest) manager
+  if responseStatus advancedResponse == ok200
+    then return advancedResponse
+    else do
+      directRequest <- liftIO $ parseUrlThrow directUrl
+      liftIO $ httpLbs (withMailbox directRequest) manager
+
+validateAndFilterKeys ::
+     FetchValidationMethod
+  -> (Text, Text)
+  -> BL.ByteString
+  -> ExceptT String IO [TKUnknown]
+validateAndFilterKeys fvm mailbox body = do
+  keys <- decodeWkdResponse body
+  cpt <- liftIO getPOSIXTime
+  let processedKeys = rights $ map (uncurry (liftA2 (,)) . (pure &&& processTK (Just cpt))) keys
+      mailboxFiltered = filter (mailboxMatchesKey mailbox . snd) processedKeys
+  return $
+    map fst $
+    case fvm of
+      AnySelfSigned -> processedKeys
+      MatchPrimaryKeyFingerprint -> mailboxFiltered
+      MatchPrimaryOrAnySubkeyFingerprint -> mailboxFiltered
+
+decodeWkdResponse :: BL.ByteString -> ExceptT String IO [TKUnknown]
+decodeWkdResponse body =
+  if isArmored body
+    then decodeArmored body
+    else decodeBinary body
+
+decodeBinary :: BL.ByteString -> ExceptT String IO [TKUnknown]
+decodeBinary bytes =
+  liftIO . runConduitRes $
+  CB.sourceLbs bytes .| conduitGet get .| conduitToTKsDropping .| CL.consume
+
+decodeArmored :: BL.ByteString -> ExceptT String IO [TKUnknown]
+decodeArmored larmors = do
+  bytestrings <- ExceptT . return $ fmap (mconcat . map armorToBS) (AA.decodeLazy larmors)
+  liftIO . runConduitRes $
+    CB.sourceLbs bytestrings .| conduitGet get .| conduitToTKsDropping .| CL.consume
+  where
+    armorToBS (Armor ArmorPublicKeyBlock _ bs) = bs
+    armorToBS _ = mempty
+
+isArmored :: BL.ByteString -> Bool
+isArmored =
+  BC8.isPrefixOf "-----BEGIN PGP PUBLIC KEY BLOCK-----" . BL.toStrict . BL.take 40
+
+mailboxMatchesKey :: (Text, Text) -> TKUnknown -> Bool
+mailboxMatchesKey (localPart, domain) tk =
+  let mailbox = T.toLower (localPart <> "@" <> domain)
+      bracketedMailbox = "<" <> mailbox <> ">"
+   in any
+        (\uid -> let lowered = T.toLower uid in lowered == mailbox || bracketedMailbox `T.isInfixOf` lowered)
+        (map fst (_tkuUIDs tk))
+
+sha1 :: B.ByteString -> B.ByteString
+sha1 bs = BA.convert (CH.hashWith CHA.SHA1 bs :: CH.Digest CHA.SHA1)
+
+zbase32 :: B.ByteString -> B.ByteString
+zbase32 = BC8.pack . encodeZBase32 . B.unpack
+
+encodeZBase32 :: [Word8] -> String
+encodeZBase32 = go 0 0
+  where
+    alphabet = "ybndrfg8ejkmcpqxot1uwisza345h769"
+    pick i = alphabet !! i
+    go _ 0 [] = []
+    go acc bits [] =
+      [pick (fromIntegral (((acc `shiftL` (5 - bits)) .&. 31) :: Int))]
+    go acc bits (x:xs)
+      | bits >= 5 =
+        pick (fromIntegral (((acc `shiftR` (bits - 5)) .&. 31) :: Int)) :
+        go acc (bits - 5) (x : xs)
+      | otherwise = go ((acc `shiftL` 8) .|. fromIntegral x) (bits + 8) xs
diff --git a/hkt.hs b/hkt.hs
--- a/hkt.hs
+++ b/hkt.hs
@@ -1,5 +1,5 @@
 -- hkt.hs: hOpenPGP key tool
--- Copyright © 2013-2022  Clint Adams
+-- Copyright © 2013-2026  Clint Adams
 --
 -- vim: softtabstop=4:shiftwidth=4:expandtab
 --
@@ -15,7 +15,10 @@
 --
 -- 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/>.
+
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)
 import Codec.Encryption.OpenPGP.KeyInfo (pkalgoAbbrev, pubkeySize)
@@ -32,7 +35,7 @@
 import Codec.Encryption.OpenPGP.Types
 import Control.Applicative ((<|>), optional)
 import Control.Arrow ((&&&))
-import Control.Lens ((^.), (^..), _1, _2)
+import Control.Lens ((^.), (^..), _1, _2, (&))
 import Control.Monad.Trans.Except (except, runExcept)
 import Control.Monad.Trans.Resource (MonadResource, MonadThrow)
 import qualified Data.Aeson as A
@@ -40,14 +43,14 @@
 import Data.Binary.Put (runPut)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as BL
-import Data.Conduit (ConduitM, (.|), runConduitRes)
+import Data.Conduit (ConduitM, ConduitT, (.|), runConduitRes)
 import qualified Data.Conduit.Binary as CB
 import qualified Data.Conduit.List as CL
 import Data.Conduit.OpenPGP.Filter
   ( FilterPredicates(RTKFilterPredicate)
   , conduitTKFilter
   )
-import Data.Conduit.OpenPGP.Keyring (conduitToTKsDropping, sinkKeyringMap)
+import Data.Conduit.OpenPGP.Keyring (conduitToTKsDropping, sinkPublicKeyringMap)
 import Data.Conduit.Serialization.Binary (conduitGet)
 import Data.Data.Lens (biplate)
 import Data.Either (rights)
@@ -115,7 +118,7 @@
   => FilePath
   -> Bool
   -> Text
-  -> ConduitM () TK m ()
+  -> ConduitM () TKUnknown m ()
 grabMatchingKeysConduit fp filt srch =
   CB.sourceFile fp .| conduitGet get .| conduitToTKsDropping .|
   (if filt
@@ -132,13 +135,13 @@
     parseE =
       either (error . ("filter parse error: " ++)) id . parseTKExp . T.unpack -- this should be more specialized
 
-grabMatchingKeys :: FilePath -> Bool -> Text -> IO [TK]
+grabMatchingKeys :: FilePath -> Bool -> Text -> IO [TK 'PublicTK]
 grabMatchingKeys fp filt srch =
-  runConduitRes $ grabMatchingKeysConduit fp filt srch .| CL.consume
+  runConduitRes $ grabMatchingKeysConduit fp filt srch .| CL.map fromUnknownToPublicTK .| CL.consume
 
-grabMatchingKeysKeyring :: FilePath -> Bool -> Text -> IO Keyring
+grabMatchingKeysKeyring :: FilePath -> Bool -> Text -> IO PublicKeyring
 grabMatchingKeysKeyring fp filt srch =
-  runConduitRes $ grabMatchingKeysConduit fp filt srch .| sinkKeyringMap
+  runConduitRes $ grabMatchingKeysConduit fp filt srch .| CL.map fromUnknownToPublicTK .| sinkPublicKeyringMap
 
 data Key =
   Key
@@ -161,12 +164,12 @@
 
 instance A.ToJSON TKey
 
-tkToTKey :: TK -> TKey
+tkToTKey :: TK 'PublicTK -> TKey
 tkToTKey tk =
   TKey
-    { publickey = mkey (tk ^. tkKey . _1)
+    { publickey = mkey (tk ^. tkPrimaryKey & keyPktPKPayload)
     , uids = tk ^. tkUIDs ^.. traverse . _1
-    , subkeys = map (mkey . \(PublicSubkeyPkt x, _) -> x) (tk ^. tkSubs)
+    , subkeys = map (mkey . \(x, _) -> keyPktPKPayload x) (tk ^. tkSubs)
     }
   where
     mkey =
@@ -369,17 +372,17 @@
   let ttarget1 = T.pack . target1
   keys <- grabMatchingKeys (keyring o) (targetIsFilter o) (ttarget1 o)
   case pathsOutputFormat o of
-    Unstructured -> mapM_ (BL.putStr . putTK') keys
-    JSON -> BL.putStr . A.encode $ keys
-    YAML -> B.putStr . Y.encode $ keys
+    Unstructured -> mapM_ (BL.putStr . putTK' . someTKToUnknown . SomePublicTK) keys
+    JSON -> BL.putStr . A.encode $ map (someTKToUnknown . SomePublicTK) keys
+    YAML -> B.putStr . Y.encode $ map (someTKToUnknown . SomePublicTK) keys
   where
     putTK' key =
       runPut $ do
-        put (PublicKey (key ^. tkKey . _1))
-        mapM_ (put . Signature) (_tkRevs key)
-        mapM_ putUid' (_tkUIDs key)
-        mapM_ putUat' (_tkUAts key)
-        mapM_ putSub' (_tkSubs key)
+        put (PublicKey (key ^. tkuKey . _1))
+        mapM_ (put . Signature) (_tkuRevs key)
+        mapM_ putUid' (_tkuUIDs key)
+        mapM_ putUat' (_tkuUAts key)
+        mapM_ putSub' (_tkuSubs key)
     putUid' (u, sps) = put (UserId u) >> mapM_ (put . Signature) sps
     putUat' (us, sps) = put (UserAttribute us) >> mapM_ (put . Signature) sps
     putSub' (p, sps) = put p >> mapM_ (put . Signature) sps
@@ -407,22 +410,22 @@
     nonClusteredLabeledNodesParams =
       nonClusteredParams {fmtNode = \(_, l) -> [toLabel $ show (pretty l)]}
 
-buildMaps :: [TK] -> (KeyMaps, Int)
+buildMaps :: [TK 'PublicTK] -> (KeyMaps, Int)
 buildMaps =
   foldr mapsInsertions (KeyMaps HashMap.empty HashMap.empty HashMap.empty, 0)
 
 -- FIXME: this presumes no keyID collisions in the input
 data KeyMaps =
   KeyMaps
-    { _k2f :: HashMap EightOctetKeyId TwentyOctetFingerprint
-    , _f2i :: HashMap TwentyOctetFingerprint Int
-    , _i2f :: HashMap Int TwentyOctetFingerprint
+    { _k2f :: HashMap EightOctetKeyId Fingerprint
+    , _f2i :: HashMap Fingerprint Int
+    , _i2f :: HashMap Int Fingerprint
     }
 
-mapsInsertions :: TK -> (KeyMaps, Int) -> (KeyMaps, Int)
+mapsInsertions :: TK 'PublicTK -> (KeyMaps, Int) -> (KeyMaps, Int)
 mapsInsertions tk (KeyMaps k2f f2i i2f, i) =
-  let fp = fingerprint (tk ^. tkKey . _1)
-      keyids = rights . map eightOctetKeyID $ (tk ^.. biplate :: [PKPayload])
+  let fp = fingerprint (tk ^. tkPrimaryKey & keyPktPKPayload)
+      keyids = rights . map eightOctetKeyID $ (tk ^.. biplate :: [SomePKPayload])
       i' = i + 1
       k2f' = foldr (\k m -> HashMap.insert k fp m) k2f keyids
       f2i' = HashMap.insert fp i' f2i
@@ -430,7 +433,7 @@
    in (KeyMaps k2f' f2i' i2f', i')
 
 buildKeyGraph ::
-     ((KeyMaps, Int), [TK]) -> Gr TwentyOctetFingerprint HashAlgorithm
+     ((KeyMaps, Int), [TK 'PublicTK]) -> Gr Fingerprint HashAlgorithm
 buildKeyGraph ((KeyMaps k2f f2i _, _), ks) = mkGraph nodes edges
   where
     nodes = map swap . HashMap.toList $ f2i
@@ -442,7 +445,7 @@
     target tk =
       fromMaybe
         (error "Epic fail")
-        (HashMap.lookup (fingerprint (tk ^. tkKey . _1)) f2i)
+        (HashMap.lookup (fingerprint (tk ^. tkPrimaryKey & keyPktPKPayload)) f2i)
     source i = fromMaybe (-1) (HashMap.lookup i k2f >>= flip HashMap.lookup f2i)
     fakejoin (x, y) = fmap ((,) x) y
     sigs tk =
@@ -453,7 +456,7 @@
 data PaF =
   PaF
     { certPaths :: [Path]
-    , keyFingerprints :: Map String TwentyOctetFingerprint
+    , keyFingerprints :: Map String Fingerprint
     }
   deriving (Generic)
 
@@ -470,14 +473,14 @@
   keys1 <-
     runConduitRes $ CL.sourceList (IxSet.toList kr) .|
     (if filt
-       then conduitTKFilter (ufpt (ttarget2 o))
-       else CL.filter (matchAny (ttarget2 o))) .|
+       then pup (conduitTKFilter (ufpt (ttarget2 o)))
+       else pup (CL.filter (matchAny (ttarget2 o)))) .|
     CL.consume
   keys2 <-
     runConduitRes $ CL.sourceList (IxSet.toList kr) .|
     (if filt
-       then conduitTKFilter (ufpt (ttarget3 o))
-       else CL.filter (matchAny (ttarget3 o))) .|
+       then pup (conduitTKFilter (ufpt (ttarget3 o)))
+       else pup (CL.filter (matchAny (ttarget3 o)))) .|
     CL.consume
   let ((KeyMaps k2f f2i i2f, i), ks) =
         (buildMaps &&& id)
@@ -489,7 +492,7 @@
                 (IxSet.toList kr)))
       keygraph = buildKeyGraph ((KeyMaps k2f f2i i2f, i), ks)
       keysToIs =
-        mapMaybe (\x -> HashMap.lookup (fingerprint (x ^. tkKey . _1)) f2i)
+        mapMaybe (\x -> HashMap.lookup (fingerprint (x ^. tkPrimaryKey & keyPktPKPayload)) f2i)
       froms = keysToIs keys1
       tos = keysToIs keys2
       combos = froms >>= \f -> tos >>= \t -> return (f, t)
@@ -546,3 +549,15 @@
 
 hashAlgo (SigV4 _ _ x _ _ _ _) = x
 hashAlgo _ = error "V3 sig not supported here"
+
+fromUnknownToPublicTK :: TKUnknown -> TK 'PublicTK
+fromUnknownToPublicTK = either error fromSome . fromUnknownToTK
+  where
+    fromSome (SomePublicTK tk) = tk
+    fromSome (SomeSecretTK _)  = error "impossible"
+
+pup :: Monad m
+  => ConduitT TKUnknown TKUnknown m ()
+  -> ConduitT (TK PublicTK) (TK PublicTK) m ()
+pup c = CL.map (someTKToUnknown . SomePublicTK) .| c .| CL.map fromUnknownToPublicTK
+-- upu c = CL.map fromUnknownToPublicTK .| c .| CL.map (someTKToUnknown . SomePublicTK)
diff --git a/hokey.hs b/hokey.hs
--- a/hokey.hs
+++ b/hokey.hs
@@ -1,5 +1,5 @@
 -- hokey.hs: hOpenPGP key tool
--- Copyright © 2013-2022  Clint Adams
+-- Copyright © 2013-2026  Clint Adams
 --
 -- vim: softtabstop=4:shiftwidth=4:expandtab
 --
@@ -15,6 +15,7 @@
 --
 -- 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/>.
+
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -37,7 +38,7 @@
 import Control.Arrow ((***))
 import Control.Error.Util (hush)
 import Control.Lens ((&), (^.), _1, _2, mapped, over)
-import Control.Monad.Trans.Except (runExceptT)
+import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
 import Control.Monad.Trans.Writer.Lazy (execWriter, tell)
 import qualified Crypto.Hash as CH
 import qualified Crypto.Hash.Algorithms as CHA
@@ -67,14 +68,15 @@
 import qualified Data.Yaml as Y
 import GHC.Generics
 import HOpenPGP.Tools.Common (banner, versioner, warranty)
-import HOpenPGP.Tools.HKP (FetchValidationMethod(..), fetchKeys, rearmorKeys)
+import HOpenPGP.Tools.HKP (FetchValidationMethod(..), rearmorKeys)
+import qualified HOpenPGP.Tools.HKP as HKP
 import HOpenPGP.Tools.TKUtils (processTK)
+import qualified HOpenPGP.Tools.WKD as WKD
 
 import Options.Applicative.Builder
   ( argument
   , auto
   , command
-  , eitherReader
   , footerDoc
   , headerDoc
   , help
@@ -157,7 +159,7 @@
 data KeyReport =
   KeyReport
     { keyStatus :: String
-    , keyFingerprint :: TwentyOctetFingerprint
+    , keyFingerprint :: Fingerprint
     , keyVer :: Colored KeyVersion
     , keyCreationTime :: ThirtyTwoBitTimeStamp
     , keyAlgorithmAndSize :: KAS
@@ -180,7 +182,7 @@
 
 data SubkeyReport =
   SubkeyReport
-    { skFingerprint :: Colored TwentyOctetFingerprint
+    { skFingerprint :: Colored Fingerprint
     , skVer :: Colored KeyVersion
     , skCreationTime :: ThirtyTwoBitTimeStamp
     , skAlgorithmAndSize :: KAS
@@ -232,7 +234,7 @@
   mempty = UIDReport [] [] [] [] []
   mappend = (<>)
 
-checkKey :: Maybe POSIXTime -> TK -> KeyReport
+checkKey :: Maybe POSIXTime -> TKUnknown -> KeyReport
 checkKey mpt key =
   (\x ->
      x
@@ -242,24 +244,24 @@
        })
     KeyReport
       { keyStatus = either id (const "good") processedTK
-      , keyFingerprint = key ^. tkKey . _1 & fingerprint
-      , keyVer = key ^. tkKey . _1 . keyVersion & colorizeKV
-      , keyCreationTime = key ^. tkKey . _1 . timestamp
-      , keyAlgorithmAndSize = kasIt (key ^. tkKey . _1)
+      , keyFingerprint = key ^. tkuKey . _1 & fingerprint
+      , keyVer = key ^. tkuKey . _1 & _keyVersion & colorizeKV
+      , keyCreationTime = key ^. tkuKey . _1 & _timestamp
+      , keyAlgorithmAndSize = kasIt (key ^. tkuKey . _1)
       , keyUIDsAndUAts =
           FakeMap
-            (map (\(x, y) -> (x, uidr (Just x) y)) (processedOrOrig ^. tkUIDs) ++
-             map (uatspsToText *** uidr Nothing) (processedOrOrig ^. tkUAts))
+            (map (\(x, y) -> (x, uidr (Just x) y)) (processedOrOrig ^. tkuUIDs) ++
+             map (uatspsToText *** uidr Nothing) (processedOrOrig ^. tkuUAts))
       , keyBestOf = Nothing
       , keySubkeys =
-          map (checkSK (key ^. tkKey . _1 & fingerprint)) (key ^. tkSubs)
+          map (checkSK (key ^. tkuKey . _1 & fingerprint)) (key ^. tkuSubs)
       , keyHasEncryptionCapableSubkey = Colored Nothing Nothing False
       }
   where
     processedOrOrig = either (const key) id processedTK
     processedTK = processTK mpt key
-    kasIt :: PKPayload -> KAS
-    kasIt pkp = kasIt' (pkp ^. pkalgo) (pkp ^. pubkey & pubkeySize)
+    kasIt :: SomePKPayload -> KAS
+    kasIt pkp = kasIt' (_pkalgo pkp) (_pubkey pkp & pubkeySize)
     kasIt' :: PubKeyAlgorithm -> Either String Int -> KAS
     kasIt' pka epks =
       KAS
@@ -311,9 +313,9 @@
         Colored (Just Yellow) (Just "expiration too far in future") kes
       | otherwise = Colored (Just Green) Nothing kes
     eoki pkp
-      | pkp ^. keyVersion == V4 = hush . eightOctetKeyID $ pkp
-      | pkp ^. keyVersion == DeprecatedV3 &&
-          elem (pkp ^. pkalgo) [RSA, DeprecatedRSASignOnly] =
+      | _keyVersion pkp == V4 = hush . eightOctetKeyID $ pkp
+      | _keyVersion pkp == DeprecatedV3 &&
+          elem (_pkalgo pkp) [RSA, DeprecatedRSASignOnly] =
         hush . eightOctetKeyID $ pkp
       | otherwise = Nothing
     phas (SigV4 _ _ _ xs _ _ _) =
@@ -333,7 +335,7 @@
       map (\(SigSubPacket _ (SigCreationTime x)) -> x) $ filter isCT xs
     alleged =
       filter
-        (\x -> ((==) <$> sigissuer x <*> eoki (key ^. tkKey . _1)) == Just True)
+        (\x -> ((==) <$> sigissuer x <*> eoki (key ^. tkuKey . _1)) == Just True)
     uatspsToText = T.pack . uatspsToString
     uatspsToString us =
       "<uat:[" ++ intercalate "," (map uaspToString us) ++ "]>"
@@ -355,7 +357,7 @@
            (map
               (colorizeKETs
                  (fromMaybe 0 mpt)
-                 (key ^. tkKey . _1 . timestamp & unThirtyTwoBitTimeStamp) .
+                 (unThirtyTwoBitTimeStamp (_timestamp (key ^. tkuKey . _1))) .
                getKeyExpirationTimesFromSignature)
               sps -- should that be 0?
             )
@@ -370,7 +372,7 @@
            (map
               (colorizeKETs
                  (fromMaybe 0 mpt)
-                 (key ^. tkKey . _1 . timestamp & unThirtyTwoBitTimeStamp) .
+                 (unThirtyTwoBitTimeStamp (_timestamp (key ^. tkuKey . _1))) .
                getKeyExpirationTimesFromSignature)
               sps -- should that be 0?
             )
@@ -433,15 +435,15 @@
     hasheds (SigV4 _ _ _ xs _ _ _) = xs
     hasheds _ = []
     checkSK ::
-         TwentyOctetFingerprint -> (Pkt, [SignaturePayload]) -> SubkeyReport
+         Fingerprint -> (Pkt, [SignaturePayload]) -> SubkeyReport
     checkSK pf (PublicSubkeyPkt pkp, sigs) = checkSK' pf pkp sigs
     checkSK pf (SecretSubkeyPkt pkp _, sigs) = checkSK' pf pkp sigs
     checkSK' pf pkp sigs =
       (\x -> x {skCrossCerts = ccr (map decolorize (skUsageFlags x)) sigs})
         SubkeyReport
           { skFingerprint = colorizeF pf (fingerprint pkp)
-          , skVer = colorizeKV (pkp ^. keyVersion)
-          , skCreationTime = pkp ^. timestamp
+          , skVer = colorizeKV (_keyVersion pkp)
+          , skCreationTime = _timestamp pkp
           , skAlgorithmAndSize = kasIt pkp
           , skBindingSigHashAlgorithms = has (filter isSKBindingSig sigs)
           , skUsageFlags = kufs True (filter isSKBindingSig sigs)
@@ -499,7 +501,7 @@
            else (Just Green, Nothing))
         fp
 
-prettyKeyReport :: POSIXTime -> TK -> Doc PPA.AnsiStyle
+prettyKeyReport :: POSIXTime -> TKUnknown -> Doc PPA.AnsiStyle
 prettyKeyReport cpt key = do
   let keyReport = checkKey (Just cpt) key
   execWriter $
@@ -632,10 +634,10 @@
          (list . map (coloredToColor pretty) . ccHashAlgorithms . skCrossCerts)
            skr)
 
-jsonReport :: POSIXTime -> TK -> BL.ByteString
+jsonReport :: POSIXTime -> TKUnknown -> BL.ByteString
 jsonReport ps = A.encode . checkKey (Just ps)
 
-yamlReport :: POSIXTime -> TK -> B.ByteString
+yamlReport :: POSIXTime -> TKUnknown -> B.ByteString
 yamlReport ps = Y.encode . (: []) . checkKey (Just ps)
 
 data LintOutputFormat
@@ -652,10 +654,16 @@
 data FetchOptions =
   FetchOptions
     { keyServer :: String
+    , fetchMethod :: FetchMethod
     , fetchValidation :: FetchValidationMethod
-    , fetchQuery :: TwentyOctetFingerprint
+    , fetchQuery :: String
     }
 
+data FetchMethod
+  = HKP
+  | WKD
+  deriving (Bounded, Enum, Eq, Read, Show)
+
 data Command
   = CmdLint LintOptions
   | CmdCanonicalize
@@ -682,20 +690,26 @@
     (long "keyserver" <> metavar "URL" <>
      value "http://pool.sks-keyservers.net:11371" <>
      showDefault <>
-     help "HKP server") <*>
+     help "HKP server (used only when --method=HKP)") <*>
   option
     auto
+    (long "method" <> metavar "METHOD" <> value HKP <> showDefault <> fmHelp) <*>
+  option
+    auto
     (long "validation-method" <> metavar "METHOD" <>
      value MatchPrimaryKeyFingerprint <>
      showDefault <>
      vmHelp) <*>
-  argument (eitherReader strToFP) (metavar "FINGERPRINT")
+  argument str (metavar "QUERY")
   where
+    fmHelp =
+     helpDoc . Just $ pretty "fetch method" <> hardline <>
+     list (map (pretty . show) fmchoices)
+    fmchoices = [minBound .. maxBound] :: [FetchMethod]
     vmHelp =
-      helpDoc . Just $ pretty "validation method" <> hardline <>
-      list (map (pretty . show) vmchoices)
+     helpDoc . Just $ pretty "validation method" <> hardline <>
+     list (map (pretty . show) vmchoices)
     vmchoices = [minBound .. maxBound] :: [FetchValidationMethod]
-    strToFP = parseFingerprint . T.pack
 
 dispatch :: Command -> IO ()
 dispatch (CmdFetch o) = banner' stderr >> hFlush stderr >> doFetch o
@@ -724,7 +738,9 @@
           (progDesc "arrange key components in a canonical ordering")) <>
      command
        "fetch"
-       (info (CmdFetch <$> fetchO) (progDesc "fetch key(s) from keyserver")) <>
+       (info
+          (CmdFetch <$> fetchO)
+          (progDesc "fetch key(s) via HKP or WKD")) <>
      command
        "lint"
        (info (CmdLint <$> lintO) (progDesc "check key(s) for 'best practices'")))
@@ -752,15 +768,20 @@
   conduitPut .|
   CB.sinkHandle stdout
   where
-    canonicalize (TK k r ui ua s) =
-      TK k (sort r) (indepthsort ui) (indepthsort ua) (indepthsort s)
+    canonicalize (TKUnknown k r ui ua s) =
+      TKUnknown k (sort r) (indepthsort ui) (indepthsort ua) (indepthsort s)
     indepthsort :: (Ord a, Ord b) => [(a, [b])] -> [(a, [b])]
     indepthsort = nub . sort . over (mapped . _2) sort
 
 doFetch :: FetchOptions -> IO ()
 doFetch o = do
   ekeys <-
-    runExceptT $ fetchKeys (keyServer o) (fetchValidation o) (fetchQuery o)
+    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
@@ -776,10 +797,14 @@
 sigissuer SigV3 {} = Nothing
 sigissuer (SigV4 _ _ _ ys xs _ _) =
   listToMaybe . mapMaybe (getIssuer . _sspPayload) $ (ys ++ xs) -- FIXME: what should this be if there are multiple matches?
-sigissuer (SigVOther _ _) = error "We're in the future." -- FIXME
+sigissuer (SigV6 _ _ _ _ ys xs _ _) =
+  listToMaybe . mapMaybe (getIssuer . _sspPayload) $ (ys ++ xs) -- FIXME: what should this be if there are multiple matches?
+sigissuer (SigVOther _ _) = Nothing
 
 getIssuer (Issuer i) = Just i
 getIssuer _ = Nothing
 
+hashAlgo (SigV3 _ _ _ _ x _ _) = x
 hashAlgo (SigV4 _ _ x _ _ _ _) = x
-hashAlgo _ = error "V3 sig not supported here"
+hashAlgo (SigV6 _ _ x _ _ _ _ _) = x
+hashAlgo (SigVOther _ _) = OtherHA 0
diff --git a/hop.hs b/hop.hs
--- a/hop.hs
+++ b/hop.hs
@@ -1,5 +1,5 @@
 -- hop.hs: hOpenPGP-stateless OpenPGP (sop) tool
--- Copyright © 2019-2023  Clint Adams
+-- Copyright © 2019-2026  Clint Adams
 --
 -- vim: softtabstop=4:shiftwidth=4:expandtab
 --
@@ -15,6 +15,8 @@
 --
 -- 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/>.
+
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE RecordWildCards #-}
 
@@ -52,12 +54,15 @@
 import qualified Data.Conduit.List as CL
 import Data.Conduit.OpenPGP.Keyring
   ( conduitToTKs
+  , conduitToPublicViewTKs
+  , conduitToSecretTKs
   , conduitToTKsDropping
-  , sinkKeyringMap
+  , sinkPublicKeyringMap
   )
 import Data.Conduit.OpenPGP.Verify (conduitVerify)
 import Data.Conduit.Serialization.Binary (conduitGet)
 import Data.Either (fromRight, isRight, rights)
+import Data.Bifunctor (first)
 import Data.List (find)
 import Data.Maybe (catMaybes, fromJust, listToMaybe)
 import Data.Monoid ((<>))
@@ -202,7 +207,7 @@
 data Vrf =
   Vrf
     { _vrfmsg :: String
-    , _vrfmfpr :: Maybe TwentyOctetFingerprint
+    , _vrfmfpr :: Maybe Fingerprint
     }
   deriving (Eq, Generic, Show)
 
@@ -213,7 +218,8 @@
   let allkfiles = sequence_ (map CC.sourceFile (keyrings o))
   krs <-
     runConduitRes $
-    allkfiles .| conduitGet Bin.get .| conduitToTKsDropping .| sinkKeyringMap
+    allkfiles .| conduitGet Bin.get .| conduitToTKs .| CL.map (fromSomePub) .| sinkPublicKeyringMap
+
   sigs <-
     runConduitRes $
     CC.sourceFile (sigFile o) .| conduitGet Bin.get .| CC.filter v4b .|
@@ -236,7 +242,7 @@
   where
     v4b (SignaturePkt s@(SigV4 BinarySig _ _ _ _ _ _)) = sf s
     v4b _ = False
-    v2v (Left l) = Vrf l Nothing
+    v2v (Left l) = Vrf (show l) Nothing
     v2v (Right v) =
       Vrf "verified signature" (Just (fingerprint (_verificationSigner v)))
     sf = const True
@@ -354,12 +360,12 @@
       then AA.encodeLazy [Armor ArmorPrivateKeyBlock [] lbs]
       else lbs
 
-type KeyBuilder = StateT TK IO
+type KeyBuilder = StateT TKUnknown IO
 
 buildKeyWith :: SecretKey -> KeyBuilder a -> IO a
 buildKeyWith sk a = evalStateT a (bareTK sk)
   where
-    bareTK (SecretKey pkp ska) = TK (pkp, Just ska) [] [] [] []
+    bareTK (SecretKey pkp ska) = TKUnknown (pkp, Just ska) [] [] [] []
 
 generateSecretKey :: ThirtyTwoBitTimeStamp -> PubKeyAlgorithm -> IO SecretKey
 generateSecretKey ts RSA = do
@@ -372,7 +378,7 @@
 addUserId :: ThirtyTwoBitTimeStamp -> Bool -> Text -> KeyBuilder ()
 addUserId ts primary userid = modify (newUID userid)
   where
-    newUID u tk = tk {_tkUIDs = _tkUIDs tk ++ [selfsign (_tkKey tk) u]}
+    newUID u tku = tku {_tkuUIDs = _tkuUIDs tku ++ [selfsign (_tkuKey tku) u]}
     selfsign (pkp, Just ska) u =
       ( u
       , [ fromRight
@@ -386,7 +392,7 @@
         ])
     hashed pkp =
       [ SigSubPacket False (SigCreationTime ts)
-      , SigSubPacket False (IssuerFingerprint 4 (fingerprint pkp))
+      , SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint pkp))
       , SigSubPacket False (KeyFlags (S.singleton CertifyKeysKey))
       , SigSubPacket False (PrimaryUserId primary)
       , SigSubPacket
@@ -402,9 +408,9 @@
 
 addSubkey :: ThirtyTwoBitTimeStamp -> [KeyFlag] -> KeyBuilder ()
 addSubkey ts keyflags = do
-  tk <- get
+  tku <- get
   (SecretKey subpkp subska) <- liftIO $ generateSecretKey ts RSA
-  let (pkp, Just ska) = _tkKey tk
+  let (pkp, Just ska) = _tkuKey tku
       Right crossig =
         crossSignSubkeyWithRSA
           pkp
@@ -418,11 +424,11 @@
   modify (addIt subpkp subska crossig)
   where
     skey (SUUnencrypted (RSAPrivateKey (RSA_PrivateKey k)) _) = k
-    addIt sp ss cross tk =
-      tk {_tkSubs = _tkSubs tk ++ [(SecretSubkeyPkt sp ss, [cross])]}
+    addIt sp ss cross tku =
+      tku {_tkuSubs = _tkuSubs tku ++ [(SecretSubkeyPkt sp ss, [cross])]}
     hashed pkp =
       [ SigSubPacket False (SigCreationTime ts)
-      , SigSubPacket False (IssuerFingerprint 4 (fingerprint pkp))
+      , SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint pkp))
       ]
     hashedwithflags pkp =
       hashed pkp ++ [SigSubPacket False (KeyFlags (S.fromList keyflags))]
@@ -454,18 +460,13 @@
           else lbs
   k <-
     runConduitRes $
-    CL.sourceList (BL.toChunks lbs') .| conduitGet Bin.get .| conduitToTKs .|
+    CL.sourceList (BL.toChunks lbs') .| conduitGet Bin.get .| conduitToPublicViewTKs .|
     CL.take 1
-  let output = runPut $ Bin.put (pubToSecret (head k))
+  let output = runPut $ Bin.put (someTKToUnknown . SomePublicTK $ head k)
   BL.putStr $
     if not ecArmor && not ecNoArmor
       then AA.encodeLazy [Armor ArmorPublicKeyBlock [] output]
       else output
-  where
-    pubToSecret tk =
-      tk {_tkKey = pToS (_tkKey tk), _tkSubs = map subPToS (_tkSubs tk)}
-    pToS (pkp, _) = (pkp, Nothing)
-    subPToS (SecretSubkeyPkt pkp _, sigs) = (PublicSubkeyPkt pkp, sigs)
 
 soP :: Parser SignOptions
 soP =
@@ -513,7 +514,7 @@
         if sAs == AsText
           then canonicalize payload'
           else payload'
-      funkeys = concatMap tkToFunKeys . rights . map (processTK (Just pt)) $ ks
+      funkeys = concatMap tkToFunKeys . rights . map (processTK (Just pt) . someTKToUnknown . SomeSecretTK) $ ks
       allSigningCapableKeys = filter (isSigner . fkufs) funkeys
   forM_ allSigningCapableKeys $ \k -> do
     let Right sig = signData sAs ts k payload
@@ -530,23 +531,25 @@
       -> FunKey
       -> BL.ByteString
       -> Either String SignaturePayload
-    signData AsBinary t k =
-      signDataWithRSA
+    signData AsBinary t k d =
+      first show $ signDataWithRSA
         BinarySig
         (skey (fromJust (fmska k)))
         (hashed (fpkp k) t)
         (unhashed (fpkp k))
-    signData AsText t k =
-      signDataWithRSA
+        d
+    signData AsText t k d =
+      first show $ signDataWithRSA
         CanonicalTextSig
         (skey (fromJust (fmska k)))
         (hashed (fpkp k) t)
         (unhashed (fpkp k))
+        (canonicalize d)
     skey (SUUnencrypted (RSAPrivateKey (RSA_PrivateKey k)) _) =
       k {RSA.private_p = 0, RSA.private_q = 0} -- FIXME: why is this necessary?
     hashed pkp ct =
       [ SigSubPacket False (SigCreationTime ct)
-      , SigSubPacket False (IssuerFingerprint 4 (fingerprint pkp))
+      , SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint pkp))
       ]
     unhashed pkp =
       [SigSubPacket False (Issuer (fromRight undefined (eightOctetKeyID pkp)))]
@@ -557,7 +560,7 @@
       TE.encodeUtf8 .
       T.intercalate (T.pack "\r\n") . T.lines . TE.decodeUtf8 . BL.toStrict
 
-grabKey :: String -> IO TK
+grabKey :: String -> IO (TK 'SecretTK)
 grabKey fp = do
   kbs <- runConduitRes $ CB.sourceFile fp .| CL.consume
   let lbs = BL.fromChunks kbs
@@ -571,20 +574,20 @@
           else lbs
   Just k <-
     runConduitRes $
-    CL.sourceList (BL.toChunks lbs') .| conduitGet Bin.get .| conduitToTKs .|
+    CL.sourceList (BL.toChunks lbs') .| conduitGet Bin.get .| conduitToSecretTKs .|
     CL.head
   return k
 
 data FunKey =
   FunKey
-    { fpkp :: PKPayload
+    { fpkp :: SomePKPayload
     , fmska :: Maybe SKAddendum
     , fkufs :: S.Set KeyFlag
     }
   deriving (Show)
 
-tkToFunKeys :: TK -> [FunKey]
-tkToFunKeys (TK (pkp, mska) revs uids uats subs) =
+tkToFunKeys :: TKUnknown -> [FunKey]
+tkToFunKeys (TKUnknown (pkp, mska) revs uids uats subs) =
   catMaybes (mainKey : map extract subs)
   where
     mainKey = grabASig uids >>= sig2KUFs >>= \kf -> return (FunKey pkp mska kf)
@@ -603,3 +606,6 @@
     extract ((PublicSubkeyPkt spkp), sigs) =
       listToMaybe sigs >>= sig2KUFs >>= \kf -> return (FunKey spkp Nothing kf)
     extract _ = Nothing
+
+fromSomePub :: SomeTK -> TK 'PublicTK
+fromSomePub (SomePublicTK tk) = tk
diff --git a/hopenpgp-tools.cabal b/hopenpgp-tools.cabal
--- a/hopenpgp-tools.cabal
+++ b/hopenpgp-tools.cabal
@@ -1,6 +1,6 @@
 cabal-version:       3.0
 name:                hopenpgp-tools
-version:             0.23.11.1
+version:             0.24
 synopsis:            hOpenPGP-based command-line tools
 description:         command-line tools for performing some OpenPGP-related operations
 homepage:            https://salsa.debian.org/clint/hOpenPGP-tools
@@ -18,14 +18,14 @@
 
 common deps
   autogen-modules:     Paths_hopenpgp_tools
-  build-depends:       base                   > 4.9       && < 5
+  build-depends:       base                   > 4.15       && < 5
                ,       aeson
                ,       binary                 >= 0.6.4.0
                ,       binary-conduit
                ,       bytestring
                ,       conduit                >= 1.3.0
                ,       errors
-               ,       hOpenPGP               >= 2.10.1   && < 3
+               ,       hOpenPGP               >= 3        && < 3.1
                ,       lens
                ,       optparse-applicative   >= 0.18.1.0
                ,       prettyprinter          >= 1.7.0
@@ -55,20 +55,21 @@
   main-is:             hokey.hs
   other-modules:       HOpenPGP.Tools.HKP
                ,       HOpenPGP.Tools.TKUtils
+               ,       HOpenPGP.Tools.WKD
   build-depends:       base16-bytestring
                ,       conduit-extra          >= 1.1
                ,       containers
                ,       http-client            >= 0.4.30
                ,       http-client-tls
                ,       http-types
-               ,       openpgp-asciiarmor     >= 0.1
+               ,       openpgp-asciiarmor     >= 1.0
                ,       prettyprinter-ansi-terminal >= 1.1.2
                ,       time
                ,       time-locale-compat
   if flag(use-memory)
-    build-depends: crypton < 1.1.0, memory
+    build-depends: crypton < 1.1, memory
   else
-    build-depends: crypton >= 1.1.0, ram
+    build-depends: crypton >= 1.1, ram
   default-language: Haskell2010
 
 executable hkt
@@ -117,4 +118,4 @@
 source-repository this
   type:     git
   location: https://salsa.debian.org/clint/hopenpgp-tools.git
-  tag:      hopenpgp-tools/0.23.11.1
+  tag:      hopenpgp-tools/0.24
