add conversion from Data.X509.PrivKey

Add the `fromX509PrivKey` function, which supports conversion from
`Data.X509.PrivKey`, such as can be read via the *crypton-x509-store*
package.

    fromX509PrivKey
      :: (AsError e, MonadError e m)
      => X509.PrivKey -> m JWK

Fixes: #121

CHANGELOG.md

@@ -1,9 +1,11 @@
 ## Version NEXT
 
-- Added `Crypto.JOSE.JWK.fromX509PubKey`, which supports conversion
-  from the `Data.X509.PubKey` type, such as can be read via the
-  *crypton-x509-store* package.  It supports RSA, NIST ECC, and
-  Edwards curve key types (Ed25519, Ed448, X25519, X448).
+- Added new conversion functions `Crypto.JOSE.JWK.fromX509PubKey`
+  and `Crypto.JOSE.JWK.fromX509PrivKey`.  These convert from the
+  `Data.X509.PubKey` and `Data.X509.PrivKey` types, which can be
+  read via the *crypton-x509-store* package.  They supports RSA,
+  NIST ECC, and Edwards curve key types (Ed25519, Ed448, X25519,
+  X448).
 
 - Updated `Crypto.JOSE.JWK.fromX509Certificate` to support Edwards
   curve key types (Ed25519, Ed448, X25519, X448).

src/Crypto/JOSE/JWA/JWK.hs

@@ -36,6 +36,7 @@ module Crypto.JOSE.JWA.JWK (
   , point
   , ecPrivateKey
   , ecParametersFromX509
+  , ecParametersFromX509Priv
   , genEC
 
   -- * Parameters for RSA Keys
@@ -306,18 +307,46 @@ ecPrivateKey :: (MonadError e m, AsError e) => ECKeyParameters -> m Integer
 ecPrivateKey (ECKeyParameters _ _ _ (Just (Types.SizedBase64Integer _ d))) = pure d
 ecPrivateKey _ = throwing _KeyMismatch "Not an EC private key"
 
+-- | See also 'Crypto.JOSE.JWK.fromX509PubKey' and
+-- 'Crypto.JOSE.JWK.fromX509Certificate'.
+--
 ecParametersFromX509 :: (MonadError e m, AsError e) => X509.PubKeyEC -> m ECKeyParameters
-ecParametersFromX509 pubKeyEC = do
-  ecCurve <- maybe (throwing _KeyMismatch "Invalid EC point") pure $ X509.EC.ecPubKeyCurve pubKeyEC
-  curveName <- maybe (throwing _KeyMismatch "Unknown curve") pure $ X509.EC.ecPubKeyCurveName pubKeyEC
-  crv <- maybe (throwing _KeyMismatch "Unsupported curve TODO ") pure $ preview fromCurveName curveName
-  pt <- maybe (throwing _KeyMismatch "Invalid EC point") pure $ X509.EC.unserializePoint ecCurve (X509.pubkeyEC_pub pubKeyEC)
+ecParametersFromX509 k = do
+  curveName <-
+    maybe (throwing _KeyMismatch "Unknown curve") pure
+      $ X509.EC.ecPubKeyCurveName k
+  crv <-
+    maybe (throwing _KeyMismatch "Unsupported curve") pure
+      $ preview fromCurveName curveName
+  pt <-
+    maybe (throwing _KeyMismatch "Invalid EC point") pure
+      $ X509.EC.unserializePoint (ECC.getCurveByName curveName) (X509.pubkeyEC_pub k)
   (x, y) <- case pt of
-    ECC.PointO    -> throwing _KeyMismatch "Cannot use point at infinity"
+    ECC.PointO ->
+      throwing _KeyMismatch "Cannot use point at infinity"
     ECC.Point x y ->
       pure (Types.makeSizedBase64Integer x, Types.makeSizedBase64Integer y)
   pure $ ECKeyParameters crv x y Nothing
 
+-- | See also 'Crypto.JOSE.JWK.fromX509PrivKey'.
+--
+ecParametersFromX509Priv :: (MonadError e m, AsError e) => X509.PrivKeyEC -> m ECKeyParameters
+ecParametersFromX509Priv k = do
+  curveName <-
+    maybe (throwing _KeyMismatch "Unknown curve") pure
+      $ X509.EC.ecPrivKeyCurveName k
+  crv <-
+    maybe (throwing _KeyMismatch "Unsupported curve") pure
+      $ preview fromCurveName curveName
+  let d = privkeyEC_priv k
+  (x, y) <- case ECC.generateQ (ECC.getCurveByName curveName) d of
+    ECC.PointO ->
+      throwing _KeyMismatch "Cannot use point at infinity"
+    ECC.Point x y ->
+      pure (Types.makeSizedBase64Integer x, Types.makeSizedBase64Integer y)
+  pure $ ECKeyParameters crv x y (Just $ Types.makeSizedBase64Integer d)
+
+
 -- | Parameters for RSA Keys.
 --
 -- @

src/Crypto/JOSE/JWK.hs

@@ -73,6 +73,7 @@ module Crypto.JOSE.JWK
   , fromOctets
   , fromX509Certificate
   , fromX509PubKey
+  , fromX509PrivKey
 
   -- * JWK Thumbprint
   , thumbprint
@@ -101,6 +102,10 @@ import Control.Lens.Cons.Extras (recons)
 import Control.Monad.Except (MonadError, runExcept)
 import Control.Monad.Error.Lens (throwing, throwing_)
 import Crypto.Hash
+import qualified Crypto.PubKey.Ed25519 as Ed25519
+import qualified Crypto.PubKey.Ed448 as Ed448
+import qualified Crypto.PubKey.Curve25519 as Curve25519
+import qualified Crypto.PubKey.Curve448 as Curve448
 import qualified Crypto.PubKey.RSA as RSA
 import Data.Aeson
 import Data.Aeson.Types (explicitParseFieldMaybe')
@@ -271,6 +276,23 @@ fromX509PubKey = \case
     fromECPublic = fmap (fromKeyMaterial . ECKeyMaterial) . ecParametersFromX509
     fromOKP = pure . fromKeyMaterial . OKPKeyMaterial
 
+-- | Convert from a 'X509.PrivKey' (such as can be read via the
+-- /crypton-x509-store/ package).  Supports RSA, ECDSA, Ed25519,
+-- Ed448, X25519 and X448 keys.
+--
+fromX509PrivKey :: (AsError e, MonadError e m) => X509.PrivKey -> m JWK
+fromX509PrivKey = \case
+  X509.PrivKeyRSA k      -> pure (fromRSA k)
+  X509.PrivKeyEC k       -> fromEC k
+  X509.PrivKeyX25519 k   -> fromOKP $ X25519Key (Curve25519.toPublic k) (Just k)
+  X509.PrivKeyX448 k     -> fromOKP $ X448Key (Curve448.toPublic k) (Just k)
+  X509.PrivKeyEd25519 k  -> fromOKP $ Ed25519Key (Ed25519.toPublic k) (Just k)
+  X509.PrivKeyEd448 k    -> fromOKP $ Ed448Key (Ed448.toPublic k) (Just k)
+  _ -> throwing _KeyMismatch "X.509 key type not supported"
+  where
+    fromEC = fmap (fromKeyMaterial . ECKeyMaterial) . ecParametersFromX509Priv
+    fromOKP = pure . fromKeyMaterial . OKPKeyMaterial
+
 
 -- | Convert an X.509 certificate into a JWK.
 --