{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Data.Conduit.OpenPGP.Keyring.Instances
(
) where
import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)
import Codec.Encryption.OpenPGP.Internal (issuer)
import Codec.Encryption.OpenPGP.SignatureQualities (sigCT)
import Codec.Encryption.OpenPGP.Types
import Control.Lens ((^.), (^..), _1, folded)
import Data.Data.Lens (biplate)
import Data.Either (rights)
import Data.Function (on)
import qualified Data.HashMap.Lazy as HashMap
import Data.IxSet.Typed (Indexable(..), ixFun, ixList)
import Data.List (nub, sort)
import qualified Data.Map as Map
import Data.Semigroup (Semigroup, (<>))
import Data.Text (Text)
instance Indexable KeyringIxs TK where
indices :: IxList KeyringIxs TK
indices = Ix EightOctetKeyId TK
-> Ix TwentyOctetFingerprint TK
-> Ix Text TK
-> IxList KeyringIxs TK
forall (ixs :: [*]) a r. MkIxList ixs ixs a r => r
ixList ((TK -> [EightOctetKeyId]) -> Ix EightOctetKeyId TK
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TK -> [EightOctetKeyId]
getEOKIs) ((TK -> [TwentyOctetFingerprint]) -> Ix TwentyOctetFingerprint TK
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TK -> [TwentyOctetFingerprint]
getTOFs) ((TK -> [Text]) -> Ix Text TK
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun TK -> [Text]
getUIDs)
getEOKIs :: TK -> [EightOctetKeyId]
getEOKIs :: TK -> [EightOctetKeyId]
getEOKIs TK
tk = [Either String EightOctetKeyId] -> [EightOctetKeyId]
forall a b. [Either a b] -> [b]
rights ((PKPayload -> Either String EightOctetKeyId)
-> [PKPayload] -> [Either String EightOctetKeyId]
forall a b. (a -> b) -> [a] -> [b]
map PKPayload -> Either String EightOctetKeyId
eightOctetKeyID (TK
tk TK -> Getting (Endo [PKPayload]) TK PKPayload -> [PKPayload]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [PKPayload]) TK PKPayload
forall s a. (Data s, Typeable a) => Traversal' s a
Traversal' TK PKPayload
biplate :: [PKPayload]))
getTOFs :: TK -> [TwentyOctetFingerprint]
getTOFs :: TK -> [TwentyOctetFingerprint]
getTOFs TK
tk = (PKPayload -> TwentyOctetFingerprint)
-> [PKPayload] -> [TwentyOctetFingerprint]
forall a b. (a -> b) -> [a] -> [b]
map PKPayload -> TwentyOctetFingerprint
fingerprint (TK
tk TK -> Getting (Endo [PKPayload]) TK PKPayload -> [PKPayload]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [PKPayload]) TK PKPayload
forall s a. (Data s, Typeable a) => Traversal' s a
Traversal' TK PKPayload
biplate :: [PKPayload])
getUIDs :: TK -> [Text]
getUIDs :: TK -> [Text]
getUIDs TK
tk = (TK
tk TK
-> Getting
[(Text, [SignaturePayload])] TK [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
[(Text, [SignaturePayload])] TK [(Text, [SignaturePayload])]
Lens' TK [(Text, [SignaturePayload])]
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 Ord SignaturePayload where
compare :: SignaturePayload -> SignaturePayload -> Ordering
compare s1 :: SignaturePayload
s1@(SigV3 SigType
st1 ThirtyTwoBitTimeStamp
ct1 EightOctetKeyId
eoki1 PubKeyAlgorithm
pka1 HashAlgorithm
ha1 Word16
left16_1 NonEmpty MPI
mpis1) s2 :: SignaturePayload
s2@(SigV3 SigType
st2 ThirtyTwoBitTimeStamp
ct2 EightOctetKeyId
eoki2 PubKeyAlgorithm
pka2 HashAlgorithm
ha2 Word16
left16_2 NonEmpty MPI
mpis2) =
ThirtyTwoBitTimeStamp -> ThirtyTwoBitTimeStamp -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ThirtyTwoBitTimeStamp
ct1 ThirtyTwoBitTimeStamp
ct2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> SigType -> SigType -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SigType
st1 SigType
st2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> EightOctetKeyId -> EightOctetKeyId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare EightOctetKeyId
eoki1 EightOctetKeyId
eoki2
compare s1 :: SignaturePayload
s1@(SigV4 SigType
st1 PubKeyAlgorithm
pka1 HashAlgorithm
ha1 [SigSubPacket]
has1 [SigSubPacket]
uhas1 Word16
left16_1 NonEmpty MPI
mpis1) s2 :: SignaturePayload
s2@(SigV4 SigType
st2 PubKeyAlgorithm
pka2 HashAlgorithm
ha2 [SigSubPacket]
has2 [SigSubPacket]
uhas2 Word16
left16_2 NonEmpty MPI
mpis2) =
Maybe ThirtyTwoBitTimeStamp
-> Maybe ThirtyTwoBitTimeStamp -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SignaturePayload -> Maybe ThirtyTwoBitTimeStamp
sigCT SignaturePayload
s1) (SignaturePayload -> Maybe ThirtyTwoBitTimeStamp
sigCT SignaturePayload
s2) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> SigType -> SigType -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SigType
st1 SigType
st2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<>
Maybe EightOctetKeyId -> Maybe EightOctetKeyId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Pkt -> Maybe EightOctetKeyId
issuer (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
s1)) (Pkt -> Maybe EightOctetKeyId
issuer (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
s2))
compare s1 :: SignaturePayload
s1@(SigVOther Word8
sv1 ByteString
bs1) s2 :: SignaturePayload
s2@(SigVOther Word8
sv2 ByteString
bs2) =
Word8 -> Word8 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word8
sv1 Word8
sv2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ByteString
bs1 ByteString
bs2
compare SigV3 {} SigV4 {} = Ordering
LT
compare SigV3 {} SigVOther {} = Ordering
LT
compare SigV4 {} SigV3 {} = Ordering
GT
compare SigV4 {} SigVOther {} = Ordering
LT
compare SigVOther {} SigV3 {} = Ordering
GT
compare SigVOther {} SigV4 {} = Ordering
GT
instance Semigroup TK where
<> :: TK -> TK -> TK
(<>) TK
a TK
b =
(PKPayload, Maybe SKAddendum)
-> [SignaturePayload]
-> [(Text, [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [(Pkt, [SignaturePayload])]
-> TK
TK
(TK -> (PKPayload, Maybe SKAddendum)
_tkKey TK
a)
([SignaturePayload] -> [SignaturePayload]
forall a. Eq a => [a] -> [a]
nub ([SignaturePayload] -> [SignaturePayload])
-> ([SignaturePayload] -> [SignaturePayload])
-> [SignaturePayload]
-> [SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SignaturePayload] -> [SignaturePayload]
forall a. Ord a => [a] -> [a]
sort ([SignaturePayload] -> [SignaturePayload])
-> [SignaturePayload] -> [SignaturePayload]
forall a b. (a -> b) -> a -> b
$ TK -> [SignaturePayload]
_tkRevs TK
a [SignaturePayload] -> [SignaturePayload] -> [SignaturePayload]
forall a. [a] -> [a] -> [a]
++ TK -> [SignaturePayload]
_tkRevs TK
b)
(([(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
forall {k} {a}.
(Ord k, Ord a) =>
[(k, [a])] -> [(k, [a])] -> [(k, [a])]
kvmerge ([(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])])
-> (TK -> [(Text, [SignaturePayload])])
-> TK
-> TK
-> [(Text, [SignaturePayload])]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TK -> [(Text, [SignaturePayload])]
_tkUIDs) TK
a TK
b)
(([([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall {k} {a}.
(Ord k, Ord a) =>
[(k, [a])] -> [(k, [a])] -> [(k, [a])]
kvmerge ([([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])])
-> (TK -> [([UserAttrSubPacket], [SignaturePayload])])
-> TK
-> TK
-> [([UserAttrSubPacket], [SignaturePayload])]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TK -> [([UserAttrSubPacket], [SignaturePayload])]
_tkUAts) TK
a TK
b)
(([(Pkt, [SignaturePayload])]
-> [(Pkt, [SignaturePayload])] -> [(Pkt, [SignaturePayload])]
forall {a} {k}.
(Ord a, Hashable k) =>
[(k, [a])] -> [(k, [a])] -> [(k, [a])]
ukvmerge ([(Pkt, [SignaturePayload])]
-> [(Pkt, [SignaturePayload])] -> [(Pkt, [SignaturePayload])])
-> (TK -> [(Pkt, [SignaturePayload])])
-> TK
-> TK
-> [(Pkt, [SignaturePayload])]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TK -> [(Pkt, [SignaturePayload])]
_tkSubs) TK
a TK
b)
where
kvmerge :: [(k, [a])] -> [(k, [a])] -> [(k, [a])]
kvmerge [(k, [a])]
x [(k, [a])]
y =
Map k [a] -> [(k, [a])]
forall k a. Map k a -> [(k, a)]
Map.toList (([a] -> [a] -> [a]) -> Map k [a] -> Map k [a] -> Map k [a]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [a] -> [a] -> [a]
forall {a}. Ord a => [a] -> [a] -> [a]
nsa ([(k, [a])] -> Map k [a]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(k, [a])]
x) ([(k, [a])] -> Map k [a]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(k, [a])]
y))
ukvmerge :: [(k, [a])] -> [(k, [a])] -> [(k, [a])]
ukvmerge [(k, [a])]
x [(k, [a])]
y =
HashMap k [a] -> [(k, [a])]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
(([a] -> [a] -> [a])
-> HashMap k [a] -> HashMap k [a] -> HashMap k [a]
forall k v.
Eq k =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith [a] -> [a] -> [a]
forall {a}. Ord a => [a] -> [a] -> [a]
nsa ([(k, [a])] -> HashMap k [a]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(k, [a])]
x) ([(k, [a])] -> HashMap k [a]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(k, [a])]
y))
nsa :: [a] -> [a] -> [a]
nsa [a]
x [a]
y = [a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
y