-- TK.hs: OpenPGP (RFC4880) transferable key data type
-- Copyright © 2012-2016  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}

module Codec.Encryption.OpenPGP.Types.Internal.TK where

import GHC.Generics (Generic)

import Codec.Encryption.OpenPGP.Types.Internal.Base
import Codec.Encryption.OpenPGP.Types.Internal.PKITypes
import Codec.Encryption.OpenPGP.Types.Internal.Pkt

import Control.Lens (makeLenses)
import qualified Data.Aeson as A
import qualified Data.Aeson.TH as ATH
import Data.Data (Data)
import Data.IxSet.Typed (IxSet)
import Data.Ord (comparing)
import Data.Text (Text)
import Data.Typeable (Typeable)

data TK = TK {
    _tkKey  :: (PKPayload, Maybe SKAddendum)
  , _tkRevs :: [SignaturePayload]
  , _tkUIDs :: [(Text, [SignaturePayload])]
  , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])]
  , _tkSubs :: [(Pkt, [SignaturePayload])]
  } deriving (Data, Eq, Generic, Show, Typeable)

instance Ord TK where
    compare = comparing _tkKey -- FIXME: is this ridiculous?

$(ATH.deriveToJSON ATH.defaultOptions ''TK)

type KeyringIxs = '[EightOctetKeyId, TwentyOctetFingerprint, Text]
type Keyring = IxSet KeyringIxs TK

$(makeLenses ''TK)