-- hkt.hs: hOpenPGP key tool
-- 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/>.
{-# LANGUAGE DeriveGeneric #-}

import Codec.Encryption.OpenPGP.Fingerprint
    ( eightOctetKeyID
    , fingerprint
    )
import Codec.Encryption.OpenPGP.KeyInfo
    ( pkalgoAbbrev
    , pubkeySize
    )
import Codec.Encryption.OpenPGP.KeySelection
    ( parseEightOctetKeyId
    , parseFingerprint
    )
import Codec.Encryption.OpenPGP.Policy
    ( defaultVerificationPolicy
    )
import Codec.Encryption.OpenPGP.Serialize ()
import Codec.Encryption.OpenPGP.Types
    ( EightOctetKeyId
    , Fingerprint
    , HashAlgorithm (..)
    , PublicKey (..)
    , PublicKeyring
    , SigSubPacket (_sspPayload)
    , SigSubPacketPayload (..)
    , Signature (..)
    , SignaturePayload (..)
    , SomePKPayload (..)
    , SomeTK (..)
    , TK (..)
    , UserAttribute (..)
    , UserId (..)
    , keyPktPKPayload
    , keyPktToPkt
    , someTKToPublicViewTK
    , someTKToUnknown
    , _pkalgo
    , _pubkey
    )
import Control.Applicative (optional, (<|>))
import Control.Arrow ((&&&))
import Control.Exception (ErrorCall, evaluate, try)
import Control.Lens ((^..), _1)
import Control.Monad.Trans.Except (except, runExcept)
import Control.Monad.Trans.Resource (MonadResource, MonadThrow)
import qualified Data.Aeson as A
import Data.Binary (get, put)
import Data.Binary.Put (runPut)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Conduit (ConduitM, runConduitRes, (.|))
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import Data.Conduit.OpenPGP.Filter
    ( FilterPredicates (RFilterPredicate)
    , runPredicate
    )
import Data.Conduit.OpenPGP.Keyring
    ( conduitDropErrorsAndNothings
    , conduitToSomeTKsDroppingEither
    , sinkPublicKeyringMap
    )
import Data.Conduit.Serialization.Binary (conduitGet)
import Data.Data.Lens (biplate)
import Data.Either (rights)
import Data.Graph.Inductive.Graph
    ( Graph (mkGraph)
    , Path
    , emap
    , prettyPrint
    )
import Data.Graph.Inductive.PatriciaTree (Gr)
import Data.Graph.Inductive.Query.SP (sp)
import Data.GraphViz
    ( GraphvizParams (..)
    , graphToDot
    , nonClusteredParams
    )
import Data.GraphViz.Attributes (toLabel)
import Data.GraphViz.Types (printDotGraph)
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HashMap
import qualified Data.IxSet.Typed as IxSet
import Data.List (nub, sort)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as TLIO
import Data.Time.Clock.POSIX
    ( getPOSIXTime
    , posixSecondsToUTCTime
    )
import Data.Tuple (swap)
import Data.Void (Void)
import qualified Data.Yaml as Y
import GHC.Generics
import Options.Applicative.Builder
    ( argument
    , auto
    , command
    , footerDoc
    , headerDoc
    , help
    , helpDoc
    , info
    , long
    , metavar
    , option
    , prefs
    , progDesc
    , showDefault
    , showHelpOnError
    , str
    , strOption
    , switch
    , value
    )
import Options.Applicative.Extra
    ( customExecParser
    , helper
    , hsubparser
    )
import Options.Applicative.Types (Parser)
import Prettyprinter
    ( defaultLayoutOptions
    , fillSep
    , hardline
    , layoutPretty
    , list
    , pretty
    , (<+>)
    )
import Prettyprinter.Render.Text (hPutDoc, putDoc)
import qualified Prettyprinter.Render.Text as PPA
import System.Directory (getHomeDirectory)
import System.Exit (exitFailure)
import System.IO
    ( BufferMode (..)
    , Handle
    , hFlush
    , hPutStrLn
    , hSetBuffering
    , stderr
    )

import HOpenPGP.Tools.Common.Common
    ( banner
    , keyMatchesEightOctetKeyId
    , keyMatchesFingerprint
    , keyMatchesUIDSubString
    , versioner
    , warranty
    )
import HOpenPGP.Tools.Common.Parser (parseTKExp)
import HOpenPGP.Tools.Common.TKUtils (verifyTKWithTyped)

grabMatchingKeysConduit
    :: (MonadResource m, MonadThrow m)
    => FilePath
    -> Bool
    -> FilterPredicates Void SomeTK
    -> Text
    -> ConduitM () SomeTK m ()
grabMatchingKeysConduit fp filt ufp srch =
    CB.sourceFile fp
        .| conduitGet get
        .| conduitToSomeTKsDroppingEither
        .| conduitDropErrorsAndNothings
        .| ( if filt
                then CL.filter (runPredicate ufp)
                else CL.filter matchAny
           )
  where
    matchAny tk =
        either (const False) id $
            runExcept $
                fmap (keyMatchesFingerprint True tk) efp
                    <|> fmap (keyMatchesEightOctetKeyId True tk . Right) eeok
                    <|> return (keyMatchesUIDSubString srch tk)
    efp = (except . parseFingerprint) srch
    eeok = (except . parseEightOctetKeyId) srch

grabMatchingKeys :: FilePath -> Bool -> Text -> IO [SomeTK]
grabMatchingKeys fp filt srch =
    if filt
        then do
            parsed <- parseFilterPredicateIO srch
            case parsed of
                Left err -> dieHKT err
                Right ufp ->
                    runConduitRes $
                        grabMatchingKeysConduit fp filt ufp srch .| CL.consume
        else
            -- When not using filter syntax, treat TARGET as a fingerprint, key ID or UID substring
            runConduitRes $
                CB.sourceFile fp
                    .| conduitGet get
                    .| conduitToSomeTKsDroppingEither
                    .| conduitDropErrorsAndNothings
                    .| CL.filter matchAny
                    .| CL.consume
  where
    matchAny tk =
        either (const False) id $
            runExcept $
                fmap (keyMatchesFingerprint True tk) efp
                    <|> fmap (keyMatchesEightOctetKeyId True tk . Right) eeok
                    <|> return (keyMatchesUIDSubString srch tk)
    efp = (except . parseFingerprint) srch
    eeok = (except . parseEightOctetKeyId) srch

grabMatchingPublicKeyring :: [SomeTK] -> IO PublicKeyring
grabMatchingPublicKeyring keys =
    runConduitRes $
        CL.sourceList (mapMaybe someTKToPublicTk keys)
            .| sinkPublicKeyringMap
  where
    someTKToPublicTk (SomePublicTK publicTk) = Just publicTk
    someTKToPublicTk (SomeSecretTK secretTk) = Just (someTKToPublicViewTK (SomeSecretTK secretTk))

data Key
    = Key
    { keysize :: Maybe Int
    , keyalgo :: String
    , keyalgoabbreviation :: String
    , fpr :: String
    }
    deriving (Generic)

data TKey
    = TKey
    { publickey :: Key
    , uids :: [Text]
    , subkeys :: [Key]
    }
    deriving (Generic)

instance A.ToJSON Key

instance A.ToJSON TKey

tkToTKey :: SomeTK -> TKey
tkToTKey stk =
    TKey
        { publickey = mkey (keyPktPKPayload (_tkPrimaryKey publicView))
        , uids = _tkUIDs publicView ^.. traverse . _1
        , subkeys =
            mapMaybe
                (\kp -> Just (mkey (keyPktPKPayload kp)))
                (map fst (_tkSubs publicView))
        }
  where
    publicView = someTKToPublicViewTK stk
    mkey =
        Key
            <$> either (const Nothing) Just . pubkeySize . _pubkey
            <*> show
                . _pkalgo
            <*> pkalgoAbbrev
                . _pkalgo
            <*> renderFingerprint
                . fingerprint

showTKey :: TKey -> IO ()
showTKey tkey =
    putDoc $
        pretty "pub  "
            <+> sizeabbrevkeyid (publickey tkey)
            <> hardline
            <> mconcat
                ( map
                    ( \x ->
                        pretty "uid                           "
                            <+> pretty (T.unpack x)
                            <> hardline
                    )
                    (uids tkey)
                )
            <> mconcat
                ( map
                    (\x -> pretty "sub  " <+> sizeabbrevkeyid x <> hardline)
                    (subkeys tkey)
                )
            <> hardline
  where
    sizeabbrevkeyid k =
        pretty (maybe "unknown" show (keysize k))
            <> pretty (keyalgoabbreviation k)
            <> pretty "/"
            <> pretty (fpr k)

renderFingerprint :: Fingerprint -> String
renderFingerprint =
    T.unpack
        . PPA.renderStrict
        . layoutPretty defaultLayoutOptions
        . pretty

data Options
    = Options
    { keyring :: String
    , graphOutputFormat :: GraphOutputFormat
    , pathsOutputFormat :: PathsOutputFormat
    , targetIsFilter :: Bool
    , target1 :: String
    , target2 :: String
    , target3 :: String
    }

data Command
    = CmdList Options
    | CmdExportPubkeys Options
    | CmdGraph Options
    | CmdFindPaths Options

data GraphOutputFormat
    = GraphViz
    | LossyPretty
    deriving (Bounded, Enum, Eq, Read, Show)

data PathsOutputFormat
    = Unstructured
    | JSON
    | YAML
    deriving (Eq, Read, Show)

listO :: String -> Parser Options
listO _ =
    Options
        <$> strOption
            ( long "keyring"
                <> metavar "FILE"
                <> help "file containing keyring"
            )
        <*> pure GraphViz -- unused
        <*> option
            auto
            ( long "output-format"
                <> metavar "FORMAT"
                <> value Unstructured
                <> showDefault
                <> help "output format"
            )
        <*> switch (long "filter" <> help "treat target as filter")
        <*> ( fromMaybe ""
                <$> optional (argument str (metavar "TARGET" <> targetHelp))
            )
        <*> pure ""
        <*> pure ""
  where
    targetHelp =
        helpDoc . Just $ pretty "target (which keys to output)*"

graphO :: String -> Parser Options
graphO _homedir =
    Options
        <$> strOption
            ( long "keyring"
                <> metavar "FILE"
                <> help "file containing keyring"
            )
        <*> option
            auto
            ( long "output-format"
                <> metavar "FORMAT"
                <> value GraphViz
                <> showDefault
                <> ofhelp
            )
        <*> pure Unstructured -- unused
        <*> switch (long "filter" <> help "treat target as filter")
        <*> ( fromMaybe ""
                <$> optional (argument str (metavar "TARGET" <> targetHelp))
            )
        <*> pure ""
        <*> pure ""
  where
    ofhelp =
        helpDoc . Just $
            pretty "output format"
                <> hardline
                <> list (map (pretty . show) ofchoices)
    ofchoices = [minBound .. maxBound] :: [GraphOutputFormat]
    targetHelp =
        helpDoc . Just $ pretty "target (which keys to graph)*"

findPathsO :: String -> Parser Options
findPathsO _homedir =
    Options
        <$> strOption
            ( long "keyring"
                <> metavar "FILE"
                <> help "file containing keyring"
            )
        <*> pure GraphViz -- unused
        <*> option
            auto
            ( long "output-format"
                <> metavar "FORMAT"
                <> value Unstructured
                <> showDefault
                <> help "output format"
            )
        <*> switch (long "filter" <> help "treat targets as filter")
        <*> argument str (metavar "TARGET-SET" <> targetHelp)
        <*> argument str (metavar "FROM-KEYS" <> fromHelp)
        <*> argument str (metavar "TO-KEYS" <> toHelp)
  where
    targetHelp =
        helpDoc . Just $
            pretty "target (which keys to use in pathfinding)*"
    fromHelp =
        helpDoc . Just $
            pretty "from (which keys to use for the source of paths)*"
    toHelp =
        helpDoc . Just $
            pretty "to (which keys to use for the destinations of paths)*"

dispatch :: Command -> IO ()
dispatch (CmdList o) = banner' stderr >> hFlush stderr >> doList o
dispatch (CmdExportPubkeys o) =
    banner' stderr >> hFlush stderr >> doExportPubkeys o
dispatch (CmdGraph o) = banner' stderr >> hFlush stderr >> doGraph o
dispatch (CmdFindPaths o) = banner' stderr >> hFlush stderr >> doFindPaths o

main :: IO ()
main = do
    hSetBuffering stderr LineBuffering
    homedir <- getHomeDirectory
    customExecParser
        (prefs showHelpOnError)
        ( info
            (helper <*> versioner "hkt" <*> cmd homedir)
            ( headerDoc (Just (banner "hkt"))
                <> progDesc "hOpenPGP Keyring Tool"
                <> footerDoc (Just (warranty "hkt"))
            )
        )
        >>= dispatch

cmd :: String -> Parser Command
cmd homedir =
    hsubparser
        ( command
            "export-pubkeys"
            ( info
                (CmdExportPubkeys <$> listO homedir)
                ( progDesc "export matching keys to stdout"
                    <> footerDoc (Just foot)
                )
            )
            <> command
                "findpaths"
                ( info
                    (CmdFindPaths <$> findPathsO homedir)
                    (progDesc "find short paths between keys" <> footerDoc (Just foot))
                )
            <> command
                "graph"
                ( info
                    (CmdGraph <$> graphO homedir)
                    (progDesc "graph certifications" <> footerDoc (Just foot))
                )
            <> command
                "list"
                ( info
                    (CmdList <$> listO homedir)
                    (progDesc "list matching keys" <> footerDoc (Just foot))
                )
        )
  where
    foot =
        hardline
            <> fillSep
                [ pretty "*if --filter is not specified, this must be"
                , pretty "a fingerprint,"
                , pretty "an eight-octet key ID,"
                , pretty "or a substring of a UID (including an empty string)"
                ]
            <> hardline
            <> fillSep
                [ pretty "if --filter is specified, it must be"
                , pretty "something in filter syntax (see source)."
                ]

banner' :: Handle -> IO ()
banner' h =
    hPutDoc
        h
        (banner "hkt" <> hardline <> warranty "hkt" <> hardline)

doList :: Options -> IO ()
doList o = do
    let ttarget1 = T.pack . target1
    keys' <-
        grabMatchingKeys (keyring o) (targetIsFilter o) (ttarget1 o)
    let keys = map tkToTKey keys'
    case pathsOutputFormat o of
        Unstructured -> mapM_ showTKey keys
        JSON -> BL.putStr . A.encode $ keys
        YAML -> B.putStr . Y.encode $ keys
    putStrLn ""

doExportPubkeys :: Options -> IO ()
doExportPubkeys o = do
    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 $ map someTKToUnknown keys
        YAML -> B.putStr . Y.encode $ map someTKToUnknown keys
  where
    putTK' tk =
        runPut $ do
            put (PublicKey (keyPktPKPayload (_tkPrimaryKey publicView)))
            mapM_ (put . Signature) (_tkRevs publicView)
            mapM_ putUid' (_tkUIDs publicView)
            mapM_ putUat' (_tkUAts publicView)
            mapM_
                putSub'
                (map (\(kp, sigs) -> (keyPktToPkt kp, sigs)) (_tkSubs publicView))
      where
        publicView = someTKToPublicViewTK tk
    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

doGraph :: Options -> IO ()
doGraph o = do
    let ttarget1 = T.pack . target1
    cpt <- getPOSIXTime
    keys <-
        grabMatchingKeys (keyring o) (targetIsFilter o) (ttarget1 o)
    kr <- grabMatchingPublicKeyring keys
    let g =
            buildKeyGraph
                ( (buildMaps &&& id)
                    ( rights
                        ( map
                            ( verifyTKWithTyped
                                defaultVerificationPolicy
                                (map SomePublicTK (IxSet.toList kr))
                                (Just (posixSecondsToUTCTime cpt))
                            )
                            keys
                        )
                    )
                )
    case g of
        Left err -> dieHKT err
        Right graph ->
            case graphOutputFormat o of
                LossyPretty -> prettyPrint graph
                GraphViz ->
                    TLIO.putStrLn
                        . printDotGraph
                        . graphToDot nonClusteredLabeledNodesParams
                        $ graph
  where
    nonClusteredLabeledNodesParams =
        nonClusteredParams
            { fmtNode = \(_, l) -> [toLabel $ renderFingerprint l]
            }

buildMaps :: [SomeTK] -> (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 Fingerprint
    , _f2i :: HashMap Fingerprint Int
    , _i2f :: HashMap Int Fingerprint
    }

mapsInsertions :: SomeTK -> (KeyMaps, Int) -> (KeyMaps, Int)
mapsInsertions stk (KeyMaps k2f f2i i2f, i) =
    let publicView = someTKToPublicViewTK stk
        fp = fingerprint (keyPktPKPayload (_tkPrimaryKey publicView))
        keyids =
            rights . map eightOctetKeyID $
                (someTKToUnknown stk ^.. biplate :: [SomePKPayload])
        i' = i + 1
        k2f' = foldr (\k m -> HashMap.insert k fp m) k2f keyids
        f2i' = HashMap.insert fp i' f2i
        i2f' = HashMap.insert i' fp i2f
     in (KeyMaps k2f' f2i' i2f', i')

buildKeyGraph
    :: ((KeyMaps, Int), [SomeTK])
    -> Either String (Gr Fingerprint HashAlgorithm)
buildKeyGraph ((KeyMaps k2f f2i _, _), ks) = do
    edges <- fmap concat (mapM tkToEdges ks)
    pure
        (mkGraph nodes (filter (not . samesies) . nub . sort $ edges))
  where
    nodes = map swap . HashMap.toList $ f2i
    tkToEdges tk = do
        let publicView = someTKToPublicViewTK tk
        target <-
            lookupNode
                (fingerprint (keyPktPKPayload (_tkPrimaryKey publicView)))
        mapM
            (edgeFor target)
            (mapMaybe (fakejoin . (hashAlgo &&& sigissuer)) (sigs tk))
    edgeFor target (ha, i) = do
        source <- lookupSource i
        pure (source, target, ha)
    lookupSource i =
        case HashMap.lookup i k2f >>= flip HashMap.lookup f2i of
            Just source -> Right source
            Nothing ->
                Left
                    ("hkt: no source node for signature issuer key ID " ++ show i)
    lookupNode fp =
        case HashMap.lookup fp f2i of
            Just node -> Right node
            Nothing ->
                Left
                    ("hkt: no graph node for fingerprint " ++ renderFingerprint fp)
    fakejoin (x, y) = fmap ((,) x) y
    sigs tk =
        someTKToUnknown tk ^.. biplate :: [SignaturePayload]
    samesies (x, y, _) = x == y

data PaF
    = PaF
    { certPaths :: [Path]
    , keyFingerprints :: Map String Fingerprint
    }
    deriving (Generic)

instance A.ToJSON PaF

doFindPaths :: Options -> IO ()
doFindPaths o = do
    let ttarget1 = T.pack . target1
        ttarget2 = T.pack . target2
        ttarget3 = T.pack . target3
        filt = targetIsFilter o
    cpt <- getPOSIXTime
    keys <-
        grabMatchingKeys (keyring o) (targetIsFilter o) (ttarget1 o)
    kr <- grabMatchingPublicKeyring keys
    -- FIXME: seriously clean this up
    filter2 <-
        parseFilterPredicateIO (ttarget2 o) >>= either dieHKT pure
    filter3 <-
        parseFilterPredicateIO (ttarget3 o) >>= either dieHKT pure
    keys1 <-
        runConduitRes $
            CL.sourceList keys
                .| ( if filt
                        then CL.filter (runPredicate filter2)
                        else CL.filter (matchAny (ttarget2 o))
                   )
                .| CL.consume
    keys2 <-
        runConduitRes $
            CL.sourceList keys
                .| ( if filt
                        then CL.filter (runPredicate filter3)
                        else CL.filter (matchAny (ttarget3 o))
                   )
                .| CL.consume
    let ((KeyMaps k2f f2i i2f, i), ks) =
            (buildMaps &&& id)
                ( rights
                    ( map
                        ( verifyTKWithTyped
                            defaultVerificationPolicy
                            (map SomePublicTK (IxSet.toList kr))
                            (Just (posixSecondsToUTCTime cpt))
                        )
                        keys
                    )
                )
    keygraph <-
        either dieHKT pure (buildKeyGraph ((KeyMaps k2f f2i i2f, i), ks))
    let keysToIs =
            mapMaybe
                ( \x ->
                    HashMap.lookup
                        ( fingerprint
                            (keyPktPKPayload (_tkPrimaryKey (someTKToPublicViewTK x)))
                        )
                        f2i
                )
        froms = keysToIs keys1
        tos = keysToIs keys2
        combos = froms >>= \f -> tos >>= \t -> return (f, t)
        paths =
            map
                ( \(x, y) ->
                    fromMaybe [] (sp x y (emap (const (1.0 :: Double)) keygraph))
                )
                combos
        paf =
            PaF
                paths
                ( Map.fromList
                    ( mapMaybe
                        (\x -> HashMap.lookup x i2f >>= \y -> return (show x, y))
                        (nub (sort (concat paths)))
                    )
                )
    case pathsOutputFormat o of
        Unstructured ->
            -- FIXME: do something about this
            do
                putStrLn . unlines $ map (show . ((,) =<< length)) paths
                putStrLn . unlines $
                    map
                        ( \x ->
                            maybe (show x) renderFingerprint (HashMap.lookup x i2f)
                        )
                        (nub (sort (concat paths)))
        JSON -> BL.putStr . A.encode $ paf
        YAML -> B.putStr . Y.encode $ paf
    putStrLn ""
  where
    matchAny srch tk =
        either (const False) id $
            runExcept $
                fmap
                    (keyMatchesFingerprint True tk)
                    ((except . parseFingerprint) srch)
                    <|> fmap
                        (keyMatchesEightOctetKeyId True tk . Right)
                        ((except . parseEightOctetKeyId) srch)
                    <|> return (keyMatchesUIDSubString srch tk)

parseFilterPredicateIO
    :: Text -> IO (Either String (FilterPredicates Void SomeTK))
parseFilterPredicateIO e = do
    parsed <-
        try (evaluate (RFilterPredicate <$> parseTKExp (T.unpack e)))
            :: IO
                ( Either
                    ErrorCall
                    (Either String (FilterPredicates Void SomeTK))
                )
    pure $
        case parsed of
            Left err -> Left (show err)
            Right result -> result

dieHKT :: String -> IO a
dieHKT msg = hPutStrLn stderr msg >> exitFailure

-- FIXME: deduplicate the following code
sigissuer :: SignaturePayload -> Maybe EightOctetKeyId
getIssuer :: SigSubPacketPayload -> Maybe EightOctetKeyId
hashAlgo :: SignaturePayload -> HashAlgorithm
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 (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 (SigV6 _ _ x _ _ _ _ _) = x
hashAlgo (SigVOther _ _) = OtherHA 0
