    -- |
    -- 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
    curve (SerializedPoint bs :: ByteString
    bs) =
        case ByteString -> Maybe (Word8, ByteString)
    B.uncons ByteString
    bs of
            Nothing                -> Maybe Point
    forall a. Maybe a
    Nothing
            Just (ptFormat :: Word8
    ptFormat, input :: ByteString
    input) ->
                case Word8
    ptFormat of
                    4 -> if ByteString -> Int
    B.length ByteString
    input Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= 2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    bytes
                            then Maybe Point
    forall a. Maybe a
    Nothing
                            else
                                let (x :: ByteString
    x, y :: 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.
                    _ -> 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
    + 7) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` 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 name :: CurveName
    name _) = 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 g :: 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 name :: CurveName
    name _) = 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 0
      where
        matchPrimeCurve :: CurveName -> Bool
    matchPrimeCurve c :: CurveName
    c =
            case CurveName -> Curve
    ECC.getCurveByName CurveName
    c of
                ECC.CurveFP (ECC.CurvePrime p :: Integer
    p cc :: 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
                _                                 -> 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 name :: CurveName
    name _) = 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 g :: 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 name :: CurveName
    name _) = 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 0
      where
        matchPrimeCurve :: CurveName -> Bool
    matchPrimeCurve c :: CurveName
    c =
            case CurveName -> Curve
    ECC.getCurveByName CurveName
    c of
                ECC.CurveFP (ECC.CurvePrime p :: Integer
    p cc :: 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
                _                                 -> 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