-- |
-- Module      : Data.X509.EC
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Utilities related to Elliptic Curve certificates and keys.
--
module Data.X509.EC
    (
      unserializePoint
    , ecPubKeyCurve
    , ecPubKeyCurveName
    , ecPrivKeyCurve
    , ecPrivKeyCurveName
    , lookupCurveNameByOID
    ) where

import Data.ASN1.OID
import Data.List (find)

import Data.X509.OID
import Data.X509.PublicKey
import Data.X509.PrivateKey

import qualified Crypto.PubKey.ECC.Prim  as ECC
import qualified Crypto.PubKey.ECC.Types as ECC
import           Crypto.Number.Serialize (os2ip)

import qualified Data.ByteString as B

-- | Read an EC point from a serialized format and make sure the point is
-- valid for the specified curve.
unserializePoint :: ECC.Curve -> SerializedPoint -> Maybe ECC.Point
unserializePoint :: Curve -> SerializedPoint -> Maybe Point
unserializePoint Curve
curve (SerializedPoint ByteString
bs) =
    case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs of
        Maybe (Word8, ByteString)
Nothing                -> Maybe Point
forall a. Maybe a
Nothing
        Just (Word8
ptFormat, ByteString
input) ->
            case Word8
ptFormat of
                Word8
4 -> if ByteString -> Int
B.length ByteString
input Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bytes
                        then Maybe Point
