{-# LANGUAGE OverloadedStrings #-}
-- | Key Binding JWT support for SD-JWT+KB.
--
-- This module provides functions for creating and verifying Key Binding JWTs
-- (KB-JWT) as specified in RFC 9901 Section 7. Key Binding provides proof
-- of possession of a key by the holder.
module SDJWT.Internal.KeyBinding
  ( createKeyBindingJWT
  , computeSDHash
  , verifyKeyBindingJWT
  , addKeyBindingToPresentation
  ) where

import SDJWT.Internal.Types (HashAlgorithm(..), Digest(..), SDJWTPresentation(..), SDJWTError(..))
import SDJWT.Internal.Utils (hashToBytes, textToByteString, base64urlEncode, constantTimeEq, base64urlDecode)
import SDJWT.Internal.Serialization (serializePresentation)
import SDJWT.Internal.JWT (signJWTWithTyp, verifyJWT, JWKLike)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Text as T
import Data.Int (Int64)

-- | Create a Key Binding JWT.
--
-- Creates a KB-JWT that proves the holder possesses a specific key.
-- The KB-JWT contains:
--
-- - aud: Audience (verifier identifier)
-- - nonce: Nonce provided by verifier
-- - iat: Issued at timestamp
-- - sd_hash: Hash of the SD-JWT presentation
-- - Optional additional claims (e.g., exp for expiration time)
--
-- Note: RFC 9901 Section 4.3 states that additional claims in @optionalClaims@ SHOULD be avoided
-- unless there is a compelling reason, as they may harm interoperability.
--
-- Returns the signed KB-JWT as a compact JWT string.
createKeyBindingJWT
  :: JWKLike jwk => HashAlgorithm  -- ^ Hash algorithm for computing sd_hash
  -> jwk  -- ^ Holder private key (Text or jose JWK object)
  -> T.Text  -- ^ Audience claim (verifier identifier)
  -> T.Text  -- ^ Nonce from verifier
  -> Int64   -- ^ Issued at timestamp (Unix epoch seconds)
  -> SDJWTPresentation  -- ^ The SD-JWT presentation to bind
  -> Aeson.Object  -- ^ Optional additional claims (e.g., exp, nbf). These will be validated during verification if present. Pass @KeyMap.empty@ for no additional claims.
  -> IO (Either SDJWTError T.Text)
createKeyBindingJWT :: forall jwk.
JWKLike jwk =>
HashAlgorithm
-> jwk
-> Text
-> Text
-> Int64
-> SDJWTPresentation
-> Object
-> IO (Either SDJWTError Text)
createKeyBindingJWT HashAlgorithm
hashAlg jwk
holderPrivateKey Text
audience Text
nonce Int64
issuedAt SDJWTPresentation
presentation Object
optionalClaims =
  -- Compute sd_hash of the presentation
  let sdHash :: Digest
sdHash = HashAlgorithm -> SDJWTPresentation -> Digest
computeSDHash HashAlgorithm
hashAlg SDJWTPresentation
presentation
      
      -- Build base KB-JWT payload with required claims
      basePayloadObj :: Object
basePayloadObj = [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList
        [ (Text -> Key
Key.fromText Text
"aud", Text -> Value
Aeson.String Text
audience)
        , (Text -> Key
Key.fromText Text
"nonce", Text -> Value
Aeson.String Text
nonce)
        , (Text -> Key
Key.fromText Text
"iat", Scientific -> Value
Aeson.Number (Int64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
issuedAt))
        , (Text -> Key
Key.fromText Text
"sd_hash", Text -> Value
Aeson.String (Digest -> Text
unDigest Digest
sdHash))
        ]
      
      -- Merge optional claims into payload (optional claims override base claims if keys conflict)
      kbPayloadObj :: Object
kbPayloadObj = Object -> Object -> Object
forall v. KeyMap v -> KeyMap v -> KeyMap v
KeyMap.union Object
optionalClaims Object
basePayloadObj  -- optionalClaims takes precedence
      kbPayload :: Value
kbPayload = Object -> Value
Aeson.Object Object
kbPayloadObj
  in
    -- Sign the KB-JWT with typ: "kb+jwt" header (RFC 9901 Section 4.3 requirement)
    -- Supports all key types: RSA (PS256 default, RS256 also supported), EC P-256 (ES256), and Ed25519 (EdDSA).
    Text -> jwk -> Value -> IO (Either SDJWTError Text)
forall jwk.
JWKLike jwk =>
Text -> jwk -> Value -> IO (Either SDJWTError Text)
signJWTWithTyp Text
"kb+jwt" jwk
holderPrivateKey Value
kbPayload

-- | Compute sd_hash for key binding.
--
-- The sd_hash is computed as the hash of the serialized SD-JWT presentation
-- (without the KB-JWT part). This hash is included in the KB-JWT to bind
-- it to the specific presentation.
--
-- The hash is computed over the US-ASCII bytes of the presentation string
-- (per RFC 9901). Since the serialized presentation contains only ASCII
-- characters (base64url-encoded strings and tilde separators), UTF-8 encoding
-- produces identical bytes to US-ASCII.
computeSDHash
  :: HashAlgorithm
  -> SDJWTPresentation
  -> Digest
computeSDHash :: HashAlgorithm -> SDJWTPresentation -> Digest
computeSDHash HashAlgorithm
hashAlg SDJWTPresentation
presentation =
  -- Serialize presentation (without KB-JWT)
  -- Create a presentation without KB-JWT for serialization
  let presentationWithoutKB :: SDJWTPresentation
presentationWithoutKB = SDJWTPresentation
presentation { keyBindingJWT = Nothing }
      presentationText :: Text
presentationText = SDJWTPresentation -> Text
serializePresentation SDJWTPresentation
presentationWithoutKB
      -- Convert to bytes (UTF-8 is equivalent to US-ASCII for ASCII-only strings)
      presentationBytes :: ByteString
presentationBytes = Text -> ByteString
textToByteString Text
presentationText
      -- Compute hash
      hashBytes :: ByteString
hashBytes = HashAlgorithm -> ByteString -> ByteString
hashToBytes HashAlgorithm
hashAlg ByteString
presentationBytes
      -- Base64url encode
      hashText :: Text
hashText = ByteString -> Text
base64urlEncode ByteString
hashBytes
  in
    Text -> Digest
Digest Text
hashText

-- | Verify a Key Binding JWT.
--
-- Verifies that:
--
-- 1. The KB-JWT signature is valid (using holder's public key)
-- 2. The sd_hash in the KB-JWT matches the computed hash of the presentation
-- 3. The nonce, audience, and iat claims are present and valid
--
-- Returns 'Right ()' if verification succeeds, 'Left' with error otherwise.
verifyKeyBindingJWT
  :: JWKLike jwk => HashAlgorithm  -- ^ Hash algorithm for verifying sd_hash
  -> jwk  -- ^ Holder public key (Text or jose JWK object)
  -> T.Text  -- ^ KB-JWT to verify
  -> SDJWTPresentation  -- ^ The SD-JWT presentation
  -> IO (Either SDJWTError ())
verifyKeyBindingJWT :: forall jwk.
JWKLike jwk =>
HashAlgorithm
-> jwk -> Text -> SDJWTPresentation -> IO (Either SDJWTError ())
verifyKeyBindingJWT HashAlgorithm
hashAlg jwk
holderPublicKey Text
kbJWT SDJWTPresentation
presentation = do
  -- RFC 9901 Section 4.3: Validate KB-JWT header first
  -- typ: REQUIRED. MUST be kb+jwt
  let kbParts :: [Text]
kbParts = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." Text
kbJWT
  case [Text]
kbParts of
    (Text
headerPart : Text
_payloadPart : [Text]
_signaturePart) -> do
      -- Decode and validate header
      Either SDJWTError ByteString
headerBytes <- case Text -> Either Text ByteString
base64urlDecode Text
headerPart of
        Left Text
err -> Either SDJWTError ByteString -> IO (Either SDJWTError ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError ByteString -> IO (Either SDJWTError ByteString))
-> Either SDJWTError ByteString
-> IO (Either SDJWTError ByteString)
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError ByteString
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError ByteString)
-> SDJWTError -> Either SDJWTError ByteString
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidKeyBinding (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode KB-JWT header: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
        Right ByteString
bs -> Either SDJWTError ByteString -> IO (Either SDJWTError ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError ByteString -> IO (Either SDJWTError ByteString))
-> Either SDJWTError ByteString
-> IO (Either SDJWTError ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either SDJWTError ByteString
forall a b. b -> Either a b
Right ByteString
bs
      
      case Either SDJWTError ByteString
headerBytes of
        Left SDJWTError
err -> Either SDJWTError () -> IO (Either SDJWTError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError () -> IO (Either SDJWTError ()))
-> Either SDJWTError () -> IO (Either SDJWTError ())
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError ()
forall a b. a -> Either a b
Left SDJWTError
err
        Right ByteString
hBytes -> do
          Either SDJWTError Value
headerJson <- case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict ByteString
hBytes of
            Left String
err -> Either SDJWTError Value -> IO (Either SDJWTError Value)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError Value -> IO (Either SDJWTError Value))
-> Either SDJWTError Value -> IO (Either SDJWTError Value)
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError Value
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError Value)
-> SDJWTError -> Either SDJWTError Value
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidKeyBinding (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Failed to parse KB-JWT header: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err
            Right Value
val -> Either SDJWTError Value -> IO (Either SDJWTError Value)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError Value -> IO (Either SDJWTError Value))
-> Either SDJWTError Value -> IO (Either SDJWTError Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either SDJWTError Value
forall a b. b -> Either a b
Right Value
val
          
          case Either SDJWTError Value
headerJson of
            Left SDJWTError
err -> Either SDJWTError () -> IO (Either SDJWTError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError () -> IO (Either SDJWTError ()))
-> Either SDJWTError () -> IO (Either SDJWTError ())
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError ()
forall a b. a -> Either a b
Left SDJWTError
err
            Right (Aeson.Object Object
hObj) -> do
              -- RFC 9901 Section 4.3: typ MUST be "kb+jwt"
              case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"typ" Object
hObj of
                Just (Aeson.String Text
"kb+jwt") -> do
                  -- typ is correct, continue with signature verification
                  -- Note: For KB-JWT, typ is already validated above, so we pass Nothing (liberal mode)
                  -- (KB-JWT typ validation is handled separately, not through verifyJWT's typ check)
                  Either SDJWTError Value
verifiedPayloadResult <- jwk -> Text -> Maybe Text -> IO (Either SDJWTError Value)
forall jwk.
JWKLike jwk =>
jwk -> Text -> Maybe Text -> IO (Either SDJWTError Value)
verifyJWT jwk
holderPublicKey Text
kbJWT Maybe Text
forall a. Maybe a
Nothing
                  case Either SDJWTError Value
verifiedPayloadResult of
                    Left SDJWTError
err -> Either SDJWTError () -> IO (Either SDJWTError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SDJWTError -> Either SDJWTError ()
forall a b. a -> Either a b
Left SDJWTError
err)
                    Right Value
kbPayload -> do
                      -- Extract claims from verified payload
                      Either SDJWTError Value
sdHashClaim <- Either SDJWTError Value -> IO (Either SDJWTError Value)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError Value -> IO (Either SDJWTError Value))
-> Either SDJWTError Value -> IO (Either SDJWTError Value)
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Either SDJWTError Value
extractClaim Text
"sd_hash" Value
kbPayload
                      Either SDJWTError Value
nonceClaim <- Either SDJWTError Value -> IO (Either SDJWTError Value)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError Value -> IO (Either SDJWTError Value))
-> Either SDJWTError Value -> IO (Either SDJWTError Value)
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Either SDJWTError Value
extractClaim Text
"nonce" Value
kbPayload
                      Either SDJWTError Value
audClaim <- Either SDJWTError Value -> IO (Either SDJWTError Value)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError Value -> IO (Either SDJWTError Value))
-> Either SDJWTError Value -> IO (Either SDJWTError Value)
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Either SDJWTError Value
extractClaim Text
"aud" Value
kbPayload
                      Either SDJWTError Value
iatClaim <- Either SDJWTError Value -> IO (Either SDJWTError Value)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError Value -> IO (Either SDJWTError Value))
-> Either SDJWTError Value -> IO (Either SDJWTError Value)
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Either SDJWTError Value
extractClaim Text
"iat" Value
kbPayload
                      
                      case Either SDJWTError Value
