-- Copyright (C) 2013-2023  Fraser Tweedale
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

{-|

A JSON Web Key (JWK) is a JavaScript Object Notation (JSON) data
structure that represents a cryptographic key.  This module also
defines a JSON Web Key Set (JWK Set) JSON data structure for
representing a set of JWKs.

@
-- Generate RSA JWK and set "kid" param to
-- base64url-encoded SHA-256 thumbprint of key.
--
doGen :: IO JWK
doGen = do
  jwk <- 'genJWK' ('RSAGenParam' (4096 \`div` 8))
  let
    h = view 'thumbprint' jwk :: Digest SHA256
    kid = view (re ('Types.base64url' . 'digest') . utf8) h
  pure $ set 'jwkKid' (Just kid) jwk
@

-}
module Crypto.JOSE.JWK
  (
  -- * JWK generation
    genJWK
  , KeyMaterialGenParam(..)
  , Crv(..)
  , OKPCrv(..)
  , JWK
  , AsPublicKey(..)

  -- * Parts of a JWK
  , jwkMaterial
  , jwkUse
  , KeyUse(..)
  , jwkKeyOps
  , KeyOp(..)
  , jwkAlg
  , JWKAlg(..)
  , jwkKid
  , jwkX5u
  , jwkX5c
  , setJWKX5c
  , jwkX5t
  , jwkX5tS256

  -- * Converting from other key formats
  , fromKeyMaterial
  , fromRSA
  , fromRSAPublic
  , fromOctets
  , fromX509Certificate
  , fromX509PubKey
  , fromX509PrivKey

  -- * JWK Thumbprint
  , thumbprint
  , digest
  , Types.base64url
  , module Crypto.Hash

  -- * JWK Set
  , JWKSet(..)

  -- Miscellaneous
  , checkJWK
  , negotiateJWSAlg
  , bestJWSAlg

  , module Crypto.JOSE.JWA.JWK
  ) where

import Control.Applicative
import Control.Monad ((>=>))
import Data.Function (on)
import Data.List (find)
import Data.Maybe (catMaybes)
import Data.Word (Word8)

import Control.Lens hiding ((.=))
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')
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Builder as Builder
import Data.List.NonEmpty
import qualified Data.Text as T
import qualified Data.X509 as X509

import Crypto.JOSE.Error
import qualified Crypto.JOSE.JWA.JWE.Alg as JWA.JWE
import Crypto.JOSE.JWA.JWK
import qualified Crypto.JOSE.JWA.JWS as JWA.JWS
import qualified Crypto.JOSE.TH
import qualified Crypto.JOSE.Types as Types
import Crypto.JOSE.Types.URI
import qualified Crypto.JOSE.Types.Internal as Types


-- | RFC 7517 §4.4.  "alg" (Algorithm) Parameter
--
-- See also RFC 7518 §6.4. which states that for "oct" keys, an
-- "alg" member SHOULD be present to identify the algorithm intended
-- to be used with the key, unless the application uses another
-- means or convention to determine the algorithm used.
--
data JWKAlg = JWSAlg JWA.JWS.Alg | JWEAlg JWA.JWE.Alg
  deriving (JWKAlg -> JWKAlg -> Bool
(JWKAlg -> JWKAlg -> Bool)
-> (JWKAlg -> JWKAlg -> Bool) -> Eq JWKAlg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JWKAlg -> JWKAlg -> Bool
== :: JWKAlg -> JWKAlg -> Bool
$c/= :: JWKAlg -> JWKAlg -> Bool
/= :: JWKAlg -> JWKAlg -> Bool
Eq, Int -> JWKAlg -> ShowS
[JWKAlg] -> ShowS
JWKAlg -> String
(Int -> JWKAlg -> ShowS)
-> (JWKAlg -> String) -> ([JWKAlg] -> ShowS) -> Show JWKAlg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JWKAlg -> ShowS
showsPrec :: Int -> JWKAlg -> ShowS
$cshow :: JWKAlg -> String
show :: JWKAlg -> String
$cshowList :: [JWKAlg] -> ShowS
showList :: [JWKAlg] -> ShowS
Show)

instance FromJSON JWKAlg where
  parseJSON :: Value -> Parser JWKAlg
parseJSON Value
v = (Alg -> JWKAlg
JWSAlg (Alg -> JWKAlg) -> Parser Alg -> Parser JWKAlg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Alg
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v) Parser JWKAlg -> Parser JWKAlg -> Parser JWKAlg
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Alg -> JWKAlg
JWEAlg (Alg -> JWKAlg) -> Parser Alg -> Parser JWKAlg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Alg
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

instance ToJSON JWKAlg where
  toJSON :: JWKAlg -> Value
toJSON (JWSAlg Alg
alg) = Alg -> Value
forall a. ToJSON a => a -> Value
toJSON Alg
alg
  toJSON (JWEAlg Alg
alg) = Alg -> Value
forall a. ToJSON a => a -> Value
toJSON Alg
alg


-- | RFC 7517 §4.3.  "key_ops" (Key Operations) Parameter
--
$(Crypto.JOSE.TH.deriveJOSEType "KeyOp"
  [ "sign", "verify", "encrypt", "decrypt"
  , "wrapKey", "unwrapKey", "deriveKey", "deriveBits"
  ])


-- | RFC 7517 §4.2.  "use" (Public Key Use) Parameter
--
$(Crypto.JOSE.TH.deriveJOSEType "KeyUse" ["sig", "enc"])


-- | RFC 7517 §4.  JSON Web Key (JWK) Format
--
data JWK = JWK
  {
    JWK -> KeyMaterial
_jwkMaterial :: Crypto.JOSE.JWA.JWK.KeyMaterial
  , JWK -> Maybe KeyUse
_jwkUse :: Maybe KeyUse
  , JWK -> Maybe [KeyOp]
_jwkKeyOps :: Maybe [KeyOp]
  , JWK -> Maybe JWKAlg
_jwkAlg :: Maybe JWKAlg
  , JWK -> Maybe Text
_jwkKid :: Maybe T.Text
  , JWK -> Maybe URI
_jwkX5u :: Maybe Types.URI
  , JWK -> Maybe (NonEmpty SignedCertificate)
_jwkX5cRaw :: Maybe (NonEmpty X509.SignedCertificate)
  , JWK -> Maybe Base64SHA1
_jwkX5t :: Maybe Types.Base64SHA1
  , JWK -> Maybe Base64SHA256
_jwkX5tS256 :: Maybe Types.Base64SHA256
  }
  deriving (JWK -> JWK -> Bool
(JWK -> JWK -> Bool) -> (JWK -> JWK -> Bool) -> Eq JWK
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JWK -> JWK -> Bool
== :: JWK -> JWK -> Bool
$c/= :: JWK -> JWK -> Bool
/= :: JWK -> JWK -> Bool
Eq, Int -> JWK -> ShowS
[JWK] -> ShowS
JWK -> String
(Int -> JWK -> ShowS)
-> (JWK -> String) -> ([JWK] -> ShowS) -> Show JWK
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JWK -> ShowS
showsPrec :: Int -> JWK -> ShowS
$cshow :: JWK -> String
show :: JWK -> String
$cshowList :: [JWK] -> ShowS
showList :: [JWK] -> ShowS
Show)
makeLenses ''JWK

