{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
module Codec.Encryption.OpenPGP.Types.Internal.PKITypes where
import GHC.Generics (Generic)
import Codec.Encryption.OpenPGP.Types.Internal.Base
import Codec.Encryption.OpenPGP.Types.Internal.CryptoniteNewtypes
import qualified Data.Aeson as A
import qualified Data.Aeson.TH as ATH
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Data (Data)
import Data.Hashable (Hashable(..))
import Data.Monoid ((<>))
import Data.Ord (comparing)
import Data.Typeable (Typeable)
import Data.Word (Word16)
import Text.PrettyPrint.Free (Pretty(..), (<+>), text)
data PKey = RSAPubKey RSA_PublicKey
| DSAPubKey DSA_PublicKey
| ElGamalPubKey Integer Integer Integer
| ECDHPubKey ECDSA_PublicKey HashAlgorithm SymmetricAlgorithm
| ECDSAPubKey ECDSA_PublicKey
| UnknownPKey ByteString
deriving (Data, Eq, Generic, Ord, Show, Typeable)
instance Hashable PKey
instance Pretty PKey where
pretty (RSAPubKey p) = text "RSA" <+> pretty p
pretty (DSAPubKey p) = text "DSA" <+> pretty p
pretty (ElGamalPubKey p g y) = text "Elgamal" <+> pretty p <+> pretty g <+> pretty y
pretty (ECDHPubKey p ha sa) = text "ECDH" <+> pretty p <+> pretty ha <+> pretty sa
pretty (ECDSAPubKey p) = text "ECDSA" <+> pretty p
pretty (UnknownPKey bs) = text "<unknown>" <+> pretty (bsToHexUpper bs)
instance A.ToJSON PKey where
toJSON (RSAPubKey p) = A.toJSON p
toJSON (DSAPubKey p) = A.toJSON p
toJSON (ElGamalPubKey p g y) = A.toJSON (p, g, y)
toJSON (ECDHPubKey p ha sa) = A.toJSON (p, ha, sa)
toJSON (ECDSAPubKey p) = A.toJSON p
toJSON (UnknownPKey bs) = A.toJSON (BL.unpack bs)
data SKey = RSAPrivateKey RSA_PrivateKey
| DSAPrivateKey DSA_PrivateKey
| ElGamalPrivateKey Integer
| ECDHPrivateKey ECDSA_PrivateKey
| ECDSAPrivateKey ECDSA_PrivateKey
| UnknownSKey ByteString
deriving (Data, Eq, Generic, Show, Typeable)
instance Hashable SKey
instance Pretty SKey where
pretty (RSAPrivateKey p) = text "RSA" <+> pretty p
pretty (DSAPrivateKey p) = text "DSA" <+> pretty p
pretty (ElGamalPrivateKey p) = text "Elgamal" <+> pretty p
pretty (ECDHPrivateKey p) = text "ECDH" <+> pretty p
pretty (ECDSAPrivateKey p) = text "ECDSA" <+> pretty p
pretty (UnknownSKey bs) = text "<unknown>" <+> pretty (bsToHexUpper bs)
instance A.ToJSON SKey where
toJSON (RSAPrivateKey k) = A.toJSON k
toJSON (DSAPrivateKey k) = A.toJSON k
toJSON (ElGamalPrivateKey k) = A.toJSON k
toJSON (ECDHPrivateKey k) = A.toJSON k
toJSON (ECDSAPrivateKey k) = A.toJSON k
toJSON (UnknownSKey bs) = A.toJSON (BL.unpack bs)
data PKPayload = PKPayload {
_keyVersion :: KeyVersion
, _timestamp :: ThirtyTwoBitTimeStamp
, _v3exp :: V3Expiration
, _pkalgo :: PubKeyAlgorithm
, _pubkey :: PKey
} deriving (Data, Eq, Generic, Show, Typeable)
instance Ord PKPayload where
compare = comparing _keyVersion <> comparing _timestamp <> comparing _v3exp <> comparing _pkalgo <> comparing _pubkey
instance Hashable PKPayload
instance Pretty PKPayload where
pretty (PKPayload kv ts v3e pka p) = pretty kv <+> pretty ts <+> pretty v3e <+> pretty pka <+> pretty p
$(ATH.deriveToJSON ATH.defaultOptions ''PKPayload)
data SKAddendum = SUS16bit SymmetricAlgorithm S2K IV ByteString
| SUSSHA1 SymmetricAlgorithm S2K IV ByteString
| SUSym SymmetricAlgorithm IV ByteString
| SUUnencrypted SKey Word16
deriving (Data, Eq, Generic, Show, Typeable)
instance Ord SKAddendum where
compare a b = show a `compare` show b
instance Hashable SKAddendum
instance Pretty SKAddendum where
pretty (SUS16bit sa s2k iv bs) = text "SUS16bit" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)
pretty (SUSSHA1 sa s2k iv bs) = text "SUSSHA1" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)
pretty (SUSym sa iv bs) = text "SUSym" <+> pretty sa <+> pretty iv <+> pretty (bsToHexUpper bs)
pretty (SUUnencrypted s ck) = text "SUUnencrypted" <+> pretty s <+> pretty ck
instance A.ToJSON SKAddendum where
toJSON (SUS16bit sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs)
toJSON (SUSSHA1 sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs)
toJSON (SUSym sa iv bs) = A.toJSON (sa, iv, BL.unpack bs)
toJSON (SUUnencrypted s ck) = A.toJSON (s, ck)