sdHashClaim of
                        Left SDJWTError
err -> Either SDJWTError () -> IO (Either SDJWTError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SDJWTError -> Either SDJWTError ()
forall a b. a -> Either a b
Left SDJWTError
err)
                        Right (Aeson.String Text
hashText) -> do
                          -- Verify sd_hash matches presentation using constant-time comparison
                          -- SECURITY: Constant-time comparison prevents timing attacks
                          let computedHash :: Digest
computedHash = HashAlgorithm -> SDJWTPresentation -> Digest
computeSDHash HashAlgorithm
hashAlg SDJWTPresentation
presentation
                              expectedBytes :: ByteString
expectedBytes = Text -> ByteString
textToByteString Text
hashText
                              computedBytes :: ByteString
computedBytes = Text -> ByteString
textToByteString (Digest -> Text
unDigest Digest
computedHash)
                          if ByteString -> ByteString -> Bool
constantTimeEq ByteString
expectedBytes ByteString
computedBytes
                            then do
                              -- Verify nonce, audience, iat are present (basic validation)
                              case (Either SDJWTError Value
nonceClaim, Either SDJWTError Value
audClaim, Either SDJWTError Value
iatClaim) of
                                (Right (Aeson.String Text
_), Right (Aeson.String Text
_), Right (Aeson.Number Scientific
_)) -> Either SDJWTError () -> IO (Either SDJWTError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either SDJWTError ()
forall a b. b -> Either a b
Right ())
                                (Either SDJWTError Value, Either SDJWTError Value,
 Either SDJWTError Value)