-- | Get the certificate chain.  Not a lens, because the key of the first
-- certificate in the chain must correspond be the public key of the JWK.
-- To set the certificate chain use 'setJWKX5c'.
--
jwkX5c :: Getter JWK (Maybe (NonEmpty X509.SignedCertificate))
jwkX5c :: Getter JWK (Maybe (NonEmpty SignedCertificate))
jwkX5c = (Maybe (NonEmpty SignedCertificate)
 -> f (Maybe (NonEmpty SignedCertificate)))
-> JWK -> f JWK
Lens' JWK (Maybe (NonEmpty SignedCertificate))
jwkX5cRaw

-- | Set the @"x5c"@ Certificate Chain parameter.  If setting the list,
-- checks that the key in the first certificate matches the JWK; returns
-- @Nothing@ if it does not.
--
setJWKX5c :: Maybe (NonEmpty X509.SignedCertificate) -> JWK -> Maybe JWK
setJWKX5c :: Maybe (NonEmpty SignedCertificate) -> JWK -> Maybe JWK
setJWKX5c Maybe (NonEmpty SignedCertificate)
Nothing JWK
k = JWK -> Maybe JWK
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ASetter
  JWK
  JWK
  (Maybe (NonEmpty SignedCertificate))
  (Maybe (NonEmpty SignedCertificate))
-> Maybe (NonEmpty SignedCertificate) -> JWK -> JWK
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  JWK
  JWK
  (Maybe (NonEmpty SignedCertificate))
  (Maybe (NonEmpty SignedCertificate))
Lens' JWK (Maybe (NonEmpty SignedCertificate))
jwkX5cRaw Maybe (NonEmpty SignedCertificate)
forall a. Maybe a
Nothing JWK
k)
setJWKX5c certs :: Maybe (NonEmpty SignedCertificate)
certs@(Just (SignedCertificate
cert :| [SignedCertificate]
_)) JWK
key
  | JWK -> SignedCertificate -> Bool
certMatchesKey JWK
key SignedCertificate
cert = JWK -> Maybe JWK
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ASetter
  JWK
  JWK
  (Maybe (NonEmpty SignedCertificate))
  (Maybe (NonEmpty SignedCertificate))
-> Maybe (NonEmpty SignedCertificate) -> JWK -> JWK
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  JWK
  JWK
  (Maybe (NonEmpty SignedCertificate))
  (Maybe (NonEmpty SignedCertificate))
Lens' JWK (Maybe (NonEmpty SignedCertificate))
jwkX5cRaw Maybe (NonEmpty SignedCertificate)
certs JWK
key)
  | Bool
otherwise = Maybe JWK
forall a. Maybe a
Nothing

certMatchesKey :: JWK -> X509.SignedCertificate -> Bool
certMatchesKey :: JWK -> SignedCertificate -> Bool
certMatchesKey JWK
key SignedCertificate
cert =
  Bool -> (JWK -> Bool) -> Maybe JWK -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Maybe (Maybe KeyMaterial) -> Maybe (Maybe KeyMaterial) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe (Maybe KeyMaterial) -> Maybe (Maybe KeyMaterial) -> Bool)
-> (JWK -> Maybe (Maybe KeyMaterial)) -> JWK -> JWK -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting (First (Maybe KeyMaterial)) JWK (Maybe KeyMaterial)
-> JWK -> Maybe (Maybe KeyMaterial)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((KeyMaterial -> Const (First (Maybe KeyMaterial)) KeyMaterial)
-> JWK -> Const (First (Maybe KeyMaterial)) JWK
Lens' JWK KeyMaterial
jwkMaterial ((KeyMaterial -> Const (First (Maybe KeyMaterial)) KeyMaterial)
 -> JWK -> Const (First (Maybe KeyMaterial)) JWK)
-> ((Maybe KeyMaterial
     -> Const (First (Maybe KeyMaterial)) (Maybe KeyMaterial))
    -> KeyMaterial -> Const (First (Maybe KeyMaterial)) KeyMaterial)
-> Getting (First (Maybe KeyMaterial)) JWK (Maybe KeyMaterial)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe KeyMaterial
 -> Const (First (Maybe KeyMaterial)) (Maybe KeyMaterial))
-> KeyMaterial -> Const (First (Maybe KeyMaterial)) KeyMaterial
forall k. AsPublicKey k => Getter k (Maybe k)
Getter KeyMaterial (Maybe KeyMaterial)
asPublicKey)) JWK
key)
    (SignedCertificate -> Maybe JWK
fromX509CertificateMaybe SignedCertificate
cert)


instance FromJSON JWK where
  parseJSON :: Value -> Parser JWK
parseJSON = String -> (Object -> Parser JWK) -> Value -> Parser JWK
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JWK" (\Object
o -> KeyMaterial
-> Maybe KeyUse
-> Maybe [KeyOp]
-> Maybe JWKAlg
-> Maybe Text
-> Maybe URI
-> Maybe (NonEmpty SignedCertificate)
-> Maybe Base64SHA1
-> Maybe Base64SHA256
-> JWK
JWK
    (KeyMaterial
 -> Maybe KeyUse
 -> Maybe [KeyOp]
 -> Maybe JWKAlg
 -> Maybe Text
 -> Maybe URI
 -> Maybe (NonEmpty SignedCertificate)
 -> Maybe Base64SHA1
 -> Maybe Base64SHA256
 -> JWK)
-> Parser KeyMaterial
-> Parser
     (Maybe KeyUse
      -> Maybe [KeyOp]
      -> Maybe JWKAlg
      -> Maybe Text
      -> Maybe URI
      -> Maybe (NonEmpty SignedCertificate)
      -> Maybe Base64SHA1
      -> Maybe Base64SHA256
      -> JWK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser KeyMaterial
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
    Parser
  (Maybe KeyUse
   -> Maybe [KeyOp]
   -> Maybe JWKAlg
   -> Maybe Text
   -> Maybe URI
   -> Maybe (NonEmpty SignedCertificate)
   -> Maybe Base64SHA1
   -> Maybe Base64SHA256
   -> JWK)
-> Parser (Maybe KeyUse)
-> Parser
     (Maybe [KeyOp]
      -> Maybe JWKAlg
      -> Maybe Text
      -> Maybe URI
      -> Maybe (NonEmpty SignedCertificate)
      -> Maybe Base64SHA1
      -> Maybe Base64SHA256
      -> JWK)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe KeyUse)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"use"
    Parser
  (Maybe [KeyOp]
   -> Maybe JWKAlg
   -> Maybe Text
   -> Maybe URI
   -> Maybe (NonEmpty SignedCertificate)
   -> Maybe Base64SHA1
   -> Maybe Base64SHA256
   -> JWK)
