{-# LANGUAGE OverloadedStrings #-}
-- | Disclosure creation, encoding, and decoding (low-level).
--
-- Disclosures are base64url-encoded JSON arrays that contain the cleartext
-- values of selectively disclosable claims. This module provides functions
-- to create disclosures for object properties and array elements, and to
-- encode/decode them.
--
-- == Usage
--
-- This module contains low-level disclosure utilities that are typically
-- used internally by other SD-JWT modules. Most users should use the higher-level
-- APIs in:
--
-- * 'SDJWT.Issuer' - For issuers (handles disclosure creation internally)
-- * 'SDJWT.Holder' - For holders (handles disclosure selection internally)
-- * 'SDJWT.Verifier' - For verifiers (handles disclosure verification internally)
--
-- These utilities may be useful for:
--
-- * Advanced use cases requiring custom disclosure handling
-- * Library developers building on top of SD-JWT
-- * Testing and debugging
--
module SDJWT.Internal.Disclosure
  ( createObjectDisclosure
  , createArrayDisclosure
  , decodeDisclosure
  , encodeDisclosure
  , getDisclosureSalt
  , getDisclosureClaimName
  , getDisclosureValue
  ) where

import SDJWT.Internal.Types (Salt(..), EncodedDisclosure(..), Disclosure(..), ObjectDisclosure(..), ArrayDisclosure(..), SDJWTError(..))
import SDJWT.Internal.Utils (base64urlEncode, base64urlDecode)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import qualified Data.Vector as V

-- | Create disclosure for object property: [salt, claim_name, claim_value].
--
-- Creates a disclosure for a selectively disclosable object property.
-- The disclosure is a JSON array containing:
--
-- 1. The salt (base64url-encoded)
-- 2. The claim name
-- 3. The claim value
--
-- The result is base64url-encoded as required by RFC 9901.
createObjectDisclosure :: Salt -> T.Text -> Aeson.Value -> Either SDJWTError EncodedDisclosure
createObjectDisclosure :: Salt -> Text -> Value -> Either SDJWTError EncodedDisclosure
createObjectDisclosure Salt
salt Text
name Value
value =
  let
    saltText :: Text
saltText = ByteString -> Text
base64urlEncode (Salt -> ByteString
unSalt Salt
salt)
    -- Create JSON array: [salt, claim_name, claim_value]
    jsonArray :: Value
jsonArray = Array -> Value
Aeson.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList
      [ Text -> Value
Aeson.String Text
saltText
      , Text -> Value
Aeson.String Text
name
      , Value
value
      ]
    -- Encode to JSON bytes (lazy) and convert to strict
    jsonBytes :: ByteString
jsonBytes = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BSL.toChunks (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Value
jsonArray
    -- Base64url encode
    encoded :: Text
encoded = ByteString -> Text
base64urlEncode ByteString
jsonBytes
  in
    EncodedDisclosure -> Either SDJWTError EncodedDisclosure
forall a b. b -> Either a b
Right (EncodedDisclosure -> Either SDJWTError EncodedDisclosure)
-> EncodedDisclosure -> Either SDJWTError EncodedDisclosure
forall a b. (a -> b) -> a -> b
$ Text -> EncodedDisclosure
EncodedDisclosure Text
encoded

-- | Create disclosure for array element: [salt, claim_value].
--
-- Creates a disclosure for a selectively disclosable array element.
-- The disclosure is a JSON array containing:
--
-- 1. The salt (base64url-encoded)
-- 2. The array element value
--
-- Note: Array element disclosures do not include a claim name.
-- The result is base64url-encoded as required by RFC 9901.
createArrayDisclosure :: Salt -> Aeson.Value -> Either SDJWTError EncodedDisclosure
createArrayDisclosure :: Salt -> Value -> Either SDJWTError EncodedDisclosure
createArrayDisclosure Salt
salt Value
value =
  let
    saltText :: Text
saltText = ByteString -> Text
base64urlEncode (Salt -> ByteString
unSalt Salt
salt)
    -- Create JSON array: [salt, claim_value]
    jsonArray :: Value
jsonArray = Array -> Value
Aeson.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList
      [ Text -> Value
Aeson.String Text
saltText
      , Value
value
      ]
    -- Encode to JSON bytes (lazy) and convert to strict
    jsonBytes :: ByteString
jsonBytes = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BSL.toChunks (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Value
jsonArray
    -- Base64url encode
    encoded :: Text
encoded = ByteString -> Text
base64urlEncode ByteString
jsonBytes
  in
    EncodedDisclosure -> Either SDJWTError EncodedDisclosure
forall a b. b -> Either a b
Right (EncodedDisclosure -> Either SDJWTError EncodedDisclosure)
-> EncodedDisclosure -> Either SDJWTError EncodedDisclosure
forall a b. (a -> b) -> a -> b
$ Text -> EncodedDisclosure
EncodedDisclosure Text
encoded

-- | Decode disclosure from base64url.
--
-- Decodes a base64url-encoded disclosure string back into a 'Disclosure'
-- value. The disclosure must be a valid JSON array with either 2 elements
-- (for array disclosures) or 3 elements (for object disclosures).
--
-- Returns 'Left' with an error if the disclosure format is invalid.
decodeDisclosure :: EncodedDisclosure -> Either SDJWTError Disclosure
decodeDisclosure :: EncodedDisclosure -> Either SDJWTError Disclosure
decodeDisclosure (EncodedDisclosure Text
encoded) =
  case Text -> Either Text ByteString
base64urlDecode Text
encoded of
    Left Text
err -> SDJWTError -> Either SDJWTError Disclosure
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError Disclosure)
-> SDJWTError -> Either SDJWTError Disclosure
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode base64url: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
    Right ByteString
jsonBytes ->
      case ByteString -> Either [Char] Value
forall a. FromJSON a => ByteString -> Either [Char] a
Aeson.eitherDecode (ByteString -> ByteString
BSL.fromStrict ByteString
jsonBytes) of
        Left [Char]
err -> SDJWTError -> Either SDJWTError Disclosure
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError Disclosure)
-> SDJWTError -> Either SDJWTError Disclosure
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Failed to parse JSON: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
err
        Right (Aeson.Array Array
arr) ->
          let
            len :: Int
len = Array -> Int
forall a. Vector a -> Int
V.length Array
arr
          in
            if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
              then
                -- Array disclosure: [salt, value]
                case (Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
(V.!?) Array
arr Int
0, Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
(V.!?) Array
arr Int
1) of
                  (Just (Aeson.String Text
saltText), Just Value
value) ->
                    case Text -> Either Text ByteString
base64urlDecode Text
saltText of
                      Left Text
err -> SDJWTError -> Either SDJWTError Disclosure
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError Disclosure)
-> SDJWTError -> Either SDJWTError Disclosure
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Invalid salt encoding: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
                      Right ByteString
