-- |
-- Module      : Data.X509.PublicKey
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Public key handling in X.509 infrastructure
--
module Data.X509.PublicKey
    ( PubKey(..)
    , PubKeyEC(..)
    , SerializedPoint(..)
    , pubkeyToAlg
    ) where

import Data.ASN1.Types
import Data.ASN1.Encoding
import Data.ASN1.BinaryEncoding
import Data.ASN1.BitArray

import Data.Bits
import Data.ByteArray (convert)
import Data.ByteString (ByteString)

import Data.X509.Internal
import Data.X509.OID
import Data.X509.AlgorithmIdentifier

import Crypto.Error (CryptoFailable(..))
import qualified Crypto.PubKey.RSA.Types as RSA
import qualified Crypto.PubKey.DSA       as DSA
import qualified Crypto.PubKey.ECC.Types as ECC
import qualified Crypto.PubKey.Curve25519 as X25519
import qualified Crypto.PubKey.Curve448   as X448
import qualified Crypto.PubKey.Ed25519    as Ed25519
import qualified Crypto.PubKey.Ed448      as Ed448
import           Crypto.Number.Serialize (os2ip)
import Data.Word

import qualified Data.ByteString as B

-- | Serialized Elliptic Curve Point
newtype SerializedPoint = SerializedPoint ByteString
    deriving (Int -> SerializedPoint -> ShowS
[SerializedPoint] -> ShowS
SerializedPoint -> String
(Int -> SerializedPoint -> ShowS)
-> (SerializedPoint -> String)
-> ([SerializedPoint] -> ShowS)
-> Show SerializedPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SerializedPoint] -> ShowS
$cshowList :: [SerializedPoint] -> ShowS
show :: SerializedPoint -> String
$cshow :: SerializedPoint -> String
showsPrec :: Int -> SerializedPoint -> ShowS
$cshowsPrec :: Int -> SerializedPoint -> ShowS
Show,SerializedPoint -> SerializedPoint -> Bool
(SerializedPoint -> SerializedPoint -> Bool)
-> (SerializedPoint -> SerializedPoint -> Bool)
-> Eq SerializedPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SerializedPoint -> SerializedPoint -> Bool
$c/= :: SerializedPoint -> SerializedPoint -> Bool
== :: SerializedPoint -> SerializedPoint -> Bool
$c== :: SerializedPoint -> SerializedPoint -> Bool
Eq)

-- | Elliptic Curve Public Key
--
-- TODO: missing support for binary curve.
data PubKeyEC =
      PubKeyEC_Prime
        { PubKeyEC -> SerializedPoint
pubkeyEC_pub       :: SerializedPoint
        , PubKeyEC -> Integer
pubkeyEC_a         :: Integer
        , PubKeyEC -> Integer
pubkeyEC_b         :: Integer
        , PubKeyEC -> Integer
pubkeyEC_prime     :: Integer
        , PubKeyEC -> SerializedPoint
pubkeyEC_generator :: SerializedPoint
        , PubKeyEC -> Integer
pubkeyEC_order     :: Integer
        , PubKeyEC -> Integer
pubkeyEC_cofactor  :: Integer
        , PubKeyEC -> Integer
pubkeyEC_seed      :: Integer
        }
    | PubKeyEC_Named
        { PubKeyEC -> CurveName
pubkeyEC_name      :: ECC.CurveName
        , pubkeyEC_pub       :: SerializedPoint
        }
    deriving (Int -> PubKeyEC -> ShowS
[PubKeyEC] -> ShowS
PubKeyEC -> String
(Int -> PubKeyEC -> ShowS)
-> (PubKeyEC -> String) -> ([PubKeyEC] -> ShowS) -> Show PubKeyEC
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PubKeyEC] -> ShowS
$cshowList :: [PubKeyEC] -> ShowS
show :: PubKeyEC -> String
$cshow :: PubKeyEC -> String
showsPrec :: Int -> PubKeyEC -> ShowS
$cshowsPrec :: Int -> PubKeyEC -> ShowS
Show,PubKeyEC -> PubKeyEC -> Bool
(PubKeyEC -> PubKeyEC -> Bool)
-> (PubKeyEC -> PubKeyEC -> Bool) -> Eq PubKeyEC
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubKeyEC -> PubKeyEC -> Bool
$c/= :: PubKeyEC -> PubKeyEC -> Bool
== :: PubKeyEC -> PubKeyEC -> Bool
$c== :: PubKeyEC -> PubKeyEC -> Bool
Eq)