_ -> Either SDJWTError () -> IO (Either SDJWTError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError () -> IO (Either SDJWTError ()))
-> Either SDJWTError () -> IO (Either SDJWTError ())
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError ()
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError ())
-> SDJWTError -> Either SDJWTError ()
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidKeyBinding Text
"Missing required claims (nonce, aud, iat)"
                            else Either SDJWTError () -> IO (Either SDJWTError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError () -> IO (Either SDJWTError ()))
-> Either SDJWTError () -> IO (Either SDJWTError ())
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError ()
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError ())
-> SDJWTError -> Either SDJWTError ()
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidKeyBinding Text
"sd_hash mismatch"
                        Right Value
_ -> Either SDJWTError () -> IO (Either SDJWTError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError () -> IO (Either SDJWTError ()))
-> Either SDJWTError () -> IO (Either SDJWTError ())
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError ()
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError ())
-> SDJWTError -> Either SDJWTError ()
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidKeyBinding Text
"Invalid sd_hash claim format"
                Just (Aeson.String Text
typValue) -> Either SDJWTError () -> IO (Either SDJWTError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError () -> IO (Either SDJWTError ()))
-> Either SDJWTError () -> IO (Either SDJWTError ())
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError ()
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError ())
-> SDJWTError -> Either SDJWTError ()
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidKeyBinding (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Invalid KB-JWT typ: expected 'kb+jwt', got '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typValue Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' (RFC 9901 Section 4.3)"
                Maybe Value
_ -> Either SDJWTError () -> IO (Either SDJWTError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError () -> IO (Either SDJWTError ()))
-> Either SDJWTError () -> IO (Either SDJWTError ())
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError ()
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError ())
-> SDJWTError -> Either SDJWTError ()
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidKeyBinding Text
"Missing 'typ' header in KB-JWT (RFC 9901 Section 4.3 requires typ: 'kb+jwt')"
            Right Value