-> Parser (Maybe [KeyOp])
-> Parser
     (Maybe JWKAlg
      -> Maybe Text
      -> Maybe URI
      -> Maybe (NonEmpty SignedCertificate)
      -> Maybe Base64SHA1
      -> Maybe Base64SHA256
      -> JWK)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [KeyOp])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"key_ops"
    Parser
  (Maybe JWKAlg
   -> Maybe Text
   -> Maybe URI
   -> Maybe (NonEmpty SignedCertificate)
   -> Maybe Base64SHA1
   -> Maybe Base64SHA256
   -> JWK)
-> Parser (Maybe JWKAlg)
-> Parser
     (Maybe Text
      -> Maybe URI
      -> Maybe (NonEmpty SignedCertificate)
      -> Maybe Base64SHA1
      -> Maybe Base64SHA256
      -> JWK)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe JWKAlg)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"alg"
    Parser
  (Maybe Text
   -> Maybe URI
   -> Maybe (NonEmpty SignedCertificate)
   -> Maybe Base64SHA1
   -> Maybe Base64SHA256
   -> JWK)
-> Parser (Maybe Text)
-> Parser
     (Maybe URI
      -> Maybe (NonEmpty SignedCertificate)
      -> Maybe Base64SHA1
      -> Maybe Base64SHA256
      -> JWK)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"kid"
    Parser
  (Maybe URI
   -> Maybe (NonEmpty SignedCertificate)
   -> Maybe Base64SHA1
   -> Maybe Base64SHA256
   -> JWK)
-> Parser (Maybe URI)
-> Parser
     (Maybe (NonEmpty SignedCertificate)
      -> Maybe Base64SHA1 -> Maybe Base64SHA256 -> JWK)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser URI) -> Object -> Key -> Parser (Maybe URI)
forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe' Value -> Parser URI
uriFromJSON Object
o Key
"x5u"
    Parser
  (Maybe (NonEmpty SignedCertificate)
   -> Maybe Base64SHA1 -> Maybe Base64SHA256 -> JWK)
-> Parser (Maybe (NonEmpty SignedCertificate))
-> Parser (Maybe Base64SHA1 -> Maybe Base64SHA256 -> JWK)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (((NonEmpty Base64X509 -> NonEmpty SignedCertificate)
-> Maybe (NonEmpty Base64X509)
-> Maybe (NonEmpty SignedCertificate)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty Base64X509 -> NonEmpty SignedCertificate)
 -> Maybe (NonEmpty Base64X509)
 -> Maybe (NonEmpty SignedCertificate))
-> ((Base64X509 -> SignedCertificate)
    -> NonEmpty Base64X509 -> NonEmpty SignedCertificate)
-> (Base64X509 -> SignedCertificate)
-> Maybe (NonEmpty Base64X509)
-> Maybe (NonEmpty SignedCertificate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base64X509 -> SignedCertificate)
-> NonEmpty Base64X509 -> NonEmpty SignedCertificate
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (\(Types.Base64X509 SignedCertificate
cert) -> SignedCertificate
cert) (Maybe (NonEmpty Base64X509) -> Maybe (NonEmpty SignedCertificate))
-> Parser (Maybe (NonEmpty Base64X509))
-> Parser (Maybe (NonEmpty SignedCertificate))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe (NonEmpty Base64X509))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"x5c")
    Parser (Maybe Base64SHA1 -> Maybe Base64SHA256 -> JWK)
-> Parser (Maybe Base64SHA1) -> Parser (Maybe Base64SHA256 -> JWK)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Base64SHA1)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"x5t"
    Parser (Maybe Base64SHA256 -> JWK)
-> Parser (Maybe Base64SHA256) -> Parser JWK
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Base64SHA256)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"x5t#S256"
    ) (Value -> Parser JWK) -> (JWK -> Parser JWK) -> Value -> Parser JWK
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> JWK -> Parser JWK
forall {m :: * -> *}. MonadFail m => JWK -> m JWK
checkKey
    where
    checkKey :: JWK -> m JWK
checkKey JWK
k
      | Bool
-> (NonEmpty SignedCertificate -> Bool)
-> Maybe (NonEmpty SignedCertificate)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Bool
not (Bool -> Bool)
-> (NonEmpty SignedCertificate -> Bool)
-> NonEmpty SignedCertificate
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JWK -> SignedCertificate -> Bool
certMatchesKey JWK
k (SignedCertificate -> Bool)
-> (NonEmpty SignedCertificate -> SignedCertificate)
-> NonEmpty SignedCertificate
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty SignedCertificate -> SignedCertificate
forall a. NonEmpty a -> a
Data.List.NonEmpty.head) (Getting
  (Maybe (NonEmpty SignedCertificate))
  JWK
  (Maybe (NonEmpty SignedCertificate))
-> JWK -> Maybe (NonEmpty SignedCertificate)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (NonEmpty SignedCertificate))
  JWK
  (Maybe (NonEmpty SignedCertificate))
Getter JWK (Maybe (NonEmpty SignedCertificate))
jwkX5c JWK
k)
        = String -> m JWK
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"X.509 cert in \"x5c\" param does not match key"
      | Bool
otherwise = JWK -> m JWK
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JWK
k

instance ToJSON JWK where
  toJSON :: JWK -> Value
toJSON JWK{Maybe [KeyOp]
Maybe (NonEmpty SignedCertificate)
Maybe Text
Maybe URI
Maybe Base64SHA256
Maybe Base64SHA1
Maybe JWKAlg
Maybe KeyUse
KeyMaterial
_jwkMaterial :: JWK -> KeyMaterial
_jwkUse :: JWK -> Maybe KeyUse
_jwkKeyOps :: JWK -> Maybe [KeyOp]
_jwkAlg :: JWK -> Maybe JWKAlg
_jwkKid :: JWK -> Maybe Text
_jwkX5u :: JWK -> Maybe URI
_jwkX5cRaw :: JWK -> Maybe (NonEmpty SignedCertificate)
_jwkX5t :: JWK -> Maybe Base64SHA1
_jwkX5tS256 :: JWK -> Maybe Base64SHA256
_jwkMaterial :: KeyMaterial
_jwkUse :: Maybe KeyUse
_jwkKeyOps :: Maybe [KeyOp]
_jwkAlg :: Maybe JWKAlg
_jwkKid :: Maybe Text
_jwkX5u :: Maybe URI
_jwkX5cRaw :: Maybe (NonEmpty SignedCertificate)
_jwkX5t :: Maybe Base64SHA1
_jwkX5tS256 :: Maybe Base64SHA256
..} = [Pair] -> Value -> Value
Types.insertManyToObject [Pair]
forall {e} {a}. KeyValue e a => [a]
kvs (KeyMaterial -> Value
forall a. ToJSON a => a -> Value
toJSON KeyMaterial
_jwkMaterial)
    where
      kvs :: [a]
kvs = [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes
        [ (JWKAlg -> a) -> Maybe JWKAlg -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"alg" .=) Maybe JWKAlg
_jwkAlg
        , (KeyUse -> a) -> Maybe KeyUse -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"use" .=) Maybe KeyUse