-- | Public key types known and used in X.509
data PubKey =
      PubKeyRSA RSA.PublicKey -- ^ RSA public key
    | PubKeyDSA DSA.PublicKey -- ^ DSA public key
    | PubKeyDH (Integer,Integer,Integer,Maybe Integer,([Word8], Integer))
                                -- ^ DH format with (p,g,q,j,(seed,pgenCounter))
    | PubKeyEC PubKeyEC       -- ^ EC public key
    | PubKeyX25519    X25519.PublicKey    -- ^ X25519 public key
    | PubKeyX448      X448.PublicKey      -- ^ X448 public key
    | PubKeyEd25519   Ed25519.PublicKey   -- ^ Ed25519 public key
    | PubKeyEd448     Ed448.PublicKey     -- ^ Ed448 public key
    | PubKeyUnknown OID B.ByteString -- ^ unrecognized format
    deriving (Int -> PubKey -> ShowS
[PubKey] -> ShowS
PubKey -> String
(Int -> PubKey -> ShowS)
-> (PubKey -> String) -> ([PubKey] -> ShowS) -> Show PubKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PubKey] -> ShowS
$cshowList :: [PubKey] -> ShowS
show :: PubKey -> String
$cshow :: PubKey -> String
showsPrec :: Int -> PubKey -> ShowS
$cshowsPrec :: Int -> PubKey -> ShowS
Show,PubKey -> PubKey -> Bool
(PubKey -> PubKey -> Bool)
-> (PubKey -> PubKey -> Bool) -> Eq PubKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubKey -> PubKey -> Bool
$c/= :: PubKey -> PubKey -> Bool
== :: PubKey -> PubKey -> Bool
$c== :: PubKey -> PubKey -> Bool
Eq)

-- Public key are in the format:
--
-- Start Sequence
--      OID (Public key algorithm)
--      [public key specific format]
--      BitString
-- End Sequence
instance ASN1Object PubKey where
    fromASN1 :: [ASN1] -> Either String (PubKey, [ASN1])
fromASN1 (Start ASN1ConstructionType
Sequence:Start ASN1ConstructionType
Sequence:OID OID
pkalg:[ASN1]
xs)
        | OID
pkalg OID -> OID -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyALG -> OID
forall a. OIDable a => a -> OID
getObjectID PubKeyALG
PubKeyALG_RSA =
            case ASN1S
removeNull [ASN1]
xs of
                End ASN1ConstructionType
Sequence:BitString BitArray
bits:End ASN1ConstructionType
Sequence:[ASN1]
xs2 -> String
-> BitArray
-> [ASN1]
-> ([ASN1] -> Either String (PubKey, [ASN1]))
-> Either String (PubKey, [ASN1])
forall a a.
String
-> BitArray
-> [a]
-> ([ASN1] -> Either String (a, [a]))
-> Either String (a, [a])
decodeASN1Err String
"RSA" BitArray
bits [ASN1]
xs2 (Either String (PublicKey, [ASN1]) -> Either String (PubKey, [ASN1])
forall a b. Either a (PublicKey, b) -> Either a (PubKey, b)
toPubKeyRSA (Either String (PublicKey, [ASN1])
 -> Either String (PubKey, [ASN1]))
-> ([ASN1] -> Either String (PublicKey, [ASN1]))
-> [ASN1]
-> Either String (PubKey, [ASN1])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ASN1] -> Either String (PublicKey, [ASN1])
rsaPubFromASN1)
                [ASN1]
_ -> String -> Either String (PubKey, [ASN1])
forall a b. a -> Either a b
Left (String
"fromASN1: X509.PubKey: unknown RSA format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
forall a. Show a => a -> String
show [ASN1]
xs)
        | OID
pkalg OID -> OID -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyALG -> OID
forall a. OIDable a => a -> OID
getObjectID PubKeyALG
PubKeyALG_DSA   =
            case [ASN1]
xs of
                Start ASN1ConstructionType
Sequence:IntVal Integer
p:IntVal Integer
q:IntVal Integer
g:End ASN1ConstructionType
Sequence:End ASN1ConstructionType
Sequence:BitString BitArray
bits:End ASN1ConstructionType
Sequence:[ASN1]
xs2 ->
                    String
