-- Copyright (C) 2013, 2014, 2015, 2016, 2017  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 FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

{-|

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 ('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
  , fromOctets
  , fromX509Certificate

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

  -- * JWK Set
  , JWKSet(..)

  -- Miscellaneous
  , bestJWSAlg

  , module Crypto.JOSE.JWA.JWK
  ) where

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

import Control.Lens hiding ((.=))
import Control.Lens.Cons.Extras (recons)
import Control.Monad.Except (MonadError)
import Control.Monad.Error.Lens (throwing, throwing_)
import Crypto.Hash
import qualified Crypto.PubKey.RSA as RSA
import Data.Aeson
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 Test.QuickCheck

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 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
/= :: JWKAlg -> JWKAlg -> Bool
$c/= :: JWKAlg -> JWKAlg -> Bool
== :: JWKAlg -> JWKAlg -> Bool
$c== :: 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
showList :: [JWKAlg] -> ShowS
$cshowList :: [JWKAlg] -> ShowS
show :: JWKAlg -> String
$cshow :: JWKAlg -> String
showsPrec :: Int -> JWKAlg -> ShowS
$cshowsPrec :: Int -> 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 (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
/= :: JWK -> JWK -> Bool
$c/= :: JWK -> JWK -> Bool
== :: JWK -> JWK -> Bool
$c== :: 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
showList :: [JWK] -> ShowS
$cshowList :: [JWK] -> ShowS
show :: JWK -> String
$cshow :: JWK -> String
showsPrec :: Int -> JWK -> ShowS
$cshowsPrec :: Int -> 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 :: (Maybe (NonEmpty SignedCertificate)
 -> f (Maybe (NonEmpty SignedCertificate)))
-> JWK -> f JWK
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 (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 (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)
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 (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 (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 (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe URI)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"x5u"
    Parser
  (Maybe (NonEmpty SignedCertificate)
   -> Maybe Base64SHA1 -> Maybe Base64SHA256 -> JWK)
-> Parser (Maybe (NonEmpty SignedCertificate))
-> Parser (Maybe Base64SHA1 -> Maybe Base64SHA256 -> JWK)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (((NonEmpty Base64X509 -> NonEmpty SignedCertificate)
-> Maybe (NonEmpty Base64X509)
-> Maybe (NonEmpty SignedCertificate)
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 (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 (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 (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure JWK
k

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

-- | Generate a JWK.  Apart from key parameters, no other parameters are set.
--
genJWK :: MonadRandom m => KeyMaterialGenParam -> m JWK
genJWK :: 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

instance Arbitrary JWK where
  arbitrary :: Gen JWK
arbitrary = 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)
-> Gen KeyMaterial
-> Gen
     (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
<$> Gen KeyMaterial
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe KeyUse
   -> Maybe [KeyOp]
   -> Maybe JWKAlg
   -> Maybe Text
   -> Maybe URI
   -> Maybe (NonEmpty SignedCertificate)
   -> Maybe Base64SHA1
   -> Maybe Base64SHA256
   -> JWK)
-> Gen (Maybe KeyUse)
-> Gen
     (Maybe [KeyOp]
      -> Maybe JWKAlg
      -> Maybe Text
      -> Maybe URI
      -> Maybe (NonEmpty SignedCertificate)
      -> Maybe Base64SHA1
      -> Maybe Base64SHA256
      -> JWK)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe KeyUse -> Gen (Maybe KeyUse)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe KeyUse
forall a. Maybe a
Nothing
    Gen
  (Maybe [KeyOp]
   -> Maybe JWKAlg
   -> Maybe Text
   -> Maybe URI
   -> Maybe (NonEmpty SignedCertificate)
   -> Maybe Base64SHA1
   -> Maybe Base64SHA256
   -> JWK)
-> Gen (Maybe [KeyOp])
-> Gen
     (Maybe JWKAlg
      -> Maybe Text
      -> Maybe URI
      -> Maybe (NonEmpty SignedCertificate)
      -> Maybe Base64SHA1
      -> Maybe Base64SHA256
      -> JWK)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [KeyOp] -> Gen (Maybe [KeyOp])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [KeyOp]
forall a. Maybe a
Nothing
    Gen
  (Maybe JWKAlg
   -> Maybe Text
   -> Maybe URI
   -> Maybe (NonEmpty SignedCertificate)
   -> Maybe Base64SHA1
   -> Maybe Base64SHA256
   -> JWK)
-> Gen (Maybe JWKAlg)
-> Gen
     (Maybe Text
      -> Maybe URI
      -> Maybe (NonEmpty SignedCertificate)
      -> Maybe Base64SHA1
      -> Maybe Base64SHA256
      -> JWK)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe JWKAlg -> Gen (Maybe JWKAlg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe JWKAlg
forall a. Maybe a
Nothing
    Gen
  (Maybe Text
   -> Maybe URI
   -> Maybe (NonEmpty SignedCertificate)
   -> Maybe Base64SHA1
   -> Maybe Base64SHA256
   -> JWK)
-> Gen (Maybe Text)
-> Gen
     (Maybe URI
      -> Maybe (NonEmpty SignedCertificate)
      -> Maybe Base64SHA1
      -> Maybe Base64SHA256
      -> JWK)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Text)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe URI
   -> Maybe (NonEmpty SignedCertificate)
   -> Maybe Base64SHA1
   -> Maybe Base64SHA256
   -> JWK)
-> Gen (Maybe URI)
-> Gen
     (Maybe (NonEmpty SignedCertificate)
      -> Maybe Base64SHA1 -> Maybe Base64SHA256 -> JWK)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe URI -> Gen (Maybe URI)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe URI
forall a. Maybe a
Nothing
    Gen
  (Maybe (NonEmpty SignedCertificate)
   -> Maybe Base64SHA1 -> Maybe Base64SHA256 -> JWK)
-> Gen (Maybe (NonEmpty SignedCertificate))
-> Gen (Maybe Base64SHA1 -> Maybe Base64SHA256 -> JWK)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (NonEmpty SignedCertificate)
-> Gen (Maybe (NonEmpty SignedCertificate))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (NonEmpty SignedCertificate)
forall a. Maybe a
Nothing
    Gen (Maybe Base64SHA1 -> Maybe Base64SHA256 -> JWK)
-> Gen (Maybe Base64SHA1) -> Gen (Maybe Base64SHA256 -> JWK)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Base64SHA1)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe Base64SHA256 -> JWK)
-> Gen (Maybe Base64SHA256) -> Gen JWK
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Base64SHA256)
forall a. Arbitrary a => Gen a
arbitrary

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 an EC public key into a JWK
--
fromECPublic :: X509.PubKeyEC -> Maybe JWK
fromECPublic :: PubKeyEC -> Maybe JWK
fromECPublic = (ECKeyParameters -> JWK) -> Maybe ECKeyParameters -> Maybe JWK
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) (Maybe ECKeyParameters -> Maybe JWK)
-> (PubKeyEC -> Maybe ECKeyParameters) -> PubKeyEC -> Maybe JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyEC -> Maybe ECKeyParameters
ecParametersFromX509


-- | Convert octet string into a JWK
--
fromOctets :: Cons s s Word8 Word8 => s -> JWK
fromOctets :: 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
recons
{-# INLINE fromOctets #-}


-- | Convert an X.509 certificate into a JWK.
--
-- Only RSA keys are supported.  Other key types will throw
-- 'KeyMismatch'.
--
-- The @"x5c"@ field of the resulting JWK contains the certificate.
--
fromX509Certificate
  :: (AsError e, MonadError e m)
  => X509.SignedCertificate -> m JWK
fromX509Certificate :: SignedCertificate -> m JWK
fromX509Certificate =
  m JWK -> (JWK -> m JWK) -> Maybe JWK -> m JWK
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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
_KeyMismatch Text
"X.509 key type not supported") JWK -> m JWK
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  (Maybe JWK -> m JWK)
-> (SignedCertificate -> Maybe JWK) -> SignedCertificate -> m JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedCertificate -> Maybe JWK
fromX509CertificateMaybe

fromX509CertificateMaybe :: X509.SignedCertificate -> Maybe JWK
fromX509CertificateMaybe :: SignedCertificate -> Maybe JWK
fromX509CertificateMaybe SignedCertificate
cert = do
  JWK
k <- case (Certificate -> PubKey
X509.certPubKey (Certificate -> PubKey)
-> (SignedCertificate -> Certificate)
-> SignedCertificate
-> 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 -> Certificate)
-> (SignedCertificate -> Signed Certificate)
-> SignedCertificate
-> Certificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedCertificate -> Signed Certificate
forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
X509.getSigned) SignedCertificate
cert of
    X509.PubKeyRSA PublicKey
k -> JWK -> Maybe JWK
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> JWK
fromRSAPublic PublicKey
k)
    X509.PubKeyEC PubKeyEC
k -> PubKeyEC -> Maybe JWK
fromECPublic PubKeyEC
k
    PubKey
_ -> Maybe JWK
forall a. Maybe a
Nothing
  JWK -> Maybe JWK
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JWK -> Maybe JWK) -> JWK -> Maybe 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 (f :: * -> *) a. Applicative f => a -> f a
pure SignedCertificate
cert))



