{-# 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
/= :: AAGUID -> AAGUID -> Bool
$c/= :: AAGUID -> AAGUID -> Bool
== :: AAGUID -> AAGUID -> Bool
$c== :: 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
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
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
hash :: AAGUID -> Int
$chash :: AAGUID -> Int
hashWithSalt :: Int -> AAGUID -> Int
$chashWithSalt :: Int -> AAGUID -> Int
$cp1Hashable :: Eq AAGUID
Hashable, [AAGUID] -> Encoding
[AAGUID] -> Value
AAGUID -> Encoding
AAGUID -> Value
(AAGUID -> Value)
-> (AAGUID -> Encoding)
-> ([AAGUID] -> Value)
-> ([AAGUID] -> Encoding)
-> ToJSON AAGUID
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)
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
.= Text -> Value
String Text
"AuthenticatorIdentifierFido2",
Key
"idAaguid" Key -> AAGUID -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AAGUID
aaguid
]
toJSON (AuthenticatorIdentifierFidoU2F SubjectKeyIdentifier
subjectKeyIdentifier) =
[Pair] -> Value
object
[ Key
"tag" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AuthenticatorIdentifierFidoU2F",
Key
"idSubjectKeyIdentifier" Key -> SubjectKeyIdentifier -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= 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
/= :: SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool
$c/= :: SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool
== :: SubjectKeyIdentifier -> SubjectKeyIdentifier -> Bool
$c== :: 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
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 = ToJSON ByteString => ByteString -> Value
forall a. ToJSON a => a -> Value
toJSON @BS.ByteString (ByteString -> Value)
-> (SubjectKeyIdentifier -> ByteString)
-> SubjectKeyIdentifier
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
instance Hashable SubjectKeyIdentifier where
hashWithSalt :: Int -> SubjectKeyIdentifier -> Int
hashWithSalt = (SubjectKeyIdentifier -> ByteString)
-> Int -> SubjectKeyIdentifier -> Int
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)