_jwkUse
        , ([KeyOp] -> a) -> Maybe [KeyOp] -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"key_ops" .=) Maybe [KeyOp]
_jwkKeyOps
        , (Text -> a) -> Maybe Text -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"kid" .=) Maybe Text
_jwkKid
        , (Value -> a) -> Maybe Value -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"x5u" .=) (URI -> Value
uriToJSON (URI -> Value) -> Maybe URI -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URI
_jwkX5u)
        , (NonEmpty SignedCertificate -> a)
-> Maybe (NonEmpty SignedCertificate) -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"x5c" .=) (NonEmpty Base64X509 -> a)
-> (NonEmpty SignedCertificate -> NonEmpty Base64X509)
-> NonEmpty SignedCertificate
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignedCertificate -> Base64X509)
-> NonEmpty SignedCertificate -> NonEmpty Base64X509
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SignedCertificate -> Base64X509
Types.Base64X509) Maybe (NonEmpty SignedCertificate)
_jwkX5cRaw
        , (Base64SHA1 -> a) -> Maybe Base64SHA1 -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"x5t" .=) Maybe Base64SHA1
_jwkX5t
        , (Base64SHA256 -> a) -> Maybe Base64SHA256 -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"x5t#S256" .=) Maybe Base64SHA256
_jwkX5tS256
        ]

-- | Generate a JWK.  Apart from key parameters, no other parameters are set.
--
genJWK :: MonadRandom m => KeyMaterialGenParam -> m JWK
genJWK :: forall (m :: * -> *). MonadRandom m => KeyMaterialGenParam -> m JWK
genJWK KeyMaterialGenParam
p = KeyMaterial -> JWK
fromKeyMaterial (KeyMaterial -> JWK) -> m KeyMaterial -> m JWK
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMaterialGenParam -> m KeyMaterial
forall (m :: * -> *).
MonadRandom m =>
KeyMaterialGenParam -> m KeyMaterial
genKeyMaterial KeyMaterialGenParam
p

fromKeyMaterial :: KeyMaterial -> JWK
fromKeyMaterial :: KeyMaterial -> JWK
fromKeyMaterial KeyMaterial
k = KeyMaterial
-> Maybe KeyUse
-> Maybe [KeyOp]
-> Maybe JWKAlg
-> Maybe Text
-> Maybe URI
-> Maybe (NonEmpty SignedCertificate)
-> Maybe Base64SHA1
-> Maybe Base64SHA256
-> JWK
JWK KeyMaterial
k Maybe KeyUse
forall a. Maybe a
z Maybe [KeyOp]
forall a. Maybe a
z Maybe JWKAlg
forall a. Maybe a
z Maybe Text
forall a. Maybe a
z Maybe URI
forall a. Maybe a
z Maybe (NonEmpty SignedCertificate)
forall a. Maybe a
z Maybe Base64SHA1
forall a. Maybe a
z Maybe Base64SHA256
forall a. Maybe a
z where z :: Maybe a
z = Maybe a
forall a. Maybe a
Nothing


-- | Convert RSA private key into a JWK
--
fromRSA :: RSA.PrivateKey -> JWK
fromRSA :: PrivateKey -> JWK
fromRSA = KeyMaterial -> JWK
fromKeyMaterial (KeyMaterial -> JWK)
-> (PrivateKey -> KeyMaterial) -> PrivateKey -> JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RSAKeyParameters -> KeyMaterial
RSAKeyMaterial (RSAKeyParameters -> KeyMaterial)
-> (PrivateKey -> RSAKeyParameters) -> PrivateKey -> KeyMaterial
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> RSAKeyParameters
toRSAKeyParameters

-- | Convert an RSA public key into a JWK
--
fromRSAPublic :: RSA.PublicKey -> JWK
fromRSAPublic :: PublicKey -> JWK
fromRSAPublic = KeyMaterial -> JWK
fromKeyMaterial (KeyMaterial -> JWK)
-> (PublicKey -> KeyMaterial) -> PublicKey -> JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RSAKeyParameters -> KeyMaterial
RSAKeyMaterial (RSAKeyParameters -> KeyMaterial)
-> (PublicKey -> RSAKeyParameters) -> PublicKey -> KeyMaterial
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> RSAKeyParameters
toRSAPublicKeyParameters


-- | Convert octet string into a JWK
--
fromOctets :: Cons s s Word8 Word8 => s -> JWK
fromOctets :: forall s. Cons s s Word8 Word8 => s -> JWK
fromOctets =
  KeyMaterial -> JWK
fromKeyMaterial (KeyMaterial -> JWK) -> (s -> KeyMaterial) -> s -> JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OctKeyParameters -> KeyMaterial
OctKeyMaterial (OctKeyParameters -> KeyMaterial)
-> (s -> OctKeyParameters) -> s -> KeyMaterial
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64Octets -> OctKeyParameters
OctKeyParameters (Base64Octets -> OctKeyParameters)
-> (s -> Base64Octets) -> s -> OctKeyParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64Octets
Types.Base64Octets
  (ByteString -> Base64Octets)
-> (s -> ByteString) -> s -> Base64Octets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ByteString s ByteString -> s -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString s ByteString
forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
Getter s ByteString
recons
{-# INLINE fromOctets #-}


-- | Convert from a 'X509.PubKey' (such as can be read via the
-- /crypton-x509-store/ package).  Supports RSA, ECDSA, Ed25519,
-- Ed448, X25519 and X448 keys.
--
fromX509PubKey :: (AsError e, MonadError e m) => X509.PubKey -> m JWK
fromX509PubKey :: forall e (m :: * -> *).
(AsError e, MonadError e m) =>
PubKey -> m JWK
fromX509PubKey = \case
  X509.PubKeyRSA PublicKey
k      -> JWK -> m JWK
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> JWK
fromRSAPublic PublicKey
k)
  X509.PubKeyEC PubKeyEC
k       -> PubKeyEC -> m JWK
forall {f :: * -> *} {e}.
(MonadError e f, AsError e) =>
PubKeyEC -> f JWK
fromECPublic PubKeyEC
k
  X509.PubKeyX25519 PublicKey
k   -> OKPKeyParameters -> m JWK
forall {f :: * -> *}. Applicative f => OKPKeyParameters -> f JWK
fromOKP (OKPKeyParameters -> m JWK) -> OKPKeyParameters -> m JWK
forall a b. (a -> b) -> a -> b
$ PublicKey -> Maybe SecretKey -> OKPKeyParameters
X25519Key PublicKey
k Maybe SecretKey
forall a. Maybe a
Nothing
  X509.PubKeyX448 PublicKey
k     -> OKPKeyParameters -> m JWK
forall {f :: * -> *}. Applicative f => OKPKeyParameters -> f JWK
fromOKP (OKPKeyParameters -> m JWK) -> OKPKeyParameters -> m JWK
forall a b. (a -> b) -> a -> b
$ PublicKey -> Maybe SecretKey -> OKPKeyParameters
X448Key PublicKey
k Maybe SecretKey
forall a. Maybe a
Nothing
  X509.PubKeyEd25519 PublicKey
