{-# LANGUAGE DataKinds #-}

-- | Stability: experimental
-- This module contains functions and types for encoding 'T.CredentialOptions'
-- and decoding 'T.Credential's, based on intermediate types that implement the 'ToJSON' and 'FromJSON' types respectively, matching the serialization used by [webauthn-json](https://github.com/github/webauthn-json).
module Crypto.WebAuthn.Model.WebIDL
  ( -- * Registration
    encodeCredentialOptionsRegistration,
    IDLCredentialOptionsRegistration,
    IDLCredentialRegistration,
    decodeCredentialRegistration,

    -- * Authentication
    encodeCredentialOptionsAuthentication,
    IDLCredentialOptionsAuthentication,
    IDLCredentialAuthentication,
    decodeCredentialAuthentication,
  )
where

import qualified Crypto.WebAuthn.Model.Kinds as K
import qualified Crypto.WebAuthn.Model.Types as T
import Crypto.WebAuthn.Model.WebIDL.Internal.Decoding (Decode (decode), DecodeCreated (decodeCreated))
import Crypto.WebAuthn.Model.WebIDL.Internal.Encoding (Encode (encode))
import qualified Crypto.WebAuthn.Model.WebIDL.Types as IDL
import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)

-- | Encodes a @'T.CredentialOptions' 'K.Registration'@, which is needed for the
-- [registration ceremony](https://www.w3.org/TR/webauthn-2/#registration). The
-- resulting type from this function can be encoded using 'Data.Aeson.toJSON',
-- sent as a response, received by the Relying Party script, passed directly as the [@publicKey@](https://www.w3.org/TR/webauthn-2/#dom-credentialcreationoptions-publickey)
-- field in the argument to [webauthn-json](https://github.com/github/webauthn-json)'s [@create()@](https://github.com/github/webauthn-json#api) (or equivalent) function. The result of that function can then be decoded using 'decodeCredentialRegistration'.
encodeCredentialOptionsRegistration ::
  T.CredentialOptions 'K.Registration ->
  IDLCredentialOptionsRegistration
encodeCredentialOptionsRegistration :: CredentialOptions 'Registration -> IDLCredentialOptionsRegistration
encodeCredentialOptionsRegistration = PublicKeyCredentialCreationOptions
-> IDLCredentialOptionsRegistration
IDLCredentialOptionsRegistration (PublicKeyCredentialCreationOptions
 -> IDLCredentialOptionsRegistration)
-> (CredentialOptions 'Registration
    -> PublicKeyCredentialCreationOptions)
-> CredentialOptions 'Registration
-> IDLCredentialOptionsRegistration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CredentialOptions 'Registration
-> PublicKeyCredentialCreationOptions
forall a. Encode a => a -> IDL a
encode

-- | The intermediate type returned by 'encodeCredentialOptionsRegistration',
-- equivalent to the [@PublicKeyCredentialCreationOptions@](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialcreationoptions) dictionary
newtype IDLCredentialOptionsRegistration = IDLCredentialOptionsRegistration
  { IDLCredentialOptionsRegistration
-> PublicKeyCredentialCreationOptions
_unIDLCredentialOptionsRegistration :: IDL.PublicKeyCredentialCreationOptions
  }
  deriving newtype (Int -> IDLCredentialOptionsRegistration -> ShowS
[IDLCredentialOptionsRegistration] -> ShowS
IDLCredentialOptionsRegistration -> String
(Int -> IDLCredentialOptionsRegistration -> ShowS)
-> (IDLCredentialOptionsRegistration -> String)
-> ([IDLCredentialOptionsRegistration] -> ShowS)
-> Show IDLCredentialOptionsRegistration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IDLCredentialOptionsRegistration] -> ShowS
$cshowList :: [IDLCredentialOptionsRegistration] -> ShowS
show :: IDLCredentialOptionsRegistration -> String
$cshow :: IDLCredentialOptionsRegistration -> String
showsPrec :: Int -> IDLCredentialOptionsRegistration -> ShowS
$cshowsPrec :: Int -> IDLCredentialOptionsRegistration -> ShowS
Show, IDLCredentialOptionsRegistration
-> IDLCredentialOptionsRegistration -> Bool
(IDLCredentialOptionsRegistration
 -> IDLCredentialOptionsRegistration -> Bool)
-> (IDLCredentialOptionsRegistration
    -> IDLCredentialOptionsRegistration -> Bool)
-> Eq IDLCredentialOptionsRegistration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IDLCredentialOptionsRegistration
-> IDLCredentialOptionsRegistration -> Bool
$c/= :: IDLCredentialOptionsRegistration
-> IDLCredentialOptionsRegistration -> Bool
== :: IDLCredentialOptionsRegistration
-> IDLCredentialOptionsRegistration -> Bool
$c== :: IDLCredentialOptionsRegistration
-> IDLCredentialOptionsRegistration -> Bool
Eq, [IDLCredentialOptionsRegistration] -> Encoding
[IDLCredentialOptionsRegistration] -> Value
IDLCredentialOptionsRegistration -> Encoding
IDLCredentialOptionsRegistration -> Value
(IDLCredentialOptionsRegistration -> Value)
-> (IDLCredentialOptionsRegistration -> Encoding)
-> ([IDLCredentialOptionsRegistration] -> Value)
-> ([IDLCredentialOptionsRegistration] -> Encoding)
-> ToJSON IDLCredentialOptionsRegistration
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [IDLCredentialOptionsRegistration] -> Encoding
$ctoEncodingList :: [IDLCredentialOptionsRegistration] -> Encoding
toJSONList :: [IDLCredentialOptionsRegistration] -> Value
$ctoJSONList :: [IDLCredentialOptionsRegistration] -> Value
toEncoding :: IDLCredentialOptionsRegistration -> Encoding
$ctoEncoding :: IDLCredentialOptionsRegistration -> Encoding
toJSON :: IDLCredentialOptionsRegistration -> Value
$ctoJSON :: IDLCredentialOptionsRegistration -> Value
ToJSON)

-- | The intermediate type as an input to 'decodeCredentialRegistration',
-- equivalent to the [PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#iface-pkcredential)
-- interface with the response being an
-- [AuthenticatorAttestationResponse](https://www.w3.org/TR/webauthn-2/#authenticatorattestationresponse).
newtype IDLCredentialRegistration = IDLCredentialRegistration
  { IDLCredentialRegistration
-> PublicKeyCredential AuthenticatorAttestationResponse
unIDLCredentialRegistration :: IDL.PublicKeyCredential IDL.AuthenticatorAttestationResponse
  }
  deriving newtype (Int -> IDLCredentialRegistration -> ShowS
[IDLCredentialRegistration] -> ShowS
IDLCredentialRegistration -> String
(Int -> IDLCredentialRegistration -> ShowS)
-> (IDLCredentialRegistration -> String)
-> ([IDLCredentialRegistration] -> ShowS)
-> Show IDLCredentialRegistration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IDLCredentialRegistration] -> ShowS
$cshowList :: [IDLCredentialRegistration] -> ShowS
show :: IDLCredentialRegistration -> String
$cshow :: IDLCredentialRegistration -> String
showsPrec :: Int -> IDLCredentialRegistration -> ShowS
$cshowsPrec :: Int -> IDLCredentialRegistration -> ShowS
Show, IDLCredentialRegistration -> IDLCredentialRegistration -> Bool
(IDLCredentialRegistration -> IDLCredentialRegistration -> Bool)
-> (IDLCredentialRegistration -> IDLCredentialRegistration -> Bool)
-> Eq IDLCredentialRegistration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IDLCredentialRegistration -> IDLCredentialRegistration -> Bool
$c/= :: IDLCredentialRegistration -> IDLCredentialRegistration -> Bool
== :: IDLCredentialRegistration -> IDLCredentialRegistration -> Bool
$c== :: IDLCredentialRegistration -> IDLCredentialRegistration -> Bool
Eq, Value -> Parser [IDLCredentialRegistration]
Value -> Parser IDLCredentialRegistration
(Value -> Parser IDLCredentialRegistration)
-> (Value -> Parser [IDLCredentialRegistration])
-> FromJSON IDLCredentialRegistration
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [IDLCredentialRegistration]
$cparseJSONList :: Value -> Parser [IDLCredentialRegistration]
parseJSON :: Value -> Parser IDLCredentialRegistration
$cparseJSON :: Value -> Parser IDLCredentialRegistration
FromJSON, [IDLCredentialRegistration] -> Encoding
[IDLCredentialRegistration] -> Value
IDLCredentialRegistration -> Encoding
IDLCredentialRegistration -> Value
(IDLCredentialRegistration -> Value)
-> (IDLCredentialRegistration -> Encoding)
-> ([IDLCredentialRegistration] -> Value)
-> ([IDLCredentialRegistration] -> Encoding)
-> ToJSON IDLCredentialRegistration
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [IDLCredentialRegistration] -> Encoding
$ctoEncodingList :: [IDLCredentialRegistration] -> Encoding
toJSONList :: [IDLCredentialRegistration] -> Value
$ctoJSONList :: [IDLCredentialRegistration] -> Value
toEncoding :: IDLCredentialRegistration -> Encoding
$ctoEncoding :: IDLCredentialRegistration -> Encoding
toJSON :: IDLCredentialRegistration -> Value
$ctoJSON :: IDLCredentialRegistration -> Value
ToJSON)

-- | Decodes the intermediate 'IDLCredentialRegistration' type which can be
-- parsed with 'Data.Aeson.fromJSON' from the result of
-- [webauthn-json](https://github.com/github/webauthn-json)'s
-- [@create()@](https://github.com/github/webauthn-json#api) (or equivalent)
-- function, to a @'T.Credential' 'K.Registration'@. This is the continuation
-- of 'encodeCredentialOptionsRegistration'.
decodeCredentialRegistration ::
  -- | The [attestation statement formats](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats)
  -- that should be supported. The value of 'Crypto.WebAuthn.allSupportedFormats'
  -- can be passed here, but additional or custom formats may also be used if needed
  T.SupportedAttestationStatementFormats ->
  IDLCredentialRegistration ->
  Either Text (T.Credential 'K.Registration 'True)
decodeCredentialRegistration :: SupportedAttestationStatementFormats
-> IDLCredentialRegistration
-> Either Text (Credential 'Registration 'True)
decodeCredentialRegistration SupportedAttestationStatementFormats
supportedFormats = SupportedAttestationStatementFormats
-> IDL (Credential 'Registration 'True)
-> Either Text (Credential 'Registration 'True)
forall a.
DecodeCreated a =>
SupportedAttestationStatementFormats -> IDL a -> Either Text a
decodeCreated SupportedAttestationStatementFormats
supportedFormats (PublicKeyCredential AuthenticatorAttestationResponse
 -> Either Text (Credential 'Registration 'True))
-> (IDLCredentialRegistration
    -> PublicKeyCredential AuthenticatorAttestationResponse)
-> IDLCredentialRegistration
-> Either Text (Credential 'Registration 'True)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IDLCredentialRegistration
-> PublicKeyCredential AuthenticatorAttestationResponse
unIDLCredentialRegistration

-- | Encodes a @'T.CredentialOptions' 'K.Authentication'@, which is needed for the
-- [authentication ceremony](https://www.w3.org/TR/webauthn-2/#authentication). The
-- resulting type from this function can be encoded using 'Data.Aeson.toJSON',
-- sent as a response, received by the Relying Party script, parsed as JSON,
-- and passed directly as the [@publicKey@](https://www.w3.org/TR/webauthn-2/#dom-credentialrequestoptions-publickey)
-- field in the argument to the [@navigator.credentials.get()@](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)
-- function.
encodeCredentialOptionsAuthentication ::
  T.CredentialOptions 'K.Authentication ->
  IDLCredentialOptionsAuthentication
encodeCredentialOptionsAuthentication :: CredentialOptions 'Authentication
-> IDLCredentialOptionsAuthentication
encodeCredentialOptionsAuthentication = PublicKeyCredentialRequestOptions
-> IDLCredentialOptionsAuthentication
IDLCredentialOptionsAuthentication (PublicKeyCredentialRequestOptions
 -> IDLCredentialOptionsAuthentication)
-> (CredentialOptions 'Authentication
    -> PublicKeyCredentialRequestOptions)
-> CredentialOptions 'Authentication
-> IDLCredentialOptionsAuthentication
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CredentialOptions 'Authentication
-> PublicKeyCredentialRequestOptions
forall a. Encode a => a -> IDL a
encode

-- | The intermediate type returned by 'encodeCredentialOptionsAuthentication',
-- equivalent to the [@PublicKeyCredentialRequestOptions@](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialrequestoptions) dictionary
newtype IDLCredentialOptionsAuthentication = IDLCredentialOptionsAuthentication
  { IDLCredentialOptionsAuthentication
-> PublicKeyCredentialRequestOptions
_unIDLCredentialOptionsAuthentication :: IDL.PublicKeyCredentialRequestOptions
  }
  deriving newtype (Int -> IDLCredentialOptionsAuthentication -> ShowS
[IDLCredentialOptionsAuthentication] -> ShowS
IDLCredentialOptionsAuthentication -> String
(Int -> IDLCredentialOptionsAuthentication -> ShowS)
-> (IDLCredentialOptionsAuthentication -> String)
-> ([IDLCredentialOptionsAuthentication] -> ShowS)
-> Show IDLCredentialOptionsAuthentication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IDLCredentialOptionsAuthentication] -> ShowS
$cshowList :: [IDLCredentialOptionsAuthentication] -> ShowS
show :: IDLCredentialOptionsAuthentication -> String
$cshow :: IDLCredentialOptionsAuthentication -> String
showsPrec :: Int -> IDLCredentialOptionsAuthentication -> ShowS
$cshowsPrec :: Int -> IDLCredentialOptionsAuthentication -> ShowS
Show, IDLCredentialOptionsAuthentication
-> IDLCredentialOptionsAuthentication -> Bool
(IDLCredentialOptionsAuthentication
 -> IDLCredentialOptionsAuthentication -> Bool)
-> (IDLCredentialOptionsAuthentication
    -> IDLCredentialOptionsAuthentication -> Bool)
-> Eq IDLCredentialOptionsAuthentication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IDLCredentialOptionsAuthentication
-> IDLCredentialOptionsAuthentication -> Bool
$c/= :: IDLCredentialOptionsAuthentication
-> IDLCredentialOptionsAuthentication -> Bool
== :: IDLCredentialOptionsAuthentication
-> IDLCredentialOptionsAuthentication -> Bool
$c== :: IDLCredentialOptionsAuthentication
-> IDLCredentialOptionsAuthentication -> Bool
Eq, [IDLCredentialOptionsAuthentication] -> Encoding
[IDLCredentialOptionsAuthentication] -> Value
IDLCredentialOptionsAuthentication -> Encoding
IDLCredentialOptionsAuthentication -> Value
(IDLCredentialOptionsAuthentication -> Value)
-> (IDLCredentialOptionsAuthentication -> Encoding)
-> ([IDLCredentialOptionsAuthentication] -> Value)
-> ([IDLCredentialOptionsAuthentication] -> Encoding)
-> ToJSON IDLCredentialOptionsAuthentication
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [IDLCredentialOptionsAuthentication] -> Encoding
$ctoEncodingList :: [IDLCredentialOptionsAuthentication] -> Encoding
toJSONList :: [IDLCredentialOptionsAuthentication] -> Value
$ctoJSONList :: [IDLCredentialOptionsAuthentication] -> Value
toEncoding :: IDLCredentialOptionsAuthentication -> Encoding
$ctoEncoding :: IDLCredentialOptionsAuthentication -> Encoding
toJSON :: IDLCredentialOptionsAuthentication -> Value
$ctoJSON :: IDLCredentialOptionsAuthentication -> Value
ToJSON)

-- | The intermediate type as an input to 'decodeCredentialAuthentication',
-- equivalent to the [PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#iface-pkcredential)
-- interface with the response being an
-- [AuthenticatorAssertionResponse](https://www.w3.org/TR/webauthn-2/#authenticatorassertionresponse).
newtype IDLCredentialAuthentication = IDLCredentialAuthentication
  { IDLCredentialAuthentication
-> PublicKeyCredential AuthenticatorAssertionResponse
unIDLCredentialAuthentication :: IDL.PublicKeyCredential IDL.AuthenticatorAssertionResponse
  }
  deriving newtype (Int -> IDLCredentialAuthentication -> ShowS
[IDLCredentialAuthentication] -> ShowS
IDLCredentialAuthentication -> String
(Int -> IDLCredentialAuthentication -> ShowS)
-> (IDLCredentialAuthentication -> String)
-> ([IDLCredentialAuthentication] -> ShowS)
-> Show IDLCredentialAuthentication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IDLCredentialAuthentication] -> ShowS
$cshowList :: [IDLCredentialAuthentication] -> ShowS
show :: IDLCredentialAuthentication -> String
$cshow :: IDLCredentialAuthentication -> String
showsPrec :: Int -> IDLCredentialAuthentication -> ShowS
$cshowsPrec :: Int -> IDLCredentialAuthentication -> ShowS
Show, IDLCredentialAuthentication -> IDLCredentialAuthentication -> Bool
(IDLCredentialAuthentication
 -> IDLCredentialAuthentication -> Bool)
-> (IDLCredentialAuthentication
    -> IDLCredentialAuthentication -> Bool)
-> Eq IDLCredentialAuthentication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IDLCredentialAuthentication -> IDLCredentialAuthentication -> Bool
$c/= :: IDLCredentialAuthentication -> IDLCredentialAuthentication -> Bool
== :: IDLCredentialAuthentication -> IDLCredentialAuthentication -> Bool
$c== :: IDLCredentialAuthentication -> IDLCredentialAuthentication -> Bool
Eq, Value -> Parser [IDLCredentialAuthentication]
Value -> Parser IDLCredentialAuthentication
(Value -> Parser IDLCredentialAuthentication)
-> (Value -> Parser [IDLCredentialAuthentication])
-> FromJSON IDLCredentialAuthentication
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [IDLCredentialAuthentication]
$cparseJSONList :: Value -> Parser [IDLCredentialAuthentication]
parseJSON :: Value -> Parser IDLCredentialAuthentication
$cparseJSON :: Value -> Parser IDLCredentialAuthentication
FromJSON, [IDLCredentialAuthentication] -> Encoding
[IDLCredentialAuthentication] -> Value
IDLCredentialAuthentication -> Encoding
IDLCredentialAuthentication -> Value
(IDLCredentialAuthentication -> Value)
-> (IDLCredentialAuthentication -> Encoding)
-> ([IDLCredentialAuthentication] -> Value)
-> ([IDLCredentialAuthentication] -> Encoding)
-> ToJSON IDLCredentialAuthentication
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [IDLCredentialAuthentication] -> Encoding
$ctoEncodingList :: [IDLCredentialAuthentication] -> Encoding
toJSONList :: [IDLCredentialAuthentication] -> Value
$ctoJSONList :: [IDLCredentialAuthentication] -> Value
toEncoding :: IDLCredentialAuthentication -> Encoding
$ctoEncoding :: IDLCredentialAuthentication -> Encoding
toJSON :: IDLCredentialAuthentication -> Value
$ctoJSON :: IDLCredentialAuthentication -> Value
ToJSON)

-- | Decodes a 'IDL.RequestedPublicKeyCredential' result, corresponding to the
-- [@PublicKeyCredential@ interface](https://www.w3.org/TR/webauthn-2/#iface-pkcredential)
-- as returned by the [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)
-- method while [Verifying an Authentication Assertion](https://www.w3.org/TR/webauthn-2/#sctn-verifying-assertion)
--
-- | Decodes the intermediate 'IDLCredentialAuthentication' type which can be
-- parsed with 'Data.Aeson.fromJSON' from the result of
-- [webauthn-json](https://github.com/github/webauthn-json)'s
-- [@get()@](https://github.com/github/webauthn-json#api) (or equivalent)
-- function, to a @'T.Credential' 'K.Authentication' True@. This is the continuation
-- of 'encodeCredentialOptionsAuthentication'
decodeCredentialAuthentication ::
  IDLCredentialAuthentication ->
  Either Text (T.Credential 'K.Authentication 'True)
decodeCredentialAuthentication :: IDLCredentialAuthentication
-> Either Text (Credential 'Authentication 'True)
decodeCredentialAuthentication = PublicKeyCredential AuthenticatorAssertionResponse
-> Either Text (Credential 'Authentication 'True)
forall a. Decode a => IDL a -> Either Text a
decode (PublicKeyCredential AuthenticatorAssertionResponse
 -> Either Text (Credential 'Authentication 'True))
-> (IDLCredentialAuthentication
    -> PublicKeyCredential AuthenticatorAssertionResponse)
-> IDLCredentialAuthentication
-> Either Text (Credential 'Authentication 'True)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IDLCredentialAuthentication
-> PublicKeyCredential AuthenticatorAssertionResponse
unIDLCredentialAuthentication