{-# LANGUAGE OverloadedStrings #-}
-- | Nested structure processing for SD-JWT issuance.
--
-- This module handles nested structures according to RFC 9901 Sections 6.2 and 6.3:
--
-- * Section 6.2 (Structured SD-JWT): Parent object stays in payload with @_sd@ array
--   containing digests for sub-claims.
--
-- * Section 6.3 (Recursive Disclosures): Parent is selectively disclosable, and its
--   disclosure contains an @_sd@ array with digests for sub-claims.
--
-- This module is used internally by 'SDJWT.Internal.Issuance' and is not part of the
-- public API.
module SDJWT.Internal.Issuance.Nested
  ( processNestedStructures
  , processRecursiveDisclosures
  ) where

import SDJWT.Internal.Types (HashAlgorithm(..), Digest(..), EncodedDisclosure(..), SDJWTError(..), Salt(..), unDigest)
import SDJWT.Internal.Utils (groupPathsByFirstSegment, generateSalt)
import SDJWT.Internal.Digest (computeDigest)
import SDJWT.Internal.Disclosure (createObjectDisclosure, createArrayDisclosure)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Vector as V
import Data.List (partition, sortBy)
import Data.Maybe (mapMaybe)
import Data.Either (partitionEithers)
import Text.Read (readMaybe)
import Data.Ord (comparing)

-- | Process nested structures (Section 6.2: structured SD-JWT).
-- Creates _sd arrays within parent objects for sub-claims, or ellipsis objects in arrays.
-- Supports arbitrary depth paths like ["user", "profile", "email"] or ["user", "emails", "0"].
-- Handles both objects and arrays at each level.
-- Returns: (processed payload object, all disclosures, remaining unprocessed claims)
processNestedStructures
  :: HashAlgorithm
  -> [[T.Text]]  -- ^ List of path segments (e.g., [["user", "profile", "email"]])
  -> Aeson.Object  -- ^ Original claims object
  -> IO (Either SDJWTError (KeyMap.KeyMap Aeson.Value, [EncodedDisclosure], Aeson.Object))
processNestedStructures :: HashAlgorithm
-> [[Text]]
-> Object
-> IO (Either SDJWTError (Object, [EncodedDisclosure], Object))
processNestedStructures HashAlgorithm
hashAlg [[Text]]
nestedPaths Object
claims = do
  -- Group nested paths by first segment (top-level claim)
  let getFirstSegment :: [a] -> a
getFirstSegment [] = a
""
      getFirstSegment (a
seg:[a]
_) = a
seg
  -- Convert to format expected by groupPathsByFirstSegment (list of segments)
  let groupedByTopLevel :: Map Text [[Text]]
groupedByTopLevel = ([[Text]] -> [[Text]] -> [[Text]])
-> [(Text, [[Text]])] -> Map Text [[Text]]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [[Text]] -> [[Text]] -> [[Text]]
forall a. [a] -> [a] -> [a]
(++) ([(Text, [[Text]])] -> Map Text [[Text]])
-> [(Text, [[Text]])] -> Map Text [[Text]]
forall a b. (a -> b) -> a -> b
$ ([Text] -> (Text, [[Text]])) -> [[Text]] -> [(Text, [[Text]])]
forall a b. (a -> b) -> [a] -> [b]
map (\[Text]
path -> ([Text] -> Text
forall {a}. IsString a => [a] -> a
getFirstSegment [Text]
path, [[Text]
path])) [[Text]]
nestedPaths
  
  -- Process each top-level claim recursively (can be object or array)
  [Either SDJWTError (Text, Value, [EncodedDisclosure])]
results <- ((Text, [[Text]])
 -> IO (Either SDJWTError (Text, Value, [EncodedDisclosure])))
-> [(Text, [[Text]])]
-> IO [Either SDJWTError (Text, Value, [EncodedDisclosure])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Text
topLevelName, [[Text]]
paths) -> do
    case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Text -> Key
Key.fromText Text
topLevelName) Object
claims of
      Maybe Value
Nothing -> Either SDJWTError (Text, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Text, Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Text, Value, [EncodedDisclosure])
 -> IO (Either SDJWTError (Text, Value, [EncodedDisclosure])))
-> Either SDJWTError (Text, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Text, Value, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError (Text, Value, [EncodedDisclosure])
forall a b. a -> Either a b
Left (SDJWTError
 -> Either SDJWTError (Text, Value, [EncodedDisclosure]))
-> SDJWTError
-> Either SDJWTError (Text, Value, [EncodedDisclosure])
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Parent claim not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
topLevelName
      Just Value
topLevelValue -> do
        -- Strip the first segment (topLevelName) from each path before processing
        let strippedPaths :: [[Text]]
strippedPaths = ([Text] -> [Text]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Text]
path -> case [Text]
path of
              [] -> []
              (Text
_:[Text]
rest) -> [Text]
rest) [[Text]]
paths
        -- Process all paths under this top-level claim (handles both objects and arrays)
        Either SDJWTError (Value, [EncodedDisclosure])
processResult <- HashAlgorithm
-> [[Text]]
-> Value
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
processPathsRecursively HashAlgorithm
hashAlg [[Text]]
strippedPaths Value
topLevelValue
        case Either SDJWTError (Value, [EncodedDisclosure])
processResult of
          Left SDJWTError
err -> Either SDJWTError (Text, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Text, Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Text, Value, [EncodedDisclosure])
 -> IO (Either SDJWTError (Text, Value, [EncodedDisclosure])))
-> Either SDJWTError (Text, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Text, Value, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError (Text, Value, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err
          Right (Value
modifiedValue, [EncodedDisclosure]
disclosures) -> Either SDJWTError (Text, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Text, Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Text, Value, [EncodedDisclosure])
 -> IO (Either SDJWTError (Text, Value, [EncodedDisclosure])))
-> Either SDJWTError (Text, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Text, Value, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ (Text, Value, [EncodedDisclosure])
-> Either SDJWTError (Text, Value, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Text
topLevelName, Value
modifiedValue, [EncodedDisclosure]
disclosures)
    ) (Map Text [[Text]] -> [(Text, [[Text]])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text [[Text]]
groupedByTopLevel)
  
  -- Check for errors
  let ([SDJWTError]
errors, [(Text, Value, [EncodedDisclosure])]
successes) = [Either SDJWTError (Text, Value, [EncodedDisclosure])]
-> ([SDJWTError], [(Text, Value, [EncodedDisclosure])])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either SDJWTError (Text, Value, [EncodedDisclosure])]
results
  case [SDJWTError]
errors of
    (SDJWTError
err:[SDJWTError]
_) -> Either SDJWTError (Object, [EncodedDisclosure], Object)
-> IO (Either SDJWTError (Object, [EncodedDisclosure], Object))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SDJWTError
-> Either SDJWTError (Object, [EncodedDisclosure], Object)
forall a b. a -> Either a b
Left SDJWTError
err)
    [] -> do
      -- Separate objects and arrays
      let ([(Text, Value, [EncodedDisclosure])]
objects, [(Text, Value, [EncodedDisclosure])]
arrays) = ((Text, Value, [EncodedDisclosure]) -> Bool)
-> [(Text, Value, [EncodedDisclosure])]
-> ([(Text, Value, [EncodedDisclosure])],
    [(Text, Value, [EncodedDisclosure])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(Text
_, Value
val, [EncodedDisclosure]
_) -> case Value
val of
            Aeson.Object Object
_ -> Bool
True
            Value
_ -> Bool
False) [(Text, Value, [EncodedDisclosure])]
successes
      let processedObjects :: Map Text Object
processedObjects = [(Text, Object)] -> Map Text Object
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Object)] -> Map Text Object)
-> [(Text, Object)] -> Map Text Object
forall a b. (a -> b) -> a -> b
$ ((Text, Value, [EncodedDisclosure]) -> Maybe (Text, Object))
-> [(Text, Value, [EncodedDisclosure])] -> [(Text, Object)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Text
name, Value
val, [EncodedDisclosure]
_) -> case Value
val of
            Aeson.Object Object
