{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
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)
newtype AAGUID = AAGUID {AAGUID -> UUID
unAAGUID :: UUID}
deriving (AAGUID -> AAGUID -> Bool
(AAGUID -> AAGUID -> Bool)
-> (AAGUID -> AAGUID -> Bool) -> Eq AAGUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AAGUID -> AAGUID -> Bool
== :: AAGUID -> AAGUID -> Bool
$c/= :: AAGUID -> AAGUID -> Bool
/= :: AAGUID -> AAGUID -> Bool
Eq, Int -> AAGUID -> ShowS
[AAGUID] -> ShowS
AAGUID -> String
(Int -> AAGUID -> ShowS)
-> (AAGUID -> String) -> ([AAGUID] -> ShowS) -> Show AAGUID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AAGUID -> ShowS
showsPrec :: Int -> AAGUID -> ShowS
$cshow :: AAGUID -> String
show :: AAGUID -> String
$cshowList :: [AAGUID] -> ShowS
showList :: [AAGUID] -> ShowS
Show)
deriving newtype (Eq AAGUID
Eq AAGUID
-> (Int -> AAGUID -> Int) -> (AAGUID -> Int) -> Hashable AAGUID
Int -> AAGUID -> Int
AAGUID -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> AAGUID -> Int
hashWithSalt :: Int -> AAGUID -> Int
$chash :: AAGUID -> Int
hash :: AAGUID -> Int
Hashable)
deriving newtype instance ToJSON AAGUID
data AuthenticatorIdentifier (p :: M.ProtocolKind) where
AuthenticatorIdentifierFido2 ::
{AuthenticatorIdentifier 'Fido2 -> AAGUID
idAaguid :: AAGUID} ->
AuthenticatorIdentifier 'M.Fido2
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" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"AuthenticatorIdentifierFido2",
Key
"idAaguid" Key -> AAGUID -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AAGUID
aaguid
]
toJSON (AuthenticatorIdentifierFidoU2F SubjectKeyIdentifier
subjectKeyIdentifier) =
[Pair] -> Value
object
[ Key
"tag" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"AuthenticatorIdentifierFidoU2F",
Key
"idSubjectKeyIdentifier" Key -> SubjectKeyIdentifier -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SubjectKeyIdentifier
subjectKeyIdentifier
]
newtype SubjectKeyIdentifier = SubjectKeyIdentifier {SubjectKeyIdentifier -> Digest SHA1
unSubjectKeyIdentifier :: Digest SHA1}
deriving (SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool
(SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool)
-> (SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool)
-> Eq SubjectKeyIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool
== :: SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool
$c/= :: SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool
/= :: SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool
Eq, Int -> SubjectKeyIdentifier -> ShowS
[SubjectKeyIdentifier] -> ShowS
SubjectKeyIdentifier -> String
(Int -> SubjectKeyIdentifier -> ShowS)
-> (SubjectKeyIdentifier -> String)
-> ([SubjectKeyIdentifier] -> ShowS)
-> Show SubjectKeyIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubjectKeyIdentifier -> ShowS
showsPrec :: Int -> SubjectKeyIdentifier -> ShowS
$cshow :: SubjectKeyIdentifier -> String
show :: SubjectKeyIdentifier -> String
$cshowList :: [SubjectKeyIdentifier] -> ShowS
showList :: [SubjectKeyIdentifier] -> ShowS
Show)
deriving newtype instance ToJSON SubjectKeyIdentifier
instance Hashable SubjectKeyIdentifier where
hashWithSalt :: Int -> SubjectKeyIdentifier -> Int
hashWithSalt = forall b a. Hashable b => (a -> b) -> Int -> a -> Int
hashUsing @BS.ByteString (Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Digest SHA1 -> ByteString)
-> (SubjectKeyIdentifier -> Digest SHA1)
-> SubjectKeyIdentifier
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubjectKeyIdentifier -> Digest SHA1
unSubjectKeyIdentifier)