sd-jwt-0.1.0.0: test/DisclosureSpec.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module DisclosureSpec (spec) where

import Test.Hspec
import Test.QuickCheck
import Test.QuickCheck.Property ((==>))
import TestHelpers
import TestKeys
import SDJWT.Internal.Types
import SDJWT.Internal.Utils
import SDJWT.Internal.Digest
import SDJWT.Internal.Disclosure
import SDJWT.Internal.Serialization
import SDJWT.Internal.Issuance
import SDJWT.Internal.Presentation
import SDJWT.Internal.Verification (verifySDJWT, verifySDJWTSignature, verifySDJWTWithoutSignature, verifyKeyBinding, verifyDisclosures, extractHashAlgorithm)
import SDJWT.Internal.KeyBinding
import SDJWT.Internal.JWT
import qualified Data.Vector as V
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8, decodeUtf8')
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Map.Strict as Map
import Data.Int (Int64)
import Data.Maybe (isJust, mapMaybe)
import Data.List (find, nub)
import Control.Monad (replicateM)

spec :: Spec
spec = describe "SDJWT.Disclosure" $ do
  describe "createObjectDisclosure" $ do
    it "creates disclosure with string value" $ do
      salt <- generateSalt
      let name = "given_name"
      let value = Aeson.String "John"
      case createObjectDisclosure (Salt salt) name value of
        Right _ -> return ()  -- Success
        Left err -> expectationFailure $ "Failed to create disclosure: " ++ show err
    
    it "creates disclosure with empty string value" $ do
      salt <- generateSalt
      let name = "empty_claim"
      let value = Aeson.String ""
      case createObjectDisclosure (Salt salt) name value of
        Right _ -> return ()  -- Success
        Left err -> expectationFailure $ "Failed to create disclosure: " ++ show err
    
    it "creates disclosure with numeric value" $ do
      salt <- generateSalt
      let name = "age"
      let value = Aeson.Number 42
      case createObjectDisclosure (Salt salt) name value of
        Right _ -> return ()  -- Success
        Left err -> expectationFailure $ "Failed to create disclosure: " ++ show err
    
    it "creates disclosure with object value" $ do
        salt <- generateSalt
        let name = "address"
        let value = Aeson.Object $ KeyMap.fromList [ (Key.fromText "street", Aeson.String "123 Main St")]
        case createObjectDisclosure (Salt salt) name value of
          Right _ -> return ()  -- Success
          Left err -> expectationFailure $ "Failed to create disclosure: " ++ show err
    
    describe "createArrayDisclosure" $ do
      it "creates a valid array disclosure" $ do
        salt <- generateSalt
        let value = Aeson.String "US"
        case createArrayDisclosure (Salt salt) value of
          Right _ -> return ()  -- Success
          Left err -> expectationFailure $ "Failed to create disclosure: " ++ show err
      
      it "creates array disclosure with object value" $ do
        salt <- generateSalt
        let value = Aeson.Object $ KeyMap.fromList [ (Key.fromText "name", Aeson.String "John")]
        case createArrayDisclosure (Salt salt) value of
          Right _ -> return ()  -- Success
          Left err -> expectationFailure $ "Failed to create disclosure: " ++ show err
    
    describe "encodeDisclosure" $ do
      it "encodes object disclosure" $ do
        salt <- generateSalt
        let name = "test_claim"
        let value = Aeson.String "test_value"
        case createObjectDisclosure (Salt salt) name value of
          Right encoded1 -> do
            case decodeDisclosure encoded1 of
              Right decoded -> do
                -- Round-trip: encode -> decode -> encode should match
                let encoded2 = encodeDisclosure decoded
                unEncodedDisclosure encoded1 `shouldBe` unEncodedDisclosure encoded2
              Left err -> expectationFailure $ "Failed to decode: " ++ show err
          Left err -> expectationFailure $ "Failed to create: " ++ show err
      
      it "encodes array disclosure" $ do
        salt <- generateSalt
        let value = Aeson.String "array_value"
        case createArrayDisclosure (Salt salt) value of
          Right encoded1 -> do
            case decodeDisclosure encoded1 of
              Right decoded -> do
                -- Round-trip: encode -> decode -> encode should match
                let encoded2 = encodeDisclosure decoded
                unEncodedDisclosure encoded1 `shouldBe` unEncodedDisclosure encoded2
              Left err -> expectationFailure $ "Failed to decode: " ++ show err
          Left err -> expectationFailure $ "Failed to create: " ++ show err
    
    describe "getDisclosureSalt" $ do
      it "extracts salt from object disclosure" $ do
        salt <- generateSalt
        let name = "test_claim"
        let value = Aeson.String "test_value"
        case createObjectDisclosure (Salt salt) name value of
          Right encoded -> do
            case decodeDisclosure encoded of
              Right disclosure -> do
                unSalt (getDisclosureSalt disclosure) `shouldBe` salt
              Left err -> expectationFailure $ "Failed to decode: " ++ show err
          Left err -> expectationFailure $ "Failed to create: " ++ show err
      
      it "extracts salt from array disclosure" $ do
        salt <- generateSalt
        let value = Aeson.String "array_value"
        case createArrayDisclosure (Salt salt) value of
          Right encoded -> do
            case decodeDisclosure encoded of
              Right disclosure -> do
                unSalt (getDisclosureSalt disclosure) `shouldBe` salt
              Left err -> expectationFailure $ "Failed to decode: " ++ show err
          Left err -> expectationFailure $ "Failed to create: " ++ show err
    
    describe "decodeDisclosure" $ do
      it "decodes RFC example disclosure" $ do
        -- From RFC 9901 Section 5.1: given_name disclosure
        let encoded = EncodedDisclosure "WyIyR0xDNDJzS1F2ZUNmR2ZyeU5STjl3IiwgImdpdmVuX25hbWUiLCAiSm9obiJd"
        case decodeDisclosure encoded of
          Right disclosure -> do
            getDisclosureClaimName disclosure `shouldBe` Just "given_name"
            getDisclosureValue disclosure `shouldBe` Aeson.String "John"
          Left err -> expectationFailure $ "Failed to decode: " ++ show err
      
      it "decodes array disclosure (2 elements)" $ do
        -- Array disclosure: [salt, value]
        salt <- generateSalt
        let value = Aeson.String "US"
        case createArrayDisclosure (Salt salt) value of
          Right encoded -> do
            case decodeDisclosure encoded of
              Right disclosure -> do
                getDisclosureClaimName disclosure `shouldBe` Nothing  -- Array disclosures have no name
                getDisclosureValue disclosure `shouldBe` value
              Left err -> expectationFailure $ "Failed to decode: " ++ show err
          Left err -> expectationFailure $ "Failed to create: " ++ show err
      
      it "fails to decode invalid base64url" $ do
        let invalid = EncodedDisclosure "not-valid-base64url!!!"
        case decodeDisclosure invalid of
          Left (InvalidDisclosureFormat _) -> return ()  -- Expected error
          Left _ -> return ()  -- Any error is acceptable
          Right _ -> expectationFailure "Should fail to decode invalid base64url"
      
      it "fails to decode non-array JSON" $ do
        -- Base64url-encoded JSON object instead of array
        let jsonObj = KeyMap.fromList [ (Key.fromText "key", Aeson.String "value")]
        let jsonBytes = BS.concat $ BSL.toChunks $ Aeson.encode jsonObj
        let encoded = EncodedDisclosure $ base64urlEncode jsonBytes
        case decodeDisclosure encoded of
          Left (InvalidDisclosureFormat _) -> return ()  -- Expected error
          Left _ -> return ()  -- Any error is acceptable
          Right _ -> expectationFailure "Should fail to decode non-array JSON"
      
      it "fails to decode array with 1 element" $ do
        -- Array with only 1 element (should have 2 or 3)
        let jsonArray = Aeson.Array $ V.fromList [Aeson.String "salt"]
        let jsonBytes = BS.concat $ BSL.toChunks $ Aeson.encode jsonArray
        let encoded = EncodedDisclosure $ base64urlEncode jsonBytes
        case decodeDisclosure encoded of
          Left (InvalidDisclosureFormat msg) -> do
            T.isInfixOf "must have 2 or 3 elements" msg `shouldBe` True
          Left _ -> return ()  -- Any error is acceptable
          Right _ -> expectationFailure "Should fail to decode array with 1 element"
      
      it "fails to decode array with 4+ elements" $ do
        -- Array with 4 elements (should have 2 or 3)
        let jsonArray = Aeson.Array $ V.fromList
              [ Aeson.String "salt"
              , Aeson.String "name"
              , Aeson.String "value"
              , Aeson.String "extra"
              ]
        let jsonBytes = BS.concat $ BSL.toChunks $ Aeson.encode jsonArray
        let encoded = EncodedDisclosure $ base64urlEncode jsonBytes
        case decodeDisclosure encoded of
          Left (InvalidDisclosureFormat msg) -> do
            T.isInfixOf "must have 2 or 3 elements" msg `shouldBe` True
          Left _ -> return ()  -- Any error is acceptable
          Right _ -> expectationFailure "Should fail to decode array with 4+ elements"
      
      it "fails to decode array where first element is not a string" $ do
        -- First element (salt) must be a string
        let jsonArray = Aeson.Array $ V.fromList
              [ Aeson.Number 123  -- Not a string
              , Aeson.String "name"
              , Aeson.String "value"
              ]
        let jsonBytes = BS.concat $ BSL.toChunks $ Aeson.encode jsonArray
        let encoded = EncodedDisclosure $ base64urlEncode jsonBytes
        case decodeDisclosure encoded of
          Left (InvalidDisclosureFormat _) -> return ()  -- Expected error
          Left _ -> return ()  -- Any error is acceptable
          Right _ -> expectationFailure "Should fail when salt is not a string"
      
      it "fails to decode array disclosure where second element is not a string" $ do
        -- For object disclosure (3 elements), second element (name) must be a string
        -- But for array disclosure (2 elements), second element is the value (can be anything)
        -- So this test is for object disclosure
        let jsonArray = Aeson.Array $ V.fromList
              [ Aeson.String "salt"
              , Aeson.Number 123  -- Name should be string
              , Aeson.String "value"
              ]
        let jsonBytes = BS.concat $ BSL.toChunks $ Aeson.encode jsonArray
        let encoded = EncodedDisclosure $ base64urlEncode jsonBytes
        case decodeDisclosure encoded of
          Left (InvalidDisclosureFormat _) -> return ()  -- Expected error
          Left _ -> return ()  -- Any error is acceptable
          Right _ -> expectationFailure "Should fail when claim name is not a string"