saltBytes ->
                        Disclosure -> Either SDJWTError Disclosure
forall a b. b -> Either a b
Right (Disclosure -> Either SDJWTError Disclosure)
-> Disclosure -> Either SDJWTError Disclosure
forall a b. (a -> b) -> a -> b
$ ArrayDisclosure -> Disclosure
DisclosureArray (ArrayDisclosure -> Disclosure) -> ArrayDisclosure -> Disclosure
forall a b. (a -> b) -> a -> b
$ Salt -> Value -> ArrayDisclosure
ArrayDisclosure (ByteString -> Salt
Salt ByteString
saltBytes) Value
value
                  (Maybe Value, Maybe Value)
_ -> SDJWTError -> Either SDJWTError Disclosure
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError Disclosure)
-> SDJWTError -> Either SDJWTError Disclosure
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat Text
"Invalid array disclosure format"
              else if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3
                then
                  -- Object disclosure: [salt, name, value]
                  case (Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
(V.!?) Array
arr Int
0, Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
(V.!?) Array
arr Int
1, Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
(V.!?) Array
arr Int
2) of
                    (Just (Aeson.String Text
saltText), Just (Aeson.String Text
name), Just Value
value) ->
                      case Text -> Either Text ByteString
base64urlDecode Text
saltText of
                        Left Text
err -> SDJWTError -> Either SDJWTError Disclosure
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError Disclosure)
-> SDJWTError -> Either SDJWTError Disclosure
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Invalid salt encoding: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
                        Right ByteString
saltBytes ->
                          Disclosure -> Either SDJWTError Disclosure
