{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}

-- | Stability: experimental
-- This module concerns identification of authenticatiors, notably 'AAGUID',
-- 'SubjectKeyIdentifier' and a generic identifier type 'AuthenticatorIdentifier'
module Crypto.WebAuthn.Model.Identifier
  ( AuthenticatorIdentifier (..),
    AAGUID (..),
    SubjectKeyIdentifier (..),
  )
where

import Crypto.Hash (Digest, SHA1)
import Crypto.WebAuthn.Internal.ToJSONOrphans ()
import qualified Crypto.WebAuthn.Model.Kinds as M
import Data.Aeson (KeyValue ((.=)), ToJSON (toJSON), Value (String), object)
import Data.ByteArray (convert)
import qualified Data.ByteString as BS
import Data.Hashable (Hashable (hashWithSalt), hashUsing)
import Data.UUID (UUID)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#aaguid)
newtype AAGUID = AAGUID {AAGUID -> UUID
unAAGUID :: UUID}
  deriving (AAGUID -> AAGUID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AAGUID -> AAGUID -> Bool
$c/= :: AAGUID -> AAGUID -> Bool
== :: AAGUID -> AAGUID -> Bool
$c== :: AAGUID -> AAGUID -> Bool
Eq, Int -> AAGUID -> ShowS
[AAGUID] -> ShowS
AAGUID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AAGUID] -> ShowS
$cshowList :: [AAGUID] -> ShowS
show :: AAGUID -> String
$cshow :: AAGUID -> String
showsPrec :: Int -> AAGUID -> ShowS
$cshowsPrec :: Int -> AAGUID -> ShowS
Show)
  deriving newtype (Eq AAGUID
Int -> AAGUID -> Int
AAGUID -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: AAGUID -> Int
$chash :: AAGUID -> Int
hashWithSalt :: Int -> AAGUID -> Int
$chashWithSalt :: Int -> AAGUID -> Int
Hashable, [AAGUID] -> Encoding
[AAGUID] -> Value
AAGUID -> Encoding
AAGUID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AAGUID] -> Encoding
$ctoEncodingList :: [AAGUID] -> Encoding
toJSONList :: [AAGUID] -> Value
$ctoJSONList :: [AAGUID] -> Value
toEncoding :: AAGUID -> Encoding
$ctoEncoding :: AAGUID -> Encoding
toJSON :: AAGUID -> Value
$ctoJSON :: AAGUID -> Value
ToJSON)

-- | A way to identify an authenticator
data AuthenticatorIdentifier (p :: M.ProtocolKind) where
  -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-aaguid)
  -- A known FIDO2 [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator),
  -- identified by a 'AAGUID'. Note that the 'AAGUID' may be zero, meaning that
  -- we were able to verify that the [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential).
  -- was generated by a trusted [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator),
  -- but we don't know which model it is.
  AuthenticatorIdentifierFido2 ::
    {AuthenticatorIdentifier 'Fido2 -> AAGUID
idAaguid :: AAGUID} ->
    AuthenticatorIdentifier 'M.Fido2
  -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationcertificatekeyidentifiers)
  -- A known FIDO U2F [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator),
  -- identified by a 'SubjectKeyIdentifier'. Clients that don't implement CTAP2
  -- (which is used to communicate with FIDO2 authenticators) will use U2F to
  -- communicate with the authenticator instead, which doesn't have support for 'AAGUID's.
  AuthenticatorIdentifierFidoU2F ::
    {AuthenticatorIdentifier 'FidoU2F -> SubjectKeyIdentifier
idSubjectKeyIdentifier :: SubjectKeyIdentifier} ->
    AuthenticatorIdentifier 'M.FidoU2F

deriving instance Show (AuthenticatorIdentifier p)

deriving instance Eq (AuthenticatorIdentifier p)

instance ToJSON (AuthenticatorIdentifier p) where
  toJSON :: AuthenticatorIdentifier p -> Value
toJSON (AuthenticatorIdentifierFido2 AAGUID
aaguid) =
    [Pair] -> Value
object
      [ Key
"tag" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AuthenticatorIdentifierFido2",
        Key
"idAaguid" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AAGUID
aaguid
      ]
  toJSON (AuthenticatorIdentifierFidoU2F SubjectKeyIdentifier
subjectKeyIdentifier) =
    [Pair] -> Value
object
      [ Key
"tag" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AuthenticatorIdentifierFidoU2F",
        Key
"idSubjectKeyIdentifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SubjectKeyIdentifier
subjectKeyIdentifier
      ]

-- | [(spec)](https://datatracker.ietf.org/doc/html/rfc5280#section-4.2.1.2)
-- This type represents method 1 of computing the identifier, as used in the
-- [attestationCertificateKeyIdentifiers](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-attestationcertificatekeyidentifiers)
-- field of the [Metadata Service](https://fidoalliance.org/metadata/)
newtype SubjectKeyIdentifier = SubjectKeyIdentifier {SubjectKeyIdentifier -> Digest SHA1
unSubjectKeyIdentifier :: Digest SHA1}
  deriving (SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool
$c/= :: SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool
== :: SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool
$c== :: SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool
Eq, Int -> SubjectKeyIdentifier -> ShowS
[SubjectKeyIdentifier] -> ShowS
SubjectKeyIdentifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubjectKeyIdentifier] -> ShowS
$cshowList :: [SubjectKeyIdentifier] -> ShowS
show :: SubjectKeyIdentifier -> String
$cshow :: SubjectKeyIdentifier -> String
showsPrec :: Int -> SubjectKeyIdentifier -> ShowS
$cshowsPrec :: Int -> SubjectKeyIdentifier -> ShowS
Show)

instance ToJSON SubjectKeyIdentifier where
  toJSON :: SubjectKeyIdentifier -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON @BS.ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubjectKeyIdentifier -> Digest SHA1
unSubjectKeyIdentifier

instance Hashable SubjectKeyIdentifier where
  hashWithSalt :: Int -> SubjectKeyIdentifier -> Int
hashWithSalt = forall b a. Hashable b => (a -> b) -> Int -> a -> Int
hashUsing @BS.ByteString (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubjectKeyIdentifier -> Digest SHA1
unSubjectKeyIdentifier)