{-# 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 qualified Data.ByteString as B
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.Text.Prettyprint.Doc (Pretty(..), (<+>))
import Data.Typeable (Typeable)
import Data.Word (Word16)
data EdSigningCurve =
Ed25519
deriving (Data, Eq, Generic, Ord, Show, Typeable)
instance Hashable EdSigningCurve
instance Pretty EdSigningCurve where
pretty Ed25519 = pretty "Ed25519"
instance A.FromJSON EdSigningCurve
instance A.ToJSON EdSigningCurve
newtype EPoint =
EPoint
{ unEPoint :: Integer
}
deriving (Data, Eq, Generic, Ord, Pretty, Show, Typeable)
instance Hashable EPoint
instance A.FromJSON EPoint
instance A.ToJSON EPoint
data PKey
= RSAPubKey RSA_PublicKey
| DSAPubKey DSA_PublicKey
| ElGamalPubKey Integer Integer Integer
| ECDHPubKey PKey HashAlgorithm SymmetricAlgorithm
| ECDSAPubKey ECDSA_PublicKey
| EdDSAPubKey EdSigningCurve EPoint
| UnknownPKey ByteString
deriving (Data, Eq, Generic, Ord, Show, Typeable)
instance Hashable PKey
instance Pretty PKey where
pretty (RSAPubKey p) = pretty "RSA" <+> pretty p
pretty (DSAPubKey p) = pretty "DSA" <+> pretty p
pretty (ElGamalPubKey p g y) =
pretty "Elgamal" <+> pretty p <+> pretty g <+> pretty y
pretty (ECDHPubKey p ha sa) =
pretty "ECDH" <+> pretty p <+> pretty ha <+> pretty sa
pretty (ECDSAPubKey p) = pretty "ECDSA" <+> pretty p
pretty (EdDSAPubKey c ep) = pretty c <+> pretty ep
pretty (UnknownPKey bs) = pretty "<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 (EdDSAPubKey c ep) = A.toJSON (c, ep)
toJSON (UnknownPKey bs) = A.toJSON (BL.unpack bs)
data SKey
= RSAPrivateKey RSA_PrivateKey
| DSAPrivateKey DSA_PrivateKey
| ElGamalPrivateKey Integer
| ECDHPrivateKey ECDSA_PrivateKey
| ECDSAPrivateKey ECDSA_PrivateKey
| EdDSAPrivateKey EdSigningCurve B.ByteString
| UnknownSKey ByteString
deriving (Data, Eq, Generic, Show, Typeable)
instance Hashable SKey
instance Pretty SKey where
pretty (RSAPrivateKey p) = pretty "RSA" <+> pretty p
pretty (DSAPrivateKey p) = pretty "DSA" <+> pretty p
pretty (ElGamalPrivateKey p) = pretty "Elgamal" <+> pretty p
pretty (ECDHPrivateKey p) = pretty "ECDH" <+> pretty p
pretty (ECDSAPrivateKey p) = pretty "ECDSA" <+> pretty p
pretty (EdDSAPrivateKey c bs) =
pretty c <+> pretty (bsToHexUpper (BL.fromStrict bs))
pretty (UnknownSKey bs) = pretty "<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 (EdDSAPrivateKey c bs) = A.toJSON (c, B.unpack bs)
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) =
pretty "SUS16bit" <+>
pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)
pretty (SUSSHA1 sa s2k iv bs) =
pretty "SUSSHA1" <+>
pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)
pretty (SUSym sa iv bs) =
pretty "SUSym" <+> pretty sa <+> pretty iv <+> pretty (bsToHexUpper bs)
pretty (SUUnencrypted s ck) =
pretty "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)