add Ed448 and X448 support

Implement support for Ed448 and X448 keys.  Implement and test Ed448
signing and verifications.  ECDH with X448 remains unimplemented
(like all of JWE).

Fixes: #74

README.md

@@ -7,9 +7,9 @@ Web Token (JWT)](https://tools.ietf.org/html/rfc7519).
 The JSON Web Signature (JWS; RFC 7515) implementation is complete.
 JSON Web Encryption (JWE; RFC 7516) is not yet implemented.
 
-**EdDSA** signatures (RFC 8037) are supported (Ed25519 only).
+**EdDSA** signatures (RFC 8037) are supported.
 
-JWK Thumbprint (RFC 7638) is supported (requires *aeson* >= 0.10).
+JWK Thumbprint (RFC 7638) is supported.
 
 [Contributions](#contributing) are welcome.
 

jose.cabal

@@ -10,7 +10,7 @@ description:
   .
   The JSON Web Signature (JWS; RFC 7515) implementation is complete.
   .
-  EdDSA signatures (RFC 8037) are supported (Ed25519 only).
+  EdDSA signatures (RFC 8037) are supported.
   .
   JWK Thumbprint (RFC 7638) is supported.
   .
@@ -79,7 +79,7 @@ library
     , base64-bytestring >= 1.2.1.0 && < 1.3
     , concise >= 0.1
     , containers >= 0.5
-    , cryptonite >= 0.7
+    , cryptonite >= 0.24
     , memory >= 0.7
     , monad-time >= 0.3
     , template-haskell >= 2.11

src/Crypto/JOSE/JWA/JWK.hs

@@ -60,6 +60,7 @@ module Crypto.JOSE.JWA.JWK (
   -- * Parameters for CFRG EC keys (RFC 8037)
   , OKPKeyParameters(..)
   , OKPCrv(..)
+  , genOKP
 
   -- * Key generation
   , KeyMaterialGenParam(..)
@@ -94,7 +95,9 @@ import qualified Crypto.PubKey.RSA.PKCS15 as PKCS15
 import qualified Crypto.PubKey.RSA.PSS as PSS
 import qualified Crypto.PubKey.ECC.Types as ECC
 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 Crypto.Random
 import Data.Aeson
 import qualified Data.Aeson.KeyMap as M
@@ -456,13 +459,17 @@ signOct h (OctKeyParameters (Types.Base64Octets k)) m =
 --
 data OKPKeyParameters
   = Ed25519Key Ed25519.PublicKey (Maybe Ed25519.SecretKey)
+  | Ed448Key Ed448.PublicKey (Maybe Ed448.SecretKey)
   | X25519Key Curve25519.PublicKey (Maybe Curve25519.SecretKey)
+  | X448Key Curve448.PublicKey (Maybe Curve448.SecretKey)
   deriving (Eq)
 
 instance Show OKPKeyParameters where
   show = \case
       Ed25519Key pk sk  -> "Ed25519 " <> showKeys pk sk
+      Ed448Key pk sk  -> "Ed448 " <> showKeys pk sk
       X25519Key pk sk   -> "X25519 " <> showKeys pk sk
+      X448Key pk sk   -> "X448 " <> showKeys pk sk
     where
       showKeys pk sk = show pk <> " " <> show (("SECRET" :: String) <$ sk)
 
@@ -473,8 +480,8 @@ instance FromJSON OKPKeyParameters where
     case (crv :: T.Text) of
       "Ed25519" -> parseOKPKey Ed25519Key Ed25519.publicKey Ed25519.secretKey o
       "X25519"  -> parseOKPKey X25519Key Curve25519.publicKey Curve25519.secretKey o
-      "Ed448"   -> fail "Ed448 keys not implemented"
-      "X448"    -> fail "X448 not implemented"
+      "Ed448"   -> parseOKPKey Ed448Key Ed448.publicKey Ed448.secretKey o
+      "X448"    -> parseOKPKey X448Key Curve448.publicKey Curve448.secretKey o
       _         -> fail "unrecognised OKP key subtype"
     where
       bs (Types.Base64Octets k) = k
@@ -487,32 +494,34 @@ instance ToJSON OKPKeyParameters where
   toJSON x = object $
     "kty" .= ("OKP" :: T.Text) : case x of
       Ed25519Key pk sk -> "crv" .= ("Ed25519" :: T.Text) : params pk sk
+      Ed448Key pk sk -> "crv" .= ("Ed448" :: T.Text) : params pk sk
       X25519Key pk sk  -> "crv" .= ("X25519" :: T.Text) : params pk sk
+      X448Key pk sk  -> "crv" .= ("X448" :: T.Text) : params pk sk
     where
       b64 = Types.Base64Octets . BA.convert
       params pk sk = "x" .= b64 pk : (("d" .=) . b64 <$> toList sk)
 
-data OKPCrv = Ed25519 | X25519
+data OKPCrv = Ed25519 | Ed448 | X25519 | X448
   deriving (Eq, Show)
 
 genOKP :: MonadRandom m => OKPCrv -> m OKPKeyParameters
 genOKP = \case
-  Ed25519 -> go 32 Ed25519Key Ed25519.secretKey Ed25519.toPublic
-  X25519 -> go 32 X25519Key Curve25519.secretKey Curve25519.toPublic
-  where
-    go len con skCon toPub = do
-      (bs :: B.ByteString) <- getRandomBytes len
-      let sk = onCryptoFailure (error . show) id (skCon bs)
-      pure $ con (toPub sk) (Just sk)
+  Ed25519 -> Ed25519.generateSecretKey >>= \k -> pure (Ed25519Key (Ed25519.toPublic k) (Just k))
+  Ed448 -> Ed448.generateSecretKey >>= \k -> pure (Ed448Key (Ed448.toPublic k) (Just k))
+  X25519 -> Curve25519.generateSecretKey >>= \k -> pure (X25519Key (Curve25519.toPublic k) (Just k))
+  X448 -> Curve448.generateSecretKey >>= \k -> pure (X448Key (Curve448.toPublic k) (Just k))
 
 signEdDSA
   :: (MonadError e m, AsError e)
   => OKPKeyParameters
   -> B.ByteString
   -> m B.ByteString
 signEdDSA (Ed25519Key pk (Just sk)) m = pure . BA.convert $ Ed25519.sign sk pk m
-signEdDSA (Ed25519Key _ Nothing) _ = throwing _KeyMismatch "not a private key"
-signEdDSA _ _ = throwing _KeyMismatch "not an EdDSA key"
+signEdDSA (Ed25519Key _   Nothing)  _ = throwing _KeyMismatch "not a private key"
+signEdDSA (Ed448Key pk (Just sk))   m = pure . BA.convert $ Ed448.sign sk pk m
+signEdDSA (Ed448Key _   Nothing)    _ = throwing _KeyMismatch "not a private key"
+signEdDSA (X25519Key _ _) _ = throwing _KeyMismatch "not an EdDSA key"
+signEdDSA (X448Key _ _)   _ = throwing _KeyMismatch "not an EdDSA key"
 
 verifyEdDSA
   :: (BA.ByteArrayAccess msg, BA.ByteArrayAccess sig, MonadError e m, AsError e)
@@ -522,7 +531,13 @@ verifyEdDSA (Ed25519Key pk _) m s =
     (throwing _CryptoError)
     (pure . Ed25519.verify pk m)
     (Ed25519.signature s)
-verifyEdDSA _ _ _ = throwing _AlgorithmMismatch "not an EdDSA key"
+verifyEdDSA (Ed448Key pk _) m s =
+  onCryptoFailure
+    (throwing _CryptoError)
+    (pure . Ed448.verify pk m)
+    (Ed448.signature s)
+verifyEdDSA (X25519Key _ _) _ _ = throwing _AlgorithmMismatch "not an EdDSA key"
+verifyEdDSA (X448Key _ _)   _ _ = throwing _AlgorithmMismatch "not an EdDSA key"
 
 
 -- | Key material sum type.
@@ -639,8 +654,10 @@ instance AsPublicKey ECKeyParameters where
 
 instance AsPublicKey OKPKeyParameters where
   asPublicKey = to $ \case
-    Ed25519Key pk _ -> Just (Ed25519Key pk Nothing)
-    X25519Key pk _  -> Just (X25519Key pk Nothing)
+    Ed25519Key  pk _  -> Just (Ed25519Key pk Nothing)
+    Ed448Key    pk _  -> Just (Ed448Key pk Nothing)
+    X25519Key   pk _  -> Just (X25519Key pk Nothing)
+    X448Key     pk _  -> Just (X448Key pk Nothing)
 
 instance AsPublicKey KeyMaterial where
   asPublicKey = to $ \case

src/Crypto/JOSE/JWK.hs

@@ -319,8 +319,11 @@ bestJWSAlg jwk = case view jwkMaterial jwk of
     | B.length k >= 384 `div` 8 -> pure JWA.JWS.HS384
     | B.length k >= 256 `div` 8 -> pure JWA.JWS.HS256
     | otherwise -> throwing_ _KeySizeTooSmall
-  OKPKeyMaterial (Ed25519Key _ _) -> pure JWA.JWS.EdDSA
-  OKPKeyMaterial _ -> throwing _KeyMismatch "Cannot sign with OKP ECDH key"
+  OKPKeyMaterial k -> case k of
+    (Ed25519Key _ _)  -> pure JWA.JWS.EdDSA
+    (Ed448Key _ _)    -> pure JWA.JWS.EdDSA
+    (X25519Key _ _)   -> throwing _KeyMismatch "Cannot sign with X25519 key"
+    (X448Key _ _)     -> throwing _KeyMismatch "Cannot sign with X448 key"
 
 
 -- | Compute the JWK Thumbprint of a JWK
@@ -350,7 +353,9 @@ thumbprintRepr k = Builder.toLazyByteString . fromEncoding . pairs $
     OctKeyMaterial (OctKeyParameters k') ->
       "k" .= k' <> "kty" .= ("oct" :: T.Text)
     OKPKeyMaterial (Ed25519Key pk _) -> okpSeries "Ed25519" pk
+    OKPKeyMaterial (Ed448Key pk _) -> okpSeries "Ed448" pk
     OKPKeyMaterial (X25519Key pk _) -> okpSeries "X25519" pk
+    OKPKeyMaterial (X448Key pk _) -> okpSeries "X448" pk
   where
     b64 = Types.Base64Octets . BA.convert
     okpSeries crv pk =

test/Properties.hs

@@ -22,10 +22,7 @@ import Control.Applicative (liftA2)
 import Control.Monad.IO.Class
 
 import Control.Lens ((&), set, view)
-import Crypto.Error (onCryptoFailure)
 import Crypto.Number.Basic (log2)
-import qualified Crypto.PubKey.Ed25519 as Ed25519
-import qualified Crypto.PubKey.Curve25519 as Curve25519
 import Crypto.Random
 import Data.Aeson (FromJSON, ToJSON, decode, encode)
 import qualified Data.ByteString as B
@@ -88,7 +85,7 @@ genCrv :: Gen Crv
 genCrv = Gen.element [P_256, P_384, P_521]
 
 genOKPCrv :: Gen OKPCrv
-genOKPCrv = Gen.element [Ed25519, X25519]
+genOKPCrv = Gen.element [Ed25519, Ed448, X25519, X448]
 
 genKeyMaterialGenParam :: Gen KeyMaterialGenParam
 genKeyMaterialGenParam = Gen.choice
@@ -147,11 +144,15 @@ genRSAKeyParameters =
     <*> genBase64Integer
     <*> Gen.maybe (genRSAPrivateKeyParameters)
 
+genDRG :: Gen ChaChaDRG
+genDRG = do
+  let word64 = Gen.word64 Range.constantBounded
+  seed <- (,,,,) <$> word64 <*> word64 <*> word64 <*> word64 <*> word64
+  pure $ drgNewTest seed
+
 genECKeyParameters :: Gen ECKeyParameters
 genECKeyParameters = do
-    let word64 = Gen.word64 Range.constantBounded
-    seed <- (,,,,) <$> word64 <*> word64 <*> word64 <*> word64 <*> word64
-    let drg = drgNewTest seed
+    drg <- genDRG
     crv <- genCrv
     let (k, _) = withDRG drg (genEC crv)
     includePrivate <- Gen.bool
@@ -163,17 +164,14 @@ genOctKeyParameters :: Gen OctKeyParameters
 genOctKeyParameters = OctKeyParameters . Base64Octets <$> Gen.bytes (Range.linear 16 128)
 
 genOKPKeyParameters :: Gen OKPKeyParameters
-genOKPKeyParameters = Gen.choice
-  [ Ed25519Key
-    <$> keyOfLen 32 Ed25519.publicKey
-    <*> Gen.maybe (keyOfLen 32 Ed25519.secretKey)
-  , X25519Key
-    <$> keyOfLen 32 Curve25519.publicKey
-    <*> Gen.maybe (keyOfLen 32 Curve25519.secretKey)
-  ]
-  where
-    bsOfLen n = Gen.bytes (Range.singleton n)
-    keyOfLen n con = onCryptoFailure (error . show) id . con <$> bsOfLen n
+genOKPKeyParameters = do
+  drg <- genDRG
+  crv <- genOKPCrv
+  let (k, _) = withDRG drg (genOKP crv)
+  includePrivate <- Gen.bool
+  pure $ if includePrivate
+    then k
+    else (let Just a = view asPublicKey k in a)
 
 genKeyMaterial' :: Gen KeyMaterial
 genKeyMaterial' = Gen.choice