-- Copyright (C) 2013, 2014, 2015, 2016, 2020  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.

{-|

JSON Web Signature (JWS) represents content secured with digital
signatures or Message Authentication Codes (MACs) using JavaScript
Object Notation (JSON) based data structures.  It is defined in
<https://tools.ietf.org/html/rfc7515 RFC 7515>.

@
doJwsSign :: 'JWK' -> L.ByteString -> IO (Either 'Error' ('GeneralJWS' 'JWSHeader'))
doJwsSign jwk payload = runExceptT $ do
  alg \<- 'bestJWSAlg' jwk
  'signJWS' payload [('newJWSHeader' ('Protected', alg), jwk)]

doJwsVerify :: 'JWK' -> 'GeneralJWS' 'JWSHeader' -> IO (Either 'Error' ())
doJwsVerify jwk jws = runExceptT $ 'verifyJWS'' jwk jws
@

-}

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Crypto.JOSE.JWS
  (
  -- * Overview
    JWS
  , GeneralJWS
  , FlattenedJWS
  , CompactJWS

  -- ** Defining additional header parameters
  -- $extending

  -- * JWS creation
  , newJWSHeader
  , makeJWSHeader
  , signJWS

  -- * JWS verification
  , verifyJWS
  , verifyJWS'
  , verifyJWSWithPayload

  -- ** JWS validation settings
  , defaultValidationSettings
  , ValidationSettings
  , ValidationPolicy(..)
  , HasValidationSettings(..)
  , HasAlgorithms(..)
  , HasValidationPolicy(..)

  -- * Signature data
  , signatures
  , Signature
  , header
  , signature
  , rawProtectedHeader

  -- * JWS headers
  , Alg(..)
  , HasJWSHeader(..)
  , JWSHeader

  , module Crypto.JOSE.Error
  , module Crypto.JOSE.Header
  , module Crypto.JOSE.JWK
  ) where

import Control.Applicative ((<|>))
import Data.Foldable (toList)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid ((<>))
import Data.List.NonEmpty (NonEmpty)
import Data.Word (Word8)

import Control.Lens hiding ((.=))
import Control.Lens.Cons.Extras (recons)
import Control.Monad.Error.Lens (throwing, throwing_)
import Control.Monad.Except (MonadError, unless)
import Data.Aeson
import qualified Data.Aeson.KeyMap as M
import qualified Data.ByteString as B
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

import Crypto.JOSE.Compact
import Crypto.JOSE.Error
import Crypto.JOSE.JWA.JWS
import Crypto.JOSE.JWK
import Crypto.JOSE.JWK.Store
import Crypto.JOSE.Header
import qualified Crypto.JOSE.Types as Types
import qualified Crypto.JOSE.Types.Internal as Types

{- $extending

Several specifications extend JWS with additional header parameters.
The 'JWS' type is parameterised over the header type; this library
provides the 'JWSHeader' type which encompasses all the JWS header
parameters defined in RFC 7515.  To define an extended header type
declare the data type, and instances for 'HasJWSHeader' and
'HasParams'.  For example:

@
data ACMEHeader p = ACMEHeader
  { _acmeJwsHeader :: 'JWSHeader' p
  , _acmeNonce :: 'Types.Base64Octets'
  }

acmeJwsHeader :: Lens' (ACMEHeader p) (JWSHeader p)
acmeJwsHeader f s\@(ACMEHeader { _acmeJwsHeader = a}) =
  fmap (\\a' -> s { _acmeJwsHeader = a'}) (f a)

acmeNonce :: Lens' (ACMEHeader p) Types.Base64Octets
acmeNonce f s\@(ACMEHeader { _acmeNonce = a}) =
  fmap (\\a' -> s { _acmeNonce = a'}) (f a)

instance HasJWSHeader ACMEHeader where
  jwsHeader = acmeJwsHeader

instance HasParams ACMEHeader where
  'parseParamsFor' proxy hp hu = ACMEHeader
    \<$> 'parseParamsFor' proxy hp hu
    \<*> 'headerRequiredProtected' "nonce" hp hu
  params h =
    (True, "nonce" .= view acmeNonce h)
    : 'params' (view acmeJwsHeader h)
  'extensions' = const ["nonce"]
@

See also:

- 'HasParams'
- 'headerRequired'
- 'headerRequiredProtected'
- 'headerOptional'
- 'headerOptionalProtected'

-}


jwsCritInvalidNames :: [T.Text]
jwsCritInvalidNames :: [Text]
jwsCritInvalidNames = [
  Text
"alg"
  , Text
"jku"
  , Text
"jwk"
  , Text
"x5u"
  , Text
"x5t"
  , Text
"x5t#S256"
  , Text
"x5c"
  , Text
"kid"
  , Text
"typ"
  , Text
"cty"
  , Text
"crit"
  ]

-- | JWS Header data type.
--
data JWSHeader p = JWSHeader
  { JWSHeader p -> HeaderParam p Alg
_jwsHeaderAlg :: HeaderParam p Alg
  , JWSHeader p -> Maybe (HeaderParam p URI)
_jwsHeaderJku :: Maybe (HeaderParam p Types.URI)  -- ^ JWK Set URL
  , JWSHeader p -> Maybe (HeaderParam p JWK)
_jwsHeaderJwk :: Maybe (HeaderParam p JWK)
  , JWSHeader p -> Maybe (HeaderParam p Text)
_jwsHeaderKid :: Maybe (HeaderParam p T.Text)  -- ^ interpretation unspecified
  , JWSHeader p -> Maybe (HeaderParam p URI)
_jwsHeaderX5u :: Maybe (HeaderParam p Types.URI)
  , JWSHeader p -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
_jwsHeaderX5c :: Maybe (HeaderParam p (NonEmpty Types.SignedCertificate))
  , JWSHeader p -> Maybe (HeaderParam p Base64SHA1)
_jwsHeaderX5t :: Maybe (HeaderParam p Types.Base64SHA1)
  , JWSHeader p -> Maybe (HeaderParam p Base64SHA256)
_jwsHeaderX5tS256 :: Maybe (HeaderParam p Types.Base64SHA256)
  , JWSHeader p -> Maybe (HeaderParam p Text)
_jwsHeaderTyp :: Maybe (HeaderParam p T.Text)  -- ^ Content Type (of object)
  , JWSHeader p -> Maybe (HeaderParam p Text)
_jwsHeaderCty :: Maybe (HeaderParam p T.Text)  -- ^ Content Type (of payload)
  , JWSHeader p -> Maybe (NonEmpty Text)
_jwsHeaderCrit :: Maybe (NonEmpty T.Text)
  }
  deriving (JWSHeader p -> JWSHeader p -> Bool
(JWSHeader p -> JWSHeader p -> Bool)
-> (JWSHeader p -> JWSHeader p -> Bool) -> Eq (JWSHeader p)
forall p. Eq p => JWSHeader p -> JWSHeader p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JWSHeader p -> JWSHeader p -> Bool
$c/= :: forall p. Eq p => JWSHeader p -> JWSHeader p -> Bool
== :: JWSHeader p -> JWSHeader p -> Bool
$c== :: forall p. Eq p => JWSHeader p -> JWSHeader p -> Bool
Eq, Int -> JWSHeader p -> ShowS
[JWSHeader p] -> ShowS
JWSHeader p -> String
(Int -> JWSHeader p -> ShowS)
-> (JWSHeader p -> String)
-> ([JWSHeader p] -> ShowS)
-> Show (JWSHeader p)
forall p. Show p => Int -> JWSHeader p -> ShowS
forall p. Show p => [JWSHeader p] -> ShowS
forall p. Show p => JWSHeader p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JWSHeader p] -> ShowS
$cshowList :: forall p. Show p => [JWSHeader p] -> ShowS
show :: JWSHeader p -> String
$cshow :: forall p. Show p => JWSHeader p -> String
showsPrec :: Int -> JWSHeader p -> ShowS
$cshowsPrec :: forall p. Show p => Int -> JWSHeader p -> ShowS
Show)

class HasJWSHeader a where
  jwsHeader :: Lens' (a p) (JWSHeader p)

instance HasJWSHeader JWSHeader where
  jwsHeader :: (JWSHeader p -> f (JWSHeader p)) -> JWSHeader p -> f (JWSHeader p)
jwsHeader = (JWSHeader p -> f (JWSHeader p)) -> JWSHeader p -> f (JWSHeader p)
forall a. a -> a
id

instance HasJWSHeader a => HasAlg a where
  alg :: (HeaderParam p Alg -> f (HeaderParam p Alg)) -> a p -> f (a p)
alg = (JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p)
forall (a :: * -> *) p. HasJWSHeader a => Lens' (a p) (JWSHeader p)
jwsHeader ((JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p))
-> ((HeaderParam p Alg -> f (HeaderParam p Alg))
    -> JWSHeader p -> f (JWSHeader p))
-> (HeaderParam p Alg -> f (HeaderParam p Alg))
-> a p
-> f (a p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \HeaderParam p Alg -> f (HeaderParam p Alg)
f h :: JWSHeader p
h@(JWSHeader { _jwsHeaderAlg :: forall p. JWSHeader p -> HeaderParam p Alg
_jwsHeaderAlg = HeaderParam p Alg
a }) ->
    (HeaderParam p Alg -> JWSHeader p)
-> f (HeaderParam p Alg) -> f (JWSHeader p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p Alg
a' -> JWSHeader p
h { _jwsHeaderAlg :: HeaderParam p Alg
_jwsHeaderAlg = HeaderParam p Alg
a' }) (HeaderParam p Alg -> f (HeaderParam p Alg)
f HeaderParam p Alg
a)
instance HasJWSHeader a => HasJku a where
  jku :: (Maybe (HeaderParam p URI) -> f (Maybe (HeaderParam p URI)))
-> a p -> f (a p)
jku = (JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p)
forall (a :: * -> *) p. HasJWSHeader a => Lens' (a p) (JWSHeader p)
jwsHeader ((JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p))
-> ((Maybe (HeaderParam p URI) -> f (Maybe (HeaderParam p URI)))
    -> JWSHeader p -> f (JWSHeader p))
-> (Maybe (HeaderParam p URI) -> f (Maybe (HeaderParam p URI)))
-> a p
-> f (a p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Maybe (HeaderParam p URI) -> f (Maybe (HeaderParam p URI))
f h :: JWSHeader p
h@(JWSHeader { _jwsHeaderJku :: forall p. JWSHeader p -> Maybe (HeaderParam p URI)
_jwsHeaderJku = Maybe (HeaderParam p URI)
a }) ->
    (Maybe (HeaderParam p URI) -> JWSHeader p)
-> f (Maybe (HeaderParam p URI)) -> f (JWSHeader p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (HeaderParam p URI)
a' -> JWSHeader p
h { _jwsHeaderJku :: Maybe (HeaderParam p URI)
_jwsHeaderJku = Maybe (HeaderParam p URI)
a' }) (Maybe (HeaderParam p URI) -> f (Maybe (HeaderParam p URI))
f Maybe (HeaderParam p URI)
a)
instance HasJWSHeader a => HasJwk a where
  jwk :: (Maybe (HeaderParam p JWK) -> f (Maybe (HeaderParam p JWK)))
-> a p -> f (a p)
jwk = (JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p)
forall (a :: * -> *) p. HasJWSHeader a => Lens' (a p) (JWSHeader p)
jwsHeader ((JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p))
-> ((Maybe (HeaderParam p JWK) -> f (Maybe (HeaderParam p JWK)))
    -> JWSHeader p -> f (JWSHeader p))
-> (Maybe (HeaderParam p JWK) -> f (Maybe (HeaderParam p JWK)))
-> a p
-> f (a p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Maybe (HeaderParam p JWK) -> f (Maybe (HeaderParam p JWK))
f h :: JWSHeader p
h@(JWSHeader { _jwsHeaderJwk :: forall p. JWSHeader p -> Maybe (HeaderParam p JWK)
_jwsHeaderJwk = Maybe (HeaderParam p JWK)
a }) ->
    (Maybe (HeaderParam p JWK) -> JWSHeader p)
-> f (Maybe (HeaderParam p JWK)) -> f (JWSHeader p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (HeaderParam p JWK)
a' -> JWSHeader p
h { _jwsHeaderJwk :: Maybe (HeaderParam p JWK)
_jwsHeaderJwk = Maybe (HeaderParam p JWK)
a' }) (Maybe (HeaderParam p JWK) -> f (Maybe (HeaderParam p JWK))
f Maybe (HeaderParam p JWK)
a)
instance HasJWSHeader a => HasKid a where
  kid :: (Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text)))
-> a p -> f (a p)
kid = (JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p)
forall (a :: * -> *) p. HasJWSHeader a => Lens' (a p) (JWSHeader p)
jwsHeader ((JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p))
-> ((Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text)))
    -> JWSHeader p -> f (JWSHeader p))
-> (Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text)))
-> a p
-> f (a p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text))
f h :: JWSHeader p
h@(JWSHeader { _jwsHeaderKid :: forall p. JWSHeader p -> Maybe (HeaderParam p Text)
_jwsHeaderKid = Maybe (HeaderParam p Text)
a }) ->
    (Maybe (HeaderParam p Text) -> JWSHeader p)
