    -- Instances.hs: OpenPGP (RFC4880) additional types for transferable keys
    -- Copyright © 2012-2019  Clint Adams
    -- This software is released under the terms of the Expat license.
    -- (See the LICENSE file).
    {-# 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
    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
    biplate :: [PKPayload]))

    getTOFs :: TK -> [TwentyOctetFingerprint]
    getTOFs :: TK -> [TwentyOctetFingerprint]
    getTOFs tk :: 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
    biplate :: [PKPayload])

    getUIDs :: TK -> [Text]
    getUIDs :: TK -> [Text]
    getUIDs tk :: 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
    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
    _1

    instance Ord SignaturePayload where
      compare :: SignaturePayload -> SignaturePayload -> Ordering
    compare s1 :: SignaturePayload
    s1@(SigV3 st1 :: SigType
    st1 ct1 :: ThirtyTwoBitTimeStamp
    ct1 eoki1 :: EightOctetKeyId
    eoki1 pka1 :: PubKeyAlgorithm
    pka1 ha1 :: HashAlgorithm
    ha1 left16_1 :: Word16
    left16_1 mpis1 :: NonEmpty MPI
    mpis1) s2 :: SignaturePayload
    s2@(SigV3 st2 :: SigType
    st2 ct2 :: ThirtyTwoBitTimeStamp
    ct2 eoki2 :: EightOctetKeyId
    eoki2 pka2 :: PubKeyAlgorithm
    pka2 ha2 :: HashAlgorithm
    ha2 left16_2 :: Word16
    left16_2 mpis2 :: 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 -- FIXME: nondeterministic
      compare s1 :: SignaturePayload
    s1@(SigV4 st1 :: SigType
    st1 pka1 :: PubKeyAlgorithm
    pka1 ha1 :: HashAlgorithm
    ha1 has1 :: [SigSubPacket]
    has1 uhas1 :: [SigSubPacket]
    uhas1 left16_1 :: Word16
    left16_1 mpis1 :: NonEmpty MPI
    mpis1) s2 :: SignaturePayload
    s2@(SigV4 st2 :: SigType
    st2 pka2 :: PubKeyAlgorithm
    pka2 ha2 :: HashAlgorithm
    ha2 has2 :: [SigSubPacket]
    has2 uhas2 :: [SigSubPacket]
    uhas2 left16_2 :: Word16
    left16_2 mpis2 :: 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)) -- FIXME: nondeterministic
      compare s1 :: SignaturePayload
    s1@(SigVOther sv1 :: Word8
    sv1 bs1 :: ByteString
    bs1) s2 :: SignaturePayload
    s2@(SigVOther sv2 :: Word8
    sv2 bs2 :: 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
    (<>) a :: TK
    a b :: 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 k a.
    (Hashable k, Ord a, Eq 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 x :: [(k, [a])]
    x y :: [(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 x :: [(k, [a])]
    x y :: [(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, Hashable 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 x :: [a]
    x y :: [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