obj -> (Text, Object) -> Maybe (Text, Object)
forall a. a -> Maybe a
Just (Text
name, Object
obj)
            Value
_ -> Maybe (Text, Object)
forall a. Maybe a
Nothing) [(Text, Value, [EncodedDisclosure])]
objects
      let processedArrays :: Map Text Array
processedArrays = [(Text, Array)] -> Map Text Array
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Array)] -> Map Text Array)
-> [(Text, Array)] -> Map Text Array
forall a b. (a -> b) -> a -> b
$ ((Text, Value, [EncodedDisclosure]) -> Maybe (Text, Array))
-> [(Text, Value, [EncodedDisclosure])] -> [(Text, Array)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Text
name, Value
val, [EncodedDisclosure]
_) -> case Value
val of
            Aeson.Array Array
arr -> (Text, Array) -> Maybe (Text, Array)
forall a. a -> Maybe a
Just (Text
name, Array
arr)
            Value
_ -> Maybe (Text, Array)
forall a. Maybe a
Nothing) [(Text, Value, [EncodedDisclosure])]
arrays
      let allDisclosures :: [EncodedDisclosure]
allDisclosures = ((Text, Value, [EncodedDisclosure]) -> [EncodedDisclosure])
-> [(Text, Value, [EncodedDisclosure])] -> [EncodedDisclosure]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Text
_, Value
_, [EncodedDisclosure]
disclosures) -> [EncodedDisclosure]
disclosures) [(Text, Value, [EncodedDisclosure])]
successes
      
      -- Remove processed parents from remaining claims
      let processedParents :: Set Text
processedParents = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ ((Text, Value, [EncodedDisclosure]) -> Text)
-> [(Text, Value, [EncodedDisclosure])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
name, Value
_, [EncodedDisclosure]
_) -> Text
name) [(Text, Value, [EncodedDisclosure])]
successes
      let remainingClaims :: Object
remainingClaims = (Key -> Value -> Bool) -> Object -> Object
forall v. (Key -> v -> Bool) -> KeyMap v -> KeyMap v
KeyMap.filterWithKey (\Key
k Value
_ -> Key -> Text
Key.toText Key
k Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
processedParents) Object
claims
      
      -- Convert processed objects and arrays to KeyMap
      let processedPayload :: Object
processedPayload = (Object -> (Text, Object) -> Object)
-> Object -> [(Text, Object)] -> Object
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Object
acc (Text
name, Object
obj) ->
            Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert (Text -> Key
Key.fromText Text
name) (Object -> Value
Aeson.Object Object
obj) Object
acc) Object
forall v. KeyMap v
KeyMap.empty (Map Text Object -> [(Text, Object)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Object
processedObjects)
      -- Add processed arrays to payload
      let processedPayloadWithArrays :: Object
processedPayloadWithArrays = (Object -> Text -> Array -> Object)
-> Object -> Map Text Array -> Object
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey (\Object
acc Text
name Array
arr ->
            Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert (Text -> Key
Key.fromText Text
name) (Array -> Value
Aeson.Array Array
arr) Object
acc) Object
processedPayload Map Text Array
processedArrays
      
      Either SDJWTError (Object, [EncodedDisclosure], Object)
-> IO (Either SDJWTError (Object, [EncodedDisclosure], Object))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Object, [EncodedDisclosure], Object)
-> Either SDJWTError (Object, [EncodedDisclosure], Object)
forall a b. b -> Either a b
Right (Object
processedPayloadWithArrays, [EncodedDisclosure]
allDisclosures, Object
remainingClaims))
  
  where
    -- Helper function to recursively process paths, handling both objects and arrays at each level
    -- This unified function checks the type at each level and handles accordingly
    processPathsRecursively :: HashAlgorithm -> [[T.Text]] -> Aeson.Value -> IO (Either SDJWTError (Aeson.Value, [EncodedDisclosure]))
    processPathsRecursively :: HashAlgorithm
-> [[Text]]
-> Value
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
processPathsRecursively HashAlgorithm
hashAlg' [[Text]]
paths Value
value = case Value
value of
      Aeson.Object Object
obj -> HashAlgorithm
-> [[Text]]
-> Object
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
processObjectPaths HashAlgorithm
hashAlg' [[Text]]
paths Object
obj
      Aeson.Array Array
arr -> HashAlgorithm
-> [[Text]]
-> Array
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
processArrayPaths HashAlgorithm
hashAlg' [[Text]]
paths Array
arr
      Value
_ -> Either SDJWTError (Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Value, [EncodedDisclosure])
 -> IO (Either SDJWTError (Value, [EncodedDisclosure])))
-> Either SDJWTError (Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError (Value, [EncodedDisclosure])
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError (Value, [EncodedDisclosure]))
-> SDJWTError -> Either SDJWTError (Value, [EncodedDisclosure])
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat Text
"Cannot process paths in primitive value (not an object or array)"
    
    -- Validate that nested value is an object or array if there are remaining paths
    validateNestedValueType :: T.Text -> [[T.Text]] -> Aeson.Value -> Either SDJWTError ()
    validateNestedValueType :: Text -> [[Text]] -> Value -> Either SDJWTError ()
validateNestedValueType Text
firstSeg [[Text]]
nonEmptyPaths Value
nestedValue =
      if [[Text]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
nonEmptyPaths
        then () -> Either SDJWTError ()
forall a b. b -> Either a b
Right ()  -- No remaining paths, value type doesn't matter
        else case Value
nestedValue of
          Aeson.Object Object
_ -> () -> Either SDJWTError ()
forall a b. b -> Either a b
Right ()
          Aeson.Array Array
_ -> () -> Either SDJWTError ()
forall a b. b -> Either a b
Right ()
          Value
_ -> 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
InvalidDisclosureFormat (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Path segment is not an object: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
firstSeg
    
    -- Mark a segment as selectively disclosable and create _sd object
    markSegmentAsSelectivelyDisclosable
      :: HashAlgorithm
      -> T.Text  -- ^ Segment name
      -> Key.Key  -- ^ Segment key
      -> Aeson.Value  -- ^ Value to mark as SD
      -> KeyMap.KeyMap Aeson.Value  -- ^ Original object
      -> IO (Either SDJWTError (KeyMap.KeyMap Aeson.Value, [EncodedDisclosure]))
    markSegmentAsSelectivelyDisclosable :: HashAlgorithm
-> Text
-> Key
-> Value
-> Object
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
markSegmentAsSelectivelyDisclosable HashAlgorithm
hashAlg' Text
firstSeg Key
firstKey Value
nestedValue Object
obj = do
      Either SDJWTError (Digest, EncodedDisclosure)
result <- HashAlgorithm
-> Text
-> Value
-> IO (Either SDJWTError (Digest, EncodedDisclosure))
markSelectivelyDisclosable HashAlgorithm
hashAlg' Text
firstSeg Value
nestedValue
      case Either SDJWTError (Digest, EncodedDisclosure)
result of
        Left SDJWTError
err -> Either SDJWTError (Object, [EncodedDisclosure])
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SDJWTError -> Either SDJWTError (Object, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err)
        Right (Digest
digest, EncodedDisclosure
disclosure) -> do
          -- Replace this key with _sd object
          -- When marking a claim as selectively disclosable, we replace it with {"_sd": ["digest"]}
          -- at the same level, not nest it under the original key
          let updatedObj :: Object
updatedObj = Key -> Object -> Object
forall v. Key -> KeyMap v -> KeyMap v
KeyMap.delete Key
firstKey Object
obj
          let sdArray :: Value
sdArray = Array -> Value
Aeson.Array ([Value] -> Array
forall a. [a] -> Vector a
V.fromList [Text -> Value
Aeson.String (Digest -> Text
unDigest Digest
digest)])
          let sdObj :: Object
sdObj = Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert Key
"_sd" Value
sdArray Object
forall v. KeyMap v
KeyMap.empty
          -- Return the _sd object merged with the updated object (without the original key)
          Either SDJWTError (Object, [EncodedDisclosure])
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Object, [EncodedDisclosure])
-> Either SDJWTError (Object, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Object -> Object -> Object
forall v. KeyMap v -> KeyMap v -> KeyMap v
KeyMap.union Object
sdObj Object
updatedObj, [EncodedDisclosure
disclosure]))
    
    -- Process a single path segment (handles both target and nested cases)
    processPathSegment
      :: HashAlgorithm
      -> T.Text  -- ^ First segment name
      -> [[T.Text]]  -- ^ Remaining paths
      -> KeyMap.KeyMap Aeson.Value  -- ^ Original object
      -> Aeson.Value  -- ^ Nested value
      -> IO (Either SDJWTError (KeyMap.KeyMap Aeson.Value, [EncodedDisclosure]))
    processPathSegment :: HashAlgorithm