instance AsPublicKey JWK where
  asPublicKey :: (Maybe JWK -> f (Maybe JWK)) -> JWK -> f 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)
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
/= :: JWKSet -> JWKSet -> Bool
$c/= :: JWKSet -> JWKSet -> Bool
== :: JWKSet -> JWKSet -> Bool
$c== :: 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
showList :: [JWKSet] -> ShowS
$cshowList :: [JWKSet] -> ShowS
show :: JWKSet -> String
$cshow :: JWKSet -> String
showsPrec :: Int -> JWKSet -> ShowS
$cshowsPrec :: Int -> JWKSet -> ShowS
Show)

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 kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [JWK] -> Value
forall a. ToJSON a => a -> Value
toJSON [JWK]
ks]


-- | Choose the cryptographically strongest JWS algorithm for a
-- given key.  The JWK "alg" algorithm parameter is ignored.
--
bestJWSAlg
  :: (MonadError e m, AsError e)
  => JWK
  -> m JWA.JWS.Alg
bestJWSAlg :: JWK -> m Alg
bestJWSAlg 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
  ECKeyMaterial ECKeyParameters
k -> Alg -> m Alg
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Alg -> m Alg) -> Alg -> m Alg
forall a b. (a -> b) -> a -> b
$ 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
JWA.JWS.ES256
    Crv