forall a. Maybe a
Nothing
                        else
                            let (ByteString
x, ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
bytes ByteString
input
                                p :: Point
p      = Integer -> Integer -> Point
ECC.Point (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
x) (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
y)
                             in if Curve -> Point -> Bool
ECC.isPointValid Curve
curve Point
p
                                    then Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p
                                    else Maybe Point
forall a. Maybe a
Nothing
                -- 2 and 3 for compressed format.
                Word8
_ -> Maybe Point
forall a. Maybe a
Nothing
  where bits :: Int
bits  = Curve -> Int
ECC.curveSizeBits Curve
curve
        bytes :: Int
bytes = (Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8

-- | Return the curve associated to an EC Public Key.  This does not check
-- if a curve in explicit format is valid: if the input is not trusted one
-- should consider 'ecPubKeyCurveName' instead.
ecPubKeyCurve :: PubKeyEC -> Maybe ECC.Curve
ecPubKeyCurve :: PubKeyEC -> Maybe Curve
ecPubKeyCurve (PubKeyEC_Named CurveName
name SerializedPoint
_) = Curve -> Maybe Curve
forall a. a -> Maybe a
Just (Curve -> Maybe Curve) -> Curve -> Maybe Curve
forall a b. (a -> b) -> a -> b
$ CurveName -> Curve
ECC.getCurveByName CurveName
name
ecPubKeyCurve pub :: PubKeyEC
pub@PubKeyEC_Prime{}    =
    (Point -> Curve) -> Maybe Point -> Maybe Curve
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point -> Curve
buildCurve (Maybe Point -> Maybe Curve) -> Maybe Point -> Maybe Curve
forall a b. (a -> b) -> a -> b
$
        Curve -> SerializedPoint -> Maybe Point
unserializePoint (Point -> Curve
buildCurve Point
forall a. HasCallStack => a
undefined) (PubKeyEC -> SerializedPoint
pubkeyEC_generator PubKeyEC
pub)
  where
    prime :: Integer
prime = PubKeyEC -> Integer
pubkeyEC_prime PubKeyEC
pub
    buildCurve :: Point -> Curve
buildCurve Point
g =
        let cc :: CurveCommon
cc = CurveCommon :: Integer -> Integer -> Point -> Integer -> Integer -> CurveCommon
ECC.CurveCommon
                     { ecc_a :: Integer
ECC.ecc_a = PubKeyEC -> Integer
pubkeyEC_a        PubKeyEC
pub
                     , ecc_b :: Integer
ECC.ecc_b = PubKeyEC -> Integer
pubkeyEC_b        PubKeyEC
pub
                     , ecc_g :: Point
ECC.ecc_g = Point
g
                     , ecc_n :: Integer
ECC.ecc_n = PubKeyEC -> Integer
pubkeyEC_order    PubKeyEC
pub
                     , ecc_h :: Integer
ECC.ecc_h = PubKeyEC -> Integer
pubkeyEC_cofactor PubKeyEC
pub
                     }
         in CurvePrime -> Curve
ECC.CurveFP (Integer -> CurveCommon -> CurvePrime
ECC.CurvePrime Integer
prime CurveCommon
cc)

-- | Return the name of a standard curve associated to an EC Public Key
ecPubKeyCurveName :: PubKeyEC -> Maybe ECC.CurveName
ecPubKeyCurveName :: PubKeyEC -> Maybe CurveName
ecPubKeyCurveName (PubKeyEC_Named CurveName
name SerializedPoint
_) = CurveName -> Maybe CurveName
forall a. a -> Maybe a
Just CurveName
name
ecPubKeyCurveName pub :: PubKeyEC
pub@PubKeyEC_Prime{}    =
    (CurveName -> Bool) -> [CurveName] -> Maybe CurveName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find CurveName -> Bool
matchPrimeCurve ([CurveName] -> Maybe CurveName) -> [CurveName] -> Maybe CurveName
forall a b. (a -> b) -> a -> b
$ CurveName -> [CurveName]
forall a. Enum a => a -> [a]
enumFrom (CurveName -> [CurveName]) -> CurveName -> [CurveName]
forall a b. (a -> b) -> a -> b
$ Int -> CurveName
forall a. Enum a => Int -> a
toEnum Int
0
  where
    matchPrimeCurve :: CurveName -> Bool
matchPrimeCurve CurveName
c =
        case CurveName -> Curve
ECC.getCurveByName CurveName
c of
            ECC.CurveFP (ECC.CurvePrime Integer
p CurveCommon
cc) ->
                CurveCommon -> Integer
ECC.ecc_a CurveCommon
cc Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyEC -> Integer
pubkeyEC_a PubKeyEC
pub     Bool -> Bool -> Bool
&&
                CurveCommon -> Integer
ECC.ecc_b CurveCommon
cc Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyEC -> Integer
pubkeyEC_b PubKeyEC
pub     Bool -> Bool -> Bool
&&
                CurveCommon -> Integer
ECC.ecc_n CurveCommon
cc Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyEC -> Integer
pubkeyEC_order PubKeyEC
pub Bool -> Bool -> Bool
&&
                Integer
p            Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyEC -> Integer
pubkeyEC_prime PubKeyEC
pub
            Curve
_                                 -> Bool
False

-- | Return the EC curve associated to an EC Private Key.  This does not check
-- if a curve in explicit format is valid: if the input is not trusted one
-- should consider 'ecPrivKeyCurveName' instead.
ecPrivKeyCurve :: PrivKeyEC -> Maybe ECC.Curve
ecPrivKeyCurve :: PrivKeyEC -> Maybe Curve
ecPrivKeyCurve (PrivKeyEC_Named CurveName
name Integer
_) = Curve -> Maybe Curve
forall a. a -> Maybe a
Just (Curve -> Maybe Curve) -> Curve -> Maybe Curve
forall a b. (a -> b) -> a -> b
$ CurveName -> Curve
ECC.getCurveByName CurveName
name
ecPrivKeyCurve priv :: PrivKeyEC
priv@PrivKeyEC_Prime{}   =
    (Point -> Curve) -> Maybe Point -> Maybe Curve
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point -> Curve
buildCurve (Maybe Point -> Maybe Curve) -> Maybe Point -> Maybe Curve
forall a b. (a -> b) -> a -> b
$
        Curve -> SerializedPoint -> Maybe Point
unserializePoint (Point -> Curve
buildCurve Point
forall a. HasCallStack => a
undefined) (PrivKeyEC -> SerializedPoint
privkeyEC_generator PrivKeyEC
priv)
  where
    prime :: Integer
prime = PrivKeyEC -> Integer
privkeyEC_prime PrivKeyEC
priv
    buildCurve :: Point -> Curve
buildCurve Point
g =
        let cc :: CurveCommon
cc = CurveCommon :: Integer -> Integer -> Point -> Integer -> Integer -> CurveCommon
ECC.CurveCommon
                     { ecc_a :: Integer
ECC.ecc_a = PrivKeyEC -> Integer
privkeyEC_a        PrivKeyEC
priv
                     , ecc_b :: Integer
ECC.ecc_b = PrivKeyEC -> Integer
privkeyEC_b        PrivKeyEC
priv
                     , ecc_g :: Point
ECC.ecc_g = Point
g
                     , ecc_n :: Integer
ECC.ecc_n = PrivKeyEC -> Integer
privkeyEC_order    PrivKeyEC
priv
                     , ecc_h :: Integer
ECC.ecc_h = PrivKeyEC -> Integer
privkeyEC_cofactor PrivKeyEC
priv
                     }
         in CurvePrime -> Curve
ECC.CurveFP (Integer -> CurveCommon -> CurvePrime
ECC.CurvePrime Integer
prime CurveCommon
cc)

-- | Return the name of a standard curve associated to an EC Private Key
ecPrivKeyCurveName :: PrivKeyEC -> Maybe ECC.CurveName
ecPrivKeyCurveName :: PrivKeyEC -> Maybe CurveName
ecPrivKeyCurveName (PrivKeyEC_Named CurveName
name Integer
_) = CurveName -> Maybe CurveName
forall a. a -> Maybe a
Just CurveName
name
ecPrivKeyCurveName priv :: PrivKeyEC
priv@PrivKeyEC_Prime{}   =
    (CurveName -> Bool) -> [CurveName] -> Maybe CurveName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find CurveName -> Bool
matchPrimeCurve ([CurveName] -> Maybe CurveName) -> [CurveName] -> Maybe CurveName
forall a b. (a -> b) -> a -> b
$ CurveName -> [CurveName]
forall a. Enum a => a -> [a]
enumFrom (CurveName -> [CurveName]) -> CurveName -> [CurveName]
forall a b. (a -> b) -> a -> b
$ Int -> CurveName
forall a. Enum a => Int -> a
toEnum Int
0
  where
    matchPrimeCurve :: CurveName -> Bool
matchPrimeCurve CurveName
c =
        case CurveName -> Curve
ECC.getCurveByName CurveName
c of
            ECC.CurveFP (ECC.CurvePrime Integer
p CurveCommon
cc) ->
                CurveCommon -> Integer
ECC.ecc_a CurveCommon
cc Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== PrivKeyEC -> Integer
privkeyEC_a PrivKeyEC
priv     Bool -> Bool -> Bool
&&
                CurveCommon -> Integer
ECC.ecc_b CurveCommon
cc Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== PrivKeyEC -> Integer
privkeyEC_b PrivKeyEC
priv     Bool -> Bool -> Bool
&&
                CurveCommon -> Integer
ECC.ecc_n CurveCommon
cc Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== PrivKeyEC -> Integer
privkeyEC_order PrivKeyEC
priv Bool -> Bool -> Bool
&&
                Integer
p            Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== PrivKeyEC -> Integer
privkeyEC_prime PrivKeyEC
priv
            Curve
_                                 -> Bool
False

-- | Return the curve name associated to an OID
lookupCurveNameByOID :: OID -> Maybe ECC.CurveName
lookupCurveNameByOID :: OID -> Maybe CurveName
lookupCurveNameByOID = OIDTable CurveName -> OID -> Maybe CurveName
forall a. OIDTable a -> OID -> Maybe a
lookupByOID OIDTable CurveName
curvesOIDTable