forall a b. b -> Either a b
Right (Disclosure -> Either SDJWTError Disclosure)
-> Disclosure -> Either SDJWTError Disclosure
forall a b. (a -> b) -> a -> b
$ ObjectDisclosure -> Disclosure
DisclosureObject (ObjectDisclosure -> Disclosure) -> ObjectDisclosure -> Disclosure
forall a b. (a -> b) -> a -> b
$ Salt -> Text -> Value -> ObjectDisclosure
ObjectDisclosure (ByteString -> Salt
Salt ByteString
saltBytes) Text
name Value
value
                    (Maybe Value, Maybe Value, Maybe Value)
_ -> SDJWTError -> Either SDJWTError Disclosure
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError Disclosure)
-> SDJWTError -> Either SDJWTError Disclosure
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat Text
"Invalid object disclosure format"
                else
                  SDJWTError -> Either SDJWTError Disclosure
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError Disclosure)
-> SDJWTError -> Either SDJWTError Disclosure
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Disclosure array must have 2 or 3 elements, got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
len)
        Right Value
_ -> SDJWTError -> Either SDJWTError Disclosure
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError Disclosure)
-> SDJWTError -> Either SDJWTError Disclosure
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat Text
"Disclosure must be a JSON array"

-- | Encode disclosure to base64url.
--
-- Encodes a 'Disclosure' value to its base64url-encoded string representation.
-- This is the inverse of 'decodeDisclosure'.
encodeDisclosure :: Disclosure -> EncodedDisclosure
encodeDisclosure :: Disclosure -> EncodedDisclosure
encodeDisclosure (DisclosureObject (ObjectDisclosure Salt
s Text
n Value
v)) =
  case Salt -> Text -> Value -> Either SDJWTError EncodedDisclosure
createObjectDisclosure Salt
s Text
n Value
v of
    Left SDJWTError
err -> [Char] -> EncodedDisclosure
forall a. HasCallStack => [Char] -> a
error ([Char] -> EncodedDisclosure) -> [Char] -> EncodedDisclosure
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to encode object disclosure: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SDJWTError -> [Char]
forall a. Show a => a -> [Char]
show SDJWTError
err
    Right EncodedDisclosure
encoded -> EncodedDisclosure
encoded
encodeDisclosure (DisclosureArray (ArrayDisclosure Salt
s Value
v)) =
  case Salt -> Value -> Either SDJWTError EncodedDisclosure
createArrayDisclosure Salt
s Value
v of
    Left SDJWTError
err -> [Char] -> EncodedDisclosure
forall a. HasCallStack => [Char] -> a
error ([Char] -> EncodedDisclosure) -> [Char] -> EncodedDisclosure
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to encode array disclosure: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SDJWTError -> [Char]
forall a. Show a => a -> [Char]
show SDJWTError
err
    Right EncodedDisclosure
encoded -> EncodedDisclosure
encoded

-- | Extract salt from disclosure.
--
-- Returns the salt value used in the disclosure. The salt is the same
-- regardless of whether it's an object or array disclosure.
getDisclosureSalt :: Disclosure -> Salt
getDisclosureSalt :: Disclosure -> Salt
getDisclosureSalt (DisclosureObject (ObjectDisclosure Salt
s Text
_ Value
_)) = Salt
s
getDisclosureSalt (DisclosureArray (ArrayDisclosure Salt
s Value
_)) = Salt
s

-- | Extract claim name (for object disclosures).
--
-- Returns 'Just' the claim name for object disclosures, or 'Nothing'
-- for array element disclosures (which don't have claim names).
getDisclosureClaimName :: Disclosure -> Maybe T.Text
getDisclosureClaimName :: Disclosure -> Maybe Text
getDisclosureClaimName (DisclosureObject (ObjectDisclosure Salt
_ Text
n Value
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n
getDisclosureClaimName (DisclosureArray ArrayDisclosure
_) = Maybe Text
forall a. Maybe a
Nothing

-- | Extract claim value.
--
-- Returns the claim value from the disclosure, regardless of whether
-- it's an object or array disclosure.
getDisclosureValue :: Disclosure -> Aeson.Value
getDisclosureValue :: Disclosure -> Value
getDisclosureValue (DisclosureObject (ObjectDisclosure Salt
_ Text
_ Value
v)) = Value
v
getDisclosureValue (DisclosureArray (ArrayDisclosure Salt
_ Value
v)) = Value
v