-> BitArray
-> [ASN1]
-> ([ASN1] -> Either String (PubKey, [ASN1]))
-> Either String (PubKey, [ASN1])
forall a a.
String
-> BitArray
-> [a]
-> ([ASN1] -> Either String (a, [a]))
-> Either String (a, [a])
decodeASN1Err String
"DSA" BitArray
bits [ASN1]
xs2 (\[ASN1]
l -> case [ASN1]
l of
                        [IntVal Integer
dsapub] ->
                            let pubkey :: PublicKey
pubkey = PublicKey :: Params -> Integer -> PublicKey
DSA.PublicKey { public_params :: Params
DSA.public_params = Params :: Integer -> Integer -> Integer -> Params
DSA.Params { params_p :: Integer
DSA.params_p = Integer
p
                                                                                        , params_q :: Integer
DSA.params_q = Integer
q
                                                                                        , params_g :: Integer
DSA.params_g = Integer
g
                                                                                        }
                                                                           , public_y :: Integer
DSA.public_y = Integer
dsapub }
                             in (PubKey, [ASN1]) -> Either String (PubKey, [ASN1])
forall a b. b -> Either a b
Right (PublicKey -> PubKey
PubKeyDSA PublicKey
pubkey, [])
                        [ASN1]
_ -> String -> Either String (PubKey, [ASN1])
forall a b. a -> Either a b
Left String
"fromASN1: X509.PubKey: unknown DSA format"
                        )
                [ASN1]
_ -> String -> Either String (PubKey, [ASN1])
forall a b. a -> Either a b
Left String
"fromASN1: X509.PubKey: unknown DSA format"
        | OID
pkalg OID -> OID -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyALG -> OID
forall a. OIDable a => a -> OID
getObjectID PubKeyALG
PubKeyALG_EC =
            case [ASN1]
xs of
                OID OID
curveOid:End ASN1ConstructionType
Sequence:BitString BitArray
bits:End ASN1ConstructionType
Sequence:[ASN1]
xs2 ->
                    case OIDTable CurveName -> OID -> Maybe CurveName
forall a. OIDTable a -> OID -> Maybe a
lookupByOID OIDTable CurveName
curvesOIDTable OID
curveOid of
                        Just CurveName
curveName -> (PubKey, [ASN1]) -> Either String (PubKey, [ASN1])
forall a b. b -> Either a b
Right (PubKeyEC -> PubKey
PubKeyEC (PubKeyEC -> PubKey) -> PubKeyEC -> PubKey
forall a b. (a -> b) -> a -> b
$ CurveName -> SerializedPoint -> PubKeyEC
PubKeyEC_Named CurveName
curveName (BitArray -> SerializedPoint
bitArrayToPoint BitArray
bits), [ASN1]
xs2)
                        Maybe CurveName
Nothing        -> String -> Either String (PubKey, [ASN1])
forall a b. a -> Either a b
Left (String
"fromASN1: X509.Pubkey: EC unknown curve " String -> ShowS
forall a. [a] -> [a] -> [a]
++ OID -> String
forall a. Show a => a -> String
show OID
curveOid)
                Start ASN1ConstructionType
Sequence
                    :IntVal Integer
1
                    :Start ASN1ConstructionType
Sequence
                    :OID [Integer
1,Integer
2,Integer
840,Integer
10045,Integer
1,Integer
1]
                    :IntVal Integer
prime
                    :End ASN1ConstructionType
Sequence
                    :Start ASN1ConstructionType
Sequence
                    :OctetString ByteString
a
                    :OctetString ByteString
b
                    :BitString BitArray
seed
                    :End ASN1ConstructionType
Sequence
                    :OctetString ByteString
generator
                    :IntVal Integer
order
                    :IntVal Integer
cofactor
                    :End ASN1ConstructionType
Sequence
                    :End ASN1ConstructionType
Sequence
                    :BitString BitArray
pub
                    :End ASN1ConstructionType
Sequence
                    :[ASN1]
xs2 ->
                    (PubKey, [ASN1]) -> Either String (PubKey, [ASN1])
forall a b. b -> Either a b
Right (PubKeyEC -> PubKey
PubKeyEC (PubKeyEC -> PubKey) -> PubKeyEC -> PubKey
forall a b. (a -> b) -> a -> b
$ PubKeyEC_Prime :: SerializedPoint
-> Integer
-> Integer
-> Integer
-> SerializedPoint
-> Integer
-> Integer
-> Integer
-> PubKeyEC
PubKeyEC_Prime
                        { pubkeyEC_pub :: SerializedPoint
pubkeyEC_pub       = BitArray -> SerializedPoint
bitArrayToPoint BitArray
pub
                        , pubkeyEC_a :: Integer
pubkeyEC_a         = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
a
                        , pubkeyEC_b :: Integer
pubkeyEC_b         = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
b
                        , pubkeyEC_prime :: Integer
pubkeyEC_prime     = Integer
prime
                        , pubkeyEC_generator :: SerializedPoint
pubkeyEC_generator = ByteString -> SerializedPoint
SerializedPoint ByteString
generator
                        , pubkeyEC_order :: Integer
pubkeyEC_order     = Integer
order
                        , pubkeyEC_cofactor :: Integer
pubkeyEC_cofactor  = Integer
cofactor
                        , pubkeyEC_seed :: Integer
pubkeyEC_seed      = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ BitArray -> ByteString
bitArrayGetData BitArray
seed
                        }, [ASN1]
xs2)
                [ASN1]
