-- 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 #-}
{-# 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
  , fromOctets
  , fromX509Certificate

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

  -- * JWK Set
  , JWKSet(..)

  -- Miscellaneous
  , checkJWK
  , bestJWSAlg

  , module Crypto.JOSE.JWA.JWK
  ) where

import Control.Applicative
import Control.Monad ((>=>))
import Data.Function (on)
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.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]
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 a b. (a -> b) -> Maybe a -> Maybe b
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
forall v. ToJSON v => Key -> v -> Pair
.=) Maybe JWKAlg
_jwkAlg
        , (KeyUse -> Pair) -> Maybe KeyUse -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
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
forall v. ToJSON v => Key -> v -> Pair
.=) Maybe KeyUse
_jwkUse
        , ([KeyOp] -> Pair) -> Maybe [KeyOp] -> Maybe Pair
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" Key -> [KeyOp] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) Maybe [KeyOp]
_jwkKeyOps
        , (Text -> Pair) -> Maybe Text -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
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
forall v. ToJSON v => Key -> v -> Pair
.=) Maybe Text
_jwkKid
        , (Value -> Pair) -> Maybe Value -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"x5u" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (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 -> Pair)
-> Maybe (NonEmpty SignedCertificate) -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
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
forall v. ToJSON v => Key -> v -> Pair
.=) (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 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 -> Pair) -> Maybe Base64SHA1 -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
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
forall v. ToJSON v => Key -> v -> Pair
.=) Maybe Base64SHA1
_jwkX5t
        , (Base64SHA256 -> Pair) -> Maybe Base64SHA256 -> Maybe Pair
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" Key -> Base64SHA256 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) 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 an EC public key into a JWK
--
fromECPublic :: (AsError e, MonadError e m) => X509.PubKeyEC -> m JWK
fromECPublic :: forall e (m :: * -> *).
(AsError e, MonadError e m) =>
PubKeyEC -> m JWK
fromECPublic = (ECKeyParameters -> JWK) -> m ECKeyParameters -> m JWK
forall a b. (a -> b) -> m a -> m 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) (m ECKeyParameters -> m JWK)
-> (PubKeyEC -> m ECKeyParameters) -> PubKeyEC -> m JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyEC -> m ECKeyParameters
forall e (m :: * -> *).
(MonadError e m, AsError e) =>
PubKeyEC -> m ECKeyParameters
ecParametersFromX509


-- | 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 an X.509 certificate into a JWK.
--
-- Supports RSA and ECDSA (when the curve is supported).  Other key types
-- will throw 'AlgorithmNotImplemented'.
--
-- 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 <- 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 -> 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 e (m :: * -> *).
(AsError e, MonadError e m) =>
PubKeyEC -> m JWK
fromECPublic PubKeyEC
k
    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"
  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)

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
forall v. ToJSON v => Key -> v -> Pair
.= [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.
--
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 = 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 a. a -> m a
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
    Crv
Secp256k1 -> Alg
JWA.JWS.ES256K
  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 a. a -> m a
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 ()
Prism' e ()
_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 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 -> 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 -> m Alg
forall a. a -> m a
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 ()
Prism' e ()
_KeySizeTooSmall
  OKPKeyMaterial OKPKeyParameters
k -> case OKPKeyParameters
k of
    (Ed25519Key PublicKey
_ Maybe SecretKey
_)  -> 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 -> m Alg
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alg
JWA.JWS.EdDSA
    (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"


-- | 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
. 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 :: 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 -> 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
forall v. ToJSON v => Key -> v -> Series
.=
      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
forall v. ToJSON v => Key -> v -> Series
.= (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
forall v. ToJSON v => Key -> v -> Series
.= 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
forall v. ToJSON v => Key -> v -> Series
.= 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
forall v. ToJSON v => Key -> v -> Series
.= 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
forall v. ToJSON v => Key -> v -> Series
.= (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
forall v. ToJSON v => Key -> v -> Series
.= 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
forall v. ToJSON v => Key -> v -> Series
.= 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
forall v. ToJSON v => Key -> v -> Series
.= (Text
"oct" :: T.Text)
    OKPKeyMaterial (Ed25519Key PublicKey
pk Maybe SecretKey
_) -> Text -> PublicKey -> Series
forall {a} {a}.
(Semigroup a, KeyValue a, ByteArrayAccess a) =>
Text -> a -> a
okpSeries Text
"Ed25519" PublicKey
pk
    OKPKeyMaterial (Ed448Key PublicKey
pk Maybe SecretKey
_) -> Text -> PublicKey -> Series
forall {a} {a}.
(Semigroup a, KeyValue a, ByteArrayAccess a) =>
Text -> a -> a
okpSeries Text
"Ed448" PublicKey
pk
    OKPKeyMaterial (X25519Key PublicKey
pk Maybe SecretKey
_) -> Text -> PublicKey -> Series
forall {a} {a}.
(Semigroup a, KeyValue a, ByteArrayAccess a) =>
Text -> a -> a
okpSeries Text
"X25519" PublicKey
pk
    OKPKeyMaterial (X448Key PublicKey
pk Maybe SecretKey
_) -> Text -> PublicKey -> Series
forall {a} {a}.
(Semigroup a, KeyValue 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 kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> a
.= (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
forall v. ToJSON v => Key -> v -> a
.= (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
forall v. ToJSON v => Key -> v -> a
.= a -> Base64Octets
forall {a}. ByteArrayAccess a => a -> Base64Octets
b64 a
pk