_ -> Either SDJWTError () -> IO (Either SDJWTError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError () -> IO (Either SDJWTError ()))
-> Either SDJWTError () -> IO (Either SDJWTError ())
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError ()
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError ())
-> SDJWTError -> Either SDJWTError ()
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidKeyBinding Text
"Invalid KB-JWT header format: expected object"
    [Text]
_ -> Either SDJWTError () -> IO (Either SDJWTError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError () -> IO (Either SDJWTError ()))
-> Either SDJWTError () -> IO (Either SDJWTError ())
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError ()
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError ())
-> SDJWTError -> Either SDJWTError ()
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidKeyBinding Text
"Invalid KB-JWT format: expected header.payload.signature"

-- | Add key binding to a presentation.
--
-- Creates a KB-JWT and adds it to the presentation, converting it to SD-JWT+KB format.
-- The KB-JWT includes required claims (@aud@, @nonce@, @iat@, @sd_hash@) plus any optional
-- claims provided. Standard JWT claims like @exp@ (expiration time) and @nbf@ (not before)
-- will be automatically validated during verification if present.
--
-- Note: RFC 9901 Section 4.3 states that additional claims in @optionalClaims@ SHOULD be avoided
-- unless there is a compelling reason, as they may harm interoperability.
addKeyBindingToPresentation
  :: JWKLike jwk => HashAlgorithm  -- ^ Hash algorithm for computing sd_hash
  -> jwk  -- ^ Holder private key (Text or jose JWK object)
  -> T.Text  -- ^ Audience claim (verifier identifier)
  -> T.Text  -- ^ Nonce provided by verifier
  -> Int64   -- ^ Issued at timestamp (Unix epoch seconds)
  -> SDJWTPresentation  -- ^ The SD-JWT presentation to bind
  -> Aeson.Object  -- ^ Optional additional claims (e.g., exp, nbf). Standard JWT claims will be validated during verification if present. Pass @KeyMap.empty@ for no additional claims.
  -> IO (Either SDJWTError SDJWTPresentation)