-> Text
-> [[Text]]
-> Object
-> Value
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
processPathSegment HashAlgorithm
hashAlg' Text
firstSeg [[Text]]
remainingPaths Object
obj Value
nestedValue = do
      -- Filter out empty paths (this segment is the target)
      let ([[Text]]
emptyPaths, [[Text]]
nonEmptyPaths) = ([Text] -> Bool) -> [[Text]] -> ([[Text]], [[Text]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
remainingPaths
      
      -- Validate nested value type if there are remaining paths
      case Text -> [[Text]] -> Value -> Either SDJWTError ()
validateNestedValueType Text
firstSeg [[Text]]
nonEmptyPaths Value
nestedValue of
        Left SDJWTError
err -> Either SDJWTError (Object, [EncodedDisclosure])
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SDJWTError -> Either SDJWTError (Object, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err)
        Right () -> do
          if [[Text]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
nonEmptyPaths
            then do
              -- This segment is the target - mark it as selectively disclosable
              let firstKey :: Key
firstKey = Text -> Key
Key.fromText Text
firstSeg
              HashAlgorithm
-> Text
-> Key
-> Value
-> Object
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
markSegmentAsSelectivelyDisclosable HashAlgorithm
hashAlg' Text
firstSeg Key
firstKey Value
nestedValue Object
obj
            else do
              -- Recurse into nested value (could be object or array)
              Either SDJWTError (Value, [EncodedDisclosure])
nestedResult <- HashAlgorithm
-> [[Text]]
-> Value
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
processPathsRecursively HashAlgorithm
hashAlg' [[Text]]
nonEmptyPaths Value
nestedValue
              case Either SDJWTError (Value, [EncodedDisclosure])
nestedResult of
                Left SDJWTError
err -> Either SDJWTError (Object, [EncodedDisclosure])
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SDJWTError -> Either SDJWTError (Object, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err)
                Right (Value
modifiedNestedValue, [EncodedDisclosure]
nestedDisclosures) -> do
                  let firstKey :: Key
firstKey = Text -> Key
Key.fromText Text
firstSeg
                  if [[Text]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
emptyPaths
                    then Either SDJWTError (Object, [EncodedDisclosure])
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Object, [EncodedDisclosure])
-> Either SDJWTError (Object, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert Key
firstKey Value
modifiedNestedValue Object
obj, [EncodedDisclosure]
nestedDisclosures))
                    else do
                      -- Mark this level as selectively disclosable too
                      Either SDJWTError (Object, [EncodedDisclosure])
result <- HashAlgorithm
-> Text
-> Key
-> Value
-> Object
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
markSegmentAsSelectivelyDisclosable HashAlgorithm
hashAlg' Text
firstSeg Key
firstKey Value
modifiedNestedValue Object
obj
                      case Either SDJWTError (Object, [EncodedDisclosure])
result of
                        Left SDJWTError
err -> Either SDJWTError (Object, [EncodedDisclosure])
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SDJWTError -> Either SDJWTError (Object, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err)
                        Right (Object
sdObj, [EncodedDisclosure]
parentDisclosure) -> 
                          Either SDJWTError (Object, [EncodedDisclosure])
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Object, [EncodedDisclosure])
-> Either SDJWTError (Object, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Object
sdObj, [EncodedDisclosure]
parentDisclosure [EncodedDisclosure] -> [EncodedDisclosure] -> [EncodedDisclosure]
forall a. [a] -> [a] -> [a]
++ [EncodedDisclosure]
nestedDisclosures))
    
    -- Combine results from processing all path segments
    combineObjectPathResults
      :: KeyMap.KeyMap Aeson.Value  -- ^ Original object
      -> Map.Map T.Text [[T.Text]]  -- ^ Grouped paths
      -> [(KeyMap.KeyMap Aeson.Value, [EncodedDisclosure])]  -- ^ Success results
      -> (KeyMap.KeyMap Aeson.Value, [EncodedDisclosure])
    combineObjectPathResults :: Object
-> Map Text [[Text]]
-> [(Object, [EncodedDisclosure])]
-> (Object, [EncodedDisclosure])
combineObjectPathResults Object
obj Map Text [[Text]]
groupedByFirst [(Object, [EncodedDisclosure])]
successes = do
      -- Merge all modified objects and combine disclosures
      -- Track which keys were deleted (marked as selectively disclosable)
      let ([Object]
modifiedObjs, [[EncodedDisclosure]]
disclosuresList) = [(Object, [EncodedDisclosure])]
-> ([Object], [[EncodedDisclosure]])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Object, [EncodedDisclosure])]
successes
      let deletedKeys :: Set Key
deletedKeys = [Key] -> Set Key
forall a. Ord a => [a] -> Set a
Set.fromList ([Key] -> Set Key) -> [Key] -> Set Key
forall a b. (a -> b) -> a -> b
$ ((Text, [[Text]]) -> Key) -> [(Text, [[Text]])] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
firstSeg, [[Text]]
_) -> Text -> Key
Key.fromText Text
firstSeg) (Map Text [[Text]] -> [(Text, [[Text]])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text [[Text]]
groupedByFirst)
      -- Start with original object and apply all modifications
      -- When merging, combine _sd arrays instead of overwriting them
      -- Also remove keys that were marked as selectively disclosable
      let finalObj :: Object
finalObj = (Object -> Object -> Object) -> Object -> [Object] -> Object
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Object -> Object -> Object
mergeModifiedObject Object
obj [Object]
modifiedObjs
      -- Remove keys that were marked as selectively disclosable
      let finalObjWithoutDeleted :: Object
finalObjWithoutDeleted = (Key -> Object -> Object) -> Object -> Set Key -> Object
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr Key -> Object -> Object
forall v. Key -> KeyMap v -> KeyMap v
KeyMap.delete Object
finalObj Set Key
deletedKeys
      (Object
finalObjWithoutDeleted, [[EncodedDisclosure]] -> [EncodedDisclosure]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[EncodedDisclosure]]
disclosuresList)
    
    -- Process paths within an object
    processObjectPaths :: HashAlgorithm -> [[T.Text]] -> KeyMap.KeyMap Aeson.Value -> IO (Either SDJWTError (Aeson.Value, [EncodedDisclosure]))
    processObjectPaths :: HashAlgorithm