k  -> OKPKeyParameters -> m JWK
forall {f :: * -> *}. Applicative f => OKPKeyParameters -> f JWK
fromOKP (OKPKeyParameters -> m JWK) -> OKPKeyParameters -> m JWK
forall a b. (a -> b) -> a -> b
$ PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed25519Key PublicKey
k Maybe SecretKey
forall a. Maybe a
Nothing
  X509.PubKeyEd448 PublicKey
k    -> OKPKeyParameters -> m JWK
forall {f :: * -> *}. Applicative f => OKPKeyParameters -> f JWK
fromOKP (OKPKeyParameters -> m JWK) -> OKPKeyParameters -> m JWK
forall a b. (a -> b) -> a -> b
$ PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed448Key PublicKey
k Maybe SecretKey
forall a. Maybe a
Nothing
  PubKey
_ -> AReview e Text -> Text -> m JWK
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e Text
_KeyMismatch Text
"X.509 key type not supported"
  where
    fromECPublic :: PubKeyEC -> f JWK
fromECPublic = (ECKeyParameters -> JWK) -> f ECKeyParameters -> f JWK
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (KeyMaterial -> JWK
fromKeyMaterial (KeyMaterial -> JWK)
-> (ECKeyParameters -> KeyMaterial) -> ECKeyParameters -> JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ECKeyParameters -> KeyMaterial
ECKeyMaterial) (f ECKeyParameters -> f JWK)
-> (PubKeyEC -> f ECKeyParameters) -> PubKeyEC -> f JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyEC -> f ECKeyParameters
forall e (m :: * -> *).
(MonadError e m, AsError e) =>
PubKeyEC -> m ECKeyParameters
ecParametersFromX509
    fromOKP :: OKPKeyParameters -> f JWK
fromOKP = JWK -> f JWK
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JWK -> f JWK)
-> (OKPKeyParameters -> JWK) -> OKPKeyParameters -> f JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMaterial -> JWK
fromKeyMaterial (KeyMaterial -> JWK)
-> (OKPKeyParameters -> KeyMaterial) -> OKPKeyParameters -> JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OKPKeyParameters -> KeyMaterial
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 :: forall e (m :: * -> *).
(AsError e, MonadError e m) =>
PrivKey -> m JWK
fromX509PrivKey = \case
  X509.PrivKeyRSA PrivateKey
k      -> JWK -> m JWK
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrivateKey -> JWK
fromRSA PrivateKey
k)
  X509.PrivKeyEC PrivKeyEC
k       -> PrivKeyEC -> m JWK
forall {f :: * -> *} {e}.
(MonadError e f, AsError e) =>
PrivKeyEC -> f JWK
fromEC PrivKeyEC
k
  X509.PrivKeyX25519 SecretKey
k   -> OKPKeyParameters -> m JWK
forall {f :: * -> *}. Applicative f => OKPKeyParameters -> f JWK
fromOKP (OKPKeyParameters -> m JWK) -> OKPKeyParameters -> m JWK
forall a b. (a -> b) -> a -> b
$ PublicKey -> Maybe SecretKey -> OKPKeyParameters
X25519Key (SecretKey -> PublicKey
Curve25519.toPublic SecretKey
k) (SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just SecretKey
k)
  X509.PrivKeyX448 SecretKey
k     -> OKPKeyParameters -> m JWK
forall {f :: * -> *}. Applicative f => OKPKeyParameters -> f JWK
fromOKP (OKPKeyParameters -> m JWK) -> OKPKeyParameters -> m JWK
forall a b. (a -> b) -> a -> b
$ PublicKey -> Maybe SecretKey -> OKPKeyParameters
X448Key (SecretKey -> PublicKey
Curve448.toPublic SecretKey
k) (SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just SecretKey
k)
  X509.PrivKeyEd25519 SecretKey
k  -> OKPKeyParameters -> m JWK
forall {f :: * -> *}. Applicative f => OKPKeyParameters -> f JWK
fromOKP (OKPKeyParameters -> m JWK) -> OKPKeyParameters -> m JWK
forall a b. (a -> b) -> a -> b
$ PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed25519Key (SecretKey -> PublicKey
Ed25519.toPublic SecretKey
k) (SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just SecretKey
k)
  X509.PrivKeyEd448 SecretKey
k    -> OKPKeyParameters -> m JWK
forall {f :: * -> *}. Applicative f => OKPKeyParameters -> f JWK
fromOKP (OKPKeyParameters -> m JWK) -> OKPKeyParameters -> m JWK
forall a b. (a -> b) -> a -> b
$ PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed448Key (SecretKey -> PublicKey
Ed448.toPublic SecretKey
k) (SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just SecretKey
k)
  PrivKey
_ -> AReview e Text -> Text -> m JWK
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e Text
_KeyMismatch Text
"X.509 key type not supported"
  where
    fromEC :: PrivKeyEC -> f JWK
fromEC = (ECKeyParameters -> JWK) -> f ECKeyParameters -> f JWK
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (KeyMaterial -> JWK
fromKeyMaterial (KeyMaterial -> JWK)
-> (ECKeyParameters -> KeyMaterial) -> ECKeyParameters -> JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ECKeyParameters -> KeyMaterial
ECKeyMaterial) (f ECKeyParameters -> f JWK)
-> (PrivKeyEC -> f ECKeyParameters) -> PrivKeyEC -> f JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivKeyEC -> f ECKeyParameters
forall e (m :: * -> *).
(MonadError e m, AsError e) =>
PrivKeyEC -> m ECKeyParameters
ecParametersFromX509Priv
    fromOKP :: OKPKeyParameters -> f JWK
fromOKP = JWK -> f JWK
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JWK -> f JWK)
-> (OKPKeyParameters -> JWK) -> OKPKeyParameters -> f JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMaterial -> JWK
fromKeyMaterial (KeyMaterial -> JWK)
-> (OKPKeyParameters -> KeyMaterial) -> OKPKeyParameters -> JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OKPKeyParameters -> KeyMaterial
OKPKeyMaterial


-- | Convert an X.509 certificate into a JWK.
--
-- Supports RSA, ECDSA (curves defined for use in JOSE), and Edwards
-- curves (Ed25519, Ed448, X25519, X448).
--
-- The @"x5c"@ field of the resulting JWK contains the certificate.
--
fromX509Certificate
  :: (AsError e, MonadError e m)
  => X509.SignedCertificate -> m JWK
fromX509Certificate :: forall e (m :: * -> *).
(AsError e, MonadError e m) =>
SignedCertificate -> m JWK
fromX509Certificate SignedCertificate
cert = do
  JWK
