{-# LANGUAGE PatternSynonyms #-}

-- | P384 ECDSA cryptographic keys.
module Crypto.Paseto.Keys.V3
  ( -- * Curve
    curveP384

    -- * Private key
  , PrivateKeyP384 (PrivateKeyP384)
  , unPrivateKeyP384
  , mkPrivateKeyP384
  , generatePrivateKeyP384
  , encodePrivateKeyP384
  , Internal.ScalarDecodingError (..)
  , Internal.renderScalarDecodingError
  , decodePrivateKeyP384
  -- ** Helpers
  , generateScalarP384
  , isScalarValidP384

    -- * Public key
  , PublicKeyP384 (PublicKeyP384)
  , unPublicKeyP384
  , mkPublicKeyP384
  , fromPrivateKeyP384
  , encodePublicKeyP384
  , Internal.CompressedPointDecodingError (..)
  , Internal.UncompressedPointDecodingError (..)
  , PublicKeyP384DecodingError (..)
  , renderPublicKeyP384DecodingError
  , decodePublicKeyP384
  ) where

import qualified Crypto.Paseto.Keys.V3.Internal as Internal
import qualified Crypto.PubKey.ECC.ECDSA as ECC.ECDSA
import qualified Crypto.PubKey.ECC.Prim as ECC
import qualified Crypto.PubKey.ECC.Types as ECC
import Data.Bifunctor ( bimap )
import Data.ByteArray ( ScrubbedBytes, constEq )
import Data.ByteString ( ByteString )
import qualified Data.ByteString as BS
import Data.Text ( Text )
import Prelude

-- | Elliptic curve 'ECC.SEC_p384r1'.
curveP384 :: ECC.Curve
curveP384 :: Curve
curveP384 = CurveName -> Curve
ECC.getCurveByName CurveName
ECC.SEC_p384r1

------------------------------------------------------------------------------
-- P384 private key
------------------------------------------------------------------------------

-- | Generate a random scalar on the curve 'ECC.SEC_p384r1'.
generateScalarP384 :: IO Integer
generateScalarP384 :: IO Integer
generateScalarP384 = Curve -> IO Integer
forall (randomly :: * -> *).
MonadRandom randomly =>
Curve -> randomly Integer
ECC.scalarGenerate Curve
curveP384

-- | Whether a scalar is valid on the curve 'ECC.SEC_p384r1'.
isScalarValidP384 :: Integer -> Bool
isScalarValidP384 :: Integer -> Bool
isScalarValidP384 = Curve -> Integer -> Bool
Internal.isScalarValid Curve
curveP384

-- | ECDSA private key for curve 'ECC.SEC_p384r1'.
--
-- Note that this type's 'Eq' instance performs a constant-time equality
-- check.
newtype PrivateKeyP384 = MkPrivateKeyP384
  { PrivateKeyP384 -> PrivateKey
unPrivateKeyP384 :: ECC.ECDSA.PrivateKey }
  deriving newtype Int -> PrivateKeyP384 -> ShowS
[PrivateKeyP384] -> ShowS
PrivateKeyP384 -> String
(Int -> PrivateKeyP384 -> ShowS)
-> (PrivateKeyP384 -> String)
-> ([PrivateKeyP384] -> ShowS)
-> Show PrivateKeyP384
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrivateKeyP384 -> ShowS
showsPrec :: Int -> PrivateKeyP384 -> ShowS
$cshow :: PrivateKeyP384 -> String
show :: PrivateKeyP384 -> String
$cshowList :: [PrivateKeyP384] -> ShowS
showList :: [PrivateKeyP384] -> ShowS
Show

instance Eq PrivateKeyP384 where
  PrivateKeyP384 (ECC.ECDSA.PrivateKey Curve
cx Integer
dx) == :: PrivateKeyP384 -> PrivateKeyP384 -> Bool
== PrivateKeyP384 (ECC.ECDSA.PrivateKey Curve
cy Integer
dy) =
    Curve -> Integer -> ScrubbedBytes
Internal.encodeScalar Curve
cx Integer
dx ScrubbedBytes -> ScrubbedBytes -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`constEq` Curve -> Integer -> ScrubbedBytes
Internal.encodeScalar Curve
cy Integer
dy

pattern PrivateKeyP384 :: ECC.ECDSA.PrivateKey -> PrivateKeyP384
pattern $mPrivateKeyP384 :: forall {r}.
PrivateKeyP384 -> (PrivateKey -> r) -> ((# #) -> r) -> r
PrivateKeyP384 pk <- MkPrivateKeyP384 pk

{-# COMPLETE PrivateKeyP384 #-}

-- | Construct a private key for curve 'ECC.SEC_p384r1'.
mkPrivateKeyP384 :: ECC.ECDSA.PrivateKey -> Maybe PrivateKeyP384
mkPrivateKeyP384 :: PrivateKey -> Maybe PrivateKeyP384
mkPrivateKeyP384 privKey :: PrivateKey
privKey@(ECC.ECDSA.PrivateKey Curve
curve Integer
d)
  | Curve
curveP384 Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== Curve
curve Bool -> Bool -> Bool
&& Integer -> Bool
isScalarValidP384 Integer
d = PrivateKeyP384 -> Maybe PrivateKeyP384
forall a. a -> Maybe a
Just (PrivateKey -> PrivateKeyP384
MkPrivateKeyP384 PrivateKey
privKey)
  | Bool
otherwise = Maybe PrivateKeyP384
forall a. Maybe a
Nothing

-- | Generate a private key for curve 'ECC.SEC_p384r1'.
generatePrivateKeyP384 :: IO PrivateKeyP384
generatePrivateKeyP384 :: IO PrivateKeyP384
generatePrivateKeyP384 =
  PrivateKey -> PrivateKeyP384
MkPrivateKeyP384 (PrivateKey -> PrivateKeyP384)
-> (Integer -> PrivateKey) -> Integer -> PrivateKeyP384
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Curve -> Integer -> PrivateKey
ECC.ECDSA.PrivateKey Curve
curveP384)
    (Integer -> PrivateKeyP384) -> IO Integer -> IO PrivateKeyP384
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Integer
generateScalarP384

-- | Encode a private key into its binary format as defined in
-- [RFC 5915](https://tools.ietf.org/html/rfc5915), i.e. the @privateKey@
-- field described in
-- [section 3](https://datatracker.ietf.org/doc/html/rfc5915#section-3).
encodePrivateKeyP384 :: PrivateKeyP384 -> ScrubbedBytes
encodePrivateKeyP384 :: PrivateKeyP384 -> ScrubbedBytes
encodePrivateKeyP384 (PrivateKeyP384 (ECC.ECDSA.PrivateKey Curve
curve Integer
d)) =
  Curve -> Integer -> ScrubbedBytes
Internal.encodeScalar Curve
curve Integer
d

-- | Decode a private key from its binary format as defined in
-- [RFC 5915](https://tools.ietf.org/html/rfc5915), i.e. the @privateKey@
-- field described in
-- [section 3](https://datatracker.ietf.org/doc/html/rfc5915#section-3).
decodePrivateKeyP384 :: ScrubbedBytes -> Either Internal.ScalarDecodingError PrivateKeyP384
decodePrivateKeyP384 :: ScrubbedBytes -> Either ScalarDecodingError PrivateKeyP384
decodePrivateKeyP384 ScrubbedBytes
bs =
  PrivateKey -> PrivateKeyP384
MkPrivateKeyP384 (PrivateKey -> PrivateKeyP384)
-> (Integer -> PrivateKey) -> Integer -> PrivateKeyP384
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curve -> Integer -> PrivateKey
ECC.ECDSA.PrivateKey Curve
curve
    (Integer -> PrivateKeyP384)
-> Either ScalarDecodingError Integer
-> Either ScalarDecodingError PrivateKeyP384
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Curve -> ScrubbedBytes -> Either ScalarDecodingError Integer
Internal.decodeScalar Curve
curve ScrubbedBytes
bs
  where
    curve :: ECC.Curve
    curve :: Curve
curve = Curve
curveP384

------------------------------------------------------------------------------
-- P384 public key
------------------------------------------------------------------------------

-- | ECDSA public key for curve 'ECC.SEC_p384r1'.
newtype PublicKeyP384 = MkPublicKeyP384
  { PublicKeyP384 -> PublicKey
unPublicKeyP384 :: ECC.ECDSA.PublicKey }
  deriving newtype (Int -> PublicKeyP384 -> ShowS
[PublicKeyP384] -> ShowS
PublicKeyP384 -> String
(Int -> PublicKeyP384 -> ShowS)
-> (PublicKeyP384 -> String)
-> ([PublicKeyP384] -> ShowS)
-> Show PublicKeyP384
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicKeyP384 -> ShowS
showsPrec :: Int -> PublicKeyP384 -> ShowS
$cshow :: PublicKeyP384 -> String
show :: PublicKeyP384 -> String
$cshowList :: [PublicKeyP384] -> ShowS
showList :: [PublicKeyP384] -> ShowS
Show, PublicKeyP384 -> PublicKeyP384 -> Bool
(PublicKeyP384 -> PublicKeyP384 -> Bool)
-> (PublicKeyP384 -> PublicKeyP384 -> Bool) -> Eq PublicKeyP384
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKeyP384 -> PublicKeyP384 -> Bool
== :: PublicKeyP384 -> PublicKeyP384 -> Bool
$c/= :: PublicKeyP384 -> PublicKeyP384 -> Bool
/= :: PublicKeyP384 -> PublicKeyP384 -> Bool
Eq)

pattern PublicKeyP384 :: ECC.ECDSA.PublicKey -> PublicKeyP384
pattern $mPublicKeyP384 :: forall {r}. PublicKeyP384 -> (PublicKey -> r) -> ((# #) -> r) -> r
PublicKeyP384 pk <- MkPublicKeyP384 pk

{-# COMPLETE PublicKeyP384 #-}

-- | Construct a public key for curve 'ECC.SEC_p384r1'.
mkPublicKeyP384 :: ECC.ECDSA.PublicKey -> Maybe PublicKeyP384
mkPublicKeyP384 :: PublicKey -> Maybe PublicKeyP384
mkPublicKeyP384 pubKey :: PublicKey
pubKey@(ECC.ECDSA.PublicKey Curve
curve PublicPoint
point)
  | Curve
curveP384 Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== Curve
curve Bool -> Bool -> Bool
&& Curve -> PublicPoint -> Bool
ECC.isPointValid Curve
curve PublicPoint
point = PublicKeyP384 -> Maybe PublicKeyP384
forall a. a -> Maybe a
Just (PublicKey -> PublicKeyP384
MkPublicKeyP384 PublicKey
pubKey)
  | Bool
otherwise = Maybe PublicKeyP384
forall a. Maybe a
Nothing

-- | Construct the 'PublicKeyP384' which corresponds to a given
-- 'PrivateKeyP384'.
fromPrivateKeyP384 :: PrivateKeyP384 -> PublicKeyP384
fromPrivateKeyP384 :: PrivateKeyP384 -> PublicKeyP384
fromPrivateKeyP384 (PrivateKeyP384 PrivateKey
privateKey) =
  PublicKey -> PublicKeyP384
MkPublicKeyP384 (PrivateKey -> PublicKey
Internal.fromPrivateKey PrivateKey
privateKey)

-- | Encode an elliptic curve point into its compressed binary format as
-- defined by [SEC 1](https://www.secg.org/sec1-v2.pdf) and
-- [RFC 5480 section 2.2](https://datatracker.ietf.org/doc/html/rfc5480#section-2.2).
encodePublicKeyP384 :: PublicKeyP384 -> ByteString
encodePublicKeyP384 :: PublicKeyP384 -> ByteString
encodePublicKeyP384 (PublicKeyP384 (ECC.ECDSA.PublicKey Curve
c PublicPoint
p)) =
  case Curve
c of
    ECC.CurveFP CurvePrime
curvePrime -> CurvePrime -> PublicPoint -> ByteString
Internal.encodePointCompressed CurvePrime
curvePrime PublicPoint
p
    Curve
_ -> String -> ByteString
forall a. HasCallStack => String -> a
error String
"encodePublicKeyP384: impossible: secp384r1 curve is not a prime curve"

-- | Error decoding a public key for curve 'ECC.SEC_p384r1'.
data PublicKeyP384DecodingError
  = -- | Error decoding a compressed public key.
    PublicKeyP384DecodingCompressedError !Internal.CompressedPointDecodingError
  | -- | Error decoding an uncompressed public key.
    PublicKeyP384DecodingUncompressedError !Internal.UncompressedPointDecodingError
  deriving stock (Int -> PublicKeyP384DecodingError -> ShowS
[PublicKeyP384DecodingError] -> ShowS
PublicKeyP384DecodingError -> String
(Int -> PublicKeyP384DecodingError -> ShowS)
-> (PublicKeyP384DecodingError -> String)
-> ([PublicKeyP384DecodingError] -> ShowS)
-> Show PublicKeyP384DecodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicKeyP384DecodingError -> ShowS
showsPrec :: Int -> PublicKeyP384DecodingError -> ShowS
$cshow :: PublicKeyP384DecodingError -> String
show :: PublicKeyP384DecodingError -> String
$cshowList :: [PublicKeyP384DecodingError] -> ShowS
showList :: [PublicKeyP384DecodingError] -> ShowS
Show, PublicKeyP384DecodingError -> PublicKeyP384DecodingError -> Bool
(PublicKeyP384DecodingError -> PublicKeyP384DecodingError -> Bool)
-> (PublicKeyP384DecodingError
    -> PublicKeyP384DecodingError -> Bool)
-> Eq PublicKeyP384DecodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKeyP384DecodingError -> PublicKeyP384DecodingError -> Bool
== :: PublicKeyP384DecodingError -> PublicKeyP384DecodingError -> Bool
$c/= :: PublicKeyP384DecodingError -> PublicKeyP384DecodingError -> Bool
/= :: PublicKeyP384DecodingError -> PublicKeyP384DecodingError -> Bool
Eq)

-- | Render a 'PublicKeyP384DecodingError' as 'Text'.
renderPublicKeyP384DecodingError :: PublicKeyP384DecodingError -> Text
renderPublicKeyP384DecodingError :: PublicKeyP384DecodingError -> Text
renderPublicKeyP384DecodingError PublicKeyP384DecodingError
err =
  case PublicKeyP384DecodingError
err of
    PublicKeyP384DecodingCompressedError CompressedPointDecodingError
e ->
      Text
"Failed to decode compressed public key: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CompressedPointDecodingError -> Text
Internal.renderCompressedPointDecodingError CompressedPointDecodingError
e
    PublicKeyP384DecodingUncompressedError UncompressedPointDecodingError
e ->
      Text
"Failed to decode uncompressed public key: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UncompressedPointDecodingError -> Text
Internal.renderUncompressedPointDecodingError UncompressedPointDecodingError
e

-- | Decode a public key from either its compressed or uncompressed binary
-- format as defined by [SEC 1](https://www.secg.org/sec1-v2.pdf) and
-- [RFC 5480 section 2.2](https://datatracker.ietf.org/doc/html/rfc5480#section-2.2).
decodePublicKeyP384 :: ByteString -> Either PublicKeyP384DecodingError PublicKeyP384
decodePublicKeyP384 :: ByteString -> Either PublicKeyP384DecodingError PublicKeyP384
decodePublicKeyP384 ByteString
bs
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
49 = (CompressedPointDecodingError -> PublicKeyP384DecodingError)
-> (PublicPoint -> PublicKeyP384)
-> Either CompressedPointDecodingError PublicPoint
-> Either PublicKeyP384DecodingError PublicKeyP384
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap CompressedPointDecodingError -> PublicKeyP384DecodingError
PublicKeyP384DecodingCompressedError PublicPoint -> PublicKeyP384
mkPk (CurvePrime
-> ByteString -> Either CompressedPointDecodingError PublicPoint
Internal.decodePointCompressed CurvePrime
curvePrime ByteString
bs)
  | Bool
otherwise = (UncompressedPointDecodingError -> PublicKeyP384DecodingError)
-> (PublicPoint -> PublicKeyP384)
-> Either UncompressedPointDecodingError PublicPoint
-> Either PublicKeyP384DecodingError PublicKeyP384
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap UncompressedPointDecodingError -> PublicKeyP384DecodingError
PublicKeyP384DecodingUncompressedError PublicPoint -> PublicKeyP384
mkPk (CurvePrime
-> ByteString -> Either UncompressedPointDecodingError PublicPoint
Internal.decodePointUncompressed CurvePrime
curvePrime ByteString
bs)
  where
    len :: Int
    len :: Int
len = ByteString -> Int
BS.length ByteString
bs

    curve :: ECC.Curve
    curve :: Curve
curve = Curve
curveP384

    curvePrime :: ECC.CurvePrime
    curvePrime :: CurvePrime
curvePrime =
      case Curve
curve of
        ECC.CurveFP CurvePrime
c -> CurvePrime
c
        Curve
_ -> String -> CurvePrime
forall a. HasCallStack => String -> a
error String
"decodePublicKeyP384: impossible: secp384r1 curve is not a prime curve"

    mkPk :: ECC.Point -> PublicKeyP384
    mkPk :: PublicPoint -> PublicKeyP384
mkPk = PublicKey -> PublicKeyP384
MkPublicKeyP384 (PublicKey -> PublicKeyP384)
-> (PublicPoint -> PublicKey) -> PublicPoint -> PublicKeyP384
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Curve -> PublicPoint -> PublicKey
ECC.ECDSA.PublicKey Curve
curve)