sd-jwt-0.1.0.0: test/SerializationSpec.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module SerializationSpec (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.Serialization" $ do
    describe "serializeSDJWT" $ do
      it "serializes SD-JWT with empty disclosures" $ do
        let jwt = "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test"
        let sdjwt = SDJWT jwt []
        serializeSDJWT sdjwt `shouldBe` "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test~"
      
      it "serializes SD-JWT with single disclosure" $ do
        let jwt = "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test"
        let disclosure = EncodedDisclosure "disclosure1"
        let sdjwt = SDJWT jwt [disclosure]
        serializeSDJWT sdjwt `shouldBe` "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test~disclosure1~"
      
      it "serializes SD-JWT with multiple disclosures" $ do
        let jwt = "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test"
        let disclosure1 = EncodedDisclosure "disclosure1"
        let disclosure2 = EncodedDisclosure "disclosure2"
        let disclosure3 = EncodedDisclosure "disclosure3"
        let sdjwt = SDJWT jwt [disclosure1, disclosure2, disclosure3]
        serializeSDJWT sdjwt `shouldBe` "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test~disclosure1~disclosure2~disclosure3~"
    
    describe "parseTildeSeparated" $ do
      it "parses SD-JWT format" $ do
        let input = "jwt~disclosure1~disclosure2~"
        case parseTildeSeparated input of
          Right (jwt, parsedDisclosures, Nothing) -> do
            jwt `shouldBe` "jwt"
            length parsedDisclosures `shouldBe` 2
          Right (_, _, Just _) -> expectationFailure "Unexpected key binding JWT"
          Left err -> expectationFailure $ "Failed to parse: " ++ show err
      
      it "parses SD-JWT+KB format" $ do
        let input = "jwt~disclosure1~disclosure2~kb-jwt"
        case parseTildeSeparated input of
          Right (jwt, parsedDisclosures, Just kbJwt) -> do
            jwt `shouldBe` "jwt"
            length parsedDisclosures `shouldBe` 2
            kbJwt `shouldBe` "kb-jwt"
          Right _ -> expectationFailure "Expected KB-JWT"
          Left err -> expectationFailure $ "Failed to parse: " ++ show err
      
      it "parses JWT only (no disclosures)" $ do
        let input = "jwt"
        case parseTildeSeparated input of
          Right (jwt, parsedDisclosures, Nothing) -> do
            jwt `shouldBe` "jwt"
            length parsedDisclosures `shouldBe` 0
          Left err -> expectationFailure $ "Failed to parse: " ++ show err
          _ -> expectationFailure "Unexpected result"
      
      it "parses empty string as JWT-only" $ do
        let input = ""
        case parseTildeSeparated input of
          Right (jwt, parsedDisclosures, mbKbJwt) -> do
            jwt `shouldBe` ""
            length parsedDisclosures `shouldBe` 0
            mbKbJwt `shouldBe` Nothing
          Left err -> expectationFailure $ "Should parse empty string, got error: " ++ show err
      
      it "handles multiple consecutive tildes" $ do
        let input = "jwt~~disclosure1~~"
        case parseTildeSeparated input of
          Right (jwt, parsedDisclosures, Nothing) -> do
            jwt `shouldBe` "jwt"
            length parsedDisclosures `shouldBe` 3  -- empty, disclosure1, empty
          Left err -> expectationFailure $ "Failed to parse: " ++ show err
          _ -> expectationFailure "Unexpected result"
    
    describe "deserializeSDJWT" $ do
      it "deserializes valid SD-JWT" $ do
        let jwt = "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test"
        let input = jwt <> "~disclosure1~disclosure2~"
        case deserializeSDJWT input of
          Right (SDJWT parsedJwt parsedDisclosures) -> do
            parsedJwt `shouldBe` jwt
            length parsedDisclosures `shouldBe` 2
            unEncodedDisclosure (head parsedDisclosures) `shouldBe` "disclosure1"
            unEncodedDisclosure (parsedDisclosures !! 1) `shouldBe` "disclosure2"
          Left err -> expectationFailure $ "Failed to deserialize: " ++ show err
      
      it "deserializes SD-JWT with no disclosures" $ do
        let jwt = "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test"
        let input = jwt <> "~"
        case deserializeSDJWT input of
          Right (SDJWT parsedJwt parsedDisclosures) -> do
            parsedJwt `shouldBe` jwt
            length parsedDisclosures `shouldBe` 0
          Left err -> expectationFailure $ "Failed to deserialize: " ++ show err
      
      it "rejects SD-JWT+KB format" $ do
        let jwt = "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test"
        let input = jwt <> "~disclosure1~kb-jwt"
        case deserializeSDJWT input of
          Left _ -> return ()  -- Expected error
          Right _ -> expectationFailure "Should reject SD-JWT+KB format"
      
      it "handles empty input (parses as empty JWT)" $ do
        case deserializeSDJWT "" of
          Right (SDJWT parsedJwt parsedDisclosures) -> do
            parsedJwt `shouldBe` ""
            length parsedDisclosures `shouldBe` 0
          Left _ -> return ()  -- Empty JWT might be rejected by deserializeSDJWT validation
      
      it "rejects input without trailing tilde (parses as SD-JWT+KB)" $ do
        let jwt = "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test"
        let input = jwt <> "~disclosure1"  -- Missing trailing tilde - parses as SD-JWT+KB
        case deserializeSDJWT input of
          Left _ -> return ()  -- Expected error (SD-JWT format requires trailing tilde, this parses as SD-JWT+KB)
          Right _ -> expectationFailure "Should reject SD-JWT+KB format"
    
    describe "deserializePresentation" $ do
      it "deserializes SD-JWT presentation (no KB-JWT)" $ do
        let jwt = "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test"
        let input = jwt <> "~disclosure1~disclosure2~"
        case deserializePresentation input of
          Right (SDJWTPresentation parsedJwt parsedDisclosures Nothing) -> do
            parsedJwt `shouldBe` jwt
            length parsedDisclosures `shouldBe` 2
          Left err -> expectationFailure $ "Failed to deserialize: " ++ show err
          Right _ -> expectationFailure "Unexpected KB-JWT"
      
      it "deserializes SD-JWT+KB presentation" $ do
        let jwt = "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test"
        let kbJwt = "kb-jwt-token"
        let input = jwt <> "~disclosure1~disclosure2~" <> kbJwt
        case deserializePresentation input of
          Right (SDJWTPresentation parsedJwt parsedDisclosures (Just parsedKbJwt)) -> do
            parsedJwt `shouldBe` jwt
            length parsedDisclosures `shouldBe` 2
            parsedKbJwt `shouldBe` kbJwt
          Left err -> expectationFailure $ "Failed to deserialize: " ++ show err
          Right _ -> expectationFailure "Expected KB-JWT"
      
      it "deserializes presentation with no disclosures" $ do
        let jwt = "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test"
        let input = jwt <> "~"
        case deserializePresentation input of
          Right (SDJWTPresentation parsedJwt parsedDisclosures mbKbJwt) -> do
            parsedJwt `shouldBe` jwt
            length parsedDisclosures `shouldBe` 0
            mbKbJwt `shouldBe` Nothing
          Left err -> expectationFailure $ "Failed to deserialize: " ++ show err
      
      it "handles empty input (parses as empty JWT)" $ do
        case deserializePresentation "" of
          Right (SDJWTPresentation parsedJwt parsedDisclosures mbKbJwt) -> do
            parsedJwt `shouldBe` ""
            length parsedDisclosures `shouldBe` 0
            mbKbJwt `shouldBe` Nothing
          Left _ -> return ()  -- Empty JWT might be rejected by validation
      
      it "handles JWT only (no tilde)" $ do
        let jwt = "eyJhbGciOiJSUzI1NiJ9.eyJzdWIiOiIxMjM0NTY3ODkwIn0.test"
        case deserializePresentation jwt of
          Right (SDJWTPresentation parsedJwt parsedDisclosures mbKbJwt) -> do
            parsedJwt `shouldBe` jwt
            length parsedDisclosures `shouldBe` 0
            mbKbJwt `shouldBe` Nothing
          Left err -> expectationFailure $ "Failed to deserialize: " ++ show err