-> f (Maybe (HeaderParam p Text)) -> f (JWSHeader p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (HeaderParam p Text)
a' -> JWSHeader p
h { _jwsHeaderKid :: Maybe (HeaderParam p Text)
_jwsHeaderKid = Maybe (HeaderParam p Text)
a' }) (Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text))
f Maybe (HeaderParam p Text)
a)
instance HasJWSHeader a => HasX5u a where
  x5u :: (Maybe (HeaderParam p URI) -> f (Maybe (HeaderParam p URI)))
-> a p -> f (a p)
x5u = (JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p)
forall (a :: * -> *) p. HasJWSHeader a => Lens' (a p) (JWSHeader p)
jwsHeader ((JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p))
-> ((Maybe (HeaderParam p URI) -> f (Maybe (HeaderParam p URI)))
    -> JWSHeader p -> f (JWSHeader p))
-> (Maybe (HeaderParam p URI) -> f (Maybe (HeaderParam p URI)))
-> a p
-> f (a p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Maybe (HeaderParam p URI) -> f (Maybe (HeaderParam p URI))
f h :: JWSHeader p
h@(JWSHeader { _jwsHeaderX5u :: forall p. JWSHeader p -> Maybe (HeaderParam p URI)
_jwsHeaderX5u = Maybe (HeaderParam p URI)
a }) ->
    (Maybe (HeaderParam p URI) -> JWSHeader p)
-> f (Maybe (HeaderParam p URI)) -> f (JWSHeader p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (HeaderParam p URI)
a' -> JWSHeader p
h { _jwsHeaderX5u :: Maybe (HeaderParam p URI)
_jwsHeaderX5u = Maybe (HeaderParam p URI)
a' }) (Maybe (HeaderParam p URI) -> f (Maybe (HeaderParam p URI))
f Maybe (HeaderParam p URI)
a)
instance HasJWSHeader a => HasX5c a where
  x5c :: (Maybe (HeaderParam p (NonEmpty SignedCertificate))
 -> f (Maybe (HeaderParam p (NonEmpty SignedCertificate))))
-> a p -> f (a p)
x5c = (JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p)
forall (a :: * -> *) p. HasJWSHeader a => Lens' (a p) (JWSHeader p)
jwsHeader ((JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p))
-> ((Maybe (HeaderParam p (NonEmpty SignedCertificate))
     -> f (Maybe (HeaderParam p (NonEmpty SignedCertificate))))
    -> JWSHeader p -> f (JWSHeader p))
-> (Maybe (HeaderParam p (NonEmpty SignedCertificate))
    -> f (Maybe (HeaderParam p (NonEmpty SignedCertificate))))
-> a p
-> f (a p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Maybe (HeaderParam p (NonEmpty SignedCertificate))
-> f (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
f h :: JWSHeader p
h@(JWSHeader { _jwsHeaderX5c :: forall p.
JWSHeader p -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
_jwsHeaderX5c = Maybe (HeaderParam p (NonEmpty SignedCertificate))
a }) ->
    (Maybe (HeaderParam p (NonEmpty SignedCertificate)) -> JWSHeader p)
-> f (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
-> f (JWSHeader p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (HeaderParam p (NonEmpty SignedCertificate))
a' -> JWSHeader p
h { _jwsHeaderX5c :: Maybe (HeaderParam p (NonEmpty SignedCertificate))
_jwsHeaderX5c = Maybe (HeaderParam p (NonEmpty SignedCertificate))
a' }) (Maybe (HeaderParam p (NonEmpty SignedCertificate))
-> f (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
f Maybe (HeaderParam p (NonEmpty SignedCertificate))
a)
instance HasJWSHeader a => HasX5t a where
  x5t :: (Maybe (HeaderParam p Base64SHA1)
 -> f (Maybe (HeaderParam p Base64SHA1)))
-> a p -> f (a p)
x5t = (JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p)
forall (a :: * -> *) p. HasJWSHeader a => Lens' (a p) (JWSHeader p)
jwsHeader ((JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p))
-> ((Maybe (HeaderParam p Base64SHA1)
     -> f (Maybe (HeaderParam p Base64SHA1)))
    -> JWSHeader p -> f (JWSHeader p))
-> (Maybe (HeaderParam p Base64SHA1)
    -> f (Maybe (HeaderParam p Base64SHA1)))
-> a p
-> f (a p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Maybe (HeaderParam p Base64SHA1)
-> f (Maybe (HeaderParam p Base64SHA1))
f h :: JWSHeader p
h@(JWSHeader { _jwsHeaderX5t :: forall p. JWSHeader p -> Maybe (HeaderParam p Base64SHA1)
_jwsHeaderX5t = Maybe (HeaderParam p Base64SHA1)
a }) ->
    (Maybe (HeaderParam p Base64SHA1) -> JWSHeader p)
-> f (Maybe (HeaderParam p Base64SHA1)) -> f (JWSHeader p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (HeaderParam p Base64SHA1)
a' -> JWSHeader p
h { _jwsHeaderX5t :: Maybe (HeaderParam p Base64SHA1)
_jwsHeaderX5t = Maybe (HeaderParam p Base64SHA1)
a' }) (Maybe (HeaderParam p Base64SHA1)
-> f (Maybe (HeaderParam p Base64SHA1))
f Maybe (HeaderParam p Base64SHA1)
a)
instance HasJWSHeader a => HasX5tS256 a where
  x5tS256 :: (Maybe (HeaderParam p Base64SHA256)
 -> f (Maybe (HeaderParam p Base64SHA256)))
-> a p -> f (a p)
x5tS256 = (JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p)
forall (a :: * -> *) p. HasJWSHeader a => Lens' (a p) (JWSHeader p)
jwsHeader ((JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p))
-> ((Maybe (HeaderParam p Base64SHA256)
     -> f (Maybe (HeaderParam p Base64SHA256)))
    -> JWSHeader p -> f (JWSHeader p))
-> (Maybe (HeaderParam p Base64SHA256)
    -> f (Maybe (HeaderParam p Base64SHA256)))
-> a p
-> f (a p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Maybe (HeaderParam p Base64SHA256)
-> f (Maybe (HeaderParam p Base64SHA256))
f h :: JWSHeader p
h@(JWSHeader { _jwsHeaderX5tS256 :: forall p. JWSHeader p -> Maybe (HeaderParam p Base64SHA256)
_jwsHeaderX5tS256 = Maybe (HeaderParam p Base64SHA256)
a }) ->
    (Maybe (HeaderParam p Base64SHA256) -> JWSHeader p)
-> f (Maybe (HeaderParam p Base64SHA256)) -> f (JWSHeader p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (HeaderParam p Base64SHA256)
a' -> JWSHeader p
h { _jwsHeaderX5tS256 :: Maybe (HeaderParam p Base64SHA256)
_jwsHeaderX5tS256 = Maybe (HeaderParam p Base64SHA256)
a' }) (Maybe (HeaderParam p Base64SHA256)
-> f (Maybe (HeaderParam p Base64SHA256))
f Maybe (HeaderParam p Base64SHA256)
a)
instance HasJWSHeader a => HasTyp a where
  typ :: (Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text)))
-> a p -> f (a p)
typ = (JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p)
forall (a :: * -> *) p. HasJWSHeader a => Lens' (a p) (JWSHeader p)
jwsHeader ((JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p))
-> ((Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text)))
    -> JWSHeader p -> f (JWSHeader p))
-> (Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text)))
-> a p
-> f (a p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text))
f h :: JWSHeader p
h@(JWSHeader { _jwsHeaderTyp :: forall p. JWSHeader p -> Maybe (HeaderParam p Text)
_jwsHeaderTyp = Maybe (HeaderParam p Text)
a }) ->
    (Maybe (HeaderParam p Text) -> JWSHeader p)
-> f (Maybe (HeaderParam p Text)) -> f (JWSHeader p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (HeaderParam p Text)
a' -> JWSHeader p
h { _jwsHeaderTyp :: Maybe (HeaderParam p Text)
_jwsHeaderTyp = Maybe (HeaderParam p Text)
a' }) (Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text))
f Maybe (HeaderParam p Text)
a)
instance HasJWSHeader a => HasCty a where
  cty :: (Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text)))
-> a p -> f (a p)
cty = (JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p)
forall (a :: * -> *) p. HasJWSHeader a => Lens' (a p) (JWSHeader p)
jwsHeader ((JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p))
-> ((Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text)))
    -> JWSHeader p -> f (JWSHeader p))
-> (Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text)))
-> a p
-> f (a p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text))
f h :: JWSHeader p
h@(JWSHeader { _jwsHeaderCty :: forall p. JWSHeader p -> Maybe (HeaderParam p Text)
_jwsHeaderCty = Maybe (HeaderParam p Text)
a }) ->
    (Maybe (HeaderParam p Text) -> JWSHeader p)