P_384 -> Alg
JWA.JWS.ES384
    Crv
P_521 -> Alg
JWA.JWS.ES512
  RSAKeyMaterial RSAKeyParameters
k ->
    let
      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
    in
      if 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)
      then Alg -> m Alg
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alg
JWA.JWS.PS512
      else AReview e () -> m Alg
forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
throwing_ AReview e ()
forall r. AsError r => Prism' r ()
_KeySizeTooSmall
  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 -> m Alg
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 -> m Alg
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 -> m Alg
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alg
JWA.JWS.HS256
    | 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 ()
_KeySizeTooSmall
  OKPKeyMaterial (Ed25519Key PublicKey
_ Maybe SecretKey
_) -> Alg -> m Alg
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alg
JWA.JWS.EdDSA
  OKPKeyMaterial OKPKeyParameters
_ -> 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
_KeyMismatch Text
"Cannot sign with OKP ECDH key"


-- | Compute the JWK Thumbprint of a JWK
--
thumbprint :: HashAlgorithm a => Getter JWK (Digest a)
thumbprint :: Getter JWK (Digest a)
thumbprint = (JWK -> Digest a) -> Optic' (->) f JWK (Digest a)
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
. ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (JWK -> ByteString) -> JWK -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JWK -> ByteString
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 :: Prism' ByteString (Digest a)
digest = (Digest a -> ByteString)
-> (ByteString -> Maybe (Digest a)) -> Prism' ByteString (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 -> ByteString
thumbprintRepr JWK
k = Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> (Series -> Builder) -> Series -> ByteString
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 -> ByteString) -> Series -> ByteString
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 kv v. (KeyValue 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 kv v. (KeyValue 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 kv v. (KeyValue 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 kv v. (KeyValue 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 kv v. (KeyValue 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 kv v. (KeyValue 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 kv v. (KeyValue 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 kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Octets
k' Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"kty" Key -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"oct" :: T.Text)
    OKPKeyMaterial (Ed25519Key PublicKey
pk Maybe SecretKey
_) -> Text -> PublicKey -> Series
forall a bin.
(Semigroup a, KeyValue a, ByteArrayAccess bin) =>
Text -> bin -> a
okpSeries Text
"Ed25519" PublicKey
pk
    OKPKeyMaterial (X25519Key PublicKey
pk Maybe SecretKey
_) -> Text -> PublicKey -> Series
forall a bin.
(Semigroup a, KeyValue a, ByteArrayAccess bin) =>
Text -> bin -> a
okpSeries Text
"X25519" PublicKey
pk
  where
    b64 :: bin -> Base64Octets
b64 = ByteString -> Base64Octets
Types.Base64Octets (ByteString -> Base64Octets)
-> (bin -> ByteString) -> bin -> Base64Octets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bin -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
    okpSeries :: Text -> bin -> a
okpSeries Text
crv bin
pk =
      Key
"crv" Key -> Text -> a
forall kv v. (KeyValue 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 kv v. (KeyValue 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 kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= bin -> Base64Octets
forall bin. ByteArrayAccess bin => bin -> Base64Octets
b64 bin
pk