k <- PubKey -> m JWK
forall e (m :: * -> *).
(AsError e, MonadError e m) =>
PubKey -> m JWK
fromX509PubKey (PubKey -> m JWK)
-> (Signed Certificate -> PubKey) -> Signed Certificate -> m JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Certificate -> PubKey
X509.certPubKey (Certificate -> PubKey)
-> (Signed Certificate -> Certificate)
-> Signed Certificate
-> PubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signed Certificate -> Certificate
forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
X509.signedObject (Signed Certificate -> m JWK) -> Signed Certificate -> m JWK
forall a b. (a -> b) -> a -> b
$ SignedCertificate -> Signed Certificate
forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
X509.getSigned SignedCertificate
cert
  JWK -> m JWK
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JWK -> m JWK) -> JWK -> m JWK
forall a b. (a -> b) -> a -> b
$ JWK
k JWK -> (JWK -> JWK) -> JWK
forall a b. a -> (a -> b) -> b
& ASetter
  JWK
  JWK
  (Maybe (NonEmpty SignedCertificate))
  (Maybe (NonEmpty SignedCertificate))
-> Maybe (NonEmpty SignedCertificate) -> JWK -> JWK
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  JWK
  JWK
  (Maybe (NonEmpty SignedCertificate))
  (Maybe (NonEmpty SignedCertificate))
Lens' JWK (Maybe (NonEmpty SignedCertificate))
jwkX5cRaw (NonEmpty SignedCertificate -> Maybe (NonEmpty SignedCertificate)
forall a. a -> Maybe a
Just (SignedCertificate -> NonEmpty SignedCertificate
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignedCertificate
cert))

fromX509CertificateMaybe :: X509.SignedCertificate -> Maybe JWK
fromX509CertificateMaybe :: SignedCertificate -> Maybe JWK
fromX509CertificateMaybe = Either Error JWK -> Maybe JWK
f (Either Error JWK -> Maybe JWK)
-> (SignedCertificate -> Either Error JWK)
-> SignedCertificate
-> Maybe JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except Error JWK -> Either Error JWK
forall e a. Except e a -> Either e a
runExcept (Except Error JWK -> Either Error JWK)
-> (SignedCertificate -> Except Error JWK)
-> SignedCertificate
-> Either Error JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedCertificate -> Except Error JWK
forall e (m :: * -> *).
(AsError e, MonadError e m) =>
SignedCertificate -> m JWK
fromX509Certificate
  where
    f :: Either Error JWK -> Maybe JWK
    f :: Either Error JWK -> Maybe JWK
f (Left Error
_) = Maybe JWK
forall a. Maybe a
Nothing
    f (Right JWK
jwk) = JWK -> Maybe JWK
forall a. a -> Maybe a
Just JWK
jwk


instance AsPublicKey JWK where
  asPublicKey :: Getter JWK (Maybe JWK)
asPublicKey = (JWK -> Maybe JWK) -> (Maybe JWK -> f (Maybe JWK)) -> JWK -> f JWK
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((KeyMaterial -> Maybe KeyMaterial) -> JWK -> Maybe JWK
Lens' JWK KeyMaterial
jwkMaterial (Getting (Maybe KeyMaterial) KeyMaterial (Maybe KeyMaterial)
-> KeyMaterial -> Maybe KeyMaterial
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe KeyMaterial) KeyMaterial (Maybe KeyMaterial)
forall k. AsPublicKey k => Getter k (Maybe k)
Getter KeyMaterial (Maybe KeyMaterial)
asPublicKey))


-- | RFC 7517 §5.  JWK Set Format
--
newtype JWKSet = JWKSet [JWK] deriving (JWKSet -> JWKSet -> Bool
(JWKSet -> JWKSet -> Bool)
-> (JWKSet -> JWKSet -> Bool) -> Eq JWKSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JWKSet -> JWKSet -> Bool
== :: JWKSet -> JWKSet -> Bool
$c/= :: JWKSet -> JWKSet -> Bool
/= :: JWKSet -> JWKSet -> Bool
Eq, Int -> JWKSet -> ShowS
[JWKSet] -> ShowS
JWKSet -> String
(Int -> JWKSet -> ShowS)
-> (JWKSet -> String) -> ([JWKSet] -> ShowS) -> Show JWKSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JWKSet -> ShowS
showsPrec :: Int -> JWKSet -> ShowS
$cshow :: JWKSet -> String
show :: JWKSet -> String
$cshowList :: [JWKSet] -> ShowS
showList :: [JWKSet] -> ShowS
Show, NonEmpty JWKSet -> JWKSet
JWKSet -> JWKSet -> JWKSet
(JWKSet -> JWKSet -> JWKSet)
-> (NonEmpty JWKSet -> JWKSet)
-> (forall b. Integral b => b -> JWKSet -> JWKSet)
-> Semigroup JWKSet
forall b. Integral b => b -> JWKSet -> JWKSet
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: JWKSet -> JWKSet -> JWKSet
<> :: JWKSet -> JWKSet -> JWKSet
$csconcat :: NonEmpty JWKSet -> JWKSet
sconcat :: NonEmpty JWKSet -> JWKSet
$cstimes :: forall b. Integral b => b -> JWKSet -> JWKSet
stimes :: forall b. Integral b => b -> JWKSet -> JWKSet
Semigroup, Semigroup JWKSet
JWKSet
Semigroup JWKSet =>
JWKSet
-> (JWKSet -> JWKSet -> JWKSet)
-> ([JWKSet] -> JWKSet)
-> Monoid JWKSet
[JWKSet] -> JWKSet
JWKSet -> JWKSet -> JWKSet
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: JWKSet
mempty :: JWKSet
$cmappend :: JWKSet -> JWKSet -> JWKSet
mappend :: JWKSet -> JWKSet -> JWKSet
$cmconcat :: [JWKSet] -> JWKSet
mconcat :: [JWKSet] -> JWKSet
Monoid)

instance FromJSON JWKSet where
  parseJSON :: Value -> Parser JWKSet
parseJSON = String -> (Object -> Parser JWKSet) -> Value -> Parser JWKSet
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JWKSet" (\Object
o -> [JWK] -> JWKSet
JWKSet ([JWK] -> JWKSet) -> Parser [JWK] -> Parser JWKSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [JWK]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"keys")

instance ToJSON JWKSet where
  toJSON :: JWKSet -> Value
toJSON (JWKSet [JWK]
ks) = [Pair] -> Value
object [Key
"keys" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [JWK] -> Value
forall a. ToJSON a => a -> Value
toJSON [JWK]
ks]


-- | Sanity-check a JWK.
--
-- Return an appropriate error if the key is size is too small to be
-- used with any JOSE algorithm, or for other problems that mean the
-- key cannot be used.
--
checkJWK :: (MonadError e m, AsError e) => JWK -> m ()
checkJWK :: forall e (m :: * -> *). (MonadError e m, AsError e) => JWK -> m ()
checkJWK JWK
jwk = case Getting KeyMaterial JWK KeyMaterial -> JWK -> KeyMaterial
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting KeyMaterial JWK KeyMaterial
Lens' JWK KeyMaterial
jwkMaterial JWK
jwk of
  RSAKeyMaterial (Getting Base64Integer RSAKeyParameters Base64Integer
-> RSAKeyParameters -> Base64Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Base64Integer RSAKeyParameters Base64Integer
Lens' RSAKeyParameters Base64Integer
rsaN -> Types.Base64Integer Integer
n)
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
2040 :: Integer) -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    | Bool
otherwise -> AReview e () -> () -> m ()
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e ()
forall r. AsError r => Prism' r ()
Prism' e ()
_KeySizeTooSmall ()
  OctKeyMaterial (Getting Base64Octets OctKeyParameters Base64Octets
-> OctKeyParameters -> Base64Octets
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Base64Octets OctKeyParameters Base64Octets
Iso' OctKeyParameters Base64Octets
octK -> Types.Base64Octets ByteString
k)
    | ByteString -> Int
