-- 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 FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Data.Conduit.OpenPGP.Keyring.Instances
    (
    ) where

import Control.Arrow (second)
import Control.Lens (folded, (^.), (^..), _1)
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 TKUnknown where
    indices :: IxList KeyringIxs TKUnknown
indices =
        Ix EightOctetKeyId TKUnknown
-> Ix Fingerprint TKUnknown
-> Ix Text TKUnknown
-> IxList KeyringIxs TKUnknown
forall (ixs :: [*]) a r. MkIxList ixs ixs a r => r
ixList ((TKUnknown -> [EightOctetKeyId]) -> Ix EightOctetKeyId TKUnknown
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TKUnknown -> [EightOctetKeyId]
getEOKIs) ((TKUnknown -> [Fingerprint]) -> Ix Fingerprint TKUnknown
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TKUnknown -> [Fingerprint]
getFingerprints) ((TKUnknown -> [Text]) -> Ix Text TKUnknown
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TKUnknown -> [Text]
getUIDs)

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

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

getUIDs :: TKUnknown -> [Text]
getUIDs :: TKUnknown -> [Text]
getUIDs TKUnknown
tk = (TKUnknown
tk TKUnknown
-> Getting
     [(Text, [SignaturePayload])] TKUnknown [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])] TKUnknown [(Text, [SignaturePayload])]