-> [[Text]]
-> Object
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
processObjectPaths HashAlgorithm
hashAlg' [[Text]]
paths Object
obj = do
      -- Group paths by their first segment
      let groupedByFirst :: Map Text [[Text]]
groupedByFirst = [[Text]] -> Map Text [[Text]]
groupPathsByFirstSegment [[Text]]
paths
      
      -- Process each group
      [Either SDJWTError (Object, [EncodedDisclosure])]
results <- ((Text, [[Text]])
 -> IO (Either SDJWTError (Object, [EncodedDisclosure])))
-> [(Text, [[Text]])]
-> IO [Either SDJWTError (Object, [EncodedDisclosure])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Text
firstSeg, [[Text]]
remainingPaths) -> do
        let firstKey :: Key
firstKey = Text -> Key
Key.fromText Text
firstSeg
        case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
firstKey Object
obj of
          Maybe Value
Nothing -> Either SDJWTError (Object, [EncodedDisclosure])
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Object, [EncodedDisclosure])
 -> IO (Either SDJWTError (Object, [EncodedDisclosure])))
-> Either SDJWTError (Object, [EncodedDisclosure])
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError (Object, [EncodedDisclosure])
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError (Object, [EncodedDisclosure]))
-> SDJWTError -> Either SDJWTError (Object, [EncodedDisclosure])
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Path segment not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
firstSeg
          Just Value
nestedValue -> HashAlgorithm
-> Text
-> [[Text]]
-> Object
-> Value
-> IO (Either SDJWTError (Object, [EncodedDisclosure]))
processPathSegment HashAlgorithm
hashAlg' Text
firstSeg [[Text]]
remainingPaths Object
obj Value
nestedValue
        ) (Map Text [[Text]] -> [(Text, [[Text]])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text [[Text]]
groupedByFirst)
      
      -- Combine results
      let ([SDJWTError]
errors, [(Object, [EncodedDisclosure])]
successes) = [Either SDJWTError (Object, [EncodedDisclosure])]
-> ([SDJWTError], [(Object, [EncodedDisclosure])])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either SDJWTError (Object, [EncodedDisclosure])]
results
      case [SDJWTError]
errors of
        (SDJWTError
err:[SDJWTError]
_) -> Either SDJWTError (Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SDJWTError -> Either SDJWTError (Value, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err)
        [] -> do
          let (Object
finalObj, [EncodedDisclosure]
allDisclosures) = Object
-> Map Text [[Text]]
-> [(Object, [EncodedDisclosure])]
-> (Object, [EncodedDisclosure])
combineObjectPathResults Object
obj Map Text [[Text]]
groupedByFirst [(Object, [EncodedDisclosure])]
successes
          Either SDJWTError (Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Value, [EncodedDisclosure])
-> Either SDJWTError (Value, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Object -> Value
Aeson.Object Object
finalObj, [EncodedDisclosure]
allDisclosures))
    
    -- Helper function to merge a modified object into an accumulator, combining _sd arrays
    mergeModifiedObject :: KeyMap.KeyMap Aeson.Value -> KeyMap.KeyMap Aeson.Value -> KeyMap.KeyMap Aeson.Value
    mergeModifiedObject :: Object -> Object -> Object
mergeModifiedObject = (Key -> Value -> Object -> Object) -> Object -> Object -> Object
forall v a. (Key -> v -> a -> a) -> a -> KeyMap v -> a
KeyMap.foldrWithKey Key -> Value -> Object -> Object
insertOrMergeSD
    
    -- Helper function to insert a key-value pair, merging _sd arrays if present
    insertOrMergeSD :: Key.Key -> Aeson.Value -> KeyMap.KeyMap Aeson.Value -> KeyMap.KeyMap Aeson.Value
    insertOrMergeSD :: Key -> Value -> Object -> Object
insertOrMergeSD Key
k Value
v Object
acc2
      | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Key
Key.fromText Text
"_sd" = case (Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
k Object
acc2, Value
v) of
          (Just (Aeson.Array Array
existingArr), Aeson.Array Array
newArr) ->
            -- Combine arrays, removing duplicates and sorting
            let allDigestsList :: [Value]
allDigestsList = Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
existingArr [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
newArr
                allDigests :: [Text]
allDigests = (Value -> Maybe Text) -> [Value] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Value -> Maybe Text
extractDigestString [Value]
allDigestsList
                uniqueDigests :: [Text]
uniqueDigests = Set Text -> [Text]
forall a. Set a -> [a]
Set.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text]
allDigests
                sortedDigests :: [Value]
sortedDigests = (Text -> Value) -> [Text] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Value
Aeson.String ([Text] -> [Value]) -> [Text] -> [Value]
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Ordering) -> [Text] -> [Text]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Text]
uniqueDigests
            in Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert Key
k (Array -> Value
Aeson.Array ([Value] -> Array
forall a. [a] -> Vector a
V.fromList [Value]
sortedDigests)) Object
acc2
          (Maybe Value, Value)
_ -> Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert Key
k Value
v Object
acc2
      | Bool
otherwise = Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert Key
k Value
v Object
acc2
    
    -- Helper function to extract digest strings from Aeson values
    extractDigestString :: Aeson.Value -> Maybe T.Text
    extractDigestString :: Value -> Maybe Text
extractDigestString (Aeson.String Text
s) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
    extractDigestString Value
_ = Maybe Text
forall a. Maybe a
Nothing
    
    -- Process paths within an array
    -- Paths should have numeric segments representing array indices
    processArrayPaths :: HashAlgorithm -> [[T.Text]] -> V.Vector Aeson.Value -> IO (Either SDJWTError (Aeson.Value, [EncodedDisclosure]))
    processArrayPaths :: HashAlgorithm
-> [[Text]]
-> Array
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
processArrayPaths HashAlgorithm
hashAlg' [[Text]]
paths Array
arr = do
      -- Parse first segment of each path to extract array index
      -- Group paths by first index
      let groupedByFirstIndex :: Map Int [[Text]]
groupedByFirstIndex = ([[Text]] -> [[Text]] -> [[Text]])
-> [(Int, [[Text]])] -> Map Int [[Text]]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [[Text]] -> [[Text]] -> [[Text]]
forall a. [a] -> [a] -> [a]
(++) ([(Int, [[Text]])] -> Map Int [[Text]])
-> [(Int, [[Text]])] -> Map Int [[Text]]
forall a b. (a -> b) -> a -> b
$ ([Text] -> Maybe (Int, [[Text]])) -> [[Text]] -> [(Int, [[Text]])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\[Text]
path -> case [Text]
path of
            [] -> Maybe (Int, [[Text]])
forall a. Maybe a
Nothing
            (Text
firstSeg:[Text]
rest) -> case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
firstSeg) :: Maybe Int of
              Just Int
idx -> (Int, [[Text]]) -> Maybe (Int, [[Text]])
forall a. a -> Maybe a
Just (Int
idx, [[Text]
rest])
              Maybe Int
Nothing -> Maybe (Int, [[Text]])
forall a. Maybe a
Nothing  -- Not a numeric segment, skip (shouldn't happen for array paths)
            ) [[Text]]