_ ->
                    String -> Either String (PubKey, [ASN1])
forall a b. a -> Either a b
Left (String -> Either String (PubKey, [ASN1]))
-> String -> Either String (PubKey, [ASN1])
forall a b. (a -> b) -> a -> b
$ String
"fromASN1: X509.PubKey: unknown EC format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
forall a. Show a => a -> String
show [ASN1]
xs
        | OID
pkalg OID -> OID -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyALG -> OID
forall a. OIDable a => a -> OID
getObjectID PubKeyALG
PubKeyALG_X25519    =
            case [ASN1]
xs of
                End ASN1ConstructionType
Sequence:BitString BitArray
bits:End ASN1ConstructionType
Sequence:[ASN1]
xs2 -> String
-> (PublicKey -> PubKey)
-> BitArray
-> [ASN1]
-> (ByteString -> CryptoFailable PublicKey)
-> Either String (PubKey, [ASN1])
forall t a b.
String
-> (t -> a)
-> BitArray
-> b
-> (ByteString -> CryptoFailable t)
-> Either String (a, b)
decodeCF String
"X25519" PublicKey -> PubKey
PubKeyX25519 BitArray
bits [ASN1]
xs2 ByteString -> CryptoFailable PublicKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable PublicKey
X25519.publicKey
                [ASN1]
_ -> String -> Either String (PubKey, [ASN1])
forall a b. a -> Either a b
Left (String
"fromASN1: X509.PubKey: unknown X25519 format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
forall a. Show a => a -> String
show [ASN1]
xs)
        | OID
pkalg OID -> OID -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyALG -> OID
forall a. OIDable a => a -> OID
getObjectID PubKeyALG
PubKeyALG_X448      =
            case [ASN1]
xs of
                End ASN1ConstructionType
Sequence:BitString BitArray
bits:End ASN1ConstructionType
Sequence:[ASN1]
xs2 -> String
-> (PublicKey -> PubKey)
-> BitArray
-> [ASN1]
-> (ByteString -> CryptoFailable PublicKey)
-> Either String (PubKey, [ASN1])
forall t a b.
String
-> (t -> a)
-> BitArray
-> b
-> (ByteString -> CryptoFailable t)
-> Either String (a, b)
decodeCF String
"X448" PublicKey -> PubKey
PubKeyX448 BitArray
bits [ASN1]
xs2 ByteString -> CryptoFailable PublicKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable PublicKey
X448.publicKey
                [ASN1]
_ -> String -> Either String (PubKey, [ASN1])
forall a b. a -> Either a b
Left (String
"fromASN1: X509.PubKey: unknown X448 format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
forall a. Show a => a -> String
show [ASN1]
xs)
        | OID
pkalg OID -> OID -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyALG -> OID
forall a. OIDable a => a -> OID
getObjectID PubKeyALG
PubKeyALG_Ed25519   =
            case [ASN1]
xs of
                End ASN1ConstructionType
Sequence:BitString BitArray
bits:End ASN1ConstructionType
Sequence:[ASN1]
xs2 -> String
-> (PublicKey -> PubKey)
-> BitArray
-> [ASN1]
-> (ByteString -> CryptoFailable PublicKey)
-> Either String (PubKey, [ASN1])
forall t a b.
String
-> (t -> a)
-> BitArray
-> b
-> (ByteString -> CryptoFailable t)
-> Either String (a, b)
decodeCF String
"Ed25519" PublicKey -> PubKey
PubKeyEd25519 BitArray
bits [ASN1]
xs2 ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey
                [ASN1]
_ -> String -> Either String (PubKey, [ASN1])
forall a b. a -> Either a b
Left (String
"fromASN1: X509.PubKey: unknown Ed25519 format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
forall a. Show a => a -> String
show [ASN1]
xs)
        | OID
pkalg OID -> OID -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyALG -> OID
forall a. OIDable a => a -> OID
getObjectID PubKeyALG
PubKeyALG_Ed448     =
            case [ASN1]
