{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Stability: internal
-- Certain parts of the specification require that data is encoded to a
-- binary form. This module holds such functions.
module Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Encoding
  ( -- * Encoding raw fields
    encodeRawCredential,
    encodeRawAuthenticatorData,
    encodeRawCollectedClientData,

    -- * Encoding structures to bytes
    encodeAttestationObject,
    encodeCollectedClientData,
  )
where

import qualified Codec.CBOR.Term as CBOR
import qualified Codec.CBOR.Write as CBOR
import Codec.Serialise (Serialise (encode))
import Crypto.WebAuthn.Model.Identifier (AAGUID (unAAGUID))
import qualified Crypto.WebAuthn.Model.Kinds as K
import qualified Crypto.WebAuthn.Model.Types as M
import qualified Data.Aeson as Aeson
import qualified Data.Binary.Put as Binary
import Data.Bits ((.|.))
import qualified Data.Bits as Bits
import Data.ByteArray (convert)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64.URL as Base64Url
import Data.ByteString.Builder (Builder, stringUtf8, toLazyByteString)
import qualified Data.ByteString.Lazy as LBS
import Data.Singletons (SingI, sing)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import qualified Data.UUID as UUID
import Data.Word (Word16, Word8)

-- | Encodes all raw fields of a 'M.Credential'. This function is
-- mainly useful for testing that the encoding/decoding functions are correct.
-- The counterpart to this function is 'Crypto.WebAuthn.Model.Binary.Decoding.stripRawCredential'
encodeRawCredential :: forall (c :: K.CeremonyKind) raw. SingI c => M.Credential c raw -> M.Credential c 'True
encodeRawCredential :: Credential c raw -> Credential c 'True
encodeRawCredential M.Credential {AuthenticatorResponse c raw
AuthenticationExtensionsClientOutputs
CredentialId
cClientExtensionResults :: forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> AuthenticationExtensionsClientOutputs
cResponse :: forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> AuthenticatorResponse c raw
cIdentifier :: forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cResponse :: AuthenticatorResponse c raw
cIdentifier :: CredentialId
..} =
  Credential :: forall (c :: CeremonyKind) (raw :: Bool).
CredentialId
-> AuthenticatorResponse c raw
-> AuthenticationExtensionsClientOutputs
-> Credential c raw
M.Credential
    { cResponse :: AuthenticatorResponse c 'True
cResponse = case SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @c of
        Sing c
K.SRegistration -> AuthenticatorResponse 'Registration raw
-> AuthenticatorResponse 'Registration 'True
encodeRawAuthenticatorResponseRegistration AuthenticatorResponse c raw
AuthenticatorResponse 'Registration raw
cResponse
        Sing c
K.SAuthentication -> AuthenticatorResponse 'Authentication raw
-> AuthenticatorResponse 'Authentication 'True
encodeRawAuthenticatorResponseAuthentication AuthenticatorResponse c raw
AuthenticatorResponse 'Authentication raw
cResponse,
      AuthenticationExtensionsClientOutputs
CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cIdentifier :: CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cIdentifier :: CredentialId
..
    }
  where
    encodeRawAuthenticatorResponseAuthentication :: M.AuthenticatorResponse 'K.Authentication raw -> M.AuthenticatorResponse 'K.Authentication 'True
    encodeRawAuthenticatorResponseAuthentication :: AuthenticatorResponse 'Authentication raw
-> AuthenticatorResponse 'Authentication 'True
encodeRawAuthenticatorResponseAuthentication M.AuthenticatorResponseAuthentication {Maybe UserHandle
AuthenticatorData 'Authentication raw
CollectedClientData 'Authentication raw
AssertionSignature
araUserHandle :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw -> Maybe UserHandle
araSignature :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw -> AssertionSignature
araAuthenticatorData :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw
-> AuthenticatorData 'Authentication raw
araClientData :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw
-> CollectedClientData 'Authentication raw
araUserHandle :: Maybe UserHandle
araSignature :: AssertionSignature
araAuthenticatorData :: AuthenticatorData 'Authentication raw
araClientData :: CollectedClientData 'Authentication raw
..} =
      AuthenticatorResponseAuthentication :: forall (raw :: Bool).
CollectedClientData 'Authentication raw
-> AuthenticatorData 'Authentication raw
-> AssertionSignature
-> Maybe UserHandle
-> AuthenticatorResponse 'Authentication raw
M.AuthenticatorResponseAuthentication
        { araClientData :: CollectedClientData 'Authentication 'True
araClientData = CollectedClientData 'Authentication raw
-> CollectedClientData 'Authentication 'True
forall (c :: CeremonyKind) (raw :: Bool).
SingI c =>
CollectedClientData c raw -> CollectedClientData c 'True
encodeRawCollectedClientData CollectedClientData 'Authentication raw
araClientData,
          araAuthenticatorData :: AuthenticatorData 'Authentication 'True
araAuthenticatorData = AuthenticatorData 'Authentication raw
-> AuthenticatorData 'Authentication 'True
forall (c :: CeremonyKind) (raw :: Bool).
SingI c =>
AuthenticatorData c raw -> AuthenticatorData c 'True
encodeRawAuthenticatorData AuthenticatorData 'Authentication raw
araAuthenticatorData,
          Maybe UserHandle
AssertionSignature
araUserHandle :: Maybe UserHandle
araSignature :: AssertionSignature
araUserHandle :: Maybe UserHandle
araSignature :: AssertionSignature
..
        }

    encodeRawAuthenticatorResponseRegistration :: M.AuthenticatorResponse 'K.Registration raw -> M.AuthenticatorResponse 'K.Registration 'True
    encodeRawAuthenticatorResponseRegistration :: AuthenticatorResponse 'Registration raw
-> AuthenticatorResponse 'Registration 'True
encodeRawAuthenticatorResponseRegistration M.AuthenticatorResponseRegistration {[AuthenticatorTransport]
AttestationObject raw
CollectedClientData 'Registration raw
arrTransports :: forall (raw :: Bool).
AuthenticatorResponse 'Registration raw -> [AuthenticatorTransport]
arrAttestationObject :: forall (raw :: Bool).
AuthenticatorResponse 'Registration raw -> AttestationObject raw
arrClientData :: forall (raw :: Bool).
AuthenticatorResponse 'Registration raw
-> CollectedClientData 'Registration raw
arrTransports :: [AuthenticatorTransport]
arrAttestationObject :: AttestationObject raw
arrClientData :: CollectedClientData 'Registration raw
..} =
      AuthenticatorResponseRegistration :: forall (raw :: Bool).
CollectedClientData 'Registration raw
-> AttestationObject raw
-> [AuthenticatorTransport]
-> AuthenticatorResponse 'Registration raw
M.AuthenticatorResponseRegistration
        { arrClientData :: CollectedClientData 'Registration 'True
arrClientData = CollectedClientData 'Registration raw
-> CollectedClientData 'Registration 'True
forall (c :: CeremonyKind) (raw :: Bool).
SingI c =>
CollectedClientData c raw -> CollectedClientData c 'True
encodeRawCollectedClientData CollectedClientData 'Registration raw
arrClientData,
          arrAttestationObject :: AttestationObject 'True
arrAttestationObject = AttestationObject raw -> AttestationObject 'True
encodeRawAttestationObject AttestationObject raw
arrAttestationObject,
          [AuthenticatorTransport]
arrTransports :: [AuthenticatorTransport]
arrTransports :: [AuthenticatorTransport]
..
        }

    encodeRawAttestationObject :: M.AttestationObject raw -> M.AttestationObject 'True
    encodeRawAttestationObject :: AttestationObject raw -> AttestationObject 'True
encodeRawAttestationObject M.AttestationObject {a
AttStmt a
AuthenticatorData 'Registration raw
aoAttStmt :: ()
aoFmt :: ()
aoAuthData :: forall (raw :: Bool).
AttestationObject raw -> AuthenticatorData 'Registration raw
aoAttStmt :: AttStmt a
aoFmt :: a
aoAuthData :: AuthenticatorData 'Registration raw
..} =
      AttestationObject :: forall (raw :: Bool) a.
AttestationStatementFormat a =>
AuthenticatorData 'Registration raw
-> a -> AttStmt a -> AttestationObject raw
M.AttestationObject
        { aoAuthData :: AuthenticatorData 'Registration 'True
aoAuthData = AuthenticatorData 'Registration raw
-> AuthenticatorData 'Registration 'True
forall (c :: CeremonyKind) (raw :: Bool).
SingI c =>
AuthenticatorData c raw -> AuthenticatorData c 'True
encodeRawAuthenticatorData AuthenticatorData 'Registration raw
aoAuthData,
          a
AttStmt a
aoAttStmt :: AttStmt a
aoFmt :: a
aoAttStmt :: AttStmt a
aoFmt :: a
..
        }

-- | Encodes all raw fields of a 'M.AuthenticatorData'. This function is needed
-- for an authenticator implementation
encodeRawAuthenticatorData :: forall c raw. SingI c => M.AuthenticatorData c raw -> M.AuthenticatorData c 'True
encodeRawAuthenticatorData :: AuthenticatorData c raw -> AuthenticatorData c 'True
encodeRawAuthenticatorData M.AuthenticatorData {Maybe AuthenticatorExtensionOutputs
AttestedCredentialData c raw
AuthenticatorDataFlags
SignatureCounter
RpIdHash
RawField raw
adRawData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RawField raw
adExtensions :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> Maybe AuthenticatorExtensionOutputs
adAttestedCredentialData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AttestedCredentialData c raw
adSignCount :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> SignatureCounter
adFlags :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AuthenticatorDataFlags
adRpIdHash :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RpIdHash
adRawData :: RawField raw
adExtensions :: Maybe AuthenticatorExtensionOutputs
adAttestedCredentialData :: AttestedCredentialData c raw
adSignCount :: SignatureCounter
adFlags :: AuthenticatorDataFlags
adRpIdHash :: RpIdHash
..} =
  AuthenticatorData :: forall (c :: CeremonyKind) (raw :: Bool).
RpIdHash
-> AuthenticatorDataFlags
-> SignatureCounter
-> AttestedCredentialData c raw
-> Maybe AuthenticatorExtensionOutputs
-> RawField raw
-> AuthenticatorData c raw
M.AuthenticatorData
    { adRawData :: RawField 'True
adRawData = ByteString -> RawField 'True
M.WithRaw ByteString
bytes,
      adAttestedCredentialData :: AttestedCredentialData c 'True
adAttestedCredentialData = AttestedCredentialData c 'True
rawAttestedCredentialData,
      Maybe AuthenticatorExtensionOutputs
AuthenticatorDataFlags
SignatureCounter
RpIdHash
adExtensions :: Maybe AuthenticatorExtensionOutputs
adSignCount :: SignatureCounter
adFlags :: AuthenticatorDataFlags
adRpIdHash :: RpIdHash
adExtensions :: Maybe AuthenticatorExtensionOutputs
adSignCount :: SignatureCounter
adFlags :: AuthenticatorDataFlags
adRpIdHash :: RpIdHash
..
    }
  where
    rawAttestedCredentialData :: AttestedCredentialData c 'True
rawAttestedCredentialData = AttestedCredentialData c raw -> AttestedCredentialData c 'True
forall (c :: CeremonyKind) (raw :: Bool).
SingI c =>
AttestedCredentialData c raw -> AttestedCredentialData c 'True
encodeRawAttestedCredentialData AttestedCredentialData c raw
adAttestedCredentialData

    bytes :: BS.ByteString
    bytes :: ByteString
bytes = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString Builder
builder

    -- https://www.w3.org/TR/webauthn-2/#flags
    flags :: Word8
    flags :: Word8
flags =
      Word8
userPresentFlag
        Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
userVerifiedFlag
        Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
attestedCredentialDataPresentFlag
        Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
extensionsPresentFlag
      where
        userPresentFlag :: Word8
userPresentFlag = if AuthenticatorDataFlags -> Bool
M.adfUserPresent AuthenticatorDataFlags
adFlags then Int -> Word8
forall a. Bits a => Int -> a
Bits.bit Int
0 else Word8
0
        userVerifiedFlag :: Word8
userVerifiedFlag = if AuthenticatorDataFlags -> Bool
M.adfUserVerified AuthenticatorDataFlags
adFlags then Int -> Word8
forall a. Bits a => Int -> a
Bits.bit Int
2 else Word8
0
        attestedCredentialDataPresentFlag :: Word8
attestedCredentialDataPresentFlag = case SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @c of
          Sing c
K.SRegistration -> Int -> Word8
forall a. Bits a => Int -> a
Bits.bit Int
6
          Sing c
K.SAuthentication -> Word8
0
        extensionsPresentFlag :: Word8
extensionsPresentFlag = case Maybe AuthenticatorExtensionOutputs
adExtensions of
          Just AuthenticatorExtensionOutputs
_ -> Int -> Word8
forall a. Bits a => Int -> a
Bits.bit Int
7
          Maybe AuthenticatorExtensionOutputs
Nothing -> Word8
0

    -- https://www.w3.org/TR/webauthn-2/#sctn-authenticator-data
    builder :: Builder
    builder :: Builder
builder =
      PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (ByteString -> PutM ()
Binary.putByteString (ByteString -> PutM ()) -> ByteString -> PutM ()
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Digest SHA256 -> ByteString) -> Digest SHA256 -> ByteString
forall a b. (a -> b) -> a -> b
$ RpIdHash -> Digest SHA256
M.unRpIdHash RpIdHash
adRpIdHash)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (Word8 -> PutM ()
Binary.putWord8 Word8
flags)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (Word32 -> PutM ()
Binary.putWord32be (Word32 -> PutM ()) -> Word32 -> PutM ()
forall a b. (a -> b) -> a -> b
$ SignatureCounter -> Word32
M.unSignatureCounter SignatureCounter
adSignCount)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ( case SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @c of
               Sing c
K.SRegistration -> AttestedCredentialData 'Registration 'True -> Builder
encodeAttestedCredentialData AttestedCredentialData c 'True
AttestedCredentialData 'Registration 'True
rawAttestedCredentialData
               Sing c
K.SAuthentication -> Builder
forall a. Monoid a => a
mempty
           )
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
-> (AuthenticatorExtensionOutputs -> Builder)
-> Maybe AuthenticatorExtensionOutputs
-> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty AuthenticatorExtensionOutputs -> Builder
encodeExtensions Maybe AuthenticatorExtensionOutputs
adExtensions

    encodeExtensions :: M.AuthenticatorExtensionOutputs -> Builder
    encodeExtensions :: AuthenticatorExtensionOutputs -> Builder
encodeExtensions M.AuthenticatorExtensionOutputs {} = Encoding -> Builder
CBOR.toBuilder (Encoding -> Builder) -> Encoding -> Builder
forall a b. (a -> b) -> a -> b
$ Term -> Encoding
CBOR.encodeTerm ([(Term, Term)] -> Term
CBOR.TMap [])

    -- https://www.w3.org/TR/webauthn-2/#sctn-attested-credential-data
    encodeAttestedCredentialData :: M.AttestedCredentialData 'K.Registration 'True -> Builder
    encodeAttestedCredentialData :: AttestedCredentialData 'Registration 'True -> Builder
encodeAttestedCredentialData M.AttestedCredentialData {CosePublicKey
AAGUID
CredentialId
RawField 'True
acdCredentialPublicKeyBytes :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> RawField raw
acdCredentialPublicKey :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CosePublicKey
acdCredentialId :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CredentialId
acdAaguid :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> AAGUID
acdCredentialPublicKeyBytes :: RawField 'True
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
..} =
      PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (ByteString -> PutM ()
Binary.putLazyByteString (ByteString -> PutM ()) -> ByteString -> PutM ()
forall a b. (a -> b) -> a -> b
$ UUID -> ByteString
UUID.toByteString (UUID -> ByteString) -> UUID -> ByteString
forall a b. (a -> b) -> a -> b
$ AAGUID -> UUID
unAAGUID AAGUID
acdAaguid)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (Word16 -> PutM ()
Binary.putWord16be Word16
credentialLength)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (ByteString -> PutM ()
Binary.putByteString (ByteString -> PutM ()) -> ByteString -> PutM ()
forall a b. (a -> b) -> a -> b
$ CredentialId -> ByteString
M.unCredentialId CredentialId
acdCredentialId)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (ByteString -> PutM ()
Binary.putByteString (ByteString -> PutM ()) -> ByteString -> PutM ()
forall a b. (a -> b) -> a -> b
$ RawField 'True -> ByteString
M.unRaw RawField 'True
acdCredentialPublicKeyBytes)
      where
        credentialLength :: Word16
        credentialLength :: Word16
credentialLength = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ CredentialId -> ByteString
M.unCredentialId CredentialId
acdCredentialId

    encodeRawAttestedCredentialData :: forall (c :: K.CeremonyKind) raw. SingI c => M.AttestedCredentialData c raw -> M.AttestedCredentialData c 'True
    encodeRawAttestedCredentialData :: AttestedCredentialData c raw -> AttestedCredentialData c 'True
encodeRawAttestedCredentialData = case SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @c of
      Sing c
K.SRegistration -> \M.AttestedCredentialData {CosePublicKey
AAGUID
CredentialId
RawField raw
acdCredentialPublicKeyBytes :: RawField raw
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
acdCredentialPublicKeyBytes :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> RawField raw
acdCredentialPublicKey :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CosePublicKey
acdCredentialId :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CredentialId
acdAaguid :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> AAGUID
..} ->
        AttestedCredentialData :: forall (raw :: Bool).
AAGUID
-> CredentialId
-> CosePublicKey
-> RawField raw
-> AttestedCredentialData 'Registration raw
M.AttestedCredentialData
          { acdCredentialPublicKeyBytes :: RawField 'True
acdCredentialPublicKeyBytes =
              ByteString -> RawField 'True
M.WithRaw (ByteString -> RawField 'True) -> ByteString -> RawField 'True
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString
CBOR.toLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ CosePublicKey -> Encoding
forall a. Serialise a => a -> Encoding
encode CosePublicKey
acdCredentialPublicKey,
            CosePublicKey
AAGUID
CredentialId
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
..
          }
      Sing c
K.SAuthentication -> \AttestedCredentialData c raw
M.NoAttestedCredentialData -> AttestedCredentialData c 'True
forall (raw :: Bool). AttestedCredentialData 'Authentication raw
M.NoAttestedCredentialData

-- | Encodes all raw fields of a 'M.CollectedClientData'. This function is
-- needed for a client implementation
encodeRawCollectedClientData :: forall c raw. SingI c => M.CollectedClientData c raw -> M.CollectedClientData c 'True
encodeRawCollectedClientData :: CollectedClientData c raw -> CollectedClientData c 'True
encodeRawCollectedClientData M.CollectedClientData {Bool
Origin
Challenge
RawField raw
ccdRawData :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> RawField raw
ccdCrossOrigin :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Bool
ccdOrigin :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Origin
ccdChallenge :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Challenge
ccdRawData :: RawField raw
ccdCrossOrigin :: Bool
ccdOrigin :: Origin
ccdChallenge :: Challenge
..} = CollectedClientData :: forall (c :: CeremonyKind) (raw :: Bool).
Challenge
-> Origin -> Bool -> RawField raw -> CollectedClientData c raw
M.CollectedClientData {Bool
Origin
Challenge
RawField 'True
ccdRawData :: RawField 'True
ccdRawData :: RawField 'True
ccdCrossOrigin :: Bool
ccdOrigin :: Origin
ccdChallenge :: Challenge
ccdCrossOrigin :: Bool
ccdOrigin :: Origin
ccdChallenge :: Challenge
..}
  where
    ccdRawData :: RawField 'True
ccdRawData = ByteString -> RawField 'True
M.WithRaw (ByteString -> RawField 'True) -> ByteString -> RawField 'True
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString Builder
builder

    -- https://www.w3.org/TR/webauthn-2/#clientdatajson-serialization
    builder :: Builder
    builder :: Builder
builder =
      String -> Builder
stringUtf8 String
"{\"type\":"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall a. ToJSON a => a -> Builder
jsonBuilder Text
typeValue
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringUtf8 String
",\"challenge\":"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall a. ToJSON a => a -> Builder
jsonBuilder Text
challengeValue
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringUtf8 String
",\"origin\":"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall a. ToJSON a => a -> Builder
jsonBuilder Text
originValue
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringUtf8 String
",\"crossOrigin\":"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Builder
forall a. ToJSON a => a -> Builder
jsonBuilder Bool
crossOriginValue
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringUtf8 String
"}"

    typeValue :: Text
    typeValue :: Text
typeValue = case SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @c of
      Sing c
K.SRegistration -> Text
"webauthn.create"
      Sing c
K.SAuthentication -> Text
"webauthn.get"

    challengeValue :: Text
    challengeValue :: Text
challengeValue = ByteString -> Text
decodeUtf8 (ByteString -> ByteString
Base64Url.encode (Challenge -> ByteString
M.unChallenge Challenge
ccdChallenge))

    originValue :: Text
    originValue :: Text
originValue = Origin -> Text
M.unOrigin Origin
ccdOrigin

    crossOriginValue :: Bool
    crossOriginValue :: Bool
crossOriginValue = Bool
ccdCrossOrigin

    jsonBuilder :: Aeson.ToJSON a => a -> Builder
    jsonBuilder :: a -> Builder
jsonBuilder = Encoding' Value -> Builder
forall tag. Encoding' tag -> Builder
Aeson.fromEncoding (Encoding' Value -> Builder)
-> (a -> Encoding' Value) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding' Value
forall a. ToJSON a => a -> Encoding' Value
Aeson.toEncoding

-- | Encodes an 'M.AttestationObject' as a 'BS.ByteString'. This is needed by
-- the client side to generate a valid JSON response
encodeAttestationObject :: M.AttestationObject 'True -> BS.ByteString
encodeAttestationObject :: AttestationObject 'True -> ByteString
encodeAttestationObject M.AttestationObject {a
AttStmt a
AuthenticatorData 'Registration 'True
aoAttStmt :: AttStmt a
aoFmt :: a
aoAuthData :: AuthenticatorData 'Registration 'True
aoAttStmt :: ()
aoFmt :: ()
aoAuthData :: forall (raw :: Bool).
AttestationObject raw -> AuthenticatorData 'Registration raw
..} = Encoding -> ByteString
CBOR.toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Term -> Encoding
CBOR.encodeTerm Term
term
  where
    -- https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object
    term :: CBOR.Term
    term :: Term
term =
      [(Term, Term)] -> Term
CBOR.TMap
        [ (Text -> Term
CBOR.TString Text
"authData", ByteString -> Term
CBOR.TBytes (ByteString -> Term) -> ByteString -> Term
forall a b. (a -> b) -> a -> b
$ RawField 'True -> ByteString
M.unRaw (RawField 'True -> ByteString) -> RawField 'True -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthenticatorData 'Registration 'True -> RawField 'True
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RawField raw
M.adRawData AuthenticatorData 'Registration 'True
aoAuthData),
          (Text -> Term
CBOR.TString Text
"fmt", Text -> Term
CBOR.TString (Text -> Term) -> Text -> Term
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. AttestationStatementFormat a => a -> Text
M.asfIdentifier a
aoFmt),
          (Text -> Term
CBOR.TString Text
"attStmt", a -> AttStmt a -> Term
forall a. AttestationStatementFormat a => a -> AttStmt a -> Term
M.asfEncode a
aoFmt AttStmt a
aoAttStmt)
        ]

-- | Encodes an 'M.CollectedClientData' as a 'BS.ByteString'. This is needed by
-- the client side to generate a valid JSON response
encodeCollectedClientData :: forall (c :: K.CeremonyKind). SingI c => M.CollectedClientData c 'True -> BS.ByteString
encodeCollectedClientData :: CollectedClientData c 'True -> ByteString
encodeCollectedClientData M.CollectedClientData {Bool
Origin
Challenge
RawField 'True
ccdRawData :: RawField 'True
ccdCrossOrigin :: Bool
ccdOrigin :: Origin
ccdChallenge :: Challenge
ccdRawData :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> RawField raw
ccdCrossOrigin :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Bool
ccdOrigin :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Origin
ccdChallenge :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Challenge
..} = RawField 'True -> ByteString
M.unRaw RawField 'True
ccdRawData