paths
      
      -- Process each group
      [Either SDJWTError (Int, Value, [EncodedDisclosure])]
results <- ((Int, [[Text]])
 -> IO (Either SDJWTError (Int, Value, [EncodedDisclosure])))
-> [(Int, [[Text]])]
-> IO [Either SDJWTError (Int, Value, [EncodedDisclosure])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Int
firstIdx, [[Text]]
remainingPaths) -> do
        if Int
firstIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
firstIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Array -> Int
forall a. Vector a -> Int
V.length Array
arr
          then Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Int, Value, [EncodedDisclosure])
 -> IO (Either SDJWTError (Int, Value, [EncodedDisclosure])))
-> Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError (Int, Value, [EncodedDisclosure])
forall a b. a -> Either a b
Left (SDJWTError -> Either SDJWTError (Int, Value, [EncodedDisclosure]))
-> SDJWTError
-> Either SDJWTError (Int, Value, [EncodedDisclosure])
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Array index " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
firstIdx) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" out of bounds"
          else do
            let element :: Value
element = Array
arr Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
firstIdx
            -- Filter out empty paths (this element is the target)
            let ([[Text]]
_emptyPaths, [[Text]]
nonEmptyPaths) = ([Text] -> Bool) -> [[Text]] -> ([[Text]], [[Text]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
remainingPaths
            
            if [[Text]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
nonEmptyPaths
              then do
                -- This element is the target - mark it as selectively disclosable
                Either SDJWTError (Digest, EncodedDisclosure)
result <- HashAlgorithm
-> Value -> IO (Either SDJWTError (Digest, EncodedDisclosure))
markArrayElementDisclosable HashAlgorithm
hashAlg' Value
element
                case Either SDJWTError (Digest, EncodedDisclosure)
result of
                  Left SDJWTError
err -> Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Int, Value, [EncodedDisclosure])
 -> IO (Either SDJWTError (Int, Value, [EncodedDisclosure])))
-> Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError (Int, Value, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err
                  Right (Digest
digest, EncodedDisclosure
disclosure) -> 
                    let ellipsisObj :: Value
ellipsisObj = Object -> Value
Aeson.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList [(Text -> Key
Key.fromText Text
"...", Text -> Value
Aeson.String (Digest -> Text
unDigest Digest
digest))]
                    in Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Int, Value, [EncodedDisclosure])
 -> IO (Either SDJWTError (Int, Value, [EncodedDisclosure])))
-> Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ (Int, Value, [EncodedDisclosure])
-> Either SDJWTError (Int, Value, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Int
firstIdx, Value
ellipsisObj, [EncodedDisclosure
disclosure])
              else do
                -- Recurse into nested value (could be object or array)
                Either SDJWTError (Value, [EncodedDisclosure])
nestedResult <- HashAlgorithm
-> [[Text]]
-> Value
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
processPathsRecursively HashAlgorithm
hashAlg' [[Text]]
nonEmptyPaths Value
element
                case Either SDJWTError (Value, [EncodedDisclosure])
nestedResult of
                  Left SDJWTError
err -> Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Int, Value, [EncodedDisclosure])
 -> IO (Either SDJWTError (Int, Value, [EncodedDisclosure])))
-> Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError (Int, Value, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err
                  Right (Value
modifiedNestedValue, [EncodedDisclosure]
nestedDisclosures) -> do
                    -- If the modified nested value is still an array, preserve the structure
                    -- (don't mark the entire array as SD, just return it with SD elements inside)
                    case Value
modifiedNestedValue of
                      Aeson.Array Array
_ -> 
                        -- Array structure preserved, return it directly without marking as SD
                        Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Int, Value, [EncodedDisclosure])
 -> IO (Either SDJWTError (Int, Value, [EncodedDisclosure])))
-> Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ (Int, Value, [EncodedDisclosure])
-> Either SDJWTError (Int, Value, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Int
firstIdx, Value
modifiedNestedValue, [EncodedDisclosure]
nestedDisclosures)
                      Value
_ -> do
                        -- For objects or other types, mark as selectively disclosable
                        Either SDJWTError (Digest, EncodedDisclosure)
outerResult <- HashAlgorithm
-> Value -> IO (Either SDJWTError (Digest, EncodedDisclosure))
markArrayElementDisclosable HashAlgorithm
hashAlg' Value
modifiedNestedValue
                        case Either SDJWTError (Digest, EncodedDisclosure)
outerResult of
                          Left SDJWTError
err -> Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Int, Value, [EncodedDisclosure])
 -> IO (Either SDJWTError (Int, Value, [EncodedDisclosure])))
-> Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError (Int, Value, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err
                          Right (Digest
digest, EncodedDisclosure
outerDisclosure) -> 
                            let ellipsisObj :: Value
ellipsisObj = Object -> Value
Aeson.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList [(Text -> Key
Key.fromText Text
"...", Text -> Value
Aeson.String (Digest -> Text
unDigest Digest
digest))]
                            in Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Int, Value, [EncodedDisclosure])
 -> IO (Either SDJWTError (Int, Value, [EncodedDisclosure])))
-> Either SDJWTError (Int, Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Int, Value, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ (Int, Value, [EncodedDisclosure])
-> Either SDJWTError (Int, Value, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Int
firstIdx, Value
ellipsisObj, EncodedDisclosure
outerDisclosureEncodedDisclosure -> [EncodedDisclosure] -> [EncodedDisclosure]
forall a. a -> [a] -> [a]
:[EncodedDisclosure]
nestedDisclosures)
        ) (Map Int [[Text]] -> [(Int, [[Text]])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [[Text]]
groupedByFirstIndex)
      
      let ([SDJWTError]
errors, [(Int, Value, [EncodedDisclosure])]
successes) = [Either SDJWTError (Int, Value, [EncodedDisclosure])]
-> ([SDJWTError], [(Int, Value, [EncodedDisclosure])])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either SDJWTError (Int, Value, [EncodedDisclosure])]
results
      case [SDJWTError]
errors of
        (SDJWTError
err:[SDJWTError]
_) -> Either SDJWTError (Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Value, [EncodedDisclosure])
 -> IO (Either SDJWTError (Value, [EncodedDisclosure])))
-> Either SDJWTError (Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError -> Either SDJWTError (Value, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err
        [] -> do
          -- Build modified array with ellipsis objects or modified arrays at specified indices
          let arrWithDigests :: Array
arrWithDigests = (Array -> (Int, Value, [EncodedDisclosure]) -> Array)
-> Array -> [(Int, Value, [EncodedDisclosure])] -> Array
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Array
acc (Int
idx, Value
value, [EncodedDisclosure]
_) ->
                -- value can be either an ellipsis object (from markArrayElementDisclosable) or a modified array
                Array -> [(Int, Value)] -> Array
forall a. Vector a -> [(Int, a)] -> Vector a
V.unsafeUpd Array
acc [(Int
idx, Value
value)]
                ) Array
arr [(Int, Value, [EncodedDisclosure])]
successes
          let allDisclosures :: [EncodedDisclosure]
allDisclosures = [[EncodedDisclosure]] -> [EncodedDisclosure]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (((Int, Value, [EncodedDisclosure]) -> [EncodedDisclosure])
-> [(Int, Value, [EncodedDisclosure])] -> [[EncodedDisclosure]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, Value
_, [EncodedDisclosure]
disclosures) -> [EncodedDisclosure]
disclosures) [(Int, Value, [EncodedDisclosure])]
successes)
          Either SDJWTError (Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Value, [EncodedDisclosure])
 -> IO (Either SDJWTError (Value, [EncodedDisclosure])))