-> f (Maybe (HeaderParam p Text)) -> f (JWSHeader p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (HeaderParam p Text)
a' -> JWSHeader p
h { _jwsHeaderCty :: Maybe (HeaderParam p Text)
_jwsHeaderCty = Maybe (HeaderParam p Text)
a' }) (Maybe (HeaderParam p Text) -> f (Maybe (HeaderParam p Text))
f Maybe (HeaderParam p Text)
a)
instance HasJWSHeader a => HasCrit a where
  crit :: (Maybe (NonEmpty Text) -> f (Maybe (NonEmpty Text)))
-> a p -> f (a p)
crit = (JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p)
forall (a :: * -> *) p. HasJWSHeader a => Lens' (a p) (JWSHeader p)
jwsHeader ((JWSHeader p -> f (JWSHeader p)) -> a p -> f (a p))
-> ((Maybe (NonEmpty Text) -> f (Maybe (NonEmpty Text)))
    -> JWSHeader p -> f (JWSHeader p))
-> (Maybe (NonEmpty Text) -> f (Maybe (NonEmpty Text)))
-> a p
-> f (a p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Maybe (NonEmpty Text) -> f (Maybe (NonEmpty Text))
f h :: JWSHeader p
h@(JWSHeader { _jwsHeaderCrit :: forall p. JWSHeader p -> Maybe (NonEmpty Text)
_jwsHeaderCrit = Maybe (NonEmpty Text)
a }) ->
    (Maybe (NonEmpty Text) -> JWSHeader p)
-> f (Maybe (NonEmpty Text)) -> f (JWSHeader p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (NonEmpty Text)
a' -> JWSHeader p
h { _jwsHeaderCrit :: Maybe (NonEmpty Text)
_jwsHeaderCrit = Maybe (NonEmpty Text)
a' }) (Maybe (NonEmpty Text) -> f (Maybe (NonEmpty Text))
f Maybe (NonEmpty Text)
a)


-- | Construct a minimal header with the given algorithm and
-- protection indicator for the /alg/ header.
--
newJWSHeader :: (p, Alg) -> JWSHeader p
newJWSHeader :: (p, Alg) -> JWSHeader p
newJWSHeader (p, Alg)
a = HeaderParam p Alg
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p JWK)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
-> Maybe (HeaderParam p Base64SHA1)
-> Maybe (HeaderParam p Base64SHA256)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p Text)
-> Maybe (NonEmpty Text)
-> JWSHeader p
forall p.
HeaderParam p Alg
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p JWK)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
-> Maybe (HeaderParam p Base64SHA1)
-> Maybe (HeaderParam p Base64SHA256)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p Text)
-> Maybe (NonEmpty Text)
-> JWSHeader p
JWSHeader ((p -> Alg -> HeaderParam p Alg) -> (p, Alg) -> HeaderParam p Alg
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry p -> Alg -> HeaderParam p Alg
forall p a. p -> a -> HeaderParam p a
HeaderParam (p, Alg)
a) Maybe (HeaderParam p URI)
forall a. Maybe a
z Maybe (HeaderParam p JWK)
forall a. Maybe a
z Maybe (HeaderParam p Text)
forall a. Maybe a
z Maybe (HeaderParam p URI)
forall a. Maybe a
z Maybe (HeaderParam p (NonEmpty SignedCertificate))
forall a. Maybe a
z Maybe (HeaderParam p Base64SHA1)
forall a. Maybe a
z Maybe (HeaderParam p Base64SHA256)
forall a. Maybe a
z Maybe (HeaderParam p Text)
forall a. Maybe a
z Maybe (HeaderParam p Text)
forall a. Maybe a
z Maybe (NonEmpty Text)
forall a. Maybe a
z
  where z :: Maybe a
z = Maybe a
forall a. Maybe a
Nothing

-- | Make a JWS header for the given signing key.
--
-- Uses 'bestJWSAlg' to choose the algorithm.
-- If set, the JWK's @"kid"@, @"x5u"@, @"x5c"@, @"x5t"@ and
-- @"x5t#S256"@ parameters are copied to the JWS header (as
-- protected parameters).
--
-- May return 'KeySizeTooSmall' or 'KeyMismatch'.
--
makeJWSHeader
  :: forall e m p. (MonadError e m, AsError e, ProtectionIndicator p)
  => JWK
  -> m (JWSHeader p)
makeJWSHeader :: JWK -> m (JWSHeader p)
makeJWSHeader JWK
k = do
  let
    p :: p
p = p
forall a. ProtectionIndicator a => a
getProtected
    f :: ASetter s t a (Maybe (HeaderParam p a1))
      -> Getting (Maybe a1) JWK (Maybe a1)
      -> s -> t
    f :: ASetter s t a (Maybe (HeaderParam p a1))
-> Getting (Maybe a1) JWK (Maybe a1) -> s -> t
f ASetter s t a (Maybe (HeaderParam p a1))
lh Getting (Maybe a1) JWK (Maybe a1)
lk = ASetter s t a (Maybe (HeaderParam p a1))
-> Maybe (HeaderParam p a1) -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s t a (Maybe (HeaderParam p a1))
lh (p -> a1 -> HeaderParam p a1
forall p a. p -> a -> HeaderParam p a
HeaderParam p
p (a1 -> HeaderParam p a1) -> Maybe a1 -> Maybe (HeaderParam p a1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Maybe a1) JWK (Maybe a1) -> JWK -> Maybe a1
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe a1) JWK (Maybe a1)
lk JWK
k)
  Alg
algo <- JWK -> m Alg
forall e (m :: * -> *). (MonadError e m, AsError e) => JWK -> m Alg
bestJWSAlg JWK
k
  JWSHeader p -> m (JWSHeader p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JWSHeader p -> m (JWSHeader p)) -> JWSHeader p -> m (JWSHeader p)
forall a b. (a -> b) -> a -> b
$ (p, Alg) -> JWSHeader p
forall p. (p, Alg) -> JWSHeader p
newJWSHeader (p
p, Alg
algo)
    JWSHeader p -> (JWSHeader p -> JWSHeader p) -> JWSHeader p
forall a b. a -> (a -> b) -> b
& ASetter
  (JWSHeader p)
  (JWSHeader p)
  (Maybe (HeaderParam p Text))
  (Maybe (HeaderParam p Text))
-> Getting (Maybe Text) JWK (Maybe Text)
-> JWSHeader p
-> JWSHeader p
forall s t a a1.
ASetter s t a (Maybe (HeaderParam p a1))
-> Getting (Maybe a1) JWK (Maybe a1) -> s -> t
f ASetter
  (JWSHeader p)
  (JWSHeader p)
  (Maybe (HeaderParam p Text))
  (Maybe (HeaderParam p Text))
forall (a :: * -> *) p.
HasKid a =>
Lens' (a p) (Maybe (HeaderParam p Text))
kid (Getting (Maybe Text) JWK (Maybe Text)
Lens' JWK (Maybe Text)
jwkKid Getting (Maybe Text) JWK (Maybe Text)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> Maybe Text -> Const (Maybe Text) (Maybe Text))
-> Getting (Maybe Text) JWK (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Maybe Text)
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> Maybe Text
-> Const (Maybe Text) (Maybe Text)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting Text Text Text -> Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Text Text
forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
recons)))
    JWSHeader p -> (JWSHeader p -> JWSHeader p) -> JWSHeader p
forall a b. a -> (a -> b) -> b
& ASetter
  (JWSHeader p)
  (JWSHeader p)
  (Maybe (HeaderParam p URI))
  (Maybe (HeaderParam p URI))
-> Getting (Maybe URI) JWK (Maybe URI)
-> JWSHeader p
-> JWSHeader p
forall s t a a1.
ASetter s t a (Maybe (HeaderParam p a1))
-> Getting (Maybe a1) JWK (Maybe a1) -> s -> t
f ASetter
  (JWSHeader p)
  (JWSHeader p)
  (Maybe (HeaderParam p URI))
  (Maybe (HeaderParam p URI))
forall (a :: * -> *) p.
HasX5u a =>
Lens' (a p) (Maybe (HeaderParam p URI))
x5u Getting (Maybe URI) JWK (Maybe URI)
Lens' JWK (Maybe URI)
jwkX5u
    JWSHeader p -> (JWSHeader p -> JWSHeader p) -> JWSHeader p