B.length ByteString
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
256 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8 -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    | Bool
otherwise -> AReview e () -> () -> m ()
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e ()
forall r. AsError r => Prism' r ()
Prism' e ()
_KeySizeTooSmall ()
  KeyMaterial
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | Choose the cryptographically strongest JWS algorithm for a
-- given key.  The JWK "alg" algorithm parameter is ignored.
--
-- See also 'negotiateJWSAlg'.
--
-- @
-- bestJWSAlg k = negotiateJWSAlg k Nothing
-- @
--
bestJWSAlg
  :: (MonadError e m, AsError e)
  => JWK
  -> m JWA.JWS.Alg
bestJWSAlg :: forall e (m :: * -> *). (MonadError e m, AsError e) => JWK -> m Alg
bestJWSAlg JWK
jwk = JWK -> Maybe (NonEmpty Alg) -> m Alg
forall e (m :: * -> *).
(MonadError e m, AsError e) =>
JWK -> Maybe (NonEmpty Alg) -> m Alg
chooseJWSAlg JWK
jwk Maybe (NonEmpty Alg)
forall a. Maybe a
Nothing

-- | Choose the cryptographically strongest JWS algorithm for a
-- given key, restricted to a given set of algorithms.  This
-- function supports negotiation use cases where verifier's
-- supported algorithms are advertised or known.
--
-- Throws an error if the key is too small or cannot be used for
-- signing, or if there is no overlap between the allowed algorithms
-- and the algorithms supported by the key type.
--
-- RSASSA-PSS algorithms are preferred over RSASSA-PKCS1-v1_5.
--
-- The JWK "alg" parameter is ignored.
--
negotiateJWSAlg
  :: (MonadError e m, AsError e)
  => JWK
  -> NonEmpty JWA.JWS.Alg
  -> m JWA.JWS.Alg
negotiateJWSAlg :: forall e (m :: * -> *).
(MonadError e m, AsError e) =>
JWK -> NonEmpty Alg -> m Alg
negotiateJWSAlg JWK
jwk = JWK -> Maybe (NonEmpty Alg) -> m Alg
forall e (m :: * -> *).
(MonadError e m, AsError e) =>
JWK -> Maybe (NonEmpty Alg) -> m Alg
chooseJWSAlg JWK
jwk (Maybe (NonEmpty Alg) -> m Alg)
-> (NonEmpty Alg -> Maybe (NonEmpty Alg)) -> NonEmpty Alg -> m Alg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Alg -> Maybe (NonEmpty Alg)
forall a. a -> Maybe a
Just

-- | General implementation used by 'bestJWSAlg' and 'negotiateJWSAlg'.
--
chooseJWSAlg
  :: (MonadError e m, AsError e)
  => JWK
  -> Maybe (NonEmpty JWA.JWS.Alg)
  -> m JWA.JWS.Alg
chooseJWSAlg :: forall e (m :: * -> *).
(MonadError e m, AsError e) =>
JWK -> Maybe (NonEmpty Alg) -> m Alg
chooseJWSAlg JWK
jwk Maybe (NonEmpty Alg)
allowed = case Getting KeyMaterial JWK KeyMaterial -> JWK -> KeyMaterial
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting KeyMaterial JWK KeyMaterial
Lens' JWK KeyMaterial
jwkMaterial JWK
jwk of
  ECKeyMaterial ECKeyParameters
k -> case Getting Crv ECKeyParameters Crv -> ECKeyParameters -> Crv
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Crv ECKeyParameters Crv
Getter ECKeyParameters Crv
ecCrv ECKeyParameters
k of
    Crv
P_256     | Alg -> Bool
ok Alg
JWA.JWS.ES256  -> Alg -> m Alg
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alg
JWA.JWS.ES256
    Crv
P_384     | Alg -> Bool
ok Alg
JWA.JWS.ES384  -> Alg -> m Alg
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alg
JWA.JWS.ES384
    Crv
P_521     | Alg -> Bool
ok Alg
JWA.JWS.ES512  -> Alg -> m Alg
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alg
JWA.JWS.ES512
    Crv
Secp256k1 | Alg -> Bool
ok Alg
JWA.JWS.ES256K -> Alg -> m Alg
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alg
JWA.JWS.ES256K
    Crv
_                             -> m Alg
forall {e} {m :: * -> *} {x}. (MonadError e m, AsError e) => m x
negoFail
  RSAKeyMaterial RSAKeyParameters
k
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
2040 :: Integer) -> AReview e () -> m Alg
forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
throwing_ AReview e ()
forall r. AsError r => Prism' r ()
Prism' e ()
_KeySizeTooSmall
    | Bool
otherwise                 -> m Alg -> (Alg -> m Alg) -> Maybe Alg -> m Alg
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Alg
forall {e} {m :: * -> *} {x}. (MonadError e m, AsError e) => m x
negoFail Alg -> m Alg
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Alg -> Bool) -> [Alg] -> Maybe Alg
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Alg -> Bool
ok [Alg]
rsaAlgs)
    where
      Types.Base64Integer Integer
n = Getting Base64Integer RSAKeyParameters Base64Integer
-> RSAKeyParameters -> Base64Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Base64Integer RSAKeyParameters Base64Integer
Lens' RSAKeyParameters Base64Integer
rsaN RSAKeyParameters
k
      rsaAlgs :: [Alg]
rsaAlgs =
        [ Alg
JWA.JWS.PS512 , Alg
JWA.JWS.PS384 , Alg
JWA.JWS.PS256
        , Alg
JWA.JWS.RS512 , Alg
JWA.JWS.RS384 , Alg
JWA.JWS.RS256 ]
  OctKeyMaterial (OctKeyParameters (Types.Base64Octets ByteString
k))
    | ByteString -> Int
B.length ByteString
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
512 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8, Alg -> Bool
ok Alg
JWA.JWS.HS512 -> Alg -> m Alg
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alg
JWA.JWS.HS512
    | ByteString -> Int
B.length ByteString
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
384 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8, Alg -> Bool
ok Alg
JWA.JWS.HS384 -> Alg -> m Alg
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alg
JWA.JWS.HS384
    | ByteString -> Int
B.length ByteString
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
256 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8, Alg -> Bool
ok Alg
JWA.JWS.HS256 -> Alg -> m Alg
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alg
JWA.JWS.HS256
    | ByteString -> Int
B.length ByteString
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
256 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8                   -> m Alg
forall {e} {m :: * -> *} {x}. (MonadError e m, AsError e) => m x
negoFail
    | Bool