-> Either SDJWTError (Value, [EncodedDisclosure])
-> IO (Either SDJWTError (Value, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ (Value, [EncodedDisclosure])
-> Either SDJWTError (Value, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Array -> Value
Aeson.Array Array
arrWithDigests, [EncodedDisclosure]
allDisclosures)
    
    -- Helper function to mark a claim as selectively disclosable
    markSelectivelyDisclosable :: HashAlgorithm -> T.Text -> Aeson.Value -> IO (Either SDJWTError (Digest, EncodedDisclosure))
    markSelectivelyDisclosable :: HashAlgorithm
-> Text
-> Value
-> IO (Either SDJWTError (Digest, EncodedDisclosure))
markSelectivelyDisclosable HashAlgorithm
hashAlg' Text
claimName Value
claimValue =
      (ByteString -> Either SDJWTError (Digest, EncodedDisclosure))
-> IO ByteString
-> IO (Either SDJWTError (Digest, EncodedDisclosure))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ByteString
saltBytes ->
        let salt :: Salt
salt = ByteString -> Salt
Salt ByteString
saltBytes
        in case Salt -> Text -> Value -> Either SDJWTError EncodedDisclosure
createObjectDisclosure Salt
salt Text
claimName Value
claimValue of
             Left SDJWTError
err -> SDJWTError -> Either SDJWTError (Digest, EncodedDisclosure)
forall a b. a -> Either a b
Left SDJWTError
err
             Right EncodedDisclosure
encodedDisclosure ->
               let digest :: Digest
digest = HashAlgorithm -> EncodedDisclosure -> Digest
computeDigest HashAlgorithm
hashAlg' EncodedDisclosure
encodedDisclosure
               in (Digest, EncodedDisclosure)
-> Either SDJWTError (Digest, EncodedDisclosure)
forall a b. b -> Either a b
Right (Digest
digest, EncodedDisclosure
encodedDisclosure)
      ) IO ByteString
forall (m :: * -> *). MonadIO m => m ByteString
generateSalt
    
    -- Helper function to mark an array element as selectively disclosable
    markArrayElementDisclosable :: HashAlgorithm -> Aeson.Value -> IO (Either SDJWTError (Digest, EncodedDisclosure))
    markArrayElementDisclosable :: HashAlgorithm
-> Value -> IO (Either SDJWTError (Digest, EncodedDisclosure))
markArrayElementDisclosable HashAlgorithm
hashAlg' Value
elementValue =
      (ByteString -> Either SDJWTError (Digest, EncodedDisclosure))
-> IO ByteString
-> IO (Either SDJWTError (Digest, EncodedDisclosure))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ByteString
saltBytes ->
        let salt :: Salt
salt = ByteString -> Salt
Salt ByteString
saltBytes
        in case Salt -> Value -> Either SDJWTError EncodedDisclosure
createArrayDisclosure Salt
salt Value
elementValue of
             Left SDJWTError
err -> SDJWTError -> Either SDJWTError (Digest, EncodedDisclosure)
forall a b. a -> Either a b
Left SDJWTError
err
             Right EncodedDisclosure
encodedDisclosure ->
               let digest :: Digest
digest = HashAlgorithm -> EncodedDisclosure -> Digest
computeDigest HashAlgorithm
hashAlg' EncodedDisclosure
encodedDisclosure
               in (Digest, EncodedDisclosure)
-> Either SDJWTError (Digest, EncodedDisclosure)
forall a b. b -> Either a b
Right (Digest
digest, EncodedDisclosure
encodedDisclosure)
      ) IO ByteString
forall (m :: * -> *). MonadIO m => m ByteString
generateSalt

-- | Process recursive disclosures (Section 6.3: recursive disclosures).
-- Creates disclosures for parent claims where the disclosure value contains
-- an _sd array with digests for sub-claims.
-- Supports arbitrary depth paths like ["user", "profile", "email"].
-- Returns: (parent digests and disclosures with recursive structure, all disclosures including children, remaining unprocessed claims)
processRecursiveDisclosures
  :: HashAlgorithm
  -> [[T.Text]]  -- ^ List of path segments for recursive disclosures (e.g., [["user", "profile", "email"]])
  -> Aeson.Object  -- ^ Original claims object
  -> IO (Either SDJWTError ([(T.Text, Digest, EncodedDisclosure)], [EncodedDisclosure], Aeson.Object))
processRecursiveDisclosures :: HashAlgorithm
-> [[Text]]
-> Object
-> IO
     (Either
        SDJWTError
        ([(Text, Digest, EncodedDisclosure)], [EncodedDisclosure], Object))
processRecursiveDisclosures HashAlgorithm
hashAlg [[Text]]
recursivePaths Object
claims = do
  -- Group recursive paths by first segment (top-level claim)
  let getFirstSegment :: [a] -> a
getFirstSegment [] = a
""
      getFirstSegment (a
seg:[a]
_) = a
seg
  let groupedByTopLevel :: Map Text [[Text]]
groupedByTopLevel = ([[Text]] -> [[Text]] -> [[Text]])
-> [(Text, [[Text]])] -> Map Text [[Text]]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [[Text]] -> [[Text]] -> [[Text]]
forall a. [a] -> [a] -> [a]
(++) ([(Text, [[Text]])] -> Map Text [[Text]])
-> [(Text, [[Text]])] -> Map Text [[Text]]
forall a b. (a -> b) -> a -> b
$ ([Text] -> (Text, [[Text]])) -> [[Text]] -> [(Text, [[Text]])]
forall a b. (a -> b) -> [a] -> [b]
map (\[Text]
path -> ([Text] -> Text
forall {a}. IsString a => [a] -> a
getFirstSegment [Text]
path, [[Text]
path])) [[Text]]
recursivePaths
  
  -- Process each top-level claim recursively
  [Either
   SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])]
results <- ((Text, [[Text]])
 -> IO
      (Either
         SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])))
-> [(Text, [[Text]])]
-> IO
     [Either
        SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Text
topLevelName, [[Text]]
paths) -> do
    case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Text -> Key
Key.fromText Text
topLevelName) Object
claims of
      Maybe Value
Nothing -> Either
  SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError
-> Either
     SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. a -> Either a b
Left (SDJWTError
 -> Either
      SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure]))
-> SDJWTError
-> Either
     SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Parent claim not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
topLevelName
      Just (Aeson.Object Object
topLevelObj) -> do
        -- Strip the first segment (topLevelName) from each path before processing
        let strippedPaths :: [[Text]]
strippedPaths = ([Text] -> [Text]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Text]
path -> case [Text]
path of
              [] -> []
              (Text
_:[Text]
rest) -> [Text]
rest) [[Text]]
paths
        -- Process paths recursively - for recursive disclosures, the parent becomes selectively disclosable
        Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
processResult <- HashAlgorithm
-> [[Text]]
-> Object
-> Text
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
processRecursivePaths HashAlgorithm
hashAlg [[Text]]
strippedPaths Object
topLevelObj Text
topLevelName
        case Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
processResult of
          Left SDJWTError
err -> Either
  SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError
-> Either
     SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err
          Right (Digest
parentDigest, EncodedDisclosure
parentDisclosure, [EncodedDisclosure]
childDisclosures) -> 
            Either
  SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
-> Either
     SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Text
topLevelName, Digest
parentDigest, EncodedDisclosure
parentDisclosure, [EncodedDisclosure]
childDisclosures)
      Just Value
_ -> Either
  SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError
-> Either
     SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. a -> Either a b
Left (SDJWTError
 -> Either
      SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure]))
-> SDJWTError
-> Either
     SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Top-level claim is not an object: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
