add functions to access unverified payload

Fixes: #126

CHANGELOG.md

@@ -1,5 +1,11 @@
 ## Version NEXT
 
+- Added `footgunGetPayload`, `footgunGetJWTPayload` and
+  `footgunGetJWTClaimsSet` functions.  These enable access to
+  the JWS/JWT payload without cryptographic verification.  As
+  the name imlies, these should be used with the utmost caution!
+  ([#126](https://github.com/frasertweedale/hs-jose/issues/126))
+
 - Add `Crypto.JOSE.JWK.negotiateJWSAlg` which chooses the
   cryptographically strongest JWS algorithm for a given key,
   restricted to a given set of algorithms.  ([#118][])

src/Crypto/JOSE/JWS.hs

@@ -71,6 +71,9 @@ module Crypto.JOSE.JWS
   , HasAlgorithms(..)
   , HasValidationPolicy(..)
 
+  -- * Access payload without verification
+  , footgunGetPayload
+
   -- * Signature data
   , signatures
   , Signature
@@ -363,8 +366,7 @@ instance HasParams JWSHeader where
       ]
 
 
--- | JSON Web Signature data type.  The payload can only be
--- accessed by verifying the JWS.
+-- | JSON Web Signature data type.
 --
 -- Parameterised by the signature container type, the header
 -- 'ProtectionIndicator' type, and the header record type.
@@ -380,9 +382,14 @@ instance HasParams JWSHeader where
 -- 'encodeCompact').
 --
 -- Use 'signJWS' to create a signed/MACed JWS.
+
+-- Use 'verifyJWS', 'verifyJWS'' or 'verifyJWSWithPayload' to verify
+-- a JWS and extract the payload.
 --
--- Use 'verifyJWS' 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 'footgunGetPayload' 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
@@ -434,6 +441,20 @@ instance (HasParams a, ProtectionIndicator 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.
+--
+footgunGetPayload
+  :: (Cons s s Word8 Word8, AsEmpty s)
+  => (s -> m payload)   -- ^ Function to decode payload
+  -> JWS t p a          -- ^ JWS
+  -> m payload
+footgunGetPayload dec (JWS (Types.Base64Octets s) _) = views recons dec s
+
+
 signingInput
   :: (HasParams a, ProtectionIndicator p)
   => Signature p a
@@ -618,6 +639,10 @@ verifyJWS
 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
@@ -631,7 +656,7 @@ verifyJWSWithPayload
   -> k                 -- ^ key or key store
   -> JWS t p h         -- ^ JWS
   -> m payload
-verifyJWSWithPayload dec conf k (JWS p@(Types.Base64Octets p') sigs) =
+verifyJWSWithPayload dec conf k jws@(JWS p sigs) =
   let
     algs :: S.Set Alg
     algs = conf ^. algorithms
@@ -649,7 +674,7 @@ verifyJWSWithPayload dec conf k (JWS p@(Types.Base64Octets p') sigs) =
         then throwing_ _NoUsableKeys
         else pure $ any ((== Right True) . verifySig p sig) keys
   in do
-    payload <- (dec . view recons) p'
+    payload <- footgunGetPayload dec jws
     results <- traverse (validate payload) $ filter shouldValidateSig $ toList sigs
     payload <$ applyPolicy policy results
 {-# INLINE verifyJWSWithPayload #-}

src/Crypto/JWT.hs

@@ -62,6 +62,10 @@ module Crypto.JWT
   , verifyClaimsAt
   , verifyJWTAt
 
+  -- ** Extracting claims without verification
+  , footgunGetJWTPayload
+  , footgunGetJWTClaimsSet
+
   -- ** Claims Set
   , ClaimsSet
   , emptyClaimsSet
@@ -633,15 +637,33 @@ instance Monad m => MonadTime (ReaderT WrappedUTCTime m) where
   monotonicTime = pure 0
 #endif
 
+-- | Get the JWT payload __without verifying it__.  Do not use this
+-- function unless you have a compelling reason.
+--
+-- Most applications should use 'verifyJWT' or one of its variants
+-- to verify the JWT and access the claims.
+--
+-- See also 'footgunGetJWTClaimsSet' which is the same as this
+-- function with the payload type specialised to 'ClaimsSet'.
+--
+footgunGetJWTPayload
+  :: ( FromJSON payload, AsJWTError e, MonadError e m )
+  => SignedJWT -> m payload
+footgunGetJWTPayload = footgunGetPayload f
+  where
+  f = either (throwing _JWTClaimsSetDecodeError) pure . eitherDecode
+
+-- | Variant of 'footgunGetJWTPayload' specialised to 'ClaimsSet'
+footgunGetJWTClaimsSet
+  :: ( AsJWTError e, MonadError e m )
+  => SignedJWT -> m ClaimsSet
+footgunGetJWTClaimsSet = footgunGetJWTPayload
+
 
 -- | Cryptographically verify a JWS JWT, then validate the
 -- Claims Set, returning it if valid.  The claims are validated
 -- at the current system time.
 --
--- This is the only way to get at the claims of a JWS JWT,
--- enforcing that the claims are cryptographically and
--- semantically valid before the application can use them.
---
 -- This function is abstracted over any payload type with 'HasClaimsSet' and
 -- 'FromJSON' instances.  The 'verifyClaims' variant uses 'ClaimsSet' as the
 -- payload type.