xs of
                End ASN1ConstructionType
Sequence:BitString BitArray
bits:End ASN1ConstructionType
Sequence:[ASN1]
xs2 -> String
-> (PublicKey -> PubKey)
-> BitArray
-> [ASN1]
-> (ByteString -> CryptoFailable PublicKey)
-> Either String (PubKey, [ASN1])
forall t a b.
String
-> (t -> a)
-> BitArray
-> b
-> (ByteString -> CryptoFailable t)
-> Either String (a, b)
decodeCF String
"Ed448" PublicKey -> PubKey
PubKeyEd448 BitArray
bits [ASN1]
xs2 ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed448.publicKey
                [ASN1]
_ -> String -> Either String (PubKey, [ASN1])
forall a b. a -> Either a b
Left (String
"fromASN1: X509.PubKey: unknown Ed448 format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
forall a. Show a => a -> String
show [ASN1]
xs)
        | Bool
otherwise = String -> Either String (PubKey, [ASN1])
forall a b. a -> Either a b
Left (String -> Either String (PubKey, [ASN1]))
-> String -> Either String (PubKey, [ASN1])
forall a b. (a -> b) -> a -> b
$ String
"fromASN1: unknown public key OID: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ OID -> String
forall a. Show a => a -> String
show OID
pkalg
      where decodeASN1Err :: String
-> BitArray
-> [a]
-> ([ASN1] -> Either String (a, [a]))
-> Either String (a, [a])
decodeASN1Err String
format BitArray
bits [a]
xs2 [ASN1] -> Either String (a, [a])
f =
                case BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER (BitArray -> ByteString
bitArrayGetData BitArray
bits) of
                    Left ASN1Error
err -> String -> Either String (a, [a])
forall a b. a -> Either a b
Left (String
"fromASN1: X509.PubKey " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
format String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" bitarray cannot be parsed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ASN1Error -> String
forall a. Show a => a -> String
show ASN1Error
err)
                    Right [ASN1]
s  -> case [ASN1] -> Either String (a, [a])
f [ASN1]
s of
                                    Left String