Lens' TKUnknown [(Text, [SignaturePayload])]
tkuUIDs) [(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 :: TKUnknown
mergedTK = TKWithWireRep -> TKUnknown
_tkValue TKWithWireRep
a TKUnknown -> TKUnknown -> TKUnknown
forall a. Semigroup a => a -> a -> a
<> TKWithWireRep -> TKUnknown
_tkValue TKWithWireRep
b
            mergedPackets :: [PktWithWireRep]
mergedPackets =
                [Pkt] -> [PktWithWireRep] -> [PktWithWireRep]
selectPacketRefsByValue
                    (TKUnknown -> [Pkt]
flattenTKPackets TKUnknown
mergedTK)
                    ([PktWithWireRep] -> [PktWithWireRep]
dedupePacketRefsById (TKWithWireRep -> [PktWithWireRep]
_tkPackets TKWithWireRep
a [PktWithWireRep] -> [PktWithWireRep] -> [PktWithWireRep]
forall a. [a] -> [a] -> [a]
++ TKWithWireRep -> [PktWithWireRep]
_tkPackets TKWithWireRep
b))
         in WireRepRefs
-> Maybe ByteRange
-> [PktWithWireRep]
-> TKUnknown
-> TKWithWireRep
TKWithWireRep
                (WireRepRefs -> WireRepRefs -> WireRepRefs
mergeWireRepRefs (TKWithWireRep -> WireRepRefs
_tkWireRepRefs TKWithWireRep
a) (TKWithWireRep -> WireRepRefs
_tkWireRepRefs TKWithWireRep
b))
                ([PktWithWireRep] -> Maybe ByteRange
mergedWireRepRange [PktWithWireRep]
mergedPackets)
                [PktWithWireRep]
mergedPackets
                TKUnknown
mergedTK

flattenTKPackets :: TKUnknown -> [Pkt]
flattenTKPackets :: TKUnknown -> [Pkt]
flattenTKPackets TKUnknown
tk =
    [SomeKeyPkt -> Pkt
someKeyPktToPkt (SomePKPayload -> Maybe SKAddendum -> SomeKeyPkt
mkPrimaryKeyPkt SomePKPayload
pkp Maybe SKAddendum
mska)]
        [Pkt] -> [Pkt] -> [Pkt]
forall a. [a] -> [a] -> [a]
++ (SignaturePayload -> Pkt) -> [SignaturePayload] -> [Pkt]
forall a b. (a -> b) -> [a] -> [b]
map SignaturePayload -> Pkt
SignaturePkt (TKUnknown -> [SignaturePayload]
_tkuRevs TKUnknown
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 (TKUnknown -> [(Text, [SignaturePayload])]
_tkuUIDs TKUnknown
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 (TKUnknown -> [([UserAttrSubPacket], [SignaturePayload])]
_tkuUAts TKUnknown
tk)
        [Pkt] -> [Pkt] -> [Pkt]
forall a. [a] -> [a] -> [a]
++ ((Pkt, [SignaturePayload]) -> [Pkt])
-> [(Pkt, [SignaturePayload])] -> [Pkt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Pkt, [SignaturePayload]) -> [Pkt]
flattenSub (TKUnknown -> [(Pkt, [SignaturePayload])]
_tkuSubs TKUnknown
tk)
  where
    (SomePKPayload
pkp, Maybe SKAddendum
mska) = TKUnknown -> (SomePKPayload, Maybe SKAddendum)
_tkuKey TKUnknown
tk
    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
    flattenSub :: (Pkt, [SignaturePayload]) -> [Pkt]
flattenSub (Pkt
pkt, [SignaturePayload]
sigs) = Pkt
pkt 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

mergeWireRepRefs :: WireRepRefs -> WireRepRefs -> WireRepRefs
mergeWireRepRefs :: WireRepRefs -> WireRepRefs -> WireRepRefs
mergeWireRepRefs WireRepRefs
left WireRepRefs
right =
    case [WireRepRef] -> [WireRepRef]
forall {a}. Eq a => [a] -> [a]
dedupe (WireRepRefs -> [WireRepRef]
forall a. NonEmpty a -> [a]
NE.toList WireRepRefs
left [WireRepRef] -> [WireRepRef] -> [WireRepRef]
forall a. [a] -> [a] -> [a]
++ WireRepRefs -> [WireRepRef]
forall a. NonEmpty a -> [a]
NE.toList WireRepRefs
right) of
        [] -> WireRepRefs
left
        (WireRepRef
x : [WireRepRef]
xs) -> WireRepRef
x WireRepRef -> [WireRepRef] -> WireRepRefs
forall a. a -> [a] -> NonEmpty a
NE.:| [WireRepRef]
xs
  where
    dedupe :: [a] -> [a]
dedupe [] = []
    dedupe (a
x : [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
dedupe ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x) [a]
xs)

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 ->
                String -> [PktWithWireRep]
forall a. HasCallStack => String -> a
error
                    ( String
"TKWithWireRep Semigroup merge missing packet reference for tag "
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
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
tkPKPayloads :: TK k -> [SomePKPayload]
tkPKPayloads :: forall (k :: TKKind). TK k -> [SomePKPayload]
tkPKPayloads TK k
tk =
    KeyPkt (TKKindToKeyPktKind k) -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload (TK k -> KeyPkt (TKKindToKeyPktKind k)
forall (k :: TKKind). TK k -> KeyPkt (TKKindToKeyPktKind k)
_tkPrimaryKey TK k
tk)
        SomePKPayload -> [SomePKPayload] -> [SomePKPayload]
forall a. a -> [a] -> [a]
: ((KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])
 -> SomePKPayload)
-> [(KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])]
-> [SomePKPayload]
forall a b. (a -> b) -> [a] -> [b]
map (KeyPkt (TKKindToKeyPktKind k) -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload (KeyPkt (TKKindToKeyPktKind k) -> SomePKPayload)
-> ((KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])
    -> KeyPkt (TKKindToKeyPktKind k))
-> (KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])
-> SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])
-> KeyPkt (TKKindToKeyPktKind k)
forall a b. (a, b) -> a
fst) (TK k -> [(KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])]
forall (k :: TKKind).
TK k -> [(KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])]
_tkSubs TK k
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 String EightOctetKeyId] -> [EightOctetKeyId]
forall a b. [Either a b] -> [b]
rights ((SomePKPayload -> Either String EightOctetKeyId)
-> [SomePKPayload] -> [Either String EightOctetKeyId]
forall a b. (a -> b) -> [a] -> [b]
map SomePKPayload -> Either String EightOctetKeyId
eightOctetKeyID (TK 'PublicTK -> [SomePKPayload]
forall (k :: TKKind). 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). 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 String EightOctetKeyId] -> [EightOctetKeyId]
forall a b. [Either a b] -> [b]
rights ((SomePKPayload -> Either String EightOctetKeyId)
-> [SomePKPayload] -> [Either String EightOctetKeyId]
forall a b. (a -> b) -> [a] -> [b]
map SomePKPayload -> Either String EightOctetKeyId
eightOctetKeyID (TK 'SecretTK -> [SomePKPayload]
forall (k :: TKKind). 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). 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