forall a b. a -> (a -> b) -> b
& ASetter
  (JWSHeader p)
  (JWSHeader p)
  (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
  (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
-> Getting
     (Maybe (NonEmpty SignedCertificate))
     JWK
     (Maybe (NonEmpty SignedCertificate))
-> JWSHeader p
-> JWSHeader p
forall s t a a1.
ASetter s t a (Maybe (HeaderParam p a1))
-> Getting (Maybe a1) JWK (Maybe a1) -> s -> t
f ASetter
  (JWSHeader p)
  (JWSHeader p)
  (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
  (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
forall (a :: * -> *) p.
HasX5c a =>
Lens' (a p) (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
x5c Getting
  (Maybe (NonEmpty SignedCertificate))
  JWK
  (Maybe (NonEmpty SignedCertificate))
Getter JWK (Maybe (NonEmpty SignedCertificate))
jwkX5c
    JWSHeader p -> (JWSHeader p -> JWSHeader p) -> JWSHeader p
forall a b. a -> (a -> b) -> b
& ASetter
  (JWSHeader p)
  (JWSHeader p)
  (Maybe (HeaderParam p Base64SHA1))
  (Maybe (HeaderParam p Base64SHA1))
-> Getting (Maybe Base64SHA1) JWK (Maybe Base64SHA1)
-> JWSHeader p
-> JWSHeader p
forall s t a a1.
ASetter s t a (Maybe (HeaderParam p a1))
-> Getting (Maybe a1) JWK (Maybe a1) -> s -> t
f ASetter
  (JWSHeader p)
  (JWSHeader p)
  (Maybe (HeaderParam p Base64SHA1))
  (Maybe (HeaderParam p Base64SHA1))
forall (a :: * -> *) p.
HasX5t a =>
Lens' (a p) (Maybe (HeaderParam p Base64SHA1))
x5t Getting (Maybe Base64SHA1) JWK (Maybe Base64SHA1)
Lens' JWK (Maybe Base64SHA1)
jwkX5t
    JWSHeader p -> (JWSHeader p -> JWSHeader p) -> JWSHeader p
forall a b. a -> (a -> b) -> b
& ASetter
  (JWSHeader p)
  (JWSHeader p)
  (Maybe (HeaderParam p Base64SHA256))
  (Maybe (HeaderParam p Base64SHA256))
-> Getting (Maybe Base64SHA256) JWK (Maybe Base64SHA256)
-> JWSHeader p
-> JWSHeader p
forall s t a a1.
ASetter s t a (Maybe (HeaderParam p a1))
-> Getting (Maybe a1) JWK (Maybe a1) -> s -> t
f ASetter
  (JWSHeader p)
  (JWSHeader p)
  (Maybe (HeaderParam p Base64SHA256))
  (Maybe (HeaderParam p Base64SHA256))
forall (a :: * -> *) p.
HasX5tS256 a =>
Lens' (a p) (Maybe (HeaderParam p Base64SHA256))
x5tS256 Getting (Maybe Base64SHA256) JWK (Maybe Base64SHA256)
Lens' JWK (Maybe Base64SHA256)
jwkX5tS256


-- | Signature object containing header, and signature bytes.
--
-- If it was decoded from a serialised JWS, it "remembers" how the
-- protected header was encoded; the remembered value is used when
-- computing the signing input and when serialising the object.
--
-- The remembered value is not used in equality checks, i.e. two
-- decoded signatures with differently serialised by otherwise equal
-- protected headers, and equal signature bytes, are equal.
--
data Signature p a = Signature
  (Maybe T.Text)      -- Encoded protected header, if available
  (a p)               -- Header
  Types.Base64Octets  -- Signature
  deriving (Int -> Signature p a -> ShowS
[Signature p a] -> ShowS
Signature p a -> String
(Int -> Signature p a -> ShowS)
-> (Signature p a -> String)
-> ([Signature p a] -> ShowS)
-> Show (Signature p a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p (a :: * -> *). Show (a p) => Int -> Signature p a -> ShowS
forall p (a :: * -> *). Show (a p) => [Signature p a] -> ShowS
forall p (a :: * -> *). Show (a p) => Signature p a -> String
showList :: [Signature p a] -> ShowS
$cshowList :: forall p (a :: * -> *). Show (a p) => [Signature p a] -> ShowS
show :: Signature p a -> String
$cshow :: forall p (a :: * -> *). Show (a p) => Signature p a -> String
showsPrec :: Int -> Signature p a -> ShowS
$cshowsPrec :: forall p (a :: * -> *). Show (a p) => Int -> Signature p a -> ShowS
Show)

-- | Getter for header of a signature
header :: Getter (Signature p a) (a p)
header :: (a p -> f (a p)) -> Signature p a -> f (Signature p a)
header = (Signature p a -> a p)
-> (a p -> f (a p)) -> Signature p a -> f (Signature p a)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\(Signature Maybe Text
_ a p
h Base64Octets
_) -> a p
h)

-- | Getter for signature bytes
signature :: (Cons s s Word8 Word8, AsEmpty s) => Getter (Signature p a) s
signature :: Getter (Signature p a) s
signature = (Signature p a -> ByteString)
-> Optic' (->) f (Signature p a) ByteString
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\(Signature Maybe Text
_ a p
_ (Types.Base64Octets ByteString
s)) -> ByteString
s) Optic' (->) f (Signature p a) ByteString
-> ((s -> f s) -> ByteString -> f ByteString)
-> (s -> f s)
-> Signature p a
-> f (Signature p a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> f s) -> ByteString -> f ByteString
forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
recons
{-# INLINE signature #-}

instance (Eq (a p)) => Eq (Signature p a) where
  Signature Maybe Text
_ a p
h Base64Octets
s == :: Signature p a -> Signature p a -> Bool
== Signature Maybe Text
_ a p
h' Base64Octets
s' = a p
h a p -> a p -> Bool
forall a. Eq a => a -> a -> Bool
== a p
h' Bool -> Bool -> Bool
&& Base64Octets
s Base64Octets -> Base64Octets -> Bool
forall a. Eq a => a -> a -> Bool
== Base64Octets
s'

instance (HasParams a, ProtectionIndicator p) => FromJSON (Signature p a) where
  parseJSON :: Value -> Parser (Signature p a)
parseJSON = String
-> (Object -> Parser (Signature p a))
-> Value
-> Parser (Signature p a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"signature" (\Object
o -> Maybe Text -> a p -> Base64Octets -> Signature p a
forall p (a :: * -> *).
Maybe Text -> a p -> Base64Octets -> Signature p a
Signature
    (Maybe Text -> a p -> Base64Octets -> Signature p a)
-> Parser (Maybe Text)
-> Parser (a p -> Base64Octets -> Signature p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"protected" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""))  -- raw protected header
    Parser (a p -> Base64Octets -> Signature p a)
-> Parser (a p) -> Parser (Base64Octets -> Signature p a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> do
      Maybe Value
hpB64 <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"protected"
      Maybe Object
hp <- Parser (Maybe Object)
-> (Value -> Parser (Maybe Object))
-> Maybe Value
-> Parser (Maybe Object)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (Maybe Object -> Parser (Maybe Object)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Object
forall a. Maybe a
Nothing)
        (String
-> (Text -> Parser (Maybe Object))
-> Value
-> Parser (Maybe Object)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"base64url-encoded header params"
          ((ByteString -> Parser (Maybe Object))
-> Text -> Parser (Maybe Object)
forall a. (ByteString -> Parser a) -> Text -> Parser a
Types.parseB64Url (Parser (Maybe Object)
-> (Maybe Object -> Parser (Maybe Object))
-> Maybe (Maybe Object)
-> Parser (Maybe Object)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (String -> Parser (Maybe Object)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"protected header contains invalid JSON")
            Maybe Object -> Parser (Maybe Object)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Maybe Object) -> Parser (Maybe Object))
-> (ByteString -> Maybe (Maybe Object))
-> ByteString
-> Parser (Maybe Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Maybe Object)
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe (Maybe Object))
-> (ByteString -> ByteString) -> ByteString -> Maybe (Maybe Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ByteString ByteString ByteString
-> ByteString -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString ByteString ByteString
forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
recons)))
        Maybe Value
hpB64
      Maybe Object
hu <- Object
o Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"header"
      Maybe Object -> Maybe Object -> Parser (a p)
forall (a :: * -> *) p.
(HasParams a, ProtectionIndicator p) =>
Maybe Object -> Maybe Object -> Parser (a p)
parseParams Maybe Object
hp Maybe Object
hu
    Parser (Base64Octets -> Signature p a)
-> Parser Base64Octets -> Parser (Signature p a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Base64Octets
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"signature"
    )

instance (HasParams a, ProtectionIndicator p) => ToJSON (Signature p a) where
  toJSON :: Signature p a -> Value
toJSON s :: Signature p a
s@(Signature Maybe Text
_ a p
h Base64Octets
sig) =
    let
      pro :: [Pair] -> [Pair]
pro = case Signature p a -> ByteString
forall (a :: * -> *) p.
(HasParams a, ProtectionIndicator p) =>
Signature p a -> ByteString
rawProtectedHeader Signature p a
s of
        ByteString
"" -> [Pair] -> [Pair]
forall a. a -> a
id
        ByteString
bs -> (Key
"protected" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ByteString -> Text
T.decodeUtf8 (Getting ByteString ByteString ByteString
-> ByteString -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString ByteString ByteString
forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
recons ByteString
bs)) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
:)
      unp :: [Pair] -> [Pair]
unp = case a p -> Maybe Value
forall (a :: * -> *) p.
(HasParams a, ProtectionIndicator p) =>
a p -> Maybe Value
unprotectedParams a p
h of
        Maybe Value
Nothing -> [Pair] -> [Pair]
forall a. a -> a
id
        Just Value
o -> (Key
"header" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
o Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
:)
    in
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ ([Pair] -> [Pair]
pro ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> [Pair]
unp) [Key
"signature" Key -> Base64Octets -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Octets
sig]


instance HasParams JWSHeader where
  parseParamsFor :: Proxy b -> Maybe Object -> Maybe Object -> Parser (JWSHeader p)
parseParamsFor Proxy b
proxy Maybe Object
hp Maybe Object
hu = HeaderParam p Alg
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p JWK)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
-> Maybe (HeaderParam p Base64SHA1)
-> Maybe (HeaderParam p Base64SHA256)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p Text)
-> Maybe (NonEmpty Text)
-> JWSHeader p
forall p.
HeaderParam p Alg
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p JWK)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
-> Maybe (HeaderParam p Base64SHA1)
-> Maybe (HeaderParam p Base64SHA256)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p Text)
-> Maybe (NonEmpty Text)
-> JWSHeader p
JWSHeader
    (HeaderParam p Alg
 -> Maybe (HeaderParam p URI)
 -> Maybe (HeaderParam p JWK)
 -> Maybe (HeaderParam p Text)
 -> Maybe (HeaderParam p URI)
 -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
 -> Maybe (HeaderParam p Base64SHA1)
 -> Maybe (HeaderParam p Base64SHA256)
 -> Maybe (HeaderParam p Text)
 -> Maybe (HeaderParam p Text)
 -> Maybe (NonEmpty Text)
 -> JWSHeader p)
-> Parser (HeaderParam p Alg)
-> Parser
     (Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p JWK)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
      -> Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWSHeader p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Object -> Maybe Object -> Parser (HeaderParam p Alg)
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text -> Maybe Object -> Maybe Object -> Parser (HeaderParam p a)
headerRequired Text
"alg" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p JWK)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
   -> Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWSHeader p)
-> Parser (Maybe (HeaderParam p URI))
-> Parser
     (Maybe (HeaderParam p JWK)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
      -> Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWSHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p URI))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"jku" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p JWK)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
   -> Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWSHeader p)
-> Parser (Maybe (HeaderParam p JWK))
-> Parser
     (Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
      -> Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWSHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p JWK))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"jwk" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
   -> Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWSHeader p)
-> Parser (Maybe (HeaderParam p Text))
-> Parser
     (Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
      -> Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWSHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p Text))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"kid" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
   -> Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWSHeader p)
-> Parser (Maybe (HeaderParam p URI))
-> Parser
     (Maybe (HeaderParam p (NonEmpty SignedCertificate))
      -> Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWSHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p URI))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"x5u" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p (NonEmpty SignedCertificate))
   -> Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWSHeader p)
-> Parser (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
-> Parser
     (Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWSHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe (HeaderParam p (NonEmpty Base64X509))
 -> Maybe (HeaderParam p (NonEmpty SignedCertificate)))
-> Parser (Maybe (HeaderParam p (NonEmpty Base64X509)))
-> Parser (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (HeaderParam p (NonEmpty Base64X509))
  -> Maybe (HeaderParam p (NonEmpty SignedCertificate)))
 -> Parser (Maybe (HeaderParam p (NonEmpty Base64X509)))
 -> Parser (Maybe (HeaderParam p (NonEmpty SignedCertificate))))
-> ((Base64X509 -> SignedCertificate)
    -> Maybe (HeaderParam p (NonEmpty Base64X509))
    -> Maybe (HeaderParam p (NonEmpty SignedCertificate)))
-> (Base64X509 -> SignedCertificate)
-> Parser (Maybe (HeaderParam p (NonEmpty Base64X509)))
-> Parser (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderParam p (NonEmpty Base64X509)
 -> HeaderParam p (NonEmpty SignedCertificate))
-> Maybe (HeaderParam p (NonEmpty Base64X509))
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HeaderParam p (NonEmpty Base64X509)
  -> HeaderParam p (NonEmpty SignedCertificate))
 -> Maybe (HeaderParam p (NonEmpty Base64X509))
 -> Maybe (HeaderParam p (NonEmpty SignedCertificate)))
-> ((Base64X509 -> SignedCertificate)
    -> HeaderParam p (NonEmpty Base64X509)
    -> HeaderParam p (NonEmpty SignedCertificate))
-> (Base64X509 -> SignedCertificate)
-> Maybe (HeaderParam p (NonEmpty Base64X509))
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Base64X509 -> NonEmpty SignedCertificate)
-> HeaderParam p (NonEmpty Base64X509)
-> HeaderParam p (NonEmpty SignedCertificate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty Base64X509 -> NonEmpty SignedCertificate)
 -> HeaderParam p (NonEmpty Base64X509)
 -> HeaderParam p (NonEmpty SignedCertificate))
-> ((Base64X509 -> SignedCertificate)
    -> NonEmpty Base64X509 -> NonEmpty SignedCertificate)
-> (Base64X509 -> SignedCertificate)
-> HeaderParam p (NonEmpty Base64X509)
-> HeaderParam p (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) (Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p (NonEmpty Base64X509)))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"x5c" Maybe Object
hp Maybe Object
hu)
    Parser
  (Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWSHeader p)
-> Parser (Maybe (HeaderParam p Base64SHA1))
-> Parser
     (Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWSHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p Base64SHA1))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"x5t" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWSHeader p)
-> Parser (Maybe (HeaderParam p Base64SHA256))
-> Parser
     (Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWSHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p Base64SHA256))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"x5t#S256" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWSHeader p)
-> Parser (Maybe (HeaderParam p Text))
-> Parser
     (Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text) -> JWSHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p Text))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"typ" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text) -> JWSHeader p)
-> Parser (Maybe (HeaderParam p Text))
-> Parser (Maybe (NonEmpty Text) -> JWSHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p Text))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"cty" Maybe Object
hp Maybe Object
hu
    Parser (Maybe (NonEmpty Text) -> JWSHeader p)
-> Parser (Maybe (NonEmpty Text)) -> Parser (JWSHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (NonEmpty Text))
forall a.
FromJSON a =>
Text -> Maybe Object -> Maybe Object -> Parser (Maybe a)
headerOptionalProtected Text
"crit" Maybe Object
hp Maybe Object
hu
      Parser (Maybe (NonEmpty Text))