addKeyBindingToPresentation :: forall jwk.
JWKLike jwk =>
HashAlgorithm
-> jwk
-> Text
-> Text
-> Int64
-> SDJWTPresentation
-> Object
-> IO (Either SDJWTError SDJWTPresentation)
addKeyBindingToPresentation HashAlgorithm
hashAlg jwk
holderKey Text
audience Text
nonce Int64
issuedAt SDJWTPresentation
presentation Object
optionalClaims =
  (Text -> SDJWTPresentation)
-> Either SDJWTError Text -> Either SDJWTError SDJWTPresentation
forall a b. (a -> b) -> Either SDJWTError a -> Either SDJWTError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
kb -> SDJWTPresentation
presentation { keyBindingJWT = Just kb })
    (Either SDJWTError Text -> Either SDJWTError SDJWTPresentation)
-> IO (Either SDJWTError Text)
-> IO (Either SDJWTError SDJWTPresentation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashAlgorithm
-> jwk
-> Text
-> Text
-> Int64
-> SDJWTPresentation
-> Object
-> IO (Either SDJWTError Text)
forall jwk.
JWKLike jwk =>
HashAlgorithm
-> jwk
-> Text
-> Text
-> Int64
-> SDJWTPresentation
-> Object
-> IO (Either SDJWTError Text)
createKeyBindingJWT HashAlgorithm
hashAlg jwk
holderKey Text
audience Text
nonce Int64
issuedAt SDJWTPresentation
presentation Object
optionalClaims

-- Helper functions

-- | Extract a claim from a JSON object.
extractClaim :: T.Text -> Aeson.Value -> Either SDJWTError Aeson.Value
extractClaim :: Text -> Value -> Either SDJWTError Value
extractClaim Text
claimName (Aeson.Object Object
obj) =
  case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Text -> Key
Key.fromText Text
claimName) Object
obj of
    Just Value
val -> Value -> Either SDJWTError Value
forall a b. b -> Either a b
Right Value
val
    Maybe Value
Nothing -> SDJWTError -> Either SDJWTError Value
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError Value)
-> SDJWTError -> Either SDJWTError Value
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidKeyBinding (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Missing claim: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
claimName
extractClaim Text
_ Value
_ = SDJWTError -> Either SDJWTError Value
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError Value)
-> SDJWTError -> Either SDJWTError Value
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidKeyBinding Text
"KB-JWT payload is not an object"