{-# 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, 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(..), ixList, ixFun)
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
(ixFun getEOKIs)
(ixFun getTOFs)
(ixFun getUIDs)
getEOKIs :: TK -> [EightOctetKeyId]
getEOKIs tk = rights (map eightOctetKeyID (tk ^.. biplate :: [PKPayload]))
getTOFs :: TK -> [TwentyOctetFingerprint]
getTOFs tk = map fingerprint (tk ^.. biplate :: [PKPayload])
getUIDs :: TK -> [Text]
getUIDs tk = (tk^.tkUIDs)^..folded._1
instance Ord SignaturePayload where
compare s1@(SigV3 st1 ct1 eoki1 pka1 ha1 left16_1 mpis1) s2@(SigV3 st2 ct2 eoki2 pka2 ha2 left16_2 mpis2) = compare ct1 ct2 <> compare st1 st2 <> compare eoki1 eoki2
compare s1@(SigV4 st1 pka1 ha1 has1 uhas1 left16_1 mpis1) s2@(SigV4 st2 pka2 ha2 has2 uhas2 left16_2 mpis2) = compare (sigCT s1) (sigCT s2) <> compare st1 st2 <> compare (issuer (SignaturePkt s1)) (issuer (SignaturePkt s2))
compare s1@(SigVOther sv1 bs1) s2@(SigVOther sv2 bs2) = compare sv1 sv2 <> compare bs1 bs2
compare SigV3{} SigV4{} = LT
compare SigV3{} SigVOther{} = LT
compare SigV4{} SigV3{} = GT
compare SigV4{} SigVOther{} = LT
compare SigVOther{} SigV3{} = GT
compare SigVOther{} SigV4{} = GT
instance Semigroup TK where
(<>) a b = TK (_tkKey a)
(nub . sort $ _tkRevs a ++ _tkRevs b)
((kvmerge `on` _tkUIDs) a b)
((kvmerge `on` _tkUAts) a b)
((ukvmerge `on` _tkSubs) a b)
where
kvmerge x y = Map.toList (Map.unionWith nsa (Map.fromList x) (Map.fromList y))
ukvmerge x y = HashMap.toList (HashMap.unionWith nsa (HashMap.fromList x) (HashMap.fromList y))
nsa x y = nub . sort $ x ++ y