topLevelName
    ) (Map Text [[Text]] -> [(Text, [[Text]])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text [[Text]]
groupedByTopLevel)
  
  -- Check for errors
  let ([SDJWTError]
errors, [(Text, Digest, EncodedDisclosure, [EncodedDisclosure])]
successes) = [Either
   SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])]
-> ([SDJWTError],
    [(Text, Digest, EncodedDisclosure, [EncodedDisclosure])])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either
   SDJWTError (Text, Digest, EncodedDisclosure, [EncodedDisclosure])]
results
  case [SDJWTError]
errors of
    (SDJWTError
err:[SDJWTError]
_) -> Either
  SDJWTError
  ([(Text, Digest, EncodedDisclosure)], [EncodedDisclosure], Object)
-> IO
     (Either
        SDJWTError
        ([(Text, Digest, EncodedDisclosure)], [EncodedDisclosure], Object))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SDJWTError
-> Either
     SDJWTError
     ([(Text, Digest, EncodedDisclosure)], [EncodedDisclosure], Object)
forall a b. a -> Either a b
Left SDJWTError
err)
    [] -> do
      -- Extract parent info and all child disclosures
      let parentInfo :: [(Text, Digest, EncodedDisclosure)]
parentInfo = ((Text, Digest, EncodedDisclosure, [EncodedDisclosure])
 -> (Text, Digest, EncodedDisclosure))
-> [(Text, Digest, EncodedDisclosure, [EncodedDisclosure])]
-> [(Text, Digest, EncodedDisclosure)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
name, Digest
digest, EncodedDisclosure
disc, [EncodedDisclosure]
_) -> (Text
name, Digest
digest, EncodedDisclosure
disc)) [(Text, Digest, EncodedDisclosure, [EncodedDisclosure])]
successes
      let allChildDisclosures :: [EncodedDisclosure]
allChildDisclosures = ((Text, Digest, EncodedDisclosure, [EncodedDisclosure])
 -> [EncodedDisclosure])
-> [(Text, Digest, EncodedDisclosure, [EncodedDisclosure])]
-> [EncodedDisclosure]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Text
_, Digest
_, EncodedDisclosure
_, [EncodedDisclosure]
childDiscs) -> [EncodedDisclosure]
childDiscs) [(Text, Digest, EncodedDisclosure, [EncodedDisclosure])]
successes
      
      -- Remove recursive parents from remaining claims (they're now in disclosures)
      let recursiveParentNames :: Set Text
recursiveParentNames = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ ((Text, Digest, EncodedDisclosure) -> Text)
-> [(Text, Digest, EncodedDisclosure)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
name, Digest
_, EncodedDisclosure
_) -> Text
name) [(Text, Digest, EncodedDisclosure)]
parentInfo
      let remainingClaims :: Object
remainingClaims = (Key -> Value -> Bool) -> Object -> Object
forall v. (Key -> v -> Bool) -> KeyMap v -> KeyMap v
KeyMap.filterWithKey (\Key
k Value
_ -> Key -> Text
Key.toText Key
k Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
recursiveParentNames) Object
claims
      
      -- Combine parent and child disclosures (parents first, then children)
      let parentDisclosures :: [EncodedDisclosure]
parentDisclosures = ((Text, Digest, EncodedDisclosure) -> EncodedDisclosure)
-> [(Text, Digest, EncodedDisclosure)] -> [EncodedDisclosure]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
_, Digest
_, EncodedDisclosure
disc) -> EncodedDisclosure
disc) [(Text, Digest, EncodedDisclosure)]
parentInfo
      let allDisclosures :: [EncodedDisclosure]
allDisclosures = [EncodedDisclosure]
parentDisclosures [EncodedDisclosure] -> [EncodedDisclosure] -> [EncodedDisclosure]
forall a. [a] -> [a] -> [a]
++ [EncodedDisclosure]
allChildDisclosures
      
      Either
  SDJWTError
  ([(Text, Digest, EncodedDisclosure)], [EncodedDisclosure], Object)
-> IO
     (Either
        SDJWTError
        ([(Text, Digest, EncodedDisclosure)], [EncodedDisclosure], Object))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Text, Digest, EncodedDisclosure)], [EncodedDisclosure], Object)
-> Either
     SDJWTError
     ([(Text, Digest, EncodedDisclosure)], [EncodedDisclosure], Object)
forall a b. b -> Either a b
Right ([(Text, Digest, EncodedDisclosure)]
parentInfo, [EncodedDisclosure]
allDisclosures, Object
remainingClaims))
  
  where
    -- Helper function to recursively process paths for recursive disclosures
    processRecursivePaths :: HashAlgorithm -> [[T.Text]] -> KeyMap.KeyMap Aeson.Value -> T.Text -> IO (Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
    processRecursivePaths :: HashAlgorithm
-> [[Text]]
-> Object
-> Text
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
processRecursivePaths HashAlgorithm
hashAlg' [[Text]]
paths Object
obj Text
parentName = do
      -- Group paths by their first segment
      let groupedByFirst :: Map Text [[Text]]
groupedByFirst = [[Text]] -> Map Text [[Text]]
groupPathsByFirstSegment [[Text]]
paths
      
      -- Process each group
      [Either
   SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])]
results <- ((Text, [[Text]])
 -> IO
      (Either
         SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])))
-> [(Text, [[Text]])]
-> IO
     [Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Text
firstSeg, [[Text]]
remainingPaths) -> do
        let firstKey :: Key
firstKey = Text -> Key
Key.fromText Text
firstSeg
        case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
firstKey Object
obj of
          Maybe Value
