content: -- 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>.
  
  @
  import Crypto.JOSE
  
  doJwsSign :: 'JWK' -> L.ByteString -> IO (Either 'Error' ('GeneralJWS' 'JWSHeader'))
  doJwsSign jwk payload = 'runJOSE' $ do
    alg \<- 'bestJWSAlg' jwk
    'signJWS' payload [('newJWSHeader' ('Protected', alg), jwk)]
  
  doJwsVerify :: 'JWK' -> 'GeneralJWS' 'JWSHeader' -> IO (Either 'Error' ())
  doJwsVerify jwk jws = 'runJOSE' $
    'verifyJWS'' jwk jws
  @
  
  -}
  
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE UndecidableInstances #-}
  {-# LANGUAGE MonoLocalBinds #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  module Crypto.JOSE.JWS
    (
    -- * Overview
      JWS
    , GeneralJWS
    , FlattenedJWS
    , CompactJWS
  
    -- ** Defining additional header parameters
    -- $extending
  
    -- * JWS creation
    , newJWSHeader
    , newJWSHeaderProtected
    , makeJWSHeader
    , signJWS
  
    -- * JWS verification
    , verifyJWS
    , verifyJWS'
    , verifyJWSWithPayload
  
    -- ** JWS validation settings
    , defaultValidationSettings
    , ValidationSettings
    , ValidationPolicy(..)
    , HasValidationSettings(..)
    , HasAlgorithms(..)
    , HasValidationPolicy(..)
  
    -- * Access payload without verification
    , unsafeGetPayload
  
    -- * 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 Control.Monad (unless)
  import Data.Foldable (toList)
  import Data.Maybe (catMaybes, fromMaybe)
  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)
  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 Crypto.JOSE.Types.URI
  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'
  - 'headerOptional''
  - 'headerOptionalProtected'
  
  -}
  
  
  jwsCritInvalidNames :: [T.Text]
  jwsCritInvalidNames = [
    "alg"
    , "jku"
    , "jwk"
    , "x5u"
    , "x5t"
    , "x5t#S256"
    , "x5c"
    , "kid"
    , "typ"
    , "cty"
    , "crit"
    ]
  
  -- | JWS Header data type.
  --
  data JWSHeader p = JWSHeader
    { _jwsHeaderAlg :: HeaderParam p Alg
    , _jwsHeaderJku :: Maybe (HeaderParam p Types.URI)  -- ^ JWK Set URL
    , _jwsHeaderJwk :: Maybe (HeaderParam p JWK)
    , _jwsHeaderKid :: Maybe (HeaderParam p T.Text)  -- ^ interpretation unspecified
    , _jwsHeaderX5u :: Maybe (HeaderParam p Types.URI)
    , _jwsHeaderX5c :: Maybe (HeaderParam p (NonEmpty Types.SignedCertificate))
    , _jwsHeaderX5t :: Maybe (HeaderParam p Types.Base64SHA1)
    , _jwsHeaderX5tS256 :: Maybe (HeaderParam p Types.Base64SHA256)
    , _jwsHeaderTyp :: Maybe (HeaderParam p T.Text)  -- ^ Content Type (of object)
    , _jwsHeaderCty :: Maybe (HeaderParam p T.Text)  -- ^ Content Type (of payload)
    , _jwsHeaderCrit :: Maybe (NonEmpty T.Text)
    }
    deriving (Eq, Show)
  
  class HasJWSHeader a where
    jwsHeader :: Lens' (a p) (JWSHeader p)
  
  instance HasJWSHeader JWSHeader where
    jwsHeader = id
  
  instance HasJWSHeader a => HasAlg a where
    alg = jwsHeader . \f h@(JWSHeader { _jwsHeaderAlg = a }) ->
      fmap (\a' -> h { _jwsHeaderAlg = a' }) (f a)
  instance HasJWSHeader a => HasJku a where
    jku = jwsHeader . \f h@(JWSHeader { _jwsHeaderJku = a }) ->
      fmap (\a' -> h { _jwsHeaderJku = a' }) (f a)
  instance HasJWSHeader a => HasJwk a where
    jwk = jwsHeader . \f h@(JWSHeader { _jwsHeaderJwk = a }) ->
      fmap (\a' -> h { _jwsHeaderJwk = a' }) (f a)
  instance HasJWSHeader a => HasKid a where
    kid = jwsHeader . \f h@(JWSHeader { _jwsHeaderKid = a }) ->
      fmap (\a' -> h { _jwsHeaderKid = a' }) (f a)
  instance HasJWSHeader a => HasX5u a where
    x5u = jwsHeader . \f h@(JWSHeader { _jwsHeaderX5u = a }) ->
      fmap (\a' -> h { _jwsHeaderX5u = a' }) (f a)
  instance HasJWSHeader a => HasX5c a where
    x5c = jwsHeader . \f h@(JWSHeader { _jwsHeaderX5c = a }) ->
      fmap (\a' -> h { _jwsHeaderX5c = a' }) (f a)
  instance HasJWSHeader a => HasX5t a where
    x5t = jwsHeader . \f h@(JWSHeader { _jwsHeaderX5t = a }) ->
      fmap (\a' -> h { _jwsHeaderX5t = a' }) (f a)
  instance HasJWSHeader a => HasX5tS256 a where
    x5tS256 = jwsHeader . \f h@(JWSHeader { _jwsHeaderX5tS256 = a }) ->
      fmap (\a' -> h { _jwsHeaderX5tS256 = a' }) (f a)
  instance HasJWSHeader a => HasTyp a where
    typ = jwsHeader . \f h@(JWSHeader { _jwsHeaderTyp = a }) ->
      fmap (\a' -> h { _jwsHeaderTyp = a' }) (f a)
  instance HasJWSHeader a => HasCty a where
    cty = jwsHeader . \f h@(JWSHeader { _jwsHeaderCty = a }) ->
      fmap (\a' -> h { _jwsHeaderCty = a' }) (f a)
  instance HasJWSHeader a => HasCrit a where
    crit = jwsHeader . \f h@(JWSHeader { _jwsHeaderCrit = a }) ->
      fmap (\a' -> h { _jwsHeaderCrit = a' }) (f a)
  
  
  -- | Construct a minimal header with the given algorithm and
  -- protection value for the @"alg"@ header.
  --
  newJWSHeader :: (p, Alg) -> JWSHeader p
  newJWSHeader a = JWSHeader (uncurry HeaderParam a) z z z z z z z z z z
    where z = Nothing
  
  -- | Construct a minimal JWS header with the given @"alg"@ header
  -- value, to be carried as a protected header.
  newJWSHeaderProtected :: (ProtectionSupport p) => Alg -> JWSHeader p
  newJWSHeaderProtected a = newJWSHeader (getProtected, a)
  
  -- | 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, ProtectionSupport p)
    => JWK
    -> m (JWSHeader p)
  makeJWSHeader k = do
    let
      p = getProtected
      f :: ASetter s t a (Maybe (HeaderParam p a1))
        -> Getting (Maybe a1) JWK (Maybe a1)
        -> s -> t
      f lh lk = set lh (HeaderParam p <$> view lk k)
    algo <- bestJWSAlg k
    pure $ newJWSHeader (p, algo)
      & f kid (jwkKid . to (fmap (view recons)))
      & f x5u jwkX5u
      & f x5c jwkX5c
      & f x5t jwkX5t
      & f x5tS256 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 (Show)
  
  -- | Getter for header of a signature
  header :: Getter (Signature p a) (a p)
  header = to (\(Signature _ h _) -> h)
  
  -- | Getter for signature bytes
  signature :: (Cons s s Word8 Word8, AsEmpty s) => Getter (Signature p a) s
  signature = to (\(Signature _ _ (Types.Base64Octets s)) -> s) . recons
  {-# INLINE signature #-}
  
  instance (Eq (a p)) => Eq (Signature p a) where
    Signature _ h s == Signature _ h' s' = h == h' && s == s'
  
  instance (HasParams a, ProtectionSupport p) => FromJSON (Signature p a) where
    parseJSON = withObject "signature" (\o -> Signature
      <$> (Just <$> (o .: "protected" <|> pure ""))  -- raw protected header
      <*> do
        hpB64 <- o .:? "protected"
        hp <- maybe
          (pure Nothing)
          (withText "base64url-encoded header params"
            (Types.parseB64Url (maybe
              (fail "protected header contains invalid JSON")
              pure . decode . view recons)))
          hpB64
        hu <- o .:? "header"
        parseParams hp hu
      <*> o .: "signature"
      )
  
  instance (HasParams a, ProtectionSupport p) => ToJSON (Signature p a) where
    toJSON s@(Signature _ h sig) =
      let
        pro = case rawProtectedHeader s of
          "" -> id
          bs -> ("protected" .= String (T.decodeUtf8 (view recons bs)) :)
        unp = case unprotectedParams h of
          Nothing -> id
          Just o -> ("header" .= o :)
      in
        object $ (pro . unp) ["signature" .= sig]
  
  
  instance HasParams JWSHeader where
    parseParamsFor proxy hp hu = JWSHeader
      <$> headerRequired "alg" hp hu
      <*> headerOptional' uriFromJSON "jku" hp hu
      <*> headerOptional "jwk" hp hu
      <*> headerOptional "kid" hp hu
      <*> headerOptional' uriFromJSON "x5u" hp hu
      <*> (fmap . fmap . fmap . fmap)
            (\(Types.Base64X509 cert) -> cert) (headerOptional "x5c" hp hu)
      <*> headerOptional "x5t" hp hu
      <*> headerOptional "x5t#S256" hp hu
      <*> headerOptional "typ" hp hu
      <*> headerOptional "cty" hp hu
      <*> (headerOptionalProtected "crit" hp hu
        >>= parseCrit jwsCritInvalidNames (extensions proxy)
          (fromMaybe mempty hp <> fromMaybe mempty hu))
    params h =
      catMaybes
        [ Just (view (alg . isProtected) h, "alg" .= view (alg . param) h)
        , fmap (\p -> (view isProtected p, "jku" .= views param uriToJSON p)) (view jku h)
        , fmap (\p -> (view isProtected p, "jwk" .= view param p)) (view jwk h)
        , fmap (\p -> (view isProtected p, "kid" .= view param p)) (view kid h)
        , fmap (\p -> (view isProtected p, "x5u" .= views param uriToJSON p)) (view x5u h)
        , fmap (\p -> (view isProtected p, "x5c" .= fmap Types.Base64X509 (view param p))) (view x5c h)
        , fmap (\p -> (view isProtected p, "x5t" .= view param p)) (view x5t h)
        , fmap (\p -> (view isProtected p, "x5t#S256" .= view param p)) (view x5tS256 h)
        , fmap (\p -> (view isProtected p, "typ" .= view param p)) (view typ h)
        , fmap (\p -> (view isProtected p, "cty" .= view param p)) (view cty h)
        , fmap (\p -> (True, "crit" .= p)) (view crit h)
        ]
  
  
  -- | JSON Web Signature data type.
  --
  -- Parameterised by the signature container type, the header
  -- 'ProtectionSupport' 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', 'verifyJWS'' or 'verifyJWSWithPayload' to verify
  -- a JWS and extract the payload.
  --
  -- Applications generally should not access a payload without
  -- first verifying it.  If you have an exceptional use case, you
  -- can use 'unsafeGetPayload' to access 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 [] OptionalProtection
  
  -- | A JWS with one signature, which uses the
  -- /flattened serialisation/.  Headers may be 'Protected'
  -- or 'Unprotected'.
  --
  type FlattenedJWS = JWS Identity OptionalProtection
  
  -- | A JWS with one signature which only allows protected
  -- parameters.  Can use the /flattened serialisation/ or
  -- the /compact serialisation/.
  --
  type CompactJWS = JWS Identity RequiredProtection
  
  instance (Eq (t (Signature p a))) => Eq (JWS t p a) where
    JWS p sigs == JWS p' sigs' = p == p' && sigs == sigs'
  
  instance (Show (t (Signature p a))) => Show (JWS t p a) where
    show (JWS p sigs) = "JWS " <> show p <> " " <> show sigs
  
  signatures :: Foldable t => Fold (JWS t p a) (Signature p a)
  signatures = folding (\(JWS _ sigs) -> sigs)
  
  instance (HasParams a, ProtectionSupport p) => FromJSON (JWS [] p a) where
    parseJSON v =
      withObject "JWS JSON serialization" (\o -> JWS
        <$> o .: "payload"
        <*> o .: "signatures") v
      <|> fmap (\(JWS p (Identity s)) -> JWS p [s]) (parseJSON v)
  
  instance (HasParams a, ProtectionSupport p) => FromJSON (JWS Identity p a) where
    parseJSON =
      withObject "Flattened JWS JSON serialization" $ \o ->
        if M.member "signatures" o
        then fail "\"signatures\" member MUST NOT be present"
        else (\p s -> JWS p (pure s)) <$> o .: "payload" <*> parseJSON (Object o)
  
  instance (HasParams a, ProtectionSupport p) => ToJSON (JWS [] p a) where
    toJSON (JWS p [s]) = Types.insertToObject "payload" p (toJSON s)
    toJSON (JWS p ss) = object ["payload" .= p, "signatures" .= ss]
  
  instance (HasParams a, ProtectionSupport p) => ToJSON (JWS Identity p a) where
    toJSON (JWS p (Identity s)) = Types.insertToObject "payload" p (toJSON s)
  
  
  -- | Get the payload __without verifying it__.  Do not use this
  -- function unless you have a compelling reason.
  --
  -- Most applications should use 'verifyJWSWithPayload', 'verifyJWS'
  -- or 'verifyJWS'' to verify the JWS and access the payload.
  --
  unsafeGetPayload
    :: (Cons s s Word8 Word8, AsEmpty s)
    => (s -> m payload)   -- ^ Function to decode payload
    -> JWS t p a          -- ^ JWS
    -> m payload
  unsafeGetPayload dec (JWS (Types.Base64Octets s) _) = views recons dec s
  
  
  signingInput
    :: (HasParams a, ProtectionSupport p)
    => Signature p a
    -> Types.Base64Octets
    -> B.ByteString
  signingInput sig (Types.Base64Octets p) =
    rawProtectedHeader sig <> "." <> review Types.base64url 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, ProtectionSupport p)
    => Signature p a -> B.ByteString
  rawProtectedHeader (Signature raw h _) =
    maybe (view recons $ protectedParamsEncoded h) T.encodeUtf8 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 RequiredProtection a) where
    toCompact (JWS p (Identity s@(Signature _ _ (Types.Base64Octets sig)))) =
      [ view recons $ signingInput s p
      , review Types.base64url sig
      ]
  
  instance (HasParams a) => FromCompact (JWS Identity RequiredProtection a) where
    fromCompact xs = case xs of
      [h, p, s] -> do
        (h', p', s') <- (,,) <$> t 0 h <*> t 1 p <*> t 2 s
        let o = object [ ("payload", p'), ("protected", h'), ("signature", s') ]
        case fromJSON o of
          Error e -> throwing _JSONDecodeError e
          Success a -> pure a
      xs' -> throwing (_CompactDecodeError . _CompactInvalidNumberOfParts)
              (InvalidNumberOfParts 3 (fromIntegral (length xs')))
      where
        l = _CompactDecodeError . _CompactInvalidText
        t n = either (throwing l . CompactTextError n) (pure . String)
          . T.decodeUtf8' . view 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
       , ProtectionSupport p
       )
    => s          -- ^ Payload
    -> t (a p, JWK) -- ^ Traversable of header, key pairs
    -> m (JWS t p a)
  signJWS s =
    let s' = view recons s
    in fmap (JWS (Types.Base64Octets s')) . traverse (uncurry (mkSignature s'))
  {-# INLINE signJWS #-}
  
  mkSignature
    :: ( HasJWSHeader a, HasParams a, MonadRandom m, AsError e, MonadError e m
       , ProtectionSupport p
       )
    => B.ByteString -> a p -> JWK -> m (Signature p a)
  mkSignature p h k =
    let
      almostSig = Signature Nothing h . Types.Base64Octets
    in
      almostSig
      <$> sign
            (view (alg . param) h)
            (k ^. jwkMaterial)
            (signingInput (almostSig "") (Types.Base64Octets 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 (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 . go where
      go f (ValidationSettings algs pol) =
        (`ValidationSettings` pol) <$> f algs
  
    validationSettingsValidationPolicy :: Lens' a ValidationPolicy
    validationSettingsValidationPolicy = validationSettings . go where
      go f (ValidationSettings algs pol) =
        ValidationSettings algs <$> f pol
  
  instance HasValidationSettings ValidationSettings where
    validationSettings = 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 = validationSettingsAlgorithms
  instance HasValidationSettings a => HasValidationPolicy a where
    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
    ( S.fromList
      [ HS256, HS384, HS512
      , RS256, RS384, RS512
      , ES256, ES384, ES512
      , PS256, PS384, PS512
      , EdDSA
      , ES256K
      ] )
    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
        , ProtectionSupport p
        )
    => k      -- ^ key or key store
    -> JWS t p h  -- ^ JWS
    -> m s
  verifyJWS' = verifyJWS 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
        , ProtectionSupport p
        )
    => a        -- ^ validation settings
    -> k        -- ^ key or key store
    -> JWS t p h  -- ^ JWS
    -> m s
  verifyJWS = verifyJWSWithPayload pure
  {-# INLINE verifyJWS #-}
  
  -- | Verify a JWS, with explicit payload decoding.  This variant
  -- enables the key store to use information in the payload to locate
  -- verification key(s).
  --
  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
        , ProtectionSupport p
        )
    => (s -> m payload)  -- ^ payload decoder
    -> a                 -- ^ validation settings
    -> k                 -- ^ key or key store
    -> JWS t p h         -- ^ JWS
    -> m payload
  verifyJWSWithPayload dec conf k jws@(JWS p sigs) =
    let
      algs :: S.Set Alg
      algs = conf ^. algorithms
      policy :: ValidationPolicy
      policy = conf ^. validationPolicy
      shouldValidateSig = (`elem` algs) . view (header . alg . param)
  
      applyPolicy AnyValidated xs = unless (or xs) (throwing_ _JWSNoValidSignatures)
      applyPolicy AllValidated [] = throwing_ _JWSNoSignatures
      applyPolicy AllValidated xs = unless (and xs) (throwing_ _JWSInvalidSignature)
  
      validate payload sig = do
        keys <- getVerificationKeys (view header sig) payload k
        case (keys, view (header . alg . param) sig) of
          -- special case for alg "none"
          ([], None)  -> pure $ verifySig p sig undefined == Right True
          ([], _)     -> throwing_ _NoUsableKeys
          _           -> pure $ any ((== Right True) . verifySig p sig) keys
    in do
      payload <- unsafeGetPayload dec jws
      results <- traverse (validate payload) $ filter shouldValidateSig $ toList sigs
      payload <$ applyPolicy policy results
  {-# INLINE verifyJWSWithPayload #-}
  
  verifySig
    :: (HasJWSHeader a, HasParams a, ProtectionSupport p)
    => Types.Base64Octets
    -> Signature p a
    -> JWK
    -> Either Error Bool
  verifySig msg sig@(Signature _ h (Types.Base64Octets s)) k =
    verify (view (alg . param) h) (view jwkMaterial k) tbs s
    where
    tbs = signingInput sig msg
  