-> (Maybe (NonEmpty Text) -> Parser (Maybe (NonEmpty Text)))
-> Parser (Maybe (NonEmpty Text))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Text]
-> [Text]
-> Object
-> Maybe (NonEmpty Text)
-> Parser (Maybe (NonEmpty Text))
forall (t0 :: * -> *) (t1 :: * -> *) (t2 :: * -> *) (t3 :: * -> *)
       (m :: * -> *).
(Foldable t0, Foldable t1, Traversable t2, Traversable t3,
 MonadFail m) =>
t0 Text -> t1 Text -> Object -> t2 (t3 Text) -> m (t2 (t3 Text))
parseCrit [Text]
jwsCritInvalidNames (Proxy b -> [Text]
forall (a :: * -> *). HasParams a => Proxy a -> [Text]
extensions Proxy b
proxy)
        (Object -> Maybe Object -> Object
forall a. a -> Maybe a -> a
fromMaybe Object
forall a. Monoid a => a
mempty Maybe Object
hp Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object -> Maybe Object -> Object
forall a. a -> Maybe a -> a
fromMaybe Object
forall a. Monoid a => a
mempty Maybe Object
hu))
  params :: JWSHeader p -> [(Bool, Pair)]
params JWSHeader p
h =
    [Maybe (Bool, Pair)] -> [(Bool, Pair)]
forall a. [Maybe a] -> [a]
catMaybes
      [ (Bool, Pair) -> Maybe (Bool, Pair)
forall a. a -> Maybe a
Just (Getting Bool (JWSHeader p) Bool -> JWSHeader p -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((HeaderParam p Alg -> Const Bool (HeaderParam p Alg))
-> JWSHeader p -> Const Bool (JWSHeader p)
forall (a :: * -> *) p. HasAlg a => Lens' (a p) (HeaderParam p Alg)
alg ((HeaderParam p Alg -> Const Bool (HeaderParam p Alg))
 -> JWSHeader p -> Const Bool (JWSHeader p))
-> ((Bool -> Const Bool Bool)
    -> HeaderParam p Alg -> Const Bool (HeaderParam p Alg))
-> Getting Bool (JWSHeader p) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> HeaderParam p Alg -> Const Bool (HeaderParam p Alg)
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected) JWSHeader p
h, Key
"alg" Key -> Alg -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting Alg (JWSHeader p) Alg -> JWSHeader p -> Alg
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((HeaderParam p Alg -> Const Alg (HeaderParam p Alg))
-> JWSHeader p -> Const Alg (JWSHeader p)
forall (a :: * -> *) p. HasAlg a => Lens' (a p) (HeaderParam p Alg)
alg ((HeaderParam p Alg -> Const Alg (HeaderParam p Alg))
 -> JWSHeader p -> Const Alg (JWSHeader p))
-> ((Alg -> Const Alg Alg)
    -> HeaderParam p Alg -> Const Alg (HeaderParam p Alg))
-> Getting Alg (JWSHeader p) Alg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alg -> Const Alg Alg)
-> HeaderParam p Alg -> Const Alg (HeaderParam p Alg)
forall p a. Lens' (HeaderParam p a) a
param) JWSHeader p
h)
      , (HeaderParam p URI -> (Bool, Pair))
-> Maybe (HeaderParam p URI) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p URI
p -> (Getting Bool (HeaderParam p URI) Bool -> HeaderParam p URI -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p URI) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p URI
p, Key
"jku" Key -> URI -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting URI (HeaderParam p URI) URI -> HeaderParam p URI -> URI
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting URI (HeaderParam p URI) URI
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p URI
p)) (Getting
  (Maybe (HeaderParam p URI))
  (JWSHeader p)
  (Maybe (HeaderParam p URI))
-> JWSHeader p -> Maybe (HeaderParam p URI)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (HeaderParam p URI))
  (JWSHeader p)
  (Maybe (HeaderParam p URI))
forall (a :: * -> *) p.
HasJku a =>
Lens' (a p) (Maybe (HeaderParam p URI))
jku JWSHeader p
h)
      , (HeaderParam p JWK -> (Bool, Pair))
-> Maybe (HeaderParam p JWK) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p JWK
p -> (Getting Bool (HeaderParam p JWK) Bool -> HeaderParam p JWK -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p JWK) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p JWK
p, Key
"jwk" Key -> JWK -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting JWK (HeaderParam p JWK) JWK -> HeaderParam p JWK -> JWK
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting JWK (HeaderParam p JWK) JWK
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p JWK
p)) (Getting
  (Maybe (HeaderParam p JWK))
  (JWSHeader p)
  (Maybe (HeaderParam p JWK))
-> JWSHeader p -> Maybe (HeaderParam p JWK)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (HeaderParam p JWK))
  (JWSHeader p)
  (Maybe (HeaderParam p JWK))
forall (a :: * -> *) p.
HasJwk a =>
Lens' (a p) (Maybe (HeaderParam p JWK))
jwk JWSHeader p
h)
      , (HeaderParam p Text -> (Bool, Pair))
-> Maybe (HeaderParam p Text) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p Text
p -> (Getting Bool (HeaderParam p Text) Bool
-> HeaderParam p Text -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p Text) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p Text
p, Key
"kid" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting Text (HeaderParam p Text) Text
-> HeaderParam p Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text (HeaderParam p Text) Text
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p Text
p)) (Getting
  (Maybe (HeaderParam p Text))
  (JWSHeader p)
  (Maybe (HeaderParam p Text))
-> JWSHeader p -> Maybe (HeaderParam p Text)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (HeaderParam p Text))
  (JWSHeader p)
  (Maybe (HeaderParam p Text))
forall (a :: * -> *) p.
HasKid a =>
Lens' (a p) (Maybe (HeaderParam p Text))
kid JWSHeader p
h)
      , (HeaderParam p URI -> (Bool, Pair))
-> Maybe (HeaderParam p URI) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p URI
p -> (Getting Bool (HeaderParam p URI) Bool -> HeaderParam p URI -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p URI) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p URI
p, Key
"x5u" Key -> URI -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting URI (HeaderParam p URI) URI -> HeaderParam p URI -> URI
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting URI (HeaderParam p URI) URI
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p URI
p)) (Getting
  (Maybe (HeaderParam p URI))
  (JWSHeader p)
  (Maybe (HeaderParam p URI))
-> JWSHeader p -> Maybe (HeaderParam p URI)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (HeaderParam p URI))
  (JWSHeader p)
  (Maybe (HeaderParam p URI))
forall (a :: * -> *) p.
HasX5u a =>
Lens' (a p) (Maybe (HeaderParam p URI))
x5u JWSHeader p
h)
      , (HeaderParam p (NonEmpty SignedCertificate) -> (Bool, Pair))
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
-> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p (NonEmpty SignedCertificate)
p -> (Getting Bool (HeaderParam p (NonEmpty SignedCertificate)) Bool
-> HeaderParam p (NonEmpty SignedCertificate) -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p (NonEmpty SignedCertificate)) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p (NonEmpty SignedCertificate)
p, Key
"x5c" Key -> NonEmpty Base64X509 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (SignedCertificate -> Base64X509)
-> NonEmpty SignedCertificate -> NonEmpty Base64X509
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SignedCertificate -> Base64X509
Types.Base64X509 (Getting
  (NonEmpty SignedCertificate)
  (HeaderParam p (NonEmpty SignedCertificate))
  (NonEmpty SignedCertificate)
-> HeaderParam p (NonEmpty SignedCertificate)
-> NonEmpty SignedCertificate
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (NonEmpty SignedCertificate)
  (HeaderParam p (NonEmpty SignedCertificate))
  (NonEmpty SignedCertificate)
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p (NonEmpty SignedCertificate)
p))) (Getting
  (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
  (JWSHeader p)
  (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
-> JWSHeader p
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
  (JWSHeader p)
  (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
forall (a :: * -> *) p.
HasX5c a =>
Lens' (a p) (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
x5c JWSHeader p
h)
      , (HeaderParam p Base64SHA1 -> (Bool, Pair))
-> Maybe (HeaderParam p Base64SHA1) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p Base64SHA1
p -> (Getting Bool (HeaderParam p Base64SHA1) Bool
-> HeaderParam p Base64SHA1 -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p Base64SHA1) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p Base64SHA1
p, Key
"x5t" Key -> Base64SHA1 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting Base64SHA1 (HeaderParam p Base64SHA1) Base64SHA1
-> HeaderParam p Base64SHA1 -> Base64SHA1
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Base64SHA1 (HeaderParam p Base64SHA1) Base64SHA1
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p Base64SHA1
p)) (Getting
  (Maybe (HeaderParam p Base64SHA1))
  (JWSHeader p)
  (Maybe (HeaderParam p Base64SHA1))
-> JWSHeader p -> Maybe (HeaderParam p Base64SHA1)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (HeaderParam p Base64SHA1))
  (JWSHeader p)
  (Maybe (HeaderParam p Base64SHA1))
forall (a :: * -> *) p.
HasX5t a =>
Lens' (a p) (Maybe (HeaderParam p Base64SHA1))
x5t JWSHeader p
h)
      , (HeaderParam p Base64SHA256 -> (Bool, Pair))
-> Maybe (HeaderParam p Base64SHA256) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p Base64SHA256
p -> (Getting Bool (HeaderParam p Base64SHA256) Bool
-> HeaderParam p Base64SHA256 -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p Base64SHA256) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p Base64SHA256
p, Key
"x5t#S256" Key -> Base64SHA256 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting Base64SHA256 (HeaderParam p Base64SHA256) Base64SHA256
-> HeaderParam p Base64SHA256 -> Base64SHA256
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Base64SHA256 (HeaderParam p Base64SHA256) Base64SHA256
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p Base64SHA256
p)) (Getting
  (Maybe (HeaderParam p Base64SHA256))
  (JWSHeader p)
  (Maybe (HeaderParam p Base64SHA256))
-> JWSHeader p -> Maybe (HeaderParam p Base64SHA256)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (HeaderParam p Base64SHA256))
  (JWSHeader p)
  (Maybe (HeaderParam p Base64SHA256))
forall (a :: * -> *) p.
HasX5tS256 a =>
Lens' (a p) (Maybe (HeaderParam p Base64SHA256))
x5tS256 JWSHeader p
h)
      , (HeaderParam p Text -> (Bool, Pair))
-> Maybe (HeaderParam p Text) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p Text
p -> (Getting Bool (HeaderParam p Text) Bool
-> HeaderParam p Text -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p Text) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p Text
p, Key
"typ" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting Text (HeaderParam p Text) Text
-> HeaderParam p Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text (HeaderParam p Text) Text
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p Text
p)) (Getting
  (Maybe (HeaderParam p Text))
  (JWSHeader p)
  (Maybe (HeaderParam p Text))
-> JWSHeader p -> Maybe (HeaderParam p Text)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (HeaderParam p Text))
  (JWSHeader p)
  (Maybe (HeaderParam p Text))
forall (a :: * -> *) p.
HasTyp a =>
Lens' (a p) (Maybe (HeaderParam p Text))
typ JWSHeader p
h)
      , (HeaderParam p Text -> (Bool, Pair))
-> Maybe (HeaderParam p Text) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p Text
p -> (Getting Bool (HeaderParam p Text) Bool
-> HeaderParam p Text -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p Text) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p Text
p, Key
"cty" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting Text (HeaderParam p Text) Text
-> HeaderParam p Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text (HeaderParam p Text) Text
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p Text
p)) (Getting
  (Maybe (HeaderParam p Text))
  (JWSHeader p)
  (Maybe (HeaderParam p Text))
-> JWSHeader p -> Maybe (HeaderParam p Text)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (HeaderParam p Text))
  (JWSHeader p)
  (Maybe (HeaderParam p Text))