Nothing -> Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. a -> Either a b
Left (SDJWTError
 -> Either
      SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
-> SDJWTError
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Path segment not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
firstSeg
          Just (Aeson.Object Object
nestedObj) -> do
            -- Filter out empty paths (this segment is the target)
            let ([[Text]]
_emptyPaths, [[Text]]
nonEmptyPaths) = ([Text] -> Bool) -> [[Text]] -> ([[Text]], [[Text]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
remainingPaths
            if [[Text]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
nonEmptyPaths
              then do
                -- This segment is the target - mark it as selectively disclosable
                -- Return the digest and disclosure (will be combined into parent _sd array)
                Either SDJWTError (Digest, EncodedDisclosure)
result <- HashAlgorithm
-> Text
-> Value
-> IO (Either SDJWTError (Digest, EncodedDisclosure))
markSelectivelyDisclosable HashAlgorithm
hashAlg' Text
firstSeg (Object -> Value
Aeson.Object Object
nestedObj)
                case Either SDJWTError (Digest, EncodedDisclosure)
result of
                  Left SDJWTError
err -> Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err
                  Right (Digest
digest, EncodedDisclosure
disclosure) -> Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ (Digest, EncodedDisclosure, [EncodedDisclosure])
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Digest
digest, EncodedDisclosure
disclosure, [])
              else do
                -- Recurse into nested object
                Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
nestedResult <- HashAlgorithm
-> [[Text]]
-> Object
-> Text
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
processRecursivePaths HashAlgorithm
hashAlg' [[Text]]
nonEmptyPaths Object
nestedObj Text
firstSeg
                case Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
nestedResult of
                  Left SDJWTError
err -> Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err
                  Right (Digest
childDigest, EncodedDisclosure
childDisclosure, [EncodedDisclosure]
grandchildDisclosures) -> do
                    -- Return child digest and disclosure (will be combined into parent _sd array)
                    Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ (Digest, EncodedDisclosure, [EncodedDisclosure])
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Digest
childDigest, EncodedDisclosure
childDisclosure, [EncodedDisclosure]
grandchildDisclosures)
          Just Value
leafValue -> do
            -- Leaf value (string, number, bool, etc.) - this is the target
            -- Check if there are remaining paths (shouldn't happen for leaf values)
            let ([[Text]]
_emptyPaths, [[Text]]
nonEmptyPaths) = ([Text] -> Bool) -> [[Text]] -> ([[Text]], [[Text]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
remainingPaths
            if Bool -> Bool
not ([[Text]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
nonEmptyPaths)
              then Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. a -> Either a b
Left (SDJWTError
 -> Either
      SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
-> SDJWTError
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat (Text -> SDJWTError) -> Text -> SDJWTError
forall a b. (a -> b) -> a -> b
$ Text
"Cannot traverse into leaf value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
firstSeg
              else do
                -- Mark this leaf value as selectively disclosable
                Either SDJWTError (Digest, EncodedDisclosure)
result <- HashAlgorithm
-> Text
-> Value
-> IO (Either SDJWTError (Digest, EncodedDisclosure))
markSelectivelyDisclosable HashAlgorithm
hashAlg' Text
firstSeg Value
leafValue
                case Either SDJWTError (Digest, EncodedDisclosure)
result of
                  Left SDJWTError
err -> Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err
                  Right (Digest
digest, EncodedDisclosure
disclosure) -> Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ (Digest, EncodedDisclosure, [EncodedDisclosure])
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Digest
digest, EncodedDisclosure
disclosure, [])
        ) (Map Text [[Text]] -> [(Text, [[Text]])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text [[Text]]
groupedByFirst)
      
      -- Combine results - for recursive disclosures, we need to combine all child digests
      -- into one parent _sd array
      let ([SDJWTError]
errors, [(Digest, EncodedDisclosure, [EncodedDisclosure])]
successes) = [Either
   SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])]
-> ([SDJWTError],
    [(Digest, EncodedDisclosure, [EncodedDisclosure])])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either
   SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])]
results
      case [SDJWTError]
errors of
        (SDJWTError
err:[SDJWTError]
_) -> Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err
        [] -> do
          case [(Digest, EncodedDisclosure, [EncodedDisclosure])]
successes of
            [] -> Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. a -> Either a b
Left (SDJWTError
 -> Either
      SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
-> SDJWTError
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. (a -> b) -> a -> b
$ Text -> SDJWTError
InvalidDisclosureFormat Text
"No paths to process"
            [(Digest, EncodedDisclosure, [EncodedDisclosure])]
_ -> do
              -- Collect all child digests and disclosures
              -- Each success is (digest, disclosure, grandchildDisclosures)
              -- For leaf children, disclosure is the child disclosure itself
              -- For nested children, disclosure is an intermediate parent, and grandchildDisclosures contains the actual children
              let allChildDigests :: [Digest]
allChildDigests = ((Digest, EncodedDisclosure, [EncodedDisclosure]) -> Digest)
-> [(Digest, EncodedDisclosure, [EncodedDisclosure])] -> [Digest]
forall a b. (a -> b) -> [a] -> [b]
map (\(Digest
digest, EncodedDisclosure
_, [EncodedDisclosure]
_) -> Digest
digest) [(Digest, EncodedDisclosure, [EncodedDisclosure])]
successes
              let allChildDisclosures :: [EncodedDisclosure]
allChildDisclosures = ((Digest, EncodedDisclosure, [EncodedDisclosure])
 -> [EncodedDisclosure])
-> [(Digest, EncodedDisclosure, [EncodedDisclosure])]
-> [EncodedDisclosure]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Digest
_, EncodedDisclosure
disclosure, [EncodedDisclosure]
grandchildDiscs) -> EncodedDisclosure
disclosureEncodedDisclosure -> [EncodedDisclosure] -> [EncodedDisclosure]
forall a. a -> [a] -> [a]
:[EncodedDisclosure]
grandchildDiscs) [(Digest, EncodedDisclosure, [EncodedDisclosure])]
successes
              
              -- Create parent disclosure with _sd array containing all child digests
              let sdArray :: Value
sdArray = Array -> Value
Aeson.Array ([Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> [Value] -> Array
forall a b. (a -> b) -> a -> b
$ (Digest -> Value) -> [Digest] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Value
Aeson.String (Text -> Value) -> (Digest -> Text) -> Digest -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest -> Text
unDigest) ([Digest] -> [Digest]
sortDigests [Digest]
allChildDigests))
              let parentDisclosureValue :: Value
parentDisclosureValue = Object -> Value
Aeson.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList [(Key
"_sd", Value
sdArray)]
              Either SDJWTError (Digest, EncodedDisclosure)
parentResult <- HashAlgorithm
-> Text
-> Value
-> IO (Either SDJWTError (Digest, EncodedDisclosure))
markSelectivelyDisclosable HashAlgorithm
hashAlg' Text
parentName Value
parentDisclosureValue
              case Either SDJWTError (Digest, EncodedDisclosure)
parentResult of
                Left SDJWTError
err -> Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ SDJWTError
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. a -> Either a b
Left SDJWTError
err
                Right (Digest
parentDigest, EncodedDisclosure
parentDisclosure) -> 
                  Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
 -> IO
      (Either
         SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])))
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
-> IO
     (Either
        SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure]))
forall a b. (a -> b) -> a -> b
$ (Digest, EncodedDisclosure, [EncodedDisclosure])
-> Either
     SDJWTError (Digest, EncodedDisclosure, [EncodedDisclosure])
forall a b. b -> Either a b
Right (Digest
parentDigest, EncodedDisclosure
parentDisclosure, [EncodedDisclosure]
allChildDisclosures)
    
    -- Helper function to mark a claim as selectively disclosable
    markSelectivelyDisclosable :: HashAlgorithm -> T.Text -> Aeson.Value -> IO (Either SDJWTError (Digest, EncodedDisclosure))
    markSelectivelyDisclosable :: HashAlgorithm
-> Text
-> Value
-> IO (Either SDJWTError (Digest, EncodedDisclosure))
markSelectivelyDisclosable HashAlgorithm
hashAlg' Text
claimName Value
claimValue =
      (ByteString -> Either SDJWTError (Digest, EncodedDisclosure))
-> IO ByteString
-> IO (Either SDJWTError (Digest, EncodedDisclosure))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ByteString
saltBytes ->
        let salt :: Salt
salt = ByteString -> Salt
Salt ByteString
saltBytes
        in case Salt -> Text -> Value -> Either SDJWTError EncodedDisclosure
createObjectDisclosure Salt
salt Text
claimName Value
claimValue of
             Left SDJWTError
err -> SDJWTError -> Either SDJWTError (Digest, EncodedDisclosure)
forall a b. a -> Either a b
Left SDJWTError
err
             Right EncodedDisclosure
encodedDisclosure ->
               let digest :: Digest
digest = HashAlgorithm -> EncodedDisclosure -> Digest
computeDigest HashAlgorithm
hashAlg' EncodedDisclosure
encodedDisclosure
               in (Digest, EncodedDisclosure)
-> Either SDJWTError (Digest, EncodedDisclosure)
forall a b. b -> Either a b
Right (Digest
digest, EncodedDisclosure
encodedDisclosure)
      ) IO ByteString
forall (m :: * -> *). MonadIO m => m ByteString
generateSalt
    
    -- Helper function to sort digests
    sortDigests :: [Digest] -> [Digest]
    sortDigests :: [Digest] -> [Digest]
sortDigests = (Digest -> Digest -> Ordering) -> [Digest] -> [Digest]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Digest -> Text) -> Digest -> Digest -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Digest -> Text
unDigest)