otherwise                                   -> AReview e () -> m Alg
forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
throwing_ AReview e ()
forall r. AsError r => Prism' r ()
Prism' e ()
_KeySizeTooSmall
  OKPKeyMaterial OKPKeyParameters
k -> case OKPKeyParameters
k of
    (X25519Key PublicKey
_ Maybe SecretKey
_)                     -> AReview e Text -> Text -> m Alg
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e Text
_KeyMismatch Text
"Cannot sign with X25519 key"
    (X448Key PublicKey
_ Maybe SecretKey
_)                       -> AReview e Text -> Text -> m Alg
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e Text
_KeyMismatch Text
"Cannot sign with X448 key"
    (Ed25519Key PublicKey
_ Maybe SecretKey
_) | Alg -> Bool
ok Alg
JWA.JWS.EdDSA -> Alg -> m Alg
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alg
JWA.JWS.EdDSA
    (Ed448Key PublicKey
_ Maybe SecretKey
_)   | Alg -> Bool
ok Alg
JWA.JWS.EdDSA -> Alg -> m Alg
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alg
JWA.JWS.EdDSA
    OKPKeyParameters
_                                   -> m Alg
forall {e} {m :: * -> *} {x}. (MonadError e m, AsError e) => m x
negoFail
  where
    ok :: Alg -> Bool
ok Alg
alg = Bool -> (NonEmpty Alg -> Bool) -> Maybe (NonEmpty Alg) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Alg
alg `elem`) Maybe (NonEmpty Alg)
allowed
    negoFail :: m x
negoFail = AReview e String -> String -> m x
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e String
forall r. AsError r => Prism' r String
Prism' e String
_AlgorithmMismatch String
"Algorithm negotation failed"


-- | Compute the JWK Thumbprint of a JWK
--
thumbprint :: HashAlgorithm a => Getter JWK (Digest a)
thumbprint :: forall a. HashAlgorithm a => Getter JWK (Digest a)
thumbprint = (JWK -> Digest a) -> (Digest a -> f (Digest a)) -> JWK -> f JWK
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (ByteString -> Digest a
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash (ByteString -> Digest a) -> (JWK -> ByteString) -> JWK -> Digest a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> ByteString
L.toStrict (LazyByteString -> ByteString)
-> (JWK -> LazyByteString) -> JWK -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JWK -> LazyByteString
thumbprintRepr)

-- | Prism from ByteString to @HashAlgorithm a => Digest a@.
--
-- Use @'re' digest@ to view the bytes of a digest
--
digest :: HashAlgorithm a => Prism' B.ByteString (Digest a)
digest :: forall a. HashAlgorithm a => Prism' ByteString (Digest a)
digest = (Digest a -> ByteString)
-> (ByteString -> Maybe (Digest a))
-> Prism ByteString ByteString (Digest a) (Digest a)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Digest a -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ByteString -> Maybe (Digest a)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString

-- | JWK canonicalised for thumbprint computation
--
thumbprintRepr :: JWK -> L.ByteString
thumbprintRepr :: JWK -> LazyByteString
thumbprintRepr JWK
k = Builder -> LazyByteString
Builder.toLazyByteString (Builder -> LazyByteString)
-> (Series -> Builder) -> Series -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding (Encoding -> Builder) -> (Series -> Encoding) -> Series -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series -> Encoding
pairs (Series -> LazyByteString) -> Series -> LazyByteString
forall a b. (a -> b) -> a -> b
$
  case Getting KeyMaterial JWK KeyMaterial -> JWK -> KeyMaterial
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting KeyMaterial JWK KeyMaterial
Lens' JWK KeyMaterial
jwkMaterial JWK
k of
    ECKeyMaterial ECKeyParameters
k' -> Key
"crv" Key -> Crv -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=
      Getting Crv ECKeyParameters Crv -> ECKeyParameters -> Crv
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Crv ECKeyParameters Crv
Getter ECKeyParameters Crv
ecCrv ECKeyParameters
k'
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"kty" Key -> Text -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"EC" :: T.Text)
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"x" Key -> SizedBase64Integer -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
-> ECKeyParameters -> SizedBase64Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
Getter ECKeyParameters SizedBase64Integer
ecX ECKeyParameters
k'
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"y" Key -> SizedBase64Integer -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
-> ECKeyParameters -> SizedBase64Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
Getter ECKeyParameters SizedBase64Integer
ecY ECKeyParameters
k'
    RSAKeyMaterial RSAKeyParameters
k' ->
      Key
"e" Key -> Base64Integer -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Getting Base64Integer RSAKeyParameters Base64Integer
-> RSAKeyParameters -> Base64Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Base64Integer RSAKeyParameters Base64Integer
Lens' RSAKeyParameters Base64Integer
rsaE RSAKeyParameters
k' Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"kty" Key -> Text -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"RSA" :: T.Text) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"n" Key -> Base64Integer -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Getting Base64Integer RSAKeyParameters Base64Integer
-> RSAKeyParameters -> Base64Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Base64Integer RSAKeyParameters Base64Integer
Lens' RSAKeyParameters Base64Integer
rsaN RSAKeyParameters
k'
    OctKeyMaterial (OctKeyParameters Base64Octets
k') ->
      Key
"k" Key -> Base64Octets -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Base64Octets
k' Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"kty" Key -> Text -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"oct" :: T.Text)
    OKPKeyMaterial (Ed25519Key PublicKey
pk Maybe SecretKey
_) -> Text -> PublicKey -> Series
forall {a} {e} {a}.
(Semigroup a, KeyValue e a, ByteArrayAccess a) =>
Text -> a -> a
okpSeries Text
"Ed25519" PublicKey
pk
    OKPKeyMaterial (Ed448Key PublicKey
pk Maybe SecretKey
_) -> Text -> PublicKey -> Series
forall {a} {e} {a}.
(Semigroup a, KeyValue e a, ByteArrayAccess a) =>
Text -> a -> a
okpSeries Text
"Ed448" PublicKey
pk
    OKPKeyMaterial (X25519Key PublicKey
pk Maybe SecretKey
_) -> Text -> PublicKey -> Series
forall {a} {e} {a}.
(Semigroup a, KeyValue e a, ByteArrayAccess a) =>
Text -> a -> a
okpSeries Text
"X25519" PublicKey
pk
    OKPKeyMaterial (X448Key PublicKey
pk Maybe SecretKey
_) -> Text -> PublicKey -> Series
forall {a} {e} {a}.
(Semigroup a, KeyValue e a, ByteArrayAccess a) =>
Text -> a -> a
okpSeries Text
"X448" PublicKey
pk
  where
    b64 :: a -> Base64Octets
b64 = ByteString -> Base64Octets
Types.Base64Octets (ByteString -> Base64Octets)
-> (a -> ByteString) -> a -> Base64Octets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
    okpSeries :: Text -> a -> a
okpSeries Text
crv a
pk =
      Key
"crv" Key -> Text -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
crv :: T.Text) a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Key
"kty" Key -> Text -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"OKP" :: T.Text) a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Key
"x" Key -> Base64Octets -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Base64Octets
forall {a}. ByteArrayAccess a => a -> Base64Octets
b64 a
pk