forall (a :: * -> *) p.
HasCty a =>
Lens' (a p) (Maybe (HeaderParam p Text))
cty JWSHeader p
h)
      , (NonEmpty Text -> (Bool, Pair))
-> Maybe (NonEmpty Text) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NonEmpty Text
p -> (Bool
True, Key
"crit" Key -> NonEmpty Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty Text
p)) (Getting
  (Maybe (NonEmpty Text)) (JWSHeader p) (Maybe (NonEmpty Text))
-> JWSHeader p -> Maybe (NonEmpty Text)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (NonEmpty Text)) (JWSHeader p) (Maybe (NonEmpty Text))
forall (a :: * -> *) p.
HasCrit a =>
Lens' (a p) (Maybe (NonEmpty Text))
crit JWSHeader p
h)
      ]


-- | JSON Web Signature data type.  The payload can only be
-- accessed by verifying the JWS.
--
-- Parameterised by the signature container type, the header
-- 'ProtectionIndicator' type, and the header record type.
--
-- Use 'encode' and 'decode' to convert a JWS to or from JSON.
-- When encoding a @'JWS' []@ with exactly one signature, the
-- /flattened JWS JSON serialisation/ syntax is used, otherwise
-- the /general JWS JSON serialisation/ is used.
-- When decoding a @'JWS' []@ either serialisation is accepted.
--
-- @'JWS' 'Identity'@ uses the flattened JSON serialisation
-- or the /JWS compact serialisation/ (see 'decodeCompact' and
-- 'encodeCompact').
--
-- Use 'signJWS' to create a signed/MACed JWS.
--
-- Use 'verifyJWS' to verify a JWS and extract the payload.
--
data JWS t p a = JWS Types.Base64Octets (t (Signature p a))

-- | A JWS that allows multiple signatures, and cannot use
-- the /compact serialisation/.  Headers may be 'Protected'
-- or 'Unprotected'.
--
type GeneralJWS = JWS [] Protection

-- | A JWS with one signature, which uses the
-- /flattened serialisation/.  Headers may be 'Protected'
-- or 'Unprotected'.
--
type FlattenedJWS = JWS Identity Protection

-- | A JWS with one signature which only allows protected
-- parameters.  Can use the /flattened serialisation/ or
-- the /compact serialisation/.
--
type CompactJWS = JWS Identity ()

instance (Eq (t (Signature p a))) => Eq (JWS t p a) where
  JWS Base64Octets
p t (Signature p a)
sigs == :: JWS t p a -> JWS t p a -> Bool
== JWS Base64Octets
p' t (Signature p a)
sigs' = Base64Octets
p Base64Octets -> Base64Octets -> Bool
forall a. Eq a => a -> a -> Bool
== Base64Octets
p' Bool -> Bool -> Bool
&& t (Signature p a)
sigs t (Signature p a) -> t (Signature p a) -> Bool
forall a. Eq a => a -> a -> Bool
== t (Signature p a)
sigs'

instance (Show (t (Signature p a))) => Show (JWS t p a) where
  show :: JWS t p a -> String
show (JWS Base64Octets
p t (Signature p a)
sigs) = String
"JWS " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Base64Octets -> String
forall a. Show a => a -> String
show Base64Octets
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> t (Signature p a) -> String
forall a. Show a => a -> String
show t (Signature p a)
sigs

signatures :: Foldable t => Fold (JWS t p a) (Signature p a)
signatures :: Fold (JWS t p a) (Signature p a)
signatures = (JWS t p a -> t (Signature p a))
-> Fold (JWS t p a) (Signature p a)
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding (\(JWS Base64Octets
_ t (Signature p a)
sigs) -> t (Signature p a)
sigs)

instance (HasParams a, ProtectionIndicator p) => FromJSON (JWS [] p a) where
  parseJSON :: Value -> Parser (JWS [] p a)
parseJSON Value
v =
    String
-> (Object -> Parser (JWS [] p a)) -> Value -> Parser (JWS [] p a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JWS JSON serialization" (\Object
o -> Base64Octets -> [Signature p a] -> JWS [] p a
forall (t :: * -> *) p (a :: * -> *).
Base64Octets -> t (Signature p a) -> JWS t p a
JWS
      (Base64Octets -> [Signature p a] -> JWS [] p a)
-> Parser Base64Octets -> Parser ([Signature p a] -> JWS [] p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Base64Octets
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"payload"
      Parser ([Signature p a] -> JWS [] p a)
-> Parser [Signature p a] -> Parser (JWS [] p a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [Signature p a]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"signatures") Value
v
    Parser (JWS [] p a) -> Parser (JWS [] p a) -> Parser (JWS [] p a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (JWS Identity p a -> JWS [] p a)
-> Parser (JWS Identity p a) -> Parser (JWS [] p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(JWS Base64Octets
p (Identity Signature p a
s)) -> Base64Octets -> [Signature p a] -> JWS [] p a
forall (t :: * -> *) p (a :: * -> *).
Base64Octets -> t (Signature p a) -> JWS t p a
JWS Base64Octets
p [Signature p a
s]) (Value -> Parser (JWS Identity p a)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

instance (HasParams a, ProtectionIndicator p) => FromJSON (JWS Identity p a) where
  parseJSON :: Value -> Parser (JWS Identity p a)
parseJSON =
    String
-> (Object -> Parser (JWS Identity p a))
-> Value
-> Parser (JWS Identity p a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Flattened JWS JSON serialization" ((Object -> Parser (JWS Identity p a))
 -> Value -> Parser (JWS Identity p a))
-> (Object -> Parser (JWS Identity p a))
-> Value
-> Parser (JWS Identity p a)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      if Key -> Object -> Bool
forall a. Key -> KeyMap a -> Bool
M.member Key
"signatures" Object
o
      then String -> Parser (JWS Identity p a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"signatures\" member MUST NOT be present"
      else (\Base64Octets
p Signature p a
s -> Base64Octets -> Identity (Signature p a) -> JWS Identity p a
forall (t :: * -> *) p (a :: * -> *).
Base64Octets -> t (Signature p a) -> JWS t p a
JWS Base64Octets
p (Signature p a -> Identity (Signature p a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Signature p a
s)) (Base64Octets -> Signature p a -> JWS Identity p a)
-> Parser Base64Octets
-> Parser (Signature p a -> JWS Identity p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Base64Octets
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"payload" Parser (Signature p a -> JWS Identity p a)
-> Parser (Signature p a) -> Parser (JWS Identity p a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser (Signature p a)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)

instance (HasParams a, ProtectionIndicator p) => ToJSON (JWS [] p a) where
  toJSON :: JWS [] p a -> Value
toJSON (JWS Base64Octets
p [Signature p a
s]) = Key -> Base64Octets -> Value -> Value
forall v. ToJSON v => Key -> v -> Value -> Value
Types.insertToObject Key
"payload" Base64Octets
p (Signature p a -> Value
forall a. ToJSON a => a -> Value
toJSON Signature p a
s)
  toJSON (JWS Base64Octets
p [Signature p a]
ss) = [Pair] -> Value
object [Key
"payload" Key -> Base64Octets -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Octets
p, Key
"signatures" Key -> [Signature p a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Signature p a]
ss]

instance (HasParams a, ProtectionIndicator p) => ToJSON (JWS Identity p a) where
  toJSON :: JWS Identity p a -> Value
toJSON (JWS Base64Octets
p (Identity Signature p a
s)) = Key -> Base64Octets -> Value -> Value
forall v. ToJSON v => Key -> v -> Value -> Value
Types.insertToObject Key
"payload" Base64Octets
p (Signature p a -> Value
forall a. ToJSON a => a -> Value
toJSON Signature p a
s)


signingInput
  :: (HasParams a, ProtectionIndicator p)
  => Signature p a
  -> Types.Base64Octets
  -> B.ByteString
signingInput :: Signature p a -> Base64Octets -> ByteString
signingInput Signature p a
sig (Types.Base64Octets ByteString
p) =
  Signature p a -> ByteString
forall (a :: * -> *) p.
(HasParams a, ProtectionIndicator p) =>
Signature p a -> ByteString
rawProtectedHeader Signature p a
sig ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> AReview ByteString ByteString -> ByteString -> ByteString
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview ByteString ByteString
forall s1 s2.
(AsEmpty s1, AsEmpty s2, Cons s1 s1 Word8 Word8,
 Cons s2 s2 Word8 Word8) =>
Prism' s1 s2
Types.base64url ByteString
p

-- | Return the raw base64url-encoded protected header value.
-- If the Signature was decoded from JSON, this returns the
-- original string value as-is.
--
-- Application code should never need to use this.  It is exposed
-- for testing purposes.
rawProtectedHeader
  :: (HasParams a, ProtectionIndicator p)
  => Signature p a -> B.ByteString
rawProtectedHeader :: Signature p a -> ByteString
rawProtectedHeader (Signature Maybe Text
raw a p
h Base64Octets
_) =
  ByteString -> (Text -> ByteString) -> Maybe Text -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Getting ByteString ByteString ByteString
-> ByteString -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString ByteString ByteString
forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
recons (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ a p -> ByteString
forall (a :: * -> *) p.
(HasParams a, ProtectionIndicator p) =>
a p -> ByteString
protectedParamsEncoded a p
h) Text -> ByteString
T.encodeUtf8 Maybe Text
raw

-- Convert JWS to compact serialization.
--
-- The operation is defined only when there is exactly one
-- signature and returns Nothing otherwise
--
instance HasParams a => ToCompact (JWS Identity () a) where
  toCompact :: JWS Identity () a -> [ByteString]
toCompact (JWS Base64Octets
p (Identity s :: Signature () a
s@(Signature Maybe Text
_ a ()
_ (Types.Base64Octets ByteString
sig)))) =
    [ Getting ByteString ByteString ByteString
-> ByteString -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString ByteString ByteString
forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
recons (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Signature () a -> Base64Octets -> ByteString
forall (a :: * -> *) p.
(HasParams a, ProtectionIndicator p) =>
Signature p a -> Base64Octets -> ByteString
signingInput Signature () a
s Base64Octets
p
    , AReview ByteString ByteString -> ByteString -> ByteString
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview ByteString ByteString
forall s1 s2.
(AsEmpty s1, AsEmpty s2, Cons s1 s1 Word8 Word8,
 Cons s2 s2 Word8 Word8) =>
Prism' s1 s2
Types.base64url ByteString
sig
    ]

instance HasParams a => FromCompact (JWS Identity () a) where
  fromCompact :: [ByteString] -> m (JWS Identity () a)
fromCompact [ByteString]
xs = case [ByteString]
xs of
    [ByteString
h, ByteString
p, ByteString
s] -> do
      (Value
h', Value
p', Value
s') <- (,,) (Value -> Value -> Value -> (Value, Value, Value))
-> m Value -> m (Value -> Value -> (Value, Value, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> ByteString -> m Value
t Natural
0 ByteString
h m (Value -> Value -> (Value, Value, Value))
-> m Value -> m (Value -> (Value, Value, Value))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> ByteString -> m Value
t Natural
1 ByteString
p m (Value -> (Value, Value, Value))
-> m Value -> m (Value, Value, Value)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> ByteString -> m Value
t Natural
2 ByteString
s
      let o :: Value
o = [Pair] -> Value
object [ (Key
"payload", Value
p'), (Key
"protected", Value
h'), (Key
"signature", Value
s') ]
      case Value -> Result (JWS Identity () a)
forall a. FromJSON a => Value -> Result a
fromJSON Value
o of
        Error String
e -> AReview e String -> String -> m (JWS Identity () a)
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
_JSONDecodeError String
e
        Success JWS Identity () a
a -> JWS Identity () a -> m (JWS Identity () a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure JWS Identity () a
a
    [ByteString]
xs' -> AReview e InvalidNumberOfParts
-> InvalidNumberOfParts -> m (JWS Identity () a)
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing (Tagged CompactDecodeError (Identity CompactDecodeError)
-> Tagged e (Identity e)
forall r. AsError r => Prism' r CompactDecodeError
_CompactDecodeError (Tagged CompactDecodeError (Identity CompactDecodeError)
 -> Tagged e (Identity e))
-> (Tagged InvalidNumberOfParts (Identity InvalidNumberOfParts)
    -> Tagged CompactDecodeError (Identity CompactDecodeError))
-> AReview e InvalidNumberOfParts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged InvalidNumberOfParts (Identity InvalidNumberOfParts)
-> Tagged CompactDecodeError (Identity CompactDecodeError)
Prism' CompactDecodeError InvalidNumberOfParts
_CompactInvalidNumberOfParts)
            (Natural -> Natural -> InvalidNumberOfParts
InvalidNumberOfParts Natural
3 (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
xs')))
    where
      l :: Tagged CompactTextError (Identity CompactTextError)
-> Tagged e (Identity e)
l = Tagged CompactDecodeError (Identity CompactDecodeError)
-> Tagged e (Identity e)
forall r. AsError r => Prism' r CompactDecodeError
_CompactDecodeError (Tagged CompactDecodeError (Identity CompactDecodeError)
 -> Tagged e (Identity e))
-> (Tagged CompactTextError (Identity CompactTextError)
    -> Tagged CompactDecodeError (Identity CompactDecodeError))
-> Tagged CompactTextError (Identity CompactTextError)
-> Tagged e (Identity e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged CompactTextError (Identity CompactTextError)
-> Tagged CompactDecodeError (Identity CompactDecodeError)
Prism' CompactDecodeError CompactTextError
_CompactInvalidText
      t :: Natural -> ByteString -> m Value
t Natural
n = (UnicodeException -> m Value)
-> (Text -> m Value) -> Either UnicodeException Text -> m Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((Tagged CompactTextError (Identity CompactTextError)
 -> Tagged e (Identity e))
-> CompactTextError -> m Value
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing Tagged CompactTextError (Identity CompactTextError)
-> Tagged e (Identity e)
l (CompactTextError -> m Value)
-> (UnicodeException -> CompactTextError)
-> UnicodeException
-> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> UnicodeException -> CompactTextError
CompactTextError Natural
n) (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> m Value) -> (Text -> Value) -> Text -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String)
        (Either UnicodeException Text -> m Value)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
T.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> (ByteString -> ByteString)
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ByteString ByteString ByteString
-> ByteString -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString ByteString ByteString
forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
recons


-- | Create a signed or MACed JWS with the given payload by
-- traversing a collection of @(header, key)@ pairs.
--
signJWS
  :: ( Cons s s Word8 Word8
     , HasJWSHeader a, HasParams a, MonadRandom m, AsError e, MonadError e m
     , Traversable t
     , ProtectionIndicator p
     )
  => s          -- ^ Payload
  -> t (a p, JWK) -- ^ Traversable of header, key pairs
  -> m (JWS t p a)
signJWS :: s -> t (a p, JWK) -> m (JWS t p a)
signJWS s
s =
  let s' :: ByteString
s' = 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 s
s
  in (t (Signature p a) -> JWS t p a)
-> m (t (Signature p a)) -> m (JWS t p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Base64Octets -> t (Signature p a) -> JWS t p a
forall (t :: * -> *) p (a :: * -> *).
Base64Octets -> t (Signature p a) -> JWS t p a
JWS (ByteString -> Base64Octets
Types.Base64Octets ByteString
s')) (m (t (Signature p a)) -> m (JWS t p a))
-> (t (a p, JWK) -> m (t (Signature p a)))
-> t (a p, JWK)
-> m (JWS t p a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a p, JWK) -> m (Signature p a))
-> t (a p, JWK) -> m (t (Signature p a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a p -> JWK -> m (Signature p a))
-> (a p, JWK) -> m (Signature p a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ByteString -> a p -> JWK -> m (Signature p a)
forall (a :: * -> *) (m :: * -> *) e p.
(HasJWSHeader a, HasParams a, MonadRandom m, AsError e,
 MonadError e m, ProtectionIndicator p) =>
ByteString -> a p -> JWK -> m (Signature p a)
mkSignature ByteString
s'))
{-# INLINE signJWS #-}

mkSignature
  :: ( HasJWSHeader a, HasParams a, MonadRandom m, AsError e, MonadError e m
     , ProtectionIndicator p
     )
  => B.ByteString -> a p -> JWK -> m (Signature p a)
mkSignature :: ByteString -> a p -> JWK -> m (Signature p a)
mkSignature ByteString
p a p
h JWK
k =
  let
    almostSig :: ByteString -> Signature p a
almostSig = Maybe Text -> a p -> Base64Octets -> Signature p a
forall p (a :: * -> *).
Maybe Text -> a p -> Base64Octets -> Signature p a
Signature Maybe Text
forall a. Maybe a
Nothing a p
h (Base64Octets -> Signature p a)
-> (ByteString -> Base64Octets) -> ByteString -> Signature p a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64Octets
Types.Base64Octets
  in
    ByteString -> Signature p a
almostSig
    (ByteString -> Signature p a) -> m ByteString -> m (Signature p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Alg -> KeyMaterial -> ByteString -> m ByteString
forall (m :: * -> *) e.
(MonadRandom m, MonadError e m, AsError e) =>
Alg -> KeyMaterial -> ByteString -> m ByteString
sign
          (Getting Alg (a p) Alg -> a p -> Alg
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((HeaderParam p Alg -> Const Alg (HeaderParam p Alg))
-> a p -> Const Alg (a p)
forall (a :: * -> *) p. HasAlg a => Lens' (a p) (HeaderParam p Alg)
alg ((HeaderParam p Alg -> Const Alg (HeaderParam p Alg))
 -> a p -> Const Alg (a p))
-> ((Alg -> Const Alg Alg)
    -> HeaderParam p Alg -> Const Alg (HeaderParam p Alg))
-> Getting Alg (a p) Alg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alg -> Const Alg Alg)
-> HeaderParam p Alg -> Const Alg (HeaderParam p Alg)
forall p a. Lens' (HeaderParam p a) a
param) a p
h)
          (JWK
k JWK -> Getting KeyMaterial JWK KeyMaterial -> KeyMaterial
forall s a. s -> Getting a s a -> a
^. Getting KeyMaterial JWK KeyMaterial
Lens' JWK KeyMaterial
jwkMaterial)
          (Signature p a -> Base64Octets -> ByteString
forall (a :: * -> *) p.
(HasParams a, ProtectionIndicator p) =>
Signature p a -> Base64Octets -> ByteString
signingInput (ByteString -> Signature p a
almostSig ByteString
"") (ByteString -> Base64Octets
Types.Base64Octets ByteString
p))


-- | Validation policy.
--
data ValidationPolicy
  = AnyValidated
  -- ^ One successfully validated signature is sufficient
  | AllValidated
  -- ^ All signatures in all configured algorithms must be validated.
  -- No signatures in configured algorithms is also an error.
  deriving (ValidationPolicy -> ValidationPolicy -> Bool
(ValidationPolicy -> ValidationPolicy -> Bool)
-> (ValidationPolicy -> ValidationPolicy -> Bool)
-> Eq ValidationPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidationPolicy -> ValidationPolicy -> Bool
$c/= :: ValidationPolicy -> ValidationPolicy -> Bool
== :: ValidationPolicy -> ValidationPolicy -> Bool
$c== :: ValidationPolicy -> ValidationPolicy -> Bool
Eq)

-- | Validation settings:
--
-- * The set of acceptable signature algorithms
-- * The validation policy
--
data ValidationSettings = ValidationSettings
  (S.Set Alg)
  ValidationPolicy

class HasValidationSettings a where
  validationSettings :: Lens' a ValidationSettings

  validationSettingsAlgorithms :: Lens' a (S.Set Alg)
  validationSettingsAlgorithms = (ValidationSettings -> f ValidationSettings) -> a -> f a
forall a. HasValidationSettings a => Lens' a ValidationSettings
validationSettings ((ValidationSettings -> f ValidationSettings) -> a -> f a)
-> ((Set Alg -> f (Set Alg))
    -> ValidationSettings -> f ValidationSettings)
-> (Set Alg -> f (Set Alg))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Alg -> f (Set Alg))
-> ValidationSettings -> f ValidationSettings
forall (f :: * -> *).
Functor f =>
(Set Alg -> f (Set Alg))
-> ValidationSettings -> f ValidationSettings
go where
    go :: (Set Alg -> f (Set Alg))
-> ValidationSettings -> f ValidationSettings
go Set Alg -> f (Set Alg)
f (ValidationSettings Set Alg
algs ValidationPolicy
pol) =
      (Set Alg -> ValidationPolicy -> ValidationSettings
`ValidationSettings` ValidationPolicy
pol) (Set Alg -> ValidationSettings)
-> f (Set Alg) -> f ValidationSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Alg -> f (Set Alg)
f Set Alg
algs

  validationSettingsValidationPolicy :: Lens' a ValidationPolicy
  validationSettingsValidationPolicy = (ValidationSettings -> f ValidationSettings) -> a -> f a
forall a. HasValidationSettings a => Lens' a ValidationSettings
validationSettings ((ValidationSettings -> f ValidationSettings) -> a -> f a)
-> ((ValidationPolicy -> f ValidationPolicy)
    -> ValidationSettings -> f ValidationSettings)
-> (ValidationPolicy -> f ValidationPolicy)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidationPolicy -> f ValidationPolicy)
-> ValidationSettings -> f ValidationSettings
forall (f :: * -> *).
Functor f =>
(ValidationPolicy -> f ValidationPolicy)
-> ValidationSettings -> f ValidationSettings
go where
    go :: (ValidationPolicy -> f ValidationPolicy)
-> ValidationSettings -> f ValidationSettings
go ValidationPolicy -> f ValidationPolicy
f (ValidationSettings Set Alg
algs ValidationPolicy
pol) =
      Set Alg -> ValidationPolicy -> ValidationSettings
ValidationSettings Set Alg
algs (ValidationPolicy -> ValidationSettings)
-> f ValidationPolicy -> f ValidationSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValidationPolicy -> f ValidationPolicy
f ValidationPolicy
pol

instance HasValidationSettings ValidationSettings where
  validationSettings :: (ValidationSettings -> f ValidationSettings)
-> ValidationSettings -> f ValidationSettings
validationSettings = (ValidationSettings -> f ValidationSettings)
-> ValidationSettings -> f ValidationSettings
forall a. a -> a
id

class HasAlgorithms s where
  algorithms :: Lens' s (S.Set Alg)
class HasValidationPolicy s where
  validationPolicy :: Lens' s ValidationPolicy

instance HasValidationSettings a => HasAlgorithms a where
  algorithms :: (Set Alg -> f (Set Alg)) -> a -> f a
algorithms = (Set Alg -> f (Set Alg)) -> a -> f a
forall a. HasValidationSettings a => Lens' a (Set Alg)
validationSettingsAlgorithms
instance HasValidationSettings a => HasValidationPolicy a where
  validationPolicy :: (ValidationPolicy -> f ValidationPolicy) -> a -> f a
validationPolicy = (ValidationPolicy -> f ValidationPolicy) -> a -> f a
forall a. HasValidationSettings a => Lens' a ValidationPolicy
validationSettingsValidationPolicy

-- | The default validation settings.
--
-- - All algorithms except "none" are acceptable.
-- - All signatures must be valid (and there must be at least one signature.)
--
defaultValidationSettings :: ValidationSettings
defaultValidationSettings :: ValidationSettings
defaultValidationSettings = Set Alg -> ValidationPolicy -> ValidationSettings
ValidationSettings
  ( [Alg] -> Set Alg
forall a. Ord a => [a] -> Set a
S.fromList
    [ Alg
HS256, Alg
HS384, Alg
HS512
    , Alg
RS256, Alg
RS384, Alg
RS512
    , Alg
ES256, Alg
ES384, Alg
ES512
    , Alg
PS256, Alg
PS384, Alg
PS512
    , Alg
EdDSA
    ] )
  ValidationPolicy
AllValidated

-- | Verify a JWS with the default validation settings.
--
-- See also 'defaultValidationSettings'.
--
verifyJWS'
  ::  ( AsError e, MonadError e m , HasJWSHeader h, HasParams h
      , VerificationKeyStore m (h p) s k
      , Cons s s Word8 Word8, AsEmpty s
      , Foldable t
      , ProtectionIndicator p
      )
  => k      -- ^ key or key store
  -> JWS t p h  -- ^ JWS
  -> m s
verifyJWS' :: k -> JWS t p h -> m s
verifyJWS' = ValidationSettings -> k -> JWS t p h -> m s
forall a e (m :: * -> *) (h :: * -> *) p s k (t :: * -> *).
(HasAlgorithms a, HasValidationPolicy a, AsError e, MonadError e m,
 HasJWSHeader h, HasParams h, VerificationKeyStore m (h p) s k,
 Cons s s Word8 Word8, AsEmpty s, Foldable t,
 ProtectionIndicator p) =>
a -> k -> JWS t p h -> m s
verifyJWS ValidationSettings
defaultValidationSettings
{-# INLINE verifyJWS' #-}

-- | Verify a JWS.
--
-- Signatures made with an unsupported algorithms are ignored.
-- If the validation policy is 'AnyValidated', a single successfully
-- validated signature is sufficient.  If the validation policy is
-- 'AllValidated' then all remaining signatures (there must be at least one)
-- must be valid.
--
-- Returns the payload if successfully verified.
--
verifyJWS
  ::  ( HasAlgorithms a, HasValidationPolicy a, AsError e, MonadError e m
      , HasJWSHeader h, HasParams h
      , VerificationKeyStore m (h p) s k
      , Cons s s Word8 Word8, AsEmpty s
      , Foldable t
      , ProtectionIndicator p
      )
  => a        -- ^ validation settings
  -> k        -- ^ key or key store
  -> JWS t p h  -- ^ JWS
  -> m s
verifyJWS :: a -> k -> JWS t p h -> m s
verifyJWS = (s -> m s) -> a -> k -> JWS t p h -> m s
forall a e (m :: * -> *) (h :: * -> *) p payload k s (t :: * -> *).
(HasAlgorithms a, HasValidationPolicy a, AsError e, MonadError e m,
 HasJWSHeader h, HasParams h,
 VerificationKeyStore m (h p) payload k, Cons s s Word8 Word8,
 AsEmpty s, Foldable t, ProtectionIndicator p) =>
(s -> m payload) -> a -> k -> JWS t p h -> m payload
verifyJWSWithPayload s -> m s
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE verifyJWS #-}

verifyJWSWithPayload
  ::  ( HasAlgorithms a, HasValidationPolicy a, AsError e, MonadError e m
      , HasJWSHeader h, HasParams h
      , VerificationKeyStore m (h p) payload k
      , Cons s s Word8 Word8, AsEmpty s
      , Foldable t
      , ProtectionIndicator p
      )
  => (s -> m payload)  -- ^ payload decoder
  -> a                 -- ^ validation settings
  -> k                 -- ^ key or key store
  -> JWS t p h         -- ^ JWS
  -> m payload
verifyJWSWithPayload :: (s -> m payload) -> a -> k -> JWS t p h -> m payload
verifyJWSWithPayload s -> m payload
dec a
conf k
k (JWS p :: Base64Octets
p@(Types.Base64Octets ByteString
p') t (Signature p h)
sigs) =
  let
    algs :: S.Set Alg
    algs :: Set Alg
algs = a
conf a -> Getting (Set Alg) a (Set Alg) -> Set Alg
forall s a. s -> Getting a s a -> a
^. Getting (Set Alg) a (Set Alg)
forall s. HasAlgorithms s => Lens' s (Set Alg)
algorithms
    policy :: ValidationPolicy
    policy :: ValidationPolicy
policy = a
conf a
-> Getting ValidationPolicy a ValidationPolicy -> ValidationPolicy
forall s a. s -> Getting a s a -> a
^. Getting ValidationPolicy a ValidationPolicy
forall s. HasValidationPolicy s => Lens' s ValidationPolicy
validationPolicy
    shouldValidateSig :: Signature p h -> Bool
shouldValidateSig = (Alg -> Set Alg -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set Alg
algs) (Alg -> Bool) -> (Signature p h -> Alg) -> Signature p h -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Alg (Signature p h) Alg -> Signature p h -> Alg
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((h p -> Const Alg (h p))
-> Signature p h -> Const Alg (Signature p h)
forall p (a :: * -> *). Getter (Signature p a) (a p)
header ((h p -> Const Alg (h p))
 -> Signature p h -> Const Alg (Signature p h))
-> ((Alg -> Const Alg Alg) -> h p -> Const Alg (h p))
-> Getting Alg (Signature p h) Alg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderParam p Alg -> Const Alg (HeaderParam p Alg))
-> h p -> Const Alg (h p)
forall (a :: * -> *) p. HasAlg a => Lens' (a p) (HeaderParam p Alg)
alg ((HeaderParam p Alg -> Const Alg (HeaderParam p Alg))
 -> h p -> Const Alg (h p))
-> ((Alg -> Const Alg Alg)
    -> HeaderParam p Alg -> Const Alg (HeaderParam p Alg))
-> (Alg -> Const Alg Alg)
-> h p
-> Const Alg (h p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alg -> Const Alg Alg)
-> HeaderParam p Alg -> Const Alg (HeaderParam p Alg)
forall p a. Lens' (HeaderParam p a) a
param)

    applyPolicy :: ValidationPolicy -> [Bool] -> f ()
applyPolicy ValidationPolicy
AnyValidated [Bool]
xs = Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
xs) (AReview e () -> f ()
forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
throwing_ AReview e ()
forall r. AsError r => Prism' r ()
_JWSNoValidSignatures)
    applyPolicy ValidationPolicy
AllValidated [] = AReview e () -> f ()
forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
throwing_ AReview e ()
forall r. AsError r => Prism' r ()
_JWSNoSignatures
    applyPolicy ValidationPolicy
AllValidated [Bool]
xs = Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
xs) (AReview e () -> f ()
forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
throwing_ AReview e ()
forall r. AsError r => Prism' r ()
_JWSInvalidSignature)

    validate :: payload -> Signature p h -> m Bool
validate payload
payload Signature p h
sig = do
      [JWK]
keys <- h p -> payload -> k -> m [JWK]
forall (m :: * -> *) h s a.
VerificationKeyStore m h s a =>
h -> s -> a -> m [JWK]
getVerificationKeys (Getting (h p) (Signature p h) (h p) -> Signature p h -> h p
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (h p) (Signature p h) (h p)
forall p (a :: * -> *). Getter (Signature p a) (a p)
header Signature p h
sig) payload
payload k
k
      if [JWK] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [JWK]
keys
        then AReview e () -> m Bool
forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
throwing_ AReview e ()
forall r. AsError r => Prism' r ()
_NoUsableKeys
        else Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (JWK -> Bool) -> [JWK] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Either Error Bool -> Either Error Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Either Error Bool
forall a b. b -> Either a b
Right Bool
True) (Either Error Bool -> Bool)
-> (JWK -> Either Error Bool) -> JWK -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64Octets -> Signature p h -> JWK -> Either Error Bool
forall (a :: * -> *) p.
(HasJWSHeader a, HasParams a, ProtectionIndicator p) =>
Base64Octets -> Signature p a -> JWK -> Either Error Bool
verifySig Base64Octets
p Signature p h
sig) [JWK]
keys
  in do
    payload
payload <- (s -> m payload
dec (s -> m payload) -> (ByteString -> s) -> ByteString -> m payload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting s ByteString s -> ByteString -> s
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting s ByteString s
forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
recons) ByteString
p'
    [Bool]
results <- (Signature p h -> m Bool) -> [Signature p h] -> m [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (payload -> Signature p h -> m Bool
validate payload
payload) ([Signature p h] -> m [Bool]) -> [Signature p h] -> m [Bool]
forall a b. (a -> b) -> a -> b
$ (Signature p h -> Bool) -> [Signature p h] -> [Signature p h]
forall a. (a -> Bool) -> [a] -> [a]
filter Signature p h -> Bool
forall p. Signature p h -> Bool
shouldValidateSig ([Signature p h] -> [Signature p h])
-> [Signature p h] -> [Signature p h]
forall a b. (a -> b) -> a -> b
$ t (Signature p h) -> [Signature p h]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t (Signature p h)
sigs
    payload
payload payload -> m () -> m payload
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ValidationPolicy -> [Bool] -> m ()
forall e (f :: * -> *).
(MonadError e f, AsError e) =>
ValidationPolicy -> [Bool] -> f ()
applyPolicy ValidationPolicy
policy [Bool]
results
{-# INLINE verifyJWSWithPayload #-}

verifySig
  :: (HasJWSHeader a, HasParams a, ProtectionIndicator p)
  => Types.Base64Octets
  -> Signature p a
  -> JWK
  -> Either Error Bool
verifySig :: Base64Octets -> Signature p a -> JWK -> Either Error Bool
verifySig Base64Octets
msg sig :: Signature p a
sig@(Signature Maybe Text
_ a p
h (Types.Base64Octets ByteString
s)) JWK
k =
  Alg -> KeyMaterial -> ByteString -> ByteString -> Either Error Bool
forall e (m :: * -> *).
(MonadError e m, AsError e) =>
Alg -> KeyMaterial -> ByteString -> ByteString -> m Bool
verify (Getting Alg (a p) Alg -> a p -> Alg
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((HeaderParam p Alg -> Const Alg (HeaderParam p Alg))
-> a p -> Const Alg (a p)
forall (a :: * -> *) p. HasAlg a => Lens' (a p) (HeaderParam p Alg)
alg ((HeaderParam p Alg -> Const Alg (HeaderParam p Alg))
 -> a p -> Const Alg (a p))
-> ((Alg -> Const Alg Alg)
    -> HeaderParam p Alg -> Const Alg (HeaderParam p Alg))
-> Getting Alg (a p) Alg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alg -> Const Alg Alg)
-> HeaderParam p Alg -> Const Alg (HeaderParam p Alg)
forall p a. Lens' (HeaderParam p a) a
param) a p
h) (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) ByteString
tbs ByteString
s
  where
  tbs :: ByteString
tbs = Signature p a -> Base64Octets -> ByteString
forall (a :: * -> *) p.
(HasParams a, ProtectionIndicator p) =>
Signature p a -> Base64Octets -> ByteString
signingInput Signature p a
sig Base64Octets
msg