-- Instances.hs: OpenPGP (RFC9580) additional types for transferable keys
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Data.Conduit.OpenPGP.Keyring.Instances
    ( flattenTKPackets
    , flattenTKPacketsMixedTK
    , getEOKIsMixed
    , getFingerprintsMixed
    , getUIDsMixed
    ) where

import Control.Arrow (second)
import Control.Lens (folded, (^.), (^..), _1)
import Data.Containers.ListUtils (nubOrd)
import Data.Data.Lens (biplate)
import Data.Either (rights)
import Data.IxSet.Typed (Indexable (..), ixFun, ixList)
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)

import Codec.Encryption.OpenPGP.Fingerprint
    ( eightOctetKeyID
    , fingerprint
    )
import Codec.Encryption.OpenPGP.Types

instance Indexable KeyringIxs (TK 'MixedTK) where
    indices :: IxList KeyringIxs (TK 'MixedTK)
indices =
        Ix EightOctetKeyId (TK 'MixedTK)
-> Ix Fingerprint (TK 'MixedTK)
-> Ix Text (TK 'MixedTK)
-> IxList KeyringIxs (TK 'MixedTK)
forall (ixs :: [*]) a r. MkIxList ixs ixs a r => r
ixList
            ((TK 'MixedTK -> [EightOctetKeyId])
-> Ix EightOctetKeyId (TK 'MixedTK)
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TK 'MixedTK -> [EightOctetKeyId]
getEOKIsMixed)
            ((TK 'MixedTK -> [Fingerprint]) -> Ix Fingerprint (TK 'MixedTK)
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TK 'MixedTK -> [Fingerprint]
getFingerprintsMixed)
            ((TK 'MixedTK -> [Text]) -> Ix Text (TK 'MixedTK)
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TK 'MixedTK -> [Text]
getUIDsMixed)

getEOKIsMixed :: TK 'MixedTK -> [EightOctetKeyId]
getEOKIsMixed :: TK 'MixedTK -> [EightOctetKeyId]
getEOKIsMixed TK 'MixedTK
tk =
    [Either KeyIdError EightOctetKeyId] -> [EightOctetKeyId]
forall a b. [Either a b] -> [b]
rights ((SomePKPayload -> Either KeyIdError EightOctetKeyId)
-> [SomePKPayload] -> [Either KeyIdError EightOctetKeyId]
forall a b. (a -> b) -> [a] -> [b]
map SomePKPayload -> Either KeyIdError EightOctetKeyId
eightOctetKeyID (TK 'MixedTK
tk TK 'MixedTK
-> Getting (Endo [SomePKPayload]) (TK 'MixedTK) SomePKPayload
-> [SomePKPayload]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [SomePKPayload]) (TK 'MixedTK) SomePKPayload
forall s a. (Data s, Typeable a) => Traversal' s a
Traversal' (TK 'MixedTK) SomePKPayload
biplate :: [SomePKPayload]))

getFingerprintsMixed :: TK 'MixedTK -> [Fingerprint]
getFingerprintsMixed :: TK 'MixedTK -> [Fingerprint]
getFingerprintsMixed TK 'MixedTK
tk = (SomePKPayload -> Fingerprint) -> [SomePKPayload] -> [Fingerprint]
forall a b. (a -> b) -> [a] -> [b]
map SomePKPayload -> Fingerprint
fingerprint (TK 'MixedTK
tk TK 'MixedTK
-> Getting (Endo [SomePKPayload]) (TK 'MixedTK) SomePKPayload
-> [SomePKPayload]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [SomePKPayload]) (TK 'MixedTK) SomePKPayload
forall s a. (Data s, Typeable a) => Traversal' s a
Traversal' (TK 'MixedTK) SomePKPayload
biplate :: [SomePKPayload])

getUIDsMixed :: TK 'MixedTK -> [Text]
getUIDsMixed :: TK 'MixedTK -> [Text]
getUIDsMixed TK 'MixedTK
tk = (TK 'MixedTK
tk TK 'MixedTK
-> Getting
     [(Text, [SignaturePayload])]
     (TK 'MixedTK)
     [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])]
  (TK 'MixedTK)
  [(Text, [SignaturePayload])]
forall (k :: TKKind) (f :: * -> *).
Functor f =>
([(Text, [SignaturePayload])] -> f [(Text, [SignaturePayload])])
-> TK k -> f (TK k)
tkUIDs) [(Text, [SignaturePayload])]
-> Getting (Endo [Text]) [(Text, [SignaturePayload])] Text
-> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ((Text, [SignaturePayload])
 -> Const (Endo [Text]) (Text, [SignaturePayload]))
-> [(Text, [SignaturePayload])]
-> Const (Endo [Text]) [(Text, [SignaturePayload])]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int [(Text, [SignaturePayload])] (Text, [SignaturePayload])
folded (((Text, [SignaturePayload])
  -> Const (Endo [Text]) (Text, [SignaturePayload]))
 -> [(Text, [SignaturePayload])]
 -> Const (Endo [Text]) [(Text, [SignaturePayload])])
-> ((Text -> Const (Endo [Text]) Text)
    -> (Text, [SignaturePayload])
    -> Const (Endo [Text]) (Text, [SignaturePayload]))
-> Getting (Endo [Text]) [(Text, [SignaturePayload])] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> (Text, [SignaturePayload])
-> Const (Endo [Text]) (Text, [SignaturePayload])
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Text, [SignaturePayload]) (Text, [SignaturePayload]) Text Text
_1

instance Semigroup TKWithWireRep where
    <> :: TKWithWireRep -> TKWithWireRep -> TKWithWireRep
(<>) TKWithWireRep
a TKWithWireRep
b =
        let mergedTK :: TK 'MixedTK
mergedTK = TKWithWireRep -> TK 'MixedTK
_tkValue TKWithWireRep
a TK 'MixedTK -> TK 'MixedTK -> TK 'MixedTK
forall a. Semigroup a => a -> a -> a
<> TKWithWireRep -> TK 'MixedTK
_tkValue TKWithWireRep
b
            mergedPackets :: [PktWithWireRep]
mergedPackets =
                [Pkt] -> [PktWithWireRep] -> [PktWithWireRep]
selectPacketRefsByValue
                    (TK 'MixedTK -> [Pkt]
flattenTKPackets TK 'MixedTK
mergedTK)
                    ([PktWithWireRep] -> [PktWithWireRep]
dedupePacketRefsById (TKWithWireRep -> [PktWithWireRep]
_tkPackets TKWithWireRep
a [PktWithWireRep] -> [PktWithWireRep] -> [PktWithWireRep]
forall a. [a] -> [a] -> [a]
++ TKWithWireRep -> [PktWithWireRep]
_tkPackets TKWithWireRep
b))
            mergedRefs :: WireRepRefs
mergedRefs =
                case [WireRepRef] -> [WireRepRef]
forall a. Ord a => [a] -> [a]
nubOrd
                    (WireRepRefs -> [WireRepRef]
forall a. NonEmpty a -> [a]
NE.toList (TKWithWireRep -> WireRepRefs
_tkWireRepRefs TKWithWireRep
a) [WireRepRef] -> [WireRepRef] -> [WireRepRef]
forall a. [a] -> [a] -> [a]
++ WireRepRefs -> [WireRepRef]
forall a. NonEmpty a -> [a]
NE.toList (TKWithWireRep -> WireRepRefs
_tkWireRepRefs TKWithWireRep
b)) of
                    [] -> TKWithWireRep -> WireRepRefs
_tkWireRepRefs TKWithWireRep
a
                    (WireRepRef
x : [WireRepRef]
xs) -> WireRepRef
x WireRepRef -> [WireRepRef] -> WireRepRefs
forall a. a -> [a] -> NonEmpty a
NE.:| [WireRepRef]
xs
         in WireRepRefs
-> Maybe ByteRange
-> [PktWithWireRep]
-> TK 'MixedTK
-> TKWithWireRep
TKWithWireRep
                WireRepRefs
mergedRefs
                ([PktWithWireRep] -> Maybe ByteRange
mergedWireRepRange [PktWithWireRep]
mergedPackets)
                [PktWithWireRep]
mergedPackets
                TK 'MixedTK
mergedTK

flattenTKPackets :: TK 'MixedTK -> [Pkt]
flattenTKPackets :: TK 'MixedTK -> [Pkt]
flattenTKPackets = TK 'MixedTK -> [Pkt]
flattenTKPacketsMixedTK

flattenTKPacketsMixedTK :: TK 'MixedTK -> [Pkt]
flattenTKPacketsMixedTK :: TK 'MixedTK -> [Pkt]
flattenTKPacketsMixedTK TK 'MixedTK
tk =
    [SomeKeyPkt -> Pkt
someKeyPktToPkt (TK 'MixedTK -> TKKeyPkt 'MixedTK
forall (k :: TKKind). TK k -> TKKeyPkt k
_tkPrimaryKey TK 'MixedTK
tk)]
        [Pkt] -> [Pkt] -> [Pkt]
forall a. [a] -> [a] -> [a]
++ (SignaturePayload -> Pkt) -> [SignaturePayload] -> [Pkt]
forall a b. (a -> b) -> [a] -> [b]
map SignaturePayload -> Pkt
SignaturePkt (TK 'MixedTK -> [SignaturePayload]
forall (k :: TKKind). TK k -> [SignaturePayload]
_tkRevs TK 'MixedTK
tk)
        [Pkt] -> [Pkt] -> [Pkt]
forall a. [a] -> [a] -> [a]
++ (SignaturePayload -> Pkt) -> [SignaturePayload] -> [Pkt]
forall a b. (a -> b) -> [a] -> [b]
map SignaturePayload -> Pkt
SignaturePkt (TK 'MixedTK -> [SignaturePayload]
forall (k :: TKKind). TK k -> [SignaturePayload]
_tkDirectKeySigs TK 'MixedTK
tk)
        [Pkt] -> [Pkt] -> [Pkt]
forall a. [a] -> [a] -> [a]
++ ((Text, [SignaturePayload]) -> [Pkt])
-> [(Text, [SignaturePayload])] -> [Pkt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, [SignaturePayload]) -> [Pkt]
flattenUID (TK 'MixedTK -> [(Text, [SignaturePayload])]
forall (k :: TKKind). TK k -> [(Text, [SignaturePayload])]
_tkUIDs TK 'MixedTK
tk)
        [Pkt] -> [Pkt] -> [Pkt]
forall a. [a] -> [a] -> [a]
++ (([UserAttrSubPacket], [SignaturePayload]) -> [Pkt])
-> [([UserAttrSubPacket], [SignaturePayload])] -> [Pkt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([UserAttrSubPacket], [SignaturePayload]) -> [Pkt]
flattenUAt (TK 'MixedTK -> [([UserAttrSubPacket], [SignaturePayload])]
forall (k :: TKKind).
TK k -> [([UserAttrSubPacket], [SignaturePayload])]
_tkUAts TK 'MixedTK
tk)
        [Pkt] -> [Pkt] -> [Pkt]
forall a. [a] -> [a] -> [a]
++ ((SomeKeyPkt, [SignaturePayload]) -> [Pkt])
-> [(SomeKeyPkt, [SignaturePayload])] -> [Pkt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SomeKeyPkt, [SignaturePayload]) -> [Pkt]
flattenSubMixed (TK 'MixedTK -> [(TKKeyPkt 'MixedTK, [SignaturePayload])]
forall (k :: TKKind). TK k -> [(TKKeyPkt k, [SignaturePayload])]
_tkSubs TK 'MixedTK
tk)
  where
    flattenUID :: (Text, [SignaturePayload]) -> [Pkt]
flattenUID (Text
uid, [SignaturePayload]
sigs) = Text -> Pkt
UserIdPkt Text
uid Pkt -> [Pkt] -> [Pkt]
forall a. a -> [a] -> [a]
: (SignaturePayload -> Pkt) -> [SignaturePayload] -> [Pkt]
forall a b. (a -> b) -> [a] -> [b]
map SignaturePayload -> Pkt
SignaturePkt [SignaturePayload]
sigs
    flattenUAt :: ([UserAttrSubPacket], [SignaturePayload]) -> [Pkt]
flattenUAt ([UserAttrSubPacket]
uat, [SignaturePayload]
sigs) = [UserAttrSubPacket] -> Pkt
UserAttributePkt [UserAttrSubPacket]
uat Pkt -> [Pkt] -> [Pkt]
forall a. a -> [a] -> [a]
: (SignaturePayload -> Pkt) -> [SignaturePayload] -> [Pkt]
forall a b. (a -> b) -> [a] -> [b]
map SignaturePayload -> Pkt
SignaturePkt [SignaturePayload]
sigs
    flattenSubMixed :: (SomeKeyPkt, [SignaturePayload]) -> [Pkt]
flattenSubMixed (SomeKeyPkt
kp, [SignaturePayload]
sigs) = SomeKeyPkt -> Pkt
someKeyPktToPkt SomeKeyPkt
kp Pkt -> [Pkt] -> [Pkt]
forall a. a -> [a] -> [a]
: (SignaturePayload -> Pkt) -> [SignaturePayload] -> [Pkt]
forall a b. (a -> b) -> [a] -> [b]
map SignaturePayload -> Pkt
SignaturePkt [SignaturePayload]
sigs

mergedWireRepRange :: [PktWithWireRep] -> Maybe ByteRange
mergedWireRepRange :: [PktWithWireRep] -> Maybe ByteRange
mergedWireRepRange [] = Maybe ByteRange
forall a. Maybe a
Nothing
mergedWireRepRange (PktWithWireRep
pkt : [PktWithWireRep]
rest)
    | (PktWithWireRep -> Bool) -> [PktWithWireRep] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((WireRepRef -> WireRepRef -> Bool
forall a. Eq a => a -> a -> Bool
== PktWithWireRep -> WireRepRef
_pktWireRepRef PktWithWireRep
pkt) (WireRepRef -> Bool)
-> (PktWithWireRep -> WireRepRef) -> PktWithWireRep -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PktWithWireRep -> WireRepRef
_pktWireRepRef) [PktWithWireRep]
rest =
        [ByteRange] -> Maybe ByteRange
spanByteRanges ((PktWithWireRep -> ByteRange) -> [PktWithWireRep] -> [ByteRange]
forall a b. (a -> b) -> [a] -> [b]
map PktWithWireRep -> ByteRange
_pktRange (PktWithWireRep
pkt PktWithWireRep -> [PktWithWireRep] -> [PktWithWireRep]
forall a. a -> [a] -> [a]
: [PktWithWireRep]
rest))
    | Bool
otherwise = Maybe ByteRange
forall a. Maybe a
Nothing

dedupePacketRefsById :: [PktWithWireRep] -> [PktWithWireRep]
dedupePacketRefsById :: [PktWithWireRep] -> [PktWithWireRep]
dedupePacketRefsById = [PacketRefId] -> [PktWithWireRep] -> [PktWithWireRep]
go []
  where
    go :: [PacketRefId] -> [PktWithWireRep] -> [PktWithWireRep]
go [PacketRefId]
_ [] = []
    go [PacketRefId]
seen (PktWithWireRep
pkt : [PktWithWireRep]
rest) =
        let packetRefId :: PacketRefId
packetRefId = PktWithWireRep -> PacketRefId
packetRefIdOf PktWithWireRep
pkt
         in if PacketRefId
packetRefId PacketRefId -> [PacketRefId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PacketRefId]
seen
                then [PacketRefId] -> [PktWithWireRep] -> [PktWithWireRep]
go [PacketRefId]
seen [PktWithWireRep]
rest
                else PktWithWireRep
pkt PktWithWireRep -> [PktWithWireRep] -> [PktWithWireRep]
forall a. a -> [a] -> [a]
: [PacketRefId] -> [PktWithWireRep] -> [PktWithWireRep]
go (PacketRefId
packetRefId PacketRefId -> [PacketRefId] -> [PacketRefId]
forall a. a -> [a] -> [a]
: [PacketRefId]
seen) [PktWithWireRep]
rest

selectPacketRefsByValue
    :: [Pkt] -> [PktWithWireRep] -> [PktWithWireRep]
selectPacketRefsByValue :: [Pkt] -> [PktWithWireRep] -> [PktWithWireRep]
selectPacketRefsByValue [Pkt]
expected [PktWithWireRep]
available = [Pkt] -> [PktWithWireRep] -> [PktWithWireRep] -> [PktWithWireRep]
go [Pkt]
expected [PktWithWireRep]
available []
  where
    go :: [Pkt] -> [PktWithWireRep] -> [PktWithWireRep] -> [PktWithWireRep]
go [] [PktWithWireRep]
_ [PktWithWireRep]
acc = [PktWithWireRep] -> [PktWithWireRep]
forall a. [a] -> [a]
reverse [PktWithWireRep]
acc
    go (Pkt
pkt : [Pkt]
pktRest) [PktWithWireRep]
refs [PktWithWireRep]
acc =
        case Pkt -> [PktWithWireRep] -> Maybe (PktWithWireRep, [PktWithWireRep])
extractFirstByValue Pkt
pkt [PktWithWireRep]
refs of
            Maybe (PktWithWireRep, [PktWithWireRep])
Nothing ->
                [Char] -> [PktWithWireRep]
forall a. HasCallStack => [Char] -> a
error
                    ( [Char]
"TKWithWireRep Semigroup merge missing packet reference for tag "
                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show (Pkt -> Word8
pktTag Pkt
pkt)
                    )
            Just (PktWithWireRep
matched, [PktWithWireRep]
remaining) -> [Pkt] -> [PktWithWireRep] -> [PktWithWireRep] -> [PktWithWireRep]
go [Pkt]
pktRest [PktWithWireRep]
remaining (PktWithWireRep
matched PktWithWireRep -> [PktWithWireRep] -> [PktWithWireRep]
forall a. a -> [a] -> [a]
: [PktWithWireRep]
acc)

extractFirstByValue
    :: Pkt
    -> [PktWithWireRep]
    -> Maybe (PktWithWireRep, [PktWithWireRep])
extractFirstByValue :: Pkt -> [PktWithWireRep] -> Maybe (PktWithWireRep, [PktWithWireRep])
extractFirstByValue Pkt
expected = [PktWithWireRep]
-> [PktWithWireRep] -> Maybe (PktWithWireRep, [PktWithWireRep])
go []
  where
    go :: [PktWithWireRep]
-> [PktWithWireRep] -> Maybe (PktWithWireRep, [PktWithWireRep])
go [PktWithWireRep]
_ [] = Maybe (PktWithWireRep, [PktWithWireRep])
forall a. Maybe a
Nothing
    go [PktWithWireRep]
seen (PktWithWireRep
pkt : [PktWithWireRep]
rest)
        | PktWithWireRep
pkt PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue Pkt -> Pkt -> Bool
forall a. Eq a => a -> a -> Bool
== Pkt
expected =
            (PktWithWireRep, [PktWithWireRep])
-> Maybe (PktWithWireRep, [PktWithWireRep])
forall a. a -> Maybe a
Just (PktWithWireRep
pkt, [PktWithWireRep]
seen [PktWithWireRep] -> [PktWithWireRep] -> [PktWithWireRep]
forall a. [a] -> [a] -> [a]
++ [PktWithWireRep]
rest)
        | Bool
otherwise = ([PktWithWireRep] -> [PktWithWireRep])
-> (PktWithWireRep, [PktWithWireRep])
-> (PktWithWireRep, [PktWithWireRep])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (PktWithWireRep
pkt PktWithWireRep -> [PktWithWireRep] -> [PktWithWireRep]
forall a. a -> [a] -> [a]
:) ((PktWithWireRep, [PktWithWireRep])
 -> (PktWithWireRep, [PktWithWireRep]))
-> Maybe (PktWithWireRep, [PktWithWireRep])
-> Maybe (PktWithWireRep, [PktWithWireRep])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PktWithWireRep]
-> [PktWithWireRep] -> Maybe (PktWithWireRep, [PktWithWireRep])
go [PktWithWireRep]
seen [PktWithWireRep]
rest

-- | Extract all SomePKPayloads from a TK (primary + subkeys) without biplate
class TKPKPayloads (k :: TKKind) where
    tkPKPayloads :: TK k -> [SomePKPayload]

instance TKPKPayloads 'PublicTK where
    tkPKPayloads :: TK 'PublicTK -> [SomePKPayload]
tkPKPayloads TK 'PublicTK
tk =
        KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload (TK 'PublicTK -> TKKeyPkt 'PublicTK
forall (k :: TKKind). TK k -> TKKeyPkt k
_tkPrimaryKey TK 'PublicTK
tk)
            SomePKPayload -> [SomePKPayload] -> [SomePKPayload]
forall a. a -> [a] -> [a]
: ((KeyPkt 'PublicPkt, [SignaturePayload]) -> SomePKPayload)
-> [(KeyPkt 'PublicPkt, [SignaturePayload])] -> [SomePKPayload]
forall a b. (a -> b) -> [a] -> [b]
map (KeyPkt 'PublicPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload (KeyPkt 'PublicPkt -> SomePKPayload)
-> ((KeyPkt 'PublicPkt, [SignaturePayload]) -> KeyPkt 'PublicPkt)
-> (KeyPkt 'PublicPkt, [SignaturePayload])
-> SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyPkt 'PublicPkt, [SignaturePayload]) -> KeyPkt 'PublicPkt
forall a b. (a, b) -> a
fst) (TK 'PublicTK -> [(TKKeyPkt 'PublicTK, [SignaturePayload])]
forall (k :: TKKind). TK k -> [(TKKeyPkt k, [SignaturePayload])]
_tkSubs TK 'PublicTK
tk)

instance TKPKPayloads 'SecretTK where
    tkPKPayloads :: TK 'SecretTK -> [SomePKPayload]
tkPKPayloads TK 'SecretTK
tk =
        KeyPkt 'SecretPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload (TK 'SecretTK -> TKKeyPkt 'SecretTK
forall (k :: TKKind). TK k -> TKKeyPkt k
_tkPrimaryKey TK 'SecretTK
tk)
            SomePKPayload -> [SomePKPayload] -> [SomePKPayload]
forall a. a -> [a] -> [a]
: ((KeyPkt 'SecretPkt, [SignaturePayload]) -> SomePKPayload)
-> [(KeyPkt 'SecretPkt, [SignaturePayload])] -> [SomePKPayload]
forall a b. (a -> b) -> [a] -> [b]
map (KeyPkt 'SecretPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload (KeyPkt 'SecretPkt -> SomePKPayload)
-> ((KeyPkt 'SecretPkt, [SignaturePayload]) -> KeyPkt 'SecretPkt)
-> (KeyPkt 'SecretPkt, [SignaturePayload])
-> SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyPkt 'SecretPkt, [SignaturePayload]) -> KeyPkt 'SecretPkt
forall a b. (a, b) -> a
fst) (TK 'SecretTK -> [(TKKeyPkt 'SecretTK, [SignaturePayload])]
forall (k :: TKKind). TK k -> [(TKKeyPkt k, [SignaturePayload])]
_tkSubs TK 'SecretTK
tk)

instance TKPKPayloads 'MixedTK where
    tkPKPayloads :: TK 'MixedTK -> [SomePKPayload]
tkPKPayloads TK 'MixedTK
tk =
        SomeKeyPkt -> SomePKPayload
someKeyPktPKPayload (TK 'MixedTK -> TKKeyPkt 'MixedTK
forall (k :: TKKind). TK k -> TKKeyPkt k
_tkPrimaryKey TK 'MixedTK
tk)
            SomePKPayload -> [SomePKPayload] -> [SomePKPayload]
forall a. a -> [a] -> [a]
: ((SomeKeyPkt, [SignaturePayload]) -> SomePKPayload)
-> [(SomeKeyPkt, [SignaturePayload])] -> [SomePKPayload]
forall a b. (a -> b) -> [a] -> [b]
map (SomeKeyPkt -> SomePKPayload
someKeyPktPKPayload (SomeKeyPkt -> SomePKPayload)
-> ((SomeKeyPkt, [SignaturePayload]) -> SomeKeyPkt)
-> (SomeKeyPkt, [SignaturePayload])
-> SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeKeyPkt, [SignaturePayload]) -> SomeKeyPkt
forall a b. (a, b) -> a
fst) (TK 'MixedTK -> [(TKKeyPkt 'MixedTK, [SignaturePayload])]
forall (k :: TKKind). TK k -> [(TKKeyPkt k, [SignaturePayload])]
_tkSubs TK 'MixedTK
tk)

-- | Index public TKs by key ID, fingerprint, and UID
instance Indexable KeyringIxs (TK 'PublicTK) where
    indices :: IxList KeyringIxs (TK 'PublicTK)
indices =
        Ix EightOctetKeyId (TK 'PublicTK)
-> Ix Fingerprint (TK 'PublicTK)
-> Ix Text (TK 'PublicTK)
-> IxList KeyringIxs (TK 'PublicTK)
forall (ixs :: [*]) a r. MkIxList ixs ixs a r => r
ixList
            ((TK 'PublicTK -> [EightOctetKeyId])
-> Ix EightOctetKeyId (TK 'PublicTK)
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TK 'PublicTK -> [EightOctetKeyId]
getEOKIsPublic)
            ((TK 'PublicTK -> [Fingerprint]) -> Ix Fingerprint (TK 'PublicTK)
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TK 'PublicTK -> [Fingerprint]
getFingerprintsPublic)
            ((TK 'PublicTK -> [Text]) -> Ix Text (TK 'PublicTK)
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TK 'PublicTK -> [Text]
getUIDsPublic)

getEOKIsPublic :: TK 'PublicTK -> [EightOctetKeyId]
getEOKIsPublic :: TK 'PublicTK -> [EightOctetKeyId]
getEOKIsPublic TK 'PublicTK
tk = [Either KeyIdError EightOctetKeyId] -> [EightOctetKeyId]
forall a b. [Either a b] -> [b]
rights ((SomePKPayload -> Either KeyIdError EightOctetKeyId)
-> [SomePKPayload] -> [Either KeyIdError EightOctetKeyId]
forall a b. (a -> b) -> [a] -> [b]
map SomePKPayload -> Either KeyIdError EightOctetKeyId
eightOctetKeyID (TK 'PublicTK -> [SomePKPayload]
forall (k :: TKKind). TKPKPayloads k => TK k -> [SomePKPayload]
tkPKPayloads TK 'PublicTK
tk))

getFingerprintsPublic :: TK 'PublicTK -> [Fingerprint]
getFingerprintsPublic :: TK 'PublicTK -> [Fingerprint]
getFingerprintsPublic TK 'PublicTK
tk = (SomePKPayload -> Fingerprint) -> [SomePKPayload] -> [Fingerprint]
forall a b. (a -> b) -> [a] -> [b]
map SomePKPayload -> Fingerprint
fingerprint (TK 'PublicTK -> [SomePKPayload]
forall (k :: TKKind). TKPKPayloads k => TK k -> [SomePKPayload]
tkPKPayloads TK 'PublicTK
tk)

getUIDsPublic :: TK 'PublicTK -> [Text]
getUIDsPublic :: TK 'PublicTK -> [Text]
getUIDsPublic TK 'PublicTK
tk = (TK 'PublicTK
tk TK 'PublicTK
-> Getting
     [(Text, [SignaturePayload])]
     (TK 'PublicTK)
     [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])]
  (TK 'PublicTK)
  [(Text, [SignaturePayload])]
forall (k :: TKKind) (f :: * -> *).
Functor f =>
([(Text, [SignaturePayload])] -> f [(Text, [SignaturePayload])])
-> TK k -> f (TK k)
tkUIDs) [(Text, [SignaturePayload])]
-> Getting (Endo [Text]) [(Text, [SignaturePayload])] Text
-> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ((Text, [SignaturePayload])
 -> Const (Endo [Text]) (Text, [SignaturePayload]))
-> [(Text, [SignaturePayload])]
-> Const (Endo [Text]) [(Text, [SignaturePayload])]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int [(Text, [SignaturePayload])] (Text, [SignaturePayload])
folded (((Text, [SignaturePayload])
  -> Const (Endo [Text]) (Text, [SignaturePayload]))
 -> [(Text, [SignaturePayload])]
 -> Const (Endo [Text]) [(Text, [SignaturePayload])])
-> ((Text -> Const (Endo [Text]) Text)
    -> (Text, [SignaturePayload])
    -> Const (Endo [Text]) (Text, [SignaturePayload]))
-> Getting (Endo [Text]) [(Text, [SignaturePayload])] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> (Text, [SignaturePayload])
-> Const (Endo [Text]) (Text, [SignaturePayload])
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Text, [SignaturePayload]) (Text, [SignaturePayload]) Text Text
_1

-- | Index secret TKs by key ID, fingerprint, and UID
instance Indexable KeyringIxs (TK 'SecretTK) where
    indices :: IxList KeyringIxs (TK 'SecretTK)
indices =
        Ix EightOctetKeyId (TK 'SecretTK)
-> Ix Fingerprint (TK 'SecretTK)
-> Ix Text (TK 'SecretTK)
-> IxList KeyringIxs (TK 'SecretTK)
forall (ixs :: [*]) a r. MkIxList ixs ixs a r => r
ixList
            ((TK 'SecretTK -> [EightOctetKeyId])
-> Ix EightOctetKeyId (TK 'SecretTK)
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TK 'SecretTK -> [EightOctetKeyId]
getEOKIsSecret)
            ((TK 'SecretTK -> [Fingerprint]) -> Ix Fingerprint (TK 'SecretTK)
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TK 'SecretTK -> [Fingerprint]
getFingerprintsSecret)
            ((TK 'SecretTK -> [Text]) -> Ix Text (TK 'SecretTK)
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TK 'SecretTK -> [Text]
getUIDsSecret)

getEOKIsSecret :: TK 'SecretTK -> [EightOctetKeyId]
getEOKIsSecret :: TK 'SecretTK -> [EightOctetKeyId]
getEOKIsSecret TK 'SecretTK
tk = [Either KeyIdError EightOctetKeyId] -> [EightOctetKeyId]
forall a b. [Either a b] -> [b]
rights ((SomePKPayload -> Either KeyIdError EightOctetKeyId)
-> [SomePKPayload] -> [Either KeyIdError EightOctetKeyId]
forall a b. (a -> b) -> [a] -> [b]
map SomePKPayload -> Either KeyIdError EightOctetKeyId
eightOctetKeyID (TK 'SecretTK -> [SomePKPayload]
forall (k :: TKKind). TKPKPayloads k => TK k -> [SomePKPayload]
tkPKPayloads TK 'SecretTK
tk))

getFingerprintsSecret :: TK 'SecretTK -> [Fingerprint]
getFingerprintsSecret :: TK 'SecretTK -> [Fingerprint]
getFingerprintsSecret TK 'SecretTK
tk = (SomePKPayload -> Fingerprint) -> [SomePKPayload] -> [Fingerprint]
forall a b. (a -> b) -> [a] -> [b]
map SomePKPayload -> Fingerprint
fingerprint (TK 'SecretTK -> [SomePKPayload]
forall (k :: TKKind). TKPKPayloads k => TK k -> [SomePKPayload]
tkPKPayloads TK 'SecretTK
tk)

getUIDsSecret :: TK 'SecretTK -> [Text]
getUIDsSecret :: TK 'SecretTK -> [Text]
getUIDsSecret TK 'SecretTK
tk = (TK 'SecretTK
tk TK 'SecretTK
-> Getting
     [(Text, [SignaturePayload])]
     (TK 'SecretTK)
     [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])]
  (TK 'SecretTK)
  [(Text, [SignaturePayload])]
forall (k :: TKKind) (f :: * -> *).
Functor f =>
([(Text, [SignaturePayload])] -> f [(Text, [SignaturePayload])])
-> TK k -> f (TK k)
tkUIDs) [(Text, [SignaturePayload])]
-> Getting (Endo [Text]) [(Text, [SignaturePayload])] Text
-> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ((Text, [SignaturePayload])
 -> Const (Endo [Text]) (Text, [SignaturePayload]))
-> [(Text, [SignaturePayload])]
-> Const (Endo [Text]) [(Text, [SignaturePayload])]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int [(Text, [SignaturePayload])] (Text, [SignaturePayload])
folded (((Text, [SignaturePayload])
  -> Const (Endo [Text]) (Text, [SignaturePayload]))
 -> [(Text, [SignaturePayload])]
 -> Const (Endo [Text]) [(Text, [SignaturePayload])])
-> ((Text -> Const (Endo [Text]) Text)
    -> (Text, [SignaturePayload])
    -> Const (Endo [Text]) (Text, [SignaturePayload]))
-> Getting (Endo [Text]) [(Text, [SignaturePayload])] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> (Text, [SignaturePayload])
-> Const (Endo [Text]) (Text, [SignaturePayload])
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Text, [SignaturePayload]) (Text, [SignaturePayload]) Text Text
_1