err -> String -> Either String (a, [a])
forall a b. a -> Either a b
Left String
err
                                    Right (a
r, [a]
xsinner) -> (a, [a]) -> Either String (a, [a])
forall a b. b -> Either a b
Right (a
r, [a]
xsinner [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs2)
            toPubKeyRSA :: Either a (PublicKey, b) -> Either a (PubKey, b)
toPubKeyRSA = (a -> Either a (PubKey, b))
-> ((PublicKey, b) -> Either a (PubKey, b))
-> Either a (PublicKey, b)
-> Either a (PubKey, b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either a (PubKey, b)
forall a b. a -> Either a b
Left (\(PublicKey
rsaKey, b
r) -> (PubKey, b) -> Either a (PubKey, b)
forall a b. b -> Either a b
Right (PublicKey -> PubKey
PubKeyRSA PublicKey
rsaKey, b
r))

            bitArrayToPoint :: BitArray -> SerializedPoint
bitArrayToPoint = ByteString -> SerializedPoint
SerializedPoint (ByteString -> SerializedPoint)
-> (BitArray -> ByteString) -> BitArray -> SerializedPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitArray -> ByteString
bitArrayGetData

            removeNull :: ASN1S
removeNull (ASN1
Null:[ASN1]
r) = [ASN1]
r
            removeNull [ASN1]
l        = [ASN1]
l

            decodeCF :: String
-> (t -> a)
-> BitArray
-> b
-> (ByteString -> CryptoFailable t)
-> Either String (a, b)
decodeCF String
format t -> a
c BitArray
bits b
xs2 ByteString -> CryptoFailable t
f = case ByteString -> CryptoFailable t
f (BitArray -> ByteString
bitArrayGetData BitArray
bits) of
                CryptoPassed t
pk  -> (a, b) -> Either String (a, b)
forall a b. b -> Either a b
Right (t -> a
c t
pk, b
xs2)
                CryptoFailed CryptoError
err -> String -> Either String (a, b)
forall a b. a -> Either a b
Left (String
"fromASN1: X509.PubKey " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
format String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" bitarray contains an invalid public key: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
err)

    fromASN1 [ASN1]
l = String -> Either String (PubKey, [ASN1])
forall a b. a -> Either a b
Left (String
"fromASN1: X509.PubKey: unknown format:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
forall a. Show a => a -> String
show [ASN1]
l)
    toASN1 :: PubKey -> ASN1S
toASN1 PubKey
a = \[ASN1]
xs -> PubKey -> [ASN1]
encodePK PubKey
a [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [ASN1]
xs

-- | Convert a Public key to the Public Key Algorithm type
pubkeyToAlg :: PubKey -> PubKeyALG
pubkeyToAlg :: PubKey -> PubKeyALG
pubkeyToAlg (PubKeyRSA PublicKey
_)         = PubKeyALG
PubKeyALG_RSA
pubkeyToAlg (PubKeyDSA PublicKey
_)         = PubKeyALG
PubKeyALG_DSA
pubkeyToAlg (PubKeyDH (Integer, Integer, Integer, Maybe Integer, ([Word8], Integer))
_)          = PubKeyALG
PubKeyALG_DH
pubkeyToAlg (PubKeyEC PubKeyEC
_)          = PubKeyALG
PubKeyALG_EC
pubkeyToAlg (PubKeyX25519 PublicKey
_)      = PubKeyALG
PubKeyALG_X25519
pubkeyToAlg (PubKeyX448 PublicKey
_)        = PubKeyALG
PubKeyALG_X448
pubkeyToAlg (PubKeyEd25519 PublicKey
_)     = PubKeyALG
PubKeyALG_Ed25519
pubkeyToAlg (PubKeyEd448 PublicKey
_)       = PubKeyALG
PubKeyALG_Ed448
pubkeyToAlg (PubKeyUnknown OID
oid ByteString
_) = OID -> PubKeyALG
PubKeyALG_Unknown OID
oid

encodePK :: PubKey -> [ASN1]
encodePK :: PubKey -> [ASN1]
encodePK PubKey
key = ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence (PubKey -> [ASN1]
encodeInner PubKey
key)
  where
    pkalg :: ASN1
pkalg = OID -> ASN1
OID (OID -> ASN1) -> OID -> ASN1
forall a b. (a -> b) -> a -> b
$ PubKeyALG -> OID
forall a. OIDable a => a -> OID
getObjectID (PubKeyALG -> OID) -> PubKeyALG -> OID
forall a b. (a -> b) -> a -> b
$ PubKey -> PubKeyALG
pubkeyToAlg PubKey
key
    encodeInner :: PubKey -> [ASN1]
encodeInner (PubKeyRSA PublicKey
pubkey) =
        ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence [ASN1
pkalg,ASN1
Null] [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [BitArray -> ASN1
BitString (BitArray -> ASN1) -> BitArray -> ASN1
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> BitArray
toBitArray ByteString
bits Int
0]
      where bits :: ByteString
bits = DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1' DER
DER ([ASN1] -> ByteString) -> [ASN1] -> ByteString
forall a b. (a -> b) -> a -> b
$ PublicKey -> ASN1S
rsaPubToASN1 PublicKey
pubkey []
    encodeInner (PubKeyDSA PublicKey
pubkey) =
        ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence ([ASN1
pkalg] [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [ASN1]
dsaseq) [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [BitArray -> ASN1
BitString (BitArray -> ASN1) -> BitArray -> ASN1
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> BitArray
toBitArray ByteString
bits Int
0]
      where
        dsaseq :: [ASN1]
dsaseq = ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence [Integer -> ASN1
IntVal (Params -> Integer
DSA.params_p Params
params)
                                        ,Integer -> ASN1
IntVal (Params -> Integer
DSA.params_q Params
params)
                                        ,Integer -> ASN1
IntVal (Params -> Integer
DSA.params_g Params
params)]
        params :: Params
params = PublicKey -> Params
DSA.public_params PublicKey
pubkey
        bits :: ByteString
bits   = DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1' DER
DER [Integer -> ASN1
IntVal (Integer -> ASN1) -> Integer -> ASN1
forall a b. (a -> b) -> a -> b
$ PublicKey -> Integer
DSA.public_y PublicKey
pubkey]
    encodeInner (PubKeyEC (PubKeyEC_Named CurveName
curveName (SerializedPoint ByteString
bits))) =
        ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence [ASN1
pkalg,OID -> ASN1
OID OID
eOid] [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [BitArray -> ASN1
BitString (BitArray -> ASN1) -> BitArray -> ASN1
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> BitArray
toBitArray ByteString
bits Int
0]
      where
        eOid :: OID
eOid = case OIDTable CurveName -> CurveName -> Maybe OID
forall a. Eq a => OIDTable a -> a -> Maybe OID
lookupOID OIDTable CurveName
curvesOIDTable CurveName
curveName of
                    Just OID
oid -> OID
oid
                    Maybe OID
_        -> String -> OID
forall a. HasCallStack => String -> a
error (String
"undefined curve OID: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CurveName -> String
forall a. Show a => a -> String
show CurveName
curveName)
    encodeInner (PubKeyEC (PubKeyEC_Prime {})) =
        String -> [ASN1]
forall a. HasCallStack => String -> a
error String
"encodeInner: unimplemented public key EC_Prime"
    encodeInner (PubKeyX25519   PublicKey
pubkey)  =
        ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence [ASN1
pkalg] [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [BitArray -> ASN1
BitString (BitArray -> ASN1) -> BitArray -> ASN1
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> BitArray
toBitArray (PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert PublicKey
pubkey) Int
0]
    encodeInner (PubKeyX448     PublicKey
pubkey)  =
        ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence [ASN1
pkalg] [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [BitArray -> ASN1
BitString (BitArray -> ASN1) -> BitArray -> ASN1
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> BitArray
toBitArray (PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert PublicKey
pubkey) Int
0]
    encodeInner (PubKeyEd25519   PublicKey
pubkey) =
        ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence [ASN1
pkalg] [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [BitArray -> ASN1
BitString (BitArray -> ASN1) -> BitArray -> ASN1
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> BitArray
toBitArray (PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert PublicKey
pubkey) Int
0]
    encodeInner (PubKeyEd448     PublicKey
pubkey) =
        ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence [ASN1
pkalg] [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [BitArray -> ASN1
BitString (BitArray -> ASN1) -> BitArray -> ASN1
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> BitArray
toBitArray (PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert PublicKey
pubkey) Int
0]
    encodeInner (PubKeyDH (Integer, Integer, Integer, Maybe Integer, ([Word8], Integer))
_) = String -> [ASN1]
forall a. HasCallStack => String -> a
error String
"encodeInner: unimplemented public key DH"
    encodeInner (PubKeyUnknown OID
_ ByteString
l) =
        ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence [ASN1
pkalg,ASN1
Null] [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [BitArray -> ASN1
BitString (BitArray -> ASN1) -> BitArray -> ASN1
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> BitArray
toBitArray ByteString
l Int
0]

rsaPubToASN1 :: RSA.PublicKey -> [ASN1] -> [ASN1]
rsaPubToASN1 :: PublicKey -> ASN1S
rsaPubToASN1 PublicKey
pubkey [ASN1]
xs =
    ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence ASN1 -> ASN1S
forall a. a -> [a] -> [a]
: Integer -> ASN1
IntVal (PublicKey -> Integer
RSA.public_n PublicKey
pubkey) ASN1 -> ASN1S
forall a. a -> [a] -> [a]
: Integer -> ASN1
IntVal (PublicKey -> Integer
RSA.public_e PublicKey
pubkey) ASN1 -> ASN1S
forall a. a -> [a] -> [a]
: ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence ASN1 -> ASN1S
forall a. a -> [a] -> [a]
: [ASN1]
xs

rsaPubFromASN1 :: [ASN1] -> Either String (RSA.PublicKey, [ASN1])
rsaPubFromASN1 :: [ASN1] -> Either String (PublicKey, [ASN1])
rsaPubFromASN1 (Start ASN1ConstructionType
Sequence:IntVal Integer
smodulus:IntVal Integer
pubexp:End ASN1ConstructionType
Sequence:[ASN1]
xs) =
    (PublicKey, [ASN1]) -> Either String (PublicKey, [ASN1])
forall a b. b -> Either a b
Right (PublicKey
pub, [ASN1]
xs)
  where
    pub :: PublicKey
pub = PublicKey :: Int -> Integer -> Integer -> PublicKey
RSA.PublicKey { public_size :: Int
RSA.public_size = Integer -> Int -> Int
forall t t. (Integral t, Num t, Ord t) => t -> t -> t
calculate_modulus Integer
modulus Int
1
                        , public_n :: Integer
RSA.public_n    = Integer
modulus
                        , public_e :: Integer
RSA.public_e    = Integer
pubexp
                        }
    calculate_modulus :: t -> t -> t
calculate_modulus t
n t
i = if (t
2 t -> t -> t
forall a b. (Num a, Integral b) => a -> b -> a
^ (t
i t -> t -> t
forall a. Num a => a -> a -> a
* t
8)) t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
n then t
i else t -> t -> t
calculate_modulus t
n (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1)
    -- some bad implementation will not serialize ASN.1 integer properly, leading
    -- to negative modulus. if that's the case, we correct it.
    modulus :: Integer
modulus = Integer -> Integer
toPositive Integer
smodulus

rsaPubFromASN1 ( Start ASN1ConstructionType
Sequence
               : IntVal Integer
ver
               : Start ASN1ConstructionType
Sequence
               : OID OID
oid
               : ASN1
Null
               : End ASN1ConstructionType
Sequence
               : OctetString ByteString
bs
               : [ASN1]
xs
               )
    | Integer
ver Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 = String -> Either String (PublicKey, [ASN1])
forall a b. a -> Either a b
Left String
"rsaPubFromASN1: Invalid version, expecting 0"
    | OID
oid OID -> OID -> Bool
forall a. Eq a => a -> a -> Bool
/= [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
1] =
        String -> Either String (PublicKey, [ASN1])
forall a b. a -> Either a b
Left String
"rsaPubFromASN1: invalid OID"
    | Bool
otherwise =
        let inner :: Either String (PublicKey, [ASN1])
inner = (ASN1Error -> Either String (PublicKey, [ASN1]))
-> ([ASN1] -> Either String (PublicKey, [ASN1]))
-> Either ASN1Error [ASN1]
-> Either String (PublicKey, [ASN1])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ASN1Error -> Either String (PublicKey, [ASN1])
forall b. ASN1Error -> Either String b
strError [ASN1] -> Either String (PublicKey, [ASN1])
rsaPubFromASN1 (Either ASN1Error [ASN1] -> Either String (PublicKey, [ASN1]))
-> Either ASN1Error [ASN1] -> Either String (PublicKey, [ASN1])
forall a b. (a -> b) -> a -> b
$ BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bs
            strError :: ASN1Error -> Either String b
strError = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b)
-> (ASN1Error -> String) -> ASN1Error -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"fromASN1: RSA.PublicKey: " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (ASN1Error -> String) -> ASN1Error -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Error -> String
forall a. Show a => a -> String
show
         in (String -> Either String (PublicKey, [ASN1]))
-> ((PublicKey, [ASN1]) -> Either String (PublicKey, [ASN1]))
-> Either String (PublicKey, [ASN1])
-> Either String (PublicKey, [ASN1])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String (PublicKey, [ASN1])
forall a b. a -> Either a b
Left (\(PublicKey
k, [ASN1]
_) -> (PublicKey, [ASN1]) -> Either String (PublicKey, [ASN1])
forall a b. b -> Either a b
Right (PublicKey
k, [ASN1]
xs)) Either String (PublicKey, [ASN1])
inner
rsaPubFromASN1 [ASN1]
_ =
    String -> Either String (PublicKey, [ASN1])
forall a b. a -> Either a b
Left String
"fromASN1: RSA.PublicKey: unexpected format"

-- some bad implementation will not serialize ASN.1 integer properly, leading
-- to negative modulus.
toPositive :: Integer -> Integer
toPositive :: Integer -> Integer
toPositive Integer
int
    | Integer
int Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0   = [Word8] -> Integer
uintOfBytes ([Word8] -> Integer) -> [Word8] -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> [Word8]
bytesOfInt Integer
int
    | Bool
otherwise = Integer
int
  where
    uintOfBytes :: [Word8] -> Integer
uintOfBytes = (Integer -> Word8 -> Integer) -> Integer -> [Word8] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Integer
acc Word8
n -> (Integer
acc Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) Integer
0
    bytesOfInt :: Integer -> [Word8]
    bytesOfInt :: Integer -> [Word8]
bytesOfInt Integer
n = if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit ([Word8] -> Word8
forall a. [a] -> a
head [Word8]
nints) Int
7 then [Word8]
nints else Word8
0xff Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
nints
      where nints :: [Word8]
nints = [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ [Word8] -> [Word8]
forall a. (Num a, Eq a) => [a] -> [a]
plusOne ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word8
forall a. Bits a => a -> a
complement ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Integer -> [Word8]
forall t a. (Integral t, Bits a, Bits t, Num a) => t -> [a]
bytesOfUInt (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n)
            plusOne :: [a] -> [a]
plusOne []     = [a
1]
            plusOne (a
x:[a]
xs) = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0xff then a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
plusOne [a]
xs else (a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
1) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
    bytesOfUInt :: t -> [a]
bytesOfUInt t
x = [a] -> [a]
forall a. [a] -> [a]
reverse (t -> [a]
forall t a. (Integral t, Num a, Bits a, Bits t) => t -> [a]
list t
x)
      where list :: t -> [a]
list t
i = if t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0xff then [t -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
i] else (t -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
i a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xff) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a]
list (t
i t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)