{-# LANGUAGE TypeFamilies #-}

-- | Stability: experimental
-- This module implements the
-- [None Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-none-attestation).
-- Note that this attestation statement format is currently not registered in the
-- [WebAuthn Attestation Statement Format Identifiers IANA registry](https://www.iana.org/assignments/webauthn/webauthn.xhtml#webauthn-attestation-statement-format-ids).
module Crypto.WebAuthn.AttestationStatementFormat.None
  ( format,
    Format (..),
  )
where

import qualified Codec.CBOR.Term as CBOR
import qualified Crypto.WebAuthn.Model.Types as M
import qualified Data.Text as Text
import Data.Void (Void)

-- | The None format. The sole purpose of this type is to instantiate the
-- AttestationStatementFormat typeclass below.
data Format = Format

instance Show Format where
  show :: Format -> String
show = Text -> String
Text.unpack (Text -> String) -> (Format -> Text) -> Format -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text
forall a. AttestationStatementFormat a => a -> Text
M.asfIdentifier

instance M.AttestationStatementFormat Format where
  type AttStmt Format = ()
  asfIdentifier :: Format -> Text
asfIdentifier Format
_ = Text
"none"

  asfDecode :: Format -> HashMap Text Term -> Either Text (AttStmt Format)
asfDecode Format
_ HashMap Text Term
_ = () -> Either Text ()
forall a b. b -> Either a b
Right ()
  asfEncode :: Format -> AttStmt Format -> Term
asfEncode Format
_ AttStmt Format
_ = [(Term, Term)] -> Term
CBOR.TMap []

  type AttStmtVerificationError Format = Void
  asfVerify :: Format
-> DateTime
-> AttStmt Format
-> AuthenticatorData 'Registration 'True
-> ClientDataHash
-> Validation
     (NonEmpty (AttStmtVerificationError Format)) SomeAttestationType
asfVerify Format
_ DateTime
_ AttStmt Format
_ AuthenticatorData 'Registration 'True
_ ClientDataHash
_ = SomeAttestationType
-> Validation (NonEmpty Void) SomeAttestationType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeAttestationType
 -> Validation (NonEmpty Void) SomeAttestationType)
-> SomeAttestationType
-> Validation (NonEmpty Void) SomeAttestationType
forall a b. (a -> b) -> a -> b
$ AttestationType 'Unverifiable -> SomeAttestationType
forall (k :: AttestationKind).
AttestationType k -> SomeAttestationType
M.SomeAttestationType AttestationType 'Unverifiable
M.AttestationTypeNone

  asfTrustAnchors :: Format -> VerifiableAttestationType -> CertificateStore
asfTrustAnchors Format
_ VerifiableAttestationType
_ = CertificateStore
forall a. Monoid a => a
mempty

-- | Helper function that wraps the None format into the general
-- SomeAttestationStatementFormat type.
format :: M.SomeAttestationStatementFormat
format :: SomeAttestationStatementFormat
format = Format -> SomeAttestationStatementFormat
forall a.
AttestationStatementFormat a =>
a -> SomeAttestationStatementFormat
M.SomeAttestationStatementFormat Format
Format