{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Crypto.WebAuthn.AttestationStatementFormat.TPM
( format,
Format (..),
VerificationError (..),
TPMAlgId (..),
)
where
import qualified Codec.CBOR.Term as CBOR
import Control.Exception (Exception)
import Control.Monad (forM, unless, when)
import Crypto.Hash (SHA1 (SHA1), SHA256 (SHA256), hashWith)
import qualified Crypto.Hash as Hash
import Crypto.Number.Serialize (os2ip)
import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose
import qualified Crypto.WebAuthn.Cose.PublicKey as Cose
import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose
import qualified Crypto.WebAuthn.Cose.SignAlg as Cose
import Crypto.WebAuthn.Internal.ToJSONOrphans (PrettyHexByteString (PrettyHexByteString))
import Crypto.WebAuthn.Internal.Utils (IdFidoGenCeAAGUID (IdFidoGenCeAAGUID), failure)
import Crypto.WebAuthn.Model.Identifier (AAGUID)
import qualified Crypto.WebAuthn.Model.Types as M
import Data.ASN1.Error (ASN1Error)
import Data.ASN1.OID (OID)
import Data.ASN1.Parse (ParseASN1, getNext, hasNext, runParseASN1)
import Data.ASN1.Prim (ASN1 (ASN1String, OID))
import Data.Aeson (ToJSON, Value (String), object, toJSON, (.=))
import Data.Bifunctor (Bifunctor (first))
import Data.Binary (Word16, Word32, Word64)
import qualified Data.Binary.Get as Get
import qualified Data.Binary.Put as Put
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.FileEmbed (embedDir)
import Data.HashMap.Strict ((!?))
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8)
import qualified Data.X509 as X509
import qualified Data.X509.CertificateStore as X509
import GHC.Generics (Generic)
tpmManufacturers :: Set.Set Text
tpmManufacturers :: Set Text
tpmManufacturers =
[Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
[ Text
"id:FFFFF1D0",
Text
"id:414D4400",
Text
"id:41544D4C",
Text
"id:4252434D",
Text
"id:4353434F",
Text
"id:464C5953",
Text
"id:48504500",
Text
"id:49424d00",
Text
"id:49465800",
Text
"id:494E5443",
Text
"id:4C454E00",
Text
"id:4D534654",
Text
"id:4E534D20",
Text
"id:4E545A00",
Text
"id:4E544300",
Text
"id:51434F4D",
Text
"id:534D5343",
Text
"id:53544D20",
Text
"id:534D534E",
Text
"id:534E5300",
Text
"id:54584E00",
Text
"id:57454300",
Text
"id:524F4343",
Text
"id:474F4F47"
]
data TPMAlgId = TPMAlgRSA | TPMAlgSHA1 | TPMAlgSHA256 | TPMAlgECC
deriving (Int -> TPMAlgId -> ShowS
[TPMAlgId] -> ShowS
TPMAlgId -> [Char]
(Int -> TPMAlgId -> ShowS)
-> (TPMAlgId -> [Char]) -> ([TPMAlgId] -> ShowS) -> Show TPMAlgId
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TPMAlgId -> ShowS
showsPrec :: Int -> TPMAlgId -> ShowS
$cshow :: TPMAlgId -> [Char]
show :: TPMAlgId -> [Char]
$cshowList :: [TPMAlgId] -> ShowS
showList :: [TPMAlgId] -> ShowS
Show, TPMAlgId -> TPMAlgId -> Bool
(TPMAlgId -> TPMAlgId -> Bool)
-> (TPMAlgId -> TPMAlgId -> Bool) -> Eq TPMAlgId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TPMAlgId -> TPMAlgId -> Bool
== :: TPMAlgId -> TPMAlgId -> Bool
$c/= :: TPMAlgId -> TPMAlgId -> Bool
/= :: TPMAlgId -> TPMAlgId -> Bool
Eq, (forall x. TPMAlgId -> Rep TPMAlgId x)
-> (forall x. Rep TPMAlgId x -> TPMAlgId) -> Generic TPMAlgId
forall x. Rep TPMAlgId x -> TPMAlgId
forall x. TPMAlgId -> Rep TPMAlgId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TPMAlgId -> Rep TPMAlgId x
from :: forall x. TPMAlgId -> Rep TPMAlgId x
$cto :: forall x. Rep TPMAlgId x -> TPMAlgId
to :: forall x. Rep TPMAlgId x -> TPMAlgId
Generic, [TPMAlgId] -> Value
[TPMAlgId] -> Encoding
TPMAlgId -> Value
TPMAlgId -> Encoding
(TPMAlgId -> Value)
-> (TPMAlgId -> Encoding)
-> ([TPMAlgId] -> Value)
-> ([TPMAlgId] -> Encoding)
-> ToJSON TPMAlgId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TPMAlgId -> Value
toJSON :: TPMAlgId -> Value
$ctoEncoding :: TPMAlgId -> Encoding
toEncoding :: TPMAlgId -> Encoding
$ctoJSONList :: [TPMAlgId] -> Value
toJSONList :: [TPMAlgId] -> Value
$ctoEncodingList :: [TPMAlgId] -> Encoding
toEncodingList :: [TPMAlgId] -> Encoding
ToJSON)
toTPMAlgId :: (MonadFail m) => Word16 -> m TPMAlgId
toTPMAlgId :: forall (m :: * -> *). MonadFail m => Word16 -> m TPMAlgId
toTPMAlgId Word16
0x0001 = TPMAlgId -> m TPMAlgId
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TPMAlgId
TPMAlgRSA
toTPMAlgId Word16
0x0004 = TPMAlgId -> m TPMAlgId
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TPMAlgId
TPMAlgSHA1
toTPMAlgId Word16
0x000B = TPMAlgId -> m TPMAlgId
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TPMAlgId
TPMAlgSHA256
toTPMAlgId Word16
0x0023 = TPMAlgId -> m TPMAlgId
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TPMAlgId
TPMAlgECC
toTPMAlgId Word16
_ = [Char] -> m TPMAlgId
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Unsupported or invalid TPM_ALD_IG"
toCurveId :: (MonadFail m) => Word16 -> m Cose.CoseCurveECDSA
toCurveId :: forall (m :: * -> *). MonadFail m => Word16 -> m CoseCurveECDSA
toCurveId Word16
0x0003 = CoseCurveECDSA -> m CoseCurveECDSA
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseCurveECDSA
Cose.CoseCurveP256
toCurveId Word16
0x0004 = CoseCurveECDSA -> m CoseCurveECDSA
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseCurveECDSA
Cose.CoseCurveP384
toCurveId Word16
0x0005 = CoseCurveECDSA -> m CoseCurveECDSA
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseCurveECDSA
Cose.CoseCurveP521
toCurveId Word16
_ = [Char] -> m CoseCurveECDSA
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Unsupported Curve ID"
tpmGeneratedValue :: Word32
tpmGeneratedValue :: Word32
tpmGeneratedValue = Word32
0xff544347
tpmStAttestCertify :: Word16
tpmStAttestCertify :: Word16
tpmStAttestCertify = Word16
0x8017
data TPMSClockInfo = TPMSClockInfo
{ TPMSClockInfo -> Word64
tpmsciClock :: Word64,
TPMSClockInfo -> Word32
tpmsciResetCount :: Word32,
TPMSClockInfo -> Word32
tpmsciRestartCount :: Word32,
TPMSClockInfo -> Bool
tpmsciSafe :: Bool
}
deriving (TPMSClockInfo -> TPMSClockInfo -> Bool
(TPMSClockInfo -> TPMSClockInfo -> Bool)
-> (TPMSClockInfo -> TPMSClockInfo -> Bool) -> Eq TPMSClockInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TPMSClockInfo -> TPMSClockInfo -> Bool
== :: TPMSClockInfo -> TPMSClockInfo -> Bool
$c/= :: TPMSClockInfo -> TPMSClockInfo -> Bool
/= :: TPMSClockInfo -> TPMSClockInfo -> Bool
Eq, Int -> TPMSClockInfo -> ShowS
[TPMSClockInfo] -> ShowS
TPMSClockInfo -> [Char]
(Int -> TPMSClockInfo -> ShowS)
-> (TPMSClockInfo -> [Char])
-> ([TPMSClockInfo] -> ShowS)
-> Show TPMSClockInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TPMSClockInfo -> ShowS
showsPrec :: Int -> TPMSClockInfo -> ShowS
$cshow :: TPMSClockInfo -> [Char]
show :: TPMSClockInfo -> [Char]
$cshowList :: [TPMSClockInfo] -> ShowS
showList :: [TPMSClockInfo] -> ShowS
Show, (forall x. TPMSClockInfo -> Rep TPMSClockInfo x)
-> (forall x. Rep TPMSClockInfo x -> TPMSClockInfo)
-> Generic TPMSClockInfo
forall x. Rep TPMSClockInfo x -> TPMSClockInfo
forall x. TPMSClockInfo -> Rep TPMSClockInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TPMSClockInfo -> Rep TPMSClockInfo x
from :: forall x. TPMSClockInfo -> Rep TPMSClockInfo x
$cto :: forall x. Rep TPMSClockInfo x -> TPMSClockInfo
to :: forall x. Rep TPMSClockInfo x -> TPMSClockInfo
Generic, [TPMSClockInfo] -> Value
[TPMSClockInfo] -> Encoding
TPMSClockInfo -> Value
TPMSClockInfo -> Encoding
(TPMSClockInfo -> Value)
-> (TPMSClockInfo -> Encoding)
-> ([TPMSClockInfo] -> Value)
-> ([TPMSClockInfo] -> Encoding)
-> ToJSON TPMSClockInfo
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TPMSClockInfo -> Value
toJSON :: TPMSClockInfo -> Value
$ctoEncoding :: TPMSClockInfo -> Encoding
toEncoding :: TPMSClockInfo -> Encoding
$ctoJSONList :: [TPMSClockInfo] -> Value
toJSONList :: [TPMSClockInfo] -> Value
$ctoEncodingList :: [TPMSClockInfo] -> Encoding
toEncodingList :: [TPMSClockInfo] -> Encoding
ToJSON)
data TPMSCertifyInfo = TPMSCertifyInfo
{ TPMSCertifyInfo -> PrettyHexByteString
tpmsciName :: PrettyHexByteString,
TPMSCertifyInfo -> PrettyHexByteString
tpmsciQualifiedName :: PrettyHexByteString
}
deriving (TPMSCertifyInfo -> TPMSCertifyInfo -> Bool
(TPMSCertifyInfo -> TPMSCertifyInfo -> Bool)
-> (TPMSCertifyInfo -> TPMSCertifyInfo -> Bool)
-> Eq TPMSCertifyInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TPMSCertifyInfo -> TPMSCertifyInfo -> Bool
== :: TPMSCertifyInfo -> TPMSCertifyInfo -> Bool
$c/= :: TPMSCertifyInfo -> TPMSCertifyInfo -> Bool
/= :: TPMSCertifyInfo -> TPMSCertifyInfo -> Bool
Eq, Int -> TPMSCertifyInfo -> ShowS
[TPMSCertifyInfo] -> ShowS
TPMSCertifyInfo -> [Char]
(Int -> TPMSCertifyInfo -> ShowS)
-> (TPMSCertifyInfo -> [Char])
-> ([TPMSCertifyInfo] -> ShowS)
-> Show TPMSCertifyInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TPMSCertifyInfo -> ShowS
showsPrec :: Int -> TPMSCertifyInfo -> ShowS
$cshow :: TPMSCertifyInfo -> [Char]
show :: TPMSCertifyInfo -> [Char]
$cshowList :: [TPMSCertifyInfo] -> ShowS
showList :: [TPMSCertifyInfo] -> ShowS
Show, (forall x. TPMSCertifyInfo -> Rep TPMSCertifyInfo x)
-> (forall x. Rep TPMSCertifyInfo x -> TPMSCertifyInfo)
-> Generic TPMSCertifyInfo
forall x. Rep TPMSCertifyInfo x -> TPMSCertifyInfo
forall x. TPMSCertifyInfo -> Rep TPMSCertifyInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TPMSCertifyInfo -> Rep TPMSCertifyInfo x
from :: forall x. TPMSCertifyInfo -> Rep TPMSCertifyInfo x
$cto :: forall x. Rep TPMSCertifyInfo x -> TPMSCertifyInfo
to :: forall x. Rep TPMSCertifyInfo x -> TPMSCertifyInfo
Generic, [TPMSCertifyInfo] -> Value
[TPMSCertifyInfo] -> Encoding
TPMSCertifyInfo -> Value
TPMSCertifyInfo -> Encoding
(TPMSCertifyInfo -> Value)
-> (TPMSCertifyInfo -> Encoding)
-> ([TPMSCertifyInfo] -> Value)
-> ([TPMSCertifyInfo] -> Encoding)
-> ToJSON TPMSCertifyInfo
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TPMSCertifyInfo -> Value
toJSON :: TPMSCertifyInfo -> Value
$ctoEncoding :: TPMSCertifyInfo -> Encoding
toEncoding :: TPMSCertifyInfo -> Encoding
$ctoJSONList :: [TPMSCertifyInfo] -> Value
toJSONList :: [TPMSCertifyInfo] -> Value
$ctoEncodingList :: [TPMSCertifyInfo] -> Encoding
toEncodingList :: [TPMSCertifyInfo] -> Encoding
ToJSON)
data TPMSAttest = TPMSAttest
{ TPMSAttest -> Word32
tpmsaMagic :: Word32,
TPMSAttest -> Word16
tpmsaType :: Word16,
TPMSAttest -> PrettyHexByteString
tpmsaQualifiedSigner :: PrettyHexByteString,
:: PrettyHexByteString,
TPMSAttest -> TPMSClockInfo
tpmsaClockInfo :: TPMSClockInfo,
TPMSAttest -> Word64
tpmsaFirmwareVersion :: Word64,
TPMSAttest -> TPMSCertifyInfo
tpmsaAttested :: TPMSCertifyInfo
}
deriving (TPMSAttest -> TPMSAttest -> Bool
(TPMSAttest -> TPMSAttest -> Bool)
-> (TPMSAttest -> TPMSAttest -> Bool) -> Eq TPMSAttest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TPMSAttest -> TPMSAttest -> Bool
== :: TPMSAttest -> TPMSAttest -> Bool
$c/= :: TPMSAttest -> TPMSAttest -> Bool
/= :: TPMSAttest -> TPMSAttest -> Bool
Eq, Int -> TPMSAttest -> ShowS
[TPMSAttest] -> ShowS
TPMSAttest -> [Char]
(Int -> TPMSAttest -> ShowS)
-> (TPMSAttest -> [Char])
-> ([TPMSAttest] -> ShowS)
-> Show TPMSAttest
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TPMSAttest -> ShowS
showsPrec :: Int -> TPMSAttest -> ShowS
$cshow :: TPMSAttest -> [Char]
show :: TPMSAttest -> [Char]
$cshowList :: [TPMSAttest] -> ShowS
showList :: [TPMSAttest] -> ShowS
Show, (forall x. TPMSAttest -> Rep TPMSAttest x)
-> (forall x. Rep TPMSAttest x -> TPMSAttest) -> Generic TPMSAttest
forall x. Rep TPMSAttest x -> TPMSAttest
forall x. TPMSAttest -> Rep TPMSAttest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TPMSAttest -> Rep TPMSAttest x
from :: forall x. TPMSAttest -> Rep TPMSAttest x
$cto :: forall x. Rep TPMSAttest x -> TPMSAttest
to :: forall x. Rep TPMSAttest x -> TPMSAttest
Generic, [TPMSAttest] -> Value
[TPMSAttest] -> Encoding
TPMSAttest -> Value
TPMSAttest -> Encoding
(TPMSAttest -> Value)
-> (TPMSAttest -> Encoding)
-> ([TPMSAttest] -> Value)
-> ([TPMSAttest] -> Encoding)
-> ToJSON TPMSAttest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TPMSAttest -> Value
toJSON :: TPMSAttest -> Value
$ctoEncoding :: TPMSAttest -> Encoding
toEncoding :: TPMSAttest -> Encoding
$ctoJSONList :: [TPMSAttest] -> Value
toJSONList :: [TPMSAttest] -> Value
$ctoEncodingList :: [TPMSAttest] -> Encoding
toEncodingList :: [TPMSAttest] -> Encoding
ToJSON)
type TPMAObject = Word32
data TPMUPublicParms
= TPMSRSAParms
{ TPMUPublicParms -> Word16
tpmsrpSymmetric :: Word16,
TPMUPublicParms -> Word16
tpmsrpScheme :: Word16,
TPMUPublicParms -> Word16
tpmsrpKeyBits :: Word16,
TPMUPublicParms -> Word32
tpmsrpExponent :: Word32
}
| TPMSECCParms
{ TPMUPublicParms -> Word16
tpmsepSymmetric :: Word16,
TPMUPublicParms -> Word16
tpmsepScheme :: Word16,
TPMUPublicParms -> CoseCurveECDSA
tpmsepCurveId :: Cose.CoseCurveECDSA,
TPMUPublicParms -> Word16
tpmsepkdf :: Word16
}
deriving (TPMUPublicParms -> TPMUPublicParms -> Bool
(TPMUPublicParms -> TPMUPublicParms -> Bool)
-> (TPMUPublicParms -> TPMUPublicParms -> Bool)
-> Eq TPMUPublicParms
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TPMUPublicParms -> TPMUPublicParms -> Bool
== :: TPMUPublicParms -> TPMUPublicParms -> Bool
$c/= :: TPMUPublicParms -> TPMUPublicParms -> Bool
/= :: TPMUPublicParms -> TPMUPublicParms -> Bool
Eq, Int -> TPMUPublicParms -> ShowS
[TPMUPublicParms] -> ShowS
TPMUPublicParms -> [Char]
(Int -> TPMUPublicParms -> ShowS)
-> (TPMUPublicParms -> [Char])
-> ([TPMUPublicParms] -> ShowS)
-> Show TPMUPublicParms
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TPMUPublicParms -> ShowS
showsPrec :: Int -> TPMUPublicParms -> ShowS
$cshow :: TPMUPublicParms -> [Char]
show :: TPMUPublicParms -> [Char]
$cshowList :: [TPMUPublicParms] -> ShowS
showList :: [TPMUPublicParms] -> ShowS
Show, (forall x. TPMUPublicParms -> Rep TPMUPublicParms x)
-> (forall x. Rep TPMUPublicParms x -> TPMUPublicParms)
-> Generic TPMUPublicParms
forall x. Rep TPMUPublicParms x -> TPMUPublicParms
forall x. TPMUPublicParms -> Rep TPMUPublicParms x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TPMUPublicParms -> Rep TPMUPublicParms x
from :: forall x. TPMUPublicParms -> Rep TPMUPublicParms x
$cto :: forall x. Rep TPMUPublicParms x -> TPMUPublicParms
to :: forall x. Rep TPMUPublicParms x -> TPMUPublicParms
Generic, [TPMUPublicParms] -> Value
[TPMUPublicParms] -> Encoding
TPMUPublicParms -> Value
TPMUPublicParms -> Encoding
(TPMUPublicParms -> Value)
-> (TPMUPublicParms -> Encoding)
-> ([TPMUPublicParms] -> Value)
-> ([TPMUPublicParms] -> Encoding)
-> ToJSON TPMUPublicParms
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TPMUPublicParms -> Value
toJSON :: TPMUPublicParms -> Value
$ctoEncoding :: TPMUPublicParms -> Encoding
toEncoding :: TPMUPublicParms -> Encoding
$ctoJSONList :: [TPMUPublicParms] -> Value
toJSONList :: [TPMUPublicParms] -> Value
$ctoEncodingList :: [TPMUPublicParms] -> Encoding
toEncodingList :: [TPMUPublicParms] -> Encoding
ToJSON)
data TPMUPublicId
= TPM2BPublicKeyRSA PrettyHexByteString
| TPMSECCPoint
{ TPMUPublicId -> PrettyHexByteString
tpmseX :: PrettyHexByteString,
TPMUPublicId -> PrettyHexByteString
tpmseY :: PrettyHexByteString
}
deriving (TPMUPublicId -> TPMUPublicId -> Bool
(TPMUPublicId -> TPMUPublicId -> Bool)
-> (TPMUPublicId -> TPMUPublicId -> Bool) -> Eq TPMUPublicId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TPMUPublicId -> TPMUPublicId -> Bool
== :: TPMUPublicId -> TPMUPublicId -> Bool
$c/= :: TPMUPublicId -> TPMUPublicId -> Bool
/= :: TPMUPublicId -> TPMUPublicId -> Bool
Eq, Int -> TPMUPublicId -> ShowS
[TPMUPublicId] -> ShowS
TPMUPublicId -> [Char]
(Int -> TPMUPublicId -> ShowS)
-> (TPMUPublicId -> [Char])
-> ([TPMUPublicId] -> ShowS)
-> Show TPMUPublicId
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TPMUPublicId -> ShowS
showsPrec :: Int -> TPMUPublicId -> ShowS
$cshow :: TPMUPublicId -> [Char]
show :: TPMUPublicId -> [Char]
$cshowList :: [TPMUPublicId] -> ShowS
showList :: [TPMUPublicId] -> ShowS
Show, (forall x. TPMUPublicId -> Rep TPMUPublicId x)
-> (forall x. Rep TPMUPublicId x -> TPMUPublicId)
-> Generic TPMUPublicId
forall x. Rep TPMUPublicId x -> TPMUPublicId
forall x. TPMUPublicId -> Rep TPMUPublicId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TPMUPublicId -> Rep TPMUPublicId x
from :: forall x. TPMUPublicId -> Rep TPMUPublicId x
$cto :: forall x. Rep TPMUPublicId x -> TPMUPublicId
to :: forall x. Rep TPMUPublicId x -> TPMUPublicId
Generic, [TPMUPublicId] -> Value
[TPMUPublicId] -> Encoding
TPMUPublicId -> Value
TPMUPublicId -> Encoding
(TPMUPublicId -> Value)
-> (TPMUPublicId -> Encoding)
-> ([TPMUPublicId] -> Value)
-> ([TPMUPublicId] -> Encoding)
-> ToJSON TPMUPublicId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TPMUPublicId -> Value
toJSON :: TPMUPublicId -> Value
$ctoEncoding :: TPMUPublicId -> Encoding
toEncoding :: TPMUPublicId -> Encoding
$ctoJSONList :: [TPMUPublicId] -> Value
toJSONList :: [TPMUPublicId] -> Value
$ctoEncodingList :: [TPMUPublicId] -> Encoding
toEncodingList :: [TPMUPublicId] -> Encoding
ToJSON)
data TPMTPublic = TPMTPublic
{ TPMTPublic -> TPMAlgId
tpmtpType :: TPMAlgId,
TPMTPublic -> TPMAlgId
tpmtpNameAlg :: TPMAlgId,
TPMTPublic -> Word16
tpmtpNameAlgRaw :: Word16,
TPMTPublic -> Word32
tpmtpObjectAttributes :: TPMAObject,
TPMTPublic -> PrettyHexByteString
tpmtpAuthPolicy :: PrettyHexByteString,
TPMTPublic -> TPMUPublicParms
tpmtpParameters :: TPMUPublicParms,
TPMTPublic -> TPMUPublicId
tpmtpUnique :: TPMUPublicId
}
deriving (TPMTPublic -> TPMTPublic -> Bool
(TPMTPublic -> TPMTPublic -> Bool)
-> (TPMTPublic -> TPMTPublic -> Bool) -> Eq TPMTPublic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TPMTPublic -> TPMTPublic -> Bool
== :: TPMTPublic -> TPMTPublic -> Bool
$c/= :: TPMTPublic -> TPMTPublic -> Bool
/= :: TPMTPublic -> TPMTPublic -> Bool
Eq, Int -> TPMTPublic -> ShowS
[TPMTPublic] -> ShowS
TPMTPublic -> [Char]
(Int -> TPMTPublic -> ShowS)
-> (TPMTPublic -> [Char])
-> ([TPMTPublic] -> ShowS)
-> Show TPMTPublic
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TPMTPublic -> ShowS
showsPrec :: Int -> TPMTPublic -> ShowS
$cshow :: TPMTPublic -> [Char]
show :: TPMTPublic -> [Char]
$cshowList :: [TPMTPublic] -> ShowS
showList :: [TPMTPublic] -> ShowS
Show, (forall x. TPMTPublic -> Rep TPMTPublic x)
-> (forall x. Rep TPMTPublic x -> TPMTPublic) -> Generic TPMTPublic
forall x. Rep TPMTPublic x -> TPMTPublic
forall x. TPMTPublic -> Rep TPMTPublic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TPMTPublic -> Rep TPMTPublic x
from :: forall x. TPMTPublic -> Rep TPMTPublic x
$cto :: forall x. Rep TPMTPublic x -> TPMTPublic
to :: forall x. Rep TPMTPublic x -> TPMTPublic
Generic, [TPMTPublic] -> Value
[TPMTPublic] -> Encoding
TPMTPublic -> Value
TPMTPublic -> Encoding
(TPMTPublic -> Value)
-> (TPMTPublic -> Encoding)
-> ([TPMTPublic] -> Value)
-> ([TPMTPublic] -> Encoding)
-> ToJSON TPMTPublic
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TPMTPublic -> Value
toJSON :: TPMTPublic -> Value
$ctoEncoding :: TPMTPublic -> Encoding
toEncoding :: TPMTPublic -> Encoding
$ctoJSONList :: [TPMTPublic] -> Value
toJSONList :: [TPMTPublic] -> Value
$ctoEncodingList :: [TPMTPublic] -> Encoding
toEncodingList :: [TPMTPublic] -> Encoding
ToJSON)
data Format = Format
instance Show Format where
show :: Format -> [Char]
show = Text -> [Char]
Text.unpack (Text -> [Char]) -> (Format -> Text) -> Format -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text
forall a. AttestationStatementFormat a => a -> Text
M.asfIdentifier
data SubjectAlternativeName = SubjectAlternativeName
{ SubjectAlternativeName -> Text
tpmManufacturer :: Text,
SubjectAlternativeName -> Text
tpmModel :: Text,
SubjectAlternativeName -> Text
tpmVersion :: Text
}
deriving (SubjectAlternativeName -> SubjectAlternativeName -> Bool
(SubjectAlternativeName -> SubjectAlternativeName -> Bool)
-> (SubjectAlternativeName -> SubjectAlternativeName -> Bool)
-> Eq SubjectAlternativeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubjectAlternativeName -> SubjectAlternativeName -> Bool
== :: SubjectAlternativeName -> SubjectAlternativeName -> Bool
$c/= :: SubjectAlternativeName -> SubjectAlternativeName -> Bool
/= :: SubjectAlternativeName -> SubjectAlternativeName -> Bool
Eq, Int -> SubjectAlternativeName -> ShowS
[SubjectAlternativeName] -> ShowS
SubjectAlternativeName -> [Char]
(Int -> SubjectAlternativeName -> ShowS)
-> (SubjectAlternativeName -> [Char])
-> ([SubjectAlternativeName] -> ShowS)
-> Show SubjectAlternativeName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubjectAlternativeName -> ShowS
showsPrec :: Int -> SubjectAlternativeName -> ShowS
$cshow :: SubjectAlternativeName -> [Char]
show :: SubjectAlternativeName -> [Char]
$cshowList :: [SubjectAlternativeName] -> ShowS
showList :: [SubjectAlternativeName] -> ShowS
Show)
newtype CertInfoBytes = CertInfoBytes {CertInfoBytes -> ByteString
unCertInfoBytes :: BS.ByteString}
deriving newtype (CertInfoBytes -> CertInfoBytes -> Bool
(CertInfoBytes -> CertInfoBytes -> Bool)
-> (CertInfoBytes -> CertInfoBytes -> Bool) -> Eq CertInfoBytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CertInfoBytes -> CertInfoBytes -> Bool
== :: CertInfoBytes -> CertInfoBytes -> Bool
$c/= :: CertInfoBytes -> CertInfoBytes -> Bool
/= :: CertInfoBytes -> CertInfoBytes -> Bool
Eq, Int -> CertInfoBytes -> ShowS
[CertInfoBytes] -> ShowS
CertInfoBytes -> [Char]
(Int -> CertInfoBytes -> ShowS)
-> (CertInfoBytes -> [Char])
-> ([CertInfoBytes] -> ShowS)
-> Show CertInfoBytes
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CertInfoBytes -> ShowS
showsPrec :: Int -> CertInfoBytes -> ShowS
$cshow :: CertInfoBytes -> [Char]
show :: CertInfoBytes -> [Char]
$cshowList :: [CertInfoBytes] -> ShowS
showList :: [CertInfoBytes] -> ShowS
Show)
newtype PubAreaBytes = PubAreaBytes {PubAreaBytes -> ByteString
unPubAreaBytes :: BS.ByteString}
deriving newtype (PubAreaBytes -> PubAreaBytes -> Bool
(PubAreaBytes -> PubAreaBytes -> Bool)
-> (PubAreaBytes -> PubAreaBytes -> Bool) -> Eq PubAreaBytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PubAreaBytes -> PubAreaBytes -> Bool
== :: PubAreaBytes -> PubAreaBytes -> Bool
$c/= :: PubAreaBytes -> PubAreaBytes -> Bool
/= :: PubAreaBytes -> PubAreaBytes -> Bool
Eq, Int -> PubAreaBytes -> ShowS
[PubAreaBytes] -> ShowS
PubAreaBytes -> [Char]
(Int -> PubAreaBytes -> ShowS)
-> (PubAreaBytes -> [Char])
-> ([PubAreaBytes] -> ShowS)
-> Show PubAreaBytes
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PubAreaBytes -> ShowS
showsPrec :: Int -> PubAreaBytes -> ShowS
$cshow :: PubAreaBytes -> [Char]
show :: PubAreaBytes -> [Char]
$cshowList :: [PubAreaBytes] -> ShowS
showList :: [PubAreaBytes] -> ShowS
Show)
data Statement = Statement
{ Statement -> NonEmpty SignedCertificate
x5c :: NE.NonEmpty X509.SignedCertificate,
Statement -> Certificate
aikCert :: X509.Certificate,
Statement -> PublicKeyWithSignAlg
aikPubKeyAndAlg :: Cose.PublicKeyWithSignAlg,
Statement -> SubjectAlternativeName
subjectAlternativeName :: SubjectAlternativeName,
Statement -> Maybe IdFidoGenCeAAGUID
aaguidExt :: Maybe IdFidoGenCeAAGUID,
Statement -> [ExtKeyUsagePurpose]
extendedKeyUsage :: [X509.ExtKeyUsagePurpose],
Statement -> Bool
basicConstraintsCA :: Bool,
Statement -> Signature
sig :: Cose.Signature,
Statement -> TPMSAttest
certInfo :: TPMSAttest,
Statement -> CertInfoBytes
certInfoRaw :: CertInfoBytes,
Statement -> TPMTPublic
pubArea :: TPMTPublic,
Statement -> PubAreaBytes
pubAreaRaw :: PubAreaBytes,
Statement -> PublicKey
pubAreaKey :: Cose.PublicKey
}
deriving (Statement -> Statement -> Bool
(Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool) -> Eq Statement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
/= :: Statement -> Statement -> Bool
Eq, Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> [Char]
(Int -> Statement -> ShowS)
-> (Statement -> [Char])
-> ([Statement] -> ShowS)
-> Show Statement
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Statement -> ShowS
showsPrec :: Int -> Statement -> ShowS
$cshow :: Statement -> [Char]
show :: Statement -> [Char]
$cshowList :: [Statement] -> ShowS
showList :: [Statement] -> ShowS
Show)
instance ToJSON Statement where
toJSON :: Statement -> Value
toJSON Statement {Bool
[ExtKeyUsagePurpose]
Maybe IdFidoGenCeAAGUID
NonEmpty SignedCertificate
Certificate
PublicKey
Signature
PublicKeyWithSignAlg
PubAreaBytes
CertInfoBytes
SubjectAlternativeName
TPMTPublic
TPMSAttest
x5c :: Statement -> NonEmpty SignedCertificate
aikCert :: Statement -> Certificate
aikPubKeyAndAlg :: Statement -> PublicKeyWithSignAlg
subjectAlternativeName :: Statement -> SubjectAlternativeName
aaguidExt :: Statement -> Maybe IdFidoGenCeAAGUID
extendedKeyUsage :: Statement -> [ExtKeyUsagePurpose]
basicConstraintsCA :: Statement -> Bool
sig :: Statement -> Signature
certInfo :: Statement -> TPMSAttest
certInfoRaw :: Statement -> CertInfoBytes
pubArea :: Statement -> TPMTPublic
pubAreaRaw :: Statement -> PubAreaBytes
pubAreaKey :: Statement -> PublicKey
x5c :: NonEmpty SignedCertificate
aikCert :: Certificate
aikPubKeyAndAlg :: PublicKeyWithSignAlg
subjectAlternativeName :: SubjectAlternativeName
aaguidExt :: Maybe IdFidoGenCeAAGUID
extendedKeyUsage :: [ExtKeyUsagePurpose]
basicConstraintsCA :: Bool
sig :: Signature
certInfo :: TPMSAttest
certInfoRaw :: CertInfoBytes
pubArea :: TPMTPublic
pubAreaRaw :: PubAreaBytes
pubAreaKey :: PublicKey
..} =
[Pair] -> Value
object
[ Key
"ver" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"2.0",
Key
"alg" Key -> CoseSignAlg -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= PublicKeyWithSignAlg -> CoseSignAlg
Cose.signAlg PublicKeyWithSignAlg
aikPubKeyAndAlg,
Key
"x5c" Key -> NonEmpty SignedCertificate -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= NonEmpty SignedCertificate
x5c,
Key
"sig" Key -> Signature -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Signature
sig,
Key
"certInfo" Key -> TPMSAttest -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TPMSAttest
certInfo,
Key
"pubArea" Key -> TPMTPublic -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TPMTPublic
pubArea
]
data VerificationError
=
PublicKeyMismatch
{
VerificationError -> PublicKey
certificatePublicKey :: Cose.PublicKey,
VerificationError -> PublicKey
credentialDataPublicKey :: Cose.PublicKey
}
|
MagicNumberInvalid Word32
|
TypeInvalid Word16
|
NameAlgorithmInvalid TPMAlgId
|
NameMismatch
{
VerificationError -> ByteString
pubAreaName :: BS.ByteString,
VerificationError -> ByteString
certifyInfoName :: BS.ByteString
}
|
PublicKeyInvalid Text
|
CertificateVersionInvalid Int
|
VerificationFailure Text
|
SubjectFieldNotEmpty [(OID, X509.ASN1CharacterString)]
|
VendorUnknown Text
|
ExtKeyOIDMissing
|
BasicConstraintsTrue
|
CertificateAAGUIDMismatch
{
VerificationError -> AAGUID
certificateExtensionAAGUID :: AAGUID,
VerificationError -> AAGUID
attestedCredentialDataAAGUID :: AAGUID
}
|
ASN1Error ASN1Error
|
CredentialAAGUIDMissing
|
HashFunctionUnknown
|
HashMismatch
{
VerificationError -> ByteString
calculatedHash :: BS.ByteString,
:: BS.ByteString
}
deriving (Int -> VerificationError -> ShowS
[VerificationError] -> ShowS
VerificationError -> [Char]
(Int -> VerificationError -> ShowS)
-> (VerificationError -> [Char])
-> ([VerificationError] -> ShowS)
-> Show VerificationError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationError -> ShowS
showsPrec :: Int -> VerificationError -> ShowS
$cshow :: VerificationError -> [Char]
show :: VerificationError -> [Char]
$cshowList :: [VerificationError] -> ShowS
showList :: [VerificationError] -> ShowS
Show, Show VerificationError
Typeable VerificationError
Typeable VerificationError
-> Show VerificationError
-> (VerificationError -> SomeException)
-> (SomeException -> Maybe VerificationError)
-> (VerificationError -> [Char])
-> Exception VerificationError
SomeException -> Maybe VerificationError
VerificationError -> [Char]
VerificationError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> [Char])
-> Exception e
$ctoException :: VerificationError -> SomeException
toException :: VerificationError -> SomeException
$cfromException :: SomeException -> Maybe VerificationError
fromException :: SomeException -> Maybe VerificationError
$cdisplayException :: VerificationError -> [Char]
displayException :: VerificationError -> [Char]
Exception)
instance X509.Extension SubjectAlternativeName where
extOID :: SubjectAlternativeName -> OID
extOID = OID -> SubjectAlternativeName -> OID
forall a b. a -> b -> a
const [Integer
2, Integer
5, Integer
29, Integer
17]
extHasNestedASN1 :: Proxy SubjectAlternativeName -> Bool
extHasNestedASN1 = Bool -> Proxy SubjectAlternativeName -> Bool
forall a b. a -> b -> a
const Bool
True
extEncode :: SubjectAlternativeName -> [ASN1]
extEncode = [Char] -> SubjectAlternativeName -> [ASN1]
forall a. HasCallStack => [Char] -> a
error [Char]
"Unimplemented: This library does not implement encoding the SubjectAlternativeName extension"
extDecode :: [ASN1] -> Either [Char] SubjectAlternativeName
extDecode [ASN1]
asn1 =
ShowS
-> Either [Char] SubjectAlternativeName
-> Either [Char] SubjectAlternativeName
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Char]
"Could not decode ASN1 subject-alternative-name extension: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) (Either [Char] SubjectAlternativeName
-> Either [Char] SubjectAlternativeName)
-> Either [Char] SubjectAlternativeName
-> Either [Char] SubjectAlternativeName
forall a b. (a -> b) -> a -> b
$
ParseASN1 SubjectAlternativeName
-> [ASN1] -> Either [Char] SubjectAlternativeName
forall a. ParseASN1 a -> [ASN1] -> Either [Char] a
runParseASN1 ParseASN1 SubjectAlternativeName
decodeSubjectAlternativeName [ASN1]
asn1
where
decodeSubjectAlternativeName :: ParseASN1 SubjectAlternativeName
decodeSubjectAlternativeName :: ParseASN1 SubjectAlternativeName
decodeSubjectAlternativeName =
do
Map OID Text
map <- [(OID, Text)] -> Map OID Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(OID, Text)] -> Map OID Text)
-> ParseASN1 [(OID, Text)] -> ParseASN1 (Map OID Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 [(OID, Text)]
decodeFields
Text
tpmManufacturer <- ParseASN1 Text
-> (Text -> ParseASN1 Text) -> Maybe Text -> ParseASN1 Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> ParseASN1 Text
forall a. [Char] -> ParseASN1 a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"manufacturer field not found in subject alternative name") Text -> ParseASN1 Text
forall a. a -> ParseASN1 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> ParseASN1 Text) -> Maybe Text -> ParseASN1 Text
forall a b. (a -> b) -> a -> b
$ OID -> Map OID Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Integer
2, Integer
23, Integer
133, Integer
2, Integer
1] Map OID Text
map
Text
tpmModel <- ParseASN1 Text
-> (Text -> ParseASN1 Text) -> Maybe Text -> ParseASN1 Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> ParseASN1 Text
forall a. [Char] -> ParseASN1 a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"model field not found in subject alternative name") Text -> ParseASN1 Text
forall a. a -> ParseASN1 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> ParseASN1 Text) -> Maybe Text -> ParseASN1 Text
forall a b. (a -> b) -> a -> b
$ OID -> Map OID Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Integer
2, Integer
23, Integer
133, Integer
2, Integer
2] Map OID Text
map
Text
tpmVersion <- ParseASN1 Text
-> (Text -> ParseASN1 Text) -> Maybe Text -> ParseASN1 Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> ParseASN1 Text
forall a. [Char] -> ParseASN1 a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"version field not found in subject alternative name") Text -> ParseASN1 Text
forall a. a -> ParseASN1 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> ParseASN1 Text) -> Maybe Text -> ParseASN1 Text
forall a b. (a -> b) -> a -> b
$ OID -> Map OID Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Integer
2, Integer
23, Integer
133, Integer
2, Integer
3] Map OID Text
map
pure SubjectAlternativeName {Text
tpmManufacturer :: Text
tpmModel :: Text
tpmVersion :: Text
tpmManufacturer :: Text
tpmModel :: Text
tpmVersion :: Text
..}
decodeFields :: ParseASN1 [(OID, Text)]
decodeFields :: ParseASN1 [(OID, Text)]
decodeFields = do
Bool
next <- ParseASN1 Bool
hasNext
if Bool
next
then do
ASN1
n <- ParseASN1 ASN1
getNext
case ASN1
n of
OID OID
oid -> do
ASN1
m <- ParseASN1 ASN1
getNext
case ASN1
m of
ASN1String ASN1CharacterString
asnString -> do
let text :: Text
text = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ASN1CharacterString -> ByteString
X509.getCharacterStringRawData ASN1CharacterString
asnString
[(OID, Text)]
fields <- ParseASN1 [(OID, Text)]
decodeFields
pure ((OID
oid, Text
text) (OID, Text) -> [(OID, Text)] -> [(OID, Text)]
forall a. a -> [a] -> [a]
: [(OID, Text)]
fields)
ASN1
_ -> ParseASN1 [(OID, Text)]
decodeFields
ASN1
_ -> ParseASN1 [(OID, Text)]
decodeFields
else [(OID, Text)] -> ParseASN1 [(OID, Text)]
forall a. a -> ParseASN1 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance M.AttestationStatementFormat Format where
type AttStmt Format = Statement
asfIdentifier :: Format -> Text
asfIdentifier Format
_ = Text
"tpm"
asfDecode :: Format -> HashMap Text Term -> Either Text (AttStmt Format)
asfDecode Format
_ HashMap Text Term
xs =
case (HashMap Text Term
xs HashMap Text Term -> Text -> Maybe Term
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"ver", HashMap Text Term
xs HashMap Text Term -> Text -> Maybe Term
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"alg", HashMap Text Term
xs HashMap Text Term -> Text -> Maybe Term
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"x5c", HashMap Text Term
xs HashMap Text Term -> Text -> Maybe Term
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"sig", HashMap Text Term
xs HashMap Text Term -> Text -> Maybe Term
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"certInfo", HashMap Text Term
xs HashMap Text Term -> Text -> Maybe Term
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"pubArea") of
( Just (CBOR.TString Text
"2.0"),
Just (CBOR.TInt Int
algId),
Just (CBOR.TList ([Term] -> Maybe (NonEmpty Term)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty -> Just NonEmpty Term
x5cRaw)),
Just (CBOR.TBytes (ByteString -> Signature
Cose.Signature -> Signature
sig)),
Just (CBOR.TBytes (ByteString -> CertInfoBytes
CertInfoBytes -> CertInfoBytes
certInfoRaw)),
Just (CBOR.TBytes (ByteString -> PubAreaBytes
PubAreaBytes -> PubAreaBytes
pubAreaRaw))
) ->
do
x5c :: NonEmpty SignedCertificate
x5c@(SignedCertificate
signedAikCert :| [SignedCertificate]
_) <- NonEmpty Term
-> (Term -> Either Text SignedCertificate)
-> Either Text (NonEmpty SignedCertificate)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty Term
x5cRaw ((Term -> Either Text SignedCertificate)
-> Either Text (NonEmpty SignedCertificate))
-> (Term -> Either Text SignedCertificate)
-> Either Text (NonEmpty SignedCertificate)
forall a b. (a -> b) -> a -> b
$ \case
CBOR.TBytes ByteString
certBytes ->
([Char] -> Text)
-> Either [Char] SignedCertificate -> Either Text SignedCertificate
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Text
"Failed to decode signed certificate: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack) (ByteString -> Either [Char] SignedCertificate
X509.decodeSignedCertificate ByteString
certBytes)
Term
cert ->
Text -> Either Text SignedCertificate
forall a b. a -> Either a b
Left (Text -> Either Text SignedCertificate)
-> Text -> Either Text SignedCertificate
forall a b. (a -> b) -> a -> b
$ Text
"Certificate CBOR value is not bytes: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (Term -> [Char]
forall a. Show a => a -> [Char]
show Term
cert)
CoseSignAlg
alg <- Int -> Either Text CoseSignAlg
forall a. (Eq a, Num a, Show a) => a -> Either Text CoseSignAlg
Cose.toCoseSignAlg Int
algId
TPMSAttest
certInfo <- CertInfoBytes -> Either Text TPMSAttest
decodeCertInfoBytes CertInfoBytes
certInfoRaw
TPMTPublic
pubArea <- PubAreaBytes -> Either Text TPMTPublic
decodePubAreaBytes PubAreaBytes
pubAreaRaw
PublicKey
pubAreaKey <- TPMTPublic -> Either Text PublicKey
extractPublicKey TPMTPublic
pubArea
let aikCert :: Certificate
aikCert = SignedCertificate -> Certificate
X509.getCertificate SignedCertificate
signedAikCert
PublicKey
aikCertPubKey <- PubKey -> Either Text PublicKey
Cose.fromX509 (PubKey -> Either Text PublicKey)
-> PubKey -> Either Text PublicKey
forall a b. (a -> b) -> a -> b
$ Certificate -> PubKey
X509.certPubKey Certificate
aikCert
PublicKeyWithSignAlg
aikPubKeyAndAlg <- PublicKey -> CoseSignAlg -> Either Text PublicKeyWithSignAlg
Cose.makePublicKeyWithSignAlg PublicKey
aikCertPubKey CoseSignAlg
alg
SubjectAlternativeName
subjectAlternativeName <- case Extensions -> Maybe (Either [Char] SubjectAlternativeName)
forall a. Extension a => Extensions -> Maybe (Either [Char] a)
X509.extensionGetE (Certificate -> Extensions
X509.certExtensions Certificate
aikCert) of
Just (Right SubjectAlternativeName
ext) -> SubjectAlternativeName -> Either Text SubjectAlternativeName
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubjectAlternativeName
ext
Just (Left [Char]
err) -> Text -> Either Text SubjectAlternativeName
forall a b. a -> Either a b
Left (Text -> Either Text SubjectAlternativeName)
-> Text -> Either Text SubjectAlternativeName
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode certificate subject alternative name extension: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
err
Maybe (Either [Char] SubjectAlternativeName)
Nothing -> Text -> Either Text SubjectAlternativeName
forall a b. a -> Either a b
Left Text
"Certificate subject alternative name extension is missing"
Maybe IdFidoGenCeAAGUID
aaguidExt <- case Extensions -> Maybe (Either [Char] IdFidoGenCeAAGUID)
forall a. Extension a => Extensions -> Maybe (Either [Char] a)
X509.extensionGetE (Certificate -> Extensions
X509.certExtensions Certificate
aikCert) of
Just (Right IdFidoGenCeAAGUID
ext) -> Maybe IdFidoGenCeAAGUID -> Either Text (Maybe IdFidoGenCeAAGUID)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe IdFidoGenCeAAGUID -> Either Text (Maybe IdFidoGenCeAAGUID))
-> Maybe IdFidoGenCeAAGUID -> Either Text (Maybe IdFidoGenCeAAGUID)
forall a b. (a -> b) -> a -> b
$ IdFidoGenCeAAGUID -> Maybe IdFidoGenCeAAGUID
forall a. a -> Maybe a
Just IdFidoGenCeAAGUID
ext
Just (Left [Char]
err) -> Text -> Either Text (Maybe IdFidoGenCeAAGUID)
forall a b. a -> Either a b
Left (Text -> Either Text (Maybe IdFidoGenCeAAGUID))
-> Text -> Either Text (Maybe IdFidoGenCeAAGUID)
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode certificate aaguid extension: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
err
Maybe (Either [Char] IdFidoGenCeAAGUID)
Nothing -> Maybe IdFidoGenCeAAGUID -> Either Text (Maybe IdFidoGenCeAAGUID)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe IdFidoGenCeAAGUID
forall a. Maybe a
Nothing
X509.ExtExtendedKeyUsage [ExtKeyUsagePurpose]
extendedKeyUsage <- case Extensions -> Maybe (Either [Char] ExtExtendedKeyUsage)
forall a. Extension a => Extensions -> Maybe (Either [Char] a)
X509.extensionGetE (Certificate -> Extensions
X509.certExtensions Certificate
aikCert) of
Just (Right ExtExtendedKeyUsage
ext) -> ExtExtendedKeyUsage -> Either Text ExtExtendedKeyUsage
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtExtendedKeyUsage
ext
Just (Left [Char]
err) -> Text -> Either Text ExtExtendedKeyUsage
forall a b. a -> Either a b
Left (Text -> Either Text ExtExtendedKeyUsage)
-> Text -> Either Text ExtExtendedKeyUsage
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode certificate extended key usage extension: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
err
Maybe (Either [Char] ExtExtendedKeyUsage)
Nothing -> Text -> Either Text ExtExtendedKeyUsage
forall a b. a -> Either a b
Left Text
"Certificate extended key usage extension is missing"
X509.ExtBasicConstraints Bool
basicConstraintsCA Maybe Integer
_ <- case Extensions -> Maybe (Either [Char] ExtBasicConstraints)
forall a. Extension a => Extensions -> Maybe (Either [Char] a)
X509.extensionGetE (Certificate -> Extensions
X509.certExtensions Certificate
aikCert) of
Just (Right ExtBasicConstraints
ext) -> ExtBasicConstraints -> Either Text ExtBasicConstraints
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtBasicConstraints
ext
Just (Left [Char]
err) -> Text -> Either Text ExtBasicConstraints
forall a b. a -> Either a b
Left (Text -> Either Text ExtBasicConstraints)
-> Text -> Either Text ExtBasicConstraints
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode certificate basic constraints extension: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
err
Maybe (Either [Char] ExtBasicConstraints)
Nothing -> Text -> Either Text ExtBasicConstraints
forall a b. a -> Either a b
Left Text
"Certificate basic constraints extension is missing"
Statement -> Either Text Statement
forall a b. b -> Either a b
Right (Statement -> Either Text Statement)
-> Statement -> Either Text Statement
forall a b. (a -> b) -> a -> b
$ Statement {Bool
[ExtKeyUsagePurpose]
Maybe IdFidoGenCeAAGUID
NonEmpty SignedCertificate
Certificate
PublicKey
Signature
PublicKeyWithSignAlg
PubAreaBytes
CertInfoBytes
SubjectAlternativeName
TPMTPublic
TPMSAttest
x5c :: NonEmpty SignedCertificate
aikCert :: Certificate
aikPubKeyAndAlg :: PublicKeyWithSignAlg
subjectAlternativeName :: SubjectAlternativeName
aaguidExt :: Maybe IdFidoGenCeAAGUID
extendedKeyUsage :: [ExtKeyUsagePurpose]
basicConstraintsCA :: Bool
sig :: Signature
certInfo :: TPMSAttest
certInfoRaw :: CertInfoBytes
pubArea :: TPMTPublic
pubAreaRaw :: PubAreaBytes
pubAreaKey :: PublicKey
sig :: Signature
certInfoRaw :: CertInfoBytes
pubAreaRaw :: PubAreaBytes
x5c :: NonEmpty SignedCertificate
certInfo :: TPMSAttest
pubArea :: TPMTPublic
pubAreaKey :: PublicKey
aikCert :: Certificate
aikPubKeyAndAlg :: PublicKeyWithSignAlg
subjectAlternativeName :: SubjectAlternativeName
aaguidExt :: Maybe IdFidoGenCeAAGUID
extendedKeyUsage :: [ExtKeyUsagePurpose]
basicConstraintsCA :: Bool
..}
(Maybe Term, Maybe Term, Maybe Term, Maybe Term, Maybe Term,
Maybe Term)
_ -> Text -> Either Text (AttStmt Format)
forall a b. a -> Either a b
Left (Text -> Either Text (AttStmt Format))
-> Text -> Either Text (AttStmt Format)
forall a b. (a -> b) -> a -> b
$ Text
"CBOR map didn't have expected value types (ver: \"2.0\", alg: int, x5c: non-empty list, sig: bytes, certInfo: bytes, pubArea: bytes): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (HashMap Text Term -> [Char]
forall a. Show a => a -> [Char]
show HashMap Text Term
xs)
where
decodeCertInfoBytes :: CertInfoBytes -> Either Text TPMSAttest
decodeCertInfoBytes :: CertInfoBytes -> Either Text TPMSAttest
decodeCertInfoBytes (CertInfoBytes ByteString
bytes) =
case Get TPMSAttest
-> ByteString
-> Either
(ByteString, ByteOffset, [Char])
(ByteString, ByteOffset, TPMSAttest)
forall a.
Get a
-> ByteString
-> Either
(ByteString, ByteOffset, [Char]) (ByteString, ByteOffset, a)
Get.runGetOrFail Get TPMSAttest
getTPMAttest (ByteString -> ByteString
LBS.fromStrict ByteString
bytes) of
Left (ByteString
_, ByteOffset
_, [Char]
err) -> Text -> Either Text TPMSAttest
forall a b. a -> Either a b
Left (Text -> Either Text TPMSAttest) -> Text -> Either Text TPMSAttest
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode certInfo: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (ShowS
forall a. Show a => a -> [Char]
show [Char]
err)
Right (ByteString
_, ByteOffset
_, TPMSAttest
res) -> TPMSAttest -> Either Text TPMSAttest
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TPMSAttest
res
getTPMAttest :: Get.Get TPMSAttest
getTPMAttest :: Get TPMSAttest
getTPMAttest = do
Word32
tpmsaMagic <- Get Word32
Get.getWord32be
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
tpmsaMagic Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
tpmGeneratedValue) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Get ()
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid magic number"
Word16
tpmsaType <- Get Word16
Get.getWord16be
PrettyHexByteString
tpmsaQualifiedSigner <- Get PrettyHexByteString
getTPMByteString
PrettyHexByteString
tpmsaExtraData <- Get PrettyHexByteString
getTPMByteString
TPMSClockInfo
tpmsaClockInfo <- Get TPMSClockInfo
getClockInfo
Word64
tpmsaFirmwareVersion <- Get Word64
Get.getWord64be
TPMSCertifyInfo
tpmsaAttested <- Get TPMSCertifyInfo
getCertifyInfo
Bool
True <- Get Bool
Get.isEmpty
TPMSAttest -> Get TPMSAttest
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TPMSAttest {Word16
Word32
Word64
PrettyHexByteString
TPMSCertifyInfo
TPMSClockInfo
tpmsaMagic :: Word32
tpmsaType :: Word16
tpmsaQualifiedSigner :: PrettyHexByteString
tpmsaExtraData :: PrettyHexByteString
tpmsaClockInfo :: TPMSClockInfo
tpmsaFirmwareVersion :: Word64
tpmsaAttested :: TPMSCertifyInfo
tpmsaMagic :: Word32
tpmsaType :: Word16
tpmsaQualifiedSigner :: PrettyHexByteString
tpmsaExtraData :: PrettyHexByteString
tpmsaClockInfo :: TPMSClockInfo
tpmsaFirmwareVersion :: Word64
tpmsaAttested :: TPMSCertifyInfo
..}
getClockInfo :: Get.Get TPMSClockInfo
getClockInfo :: Get TPMSClockInfo
getClockInfo = do
Word64
tpmsciClock <- Get Word64
Get.getWord64be
Word32
tpmsciResetCount <- Get Word32
Get.getWord32be
Word32
tpmsciRestartCount <- Get Word32
Get.getWord32be
Bool
tpmsciSafe <- (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1) (Word8 -> Bool) -> Get Word8 -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8
pure TPMSClockInfo {Bool
Word32
Word64
tpmsciClock :: Word64
tpmsciResetCount :: Word32
tpmsciRestartCount :: Word32
tpmsciSafe :: Bool
tpmsciClock :: Word64
tpmsciResetCount :: Word32
tpmsciRestartCount :: Word32
tpmsciSafe :: Bool
..}
getCertifyInfo :: Get.Get TPMSCertifyInfo
getCertifyInfo :: Get TPMSCertifyInfo
getCertifyInfo = do
PrettyHexByteString
tpmsciName <- Get PrettyHexByteString
getTPMByteString
PrettyHexByteString
tpmsciQualifiedName <- Get PrettyHexByteString
getTPMByteString
pure TPMSCertifyInfo {PrettyHexByteString
tpmsciName :: PrettyHexByteString
tpmsciQualifiedName :: PrettyHexByteString
tpmsciName :: PrettyHexByteString
tpmsciQualifiedName :: PrettyHexByteString
..}
getTPMByteString :: Get.Get PrettyHexByteString
getTPMByteString :: Get PrettyHexByteString
getTPMByteString = do
Word16
size <- Get Word16
Get.getWord16be
ByteString -> PrettyHexByteString
PrettyHexByteString (ByteString -> PrettyHexByteString)
-> Get ByteString -> Get PrettyHexByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
Get.getByteString (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
size)
decodePubAreaBytes :: PubAreaBytes -> Either Text TPMTPublic
decodePubAreaBytes :: PubAreaBytes -> Either Text TPMTPublic
decodePubAreaBytes (PubAreaBytes ByteString
bytes) =
case Get TPMTPublic
-> ByteString
-> Either
(ByteString, ByteOffset, [Char])
(ByteString, ByteOffset, TPMTPublic)
forall a.
Get a
-> ByteString
-> Either
(ByteString, ByteOffset, [Char]) (ByteString, ByteOffset, a)
Get.runGetOrFail Get TPMTPublic
getTPMTPublic (ByteString -> ByteString
LBS.fromStrict ByteString
bytes) of
Left (ByteString
_, ByteOffset
_, [Char]
err) -> Text -> Either Text TPMTPublic
forall a b. a -> Either a b
Left (Text -> Either Text TPMTPublic) -> Text -> Either Text TPMTPublic
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode certInfo: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (ShowS
forall a. Show a => a -> [Char]
show [Char]
err)
Right (ByteString
_, ByteOffset
_, TPMTPublic
res) -> TPMTPublic -> Either Text TPMTPublic
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TPMTPublic
res
getTPMTPublic :: Get.Get TPMTPublic
getTPMTPublic :: Get TPMTPublic
getTPMTPublic = do
TPMAlgId
tpmtpType <- Word16 -> Get TPMAlgId
forall (m :: * -> *). MonadFail m => Word16 -> m TPMAlgId
toTPMAlgId (Word16 -> Get TPMAlgId) -> Get Word16 -> Get TPMAlgId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word16
Get.getWord16be
Word16
tpmtpNameAlgRaw <- Get Word16
Get.getWord16be
TPMAlgId
tpmtpNameAlg <- Word16 -> Get TPMAlgId
forall (m :: * -> *). MonadFail m => Word16 -> m TPMAlgId
toTPMAlgId Word16
tpmtpNameAlgRaw
Word32
tpmtpObjectAttributes <- Get Word32
getTPMAObject
PrettyHexByteString
tpmtpAuthPolicy <- Get PrettyHexByteString
getTPMByteString
TPMUPublicParms
tpmtpParameters <- TPMAlgId -> Get TPMUPublicParms
getTPMUPublicParms TPMAlgId
tpmtpType
TPMUPublicId
tpmtpUnique <- TPMAlgId -> Get TPMUPublicId
getTPMUPublicId TPMAlgId
tpmtpType
Bool
True <- Get Bool
Get.isEmpty
TPMTPublic -> Get TPMTPublic
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TPMTPublic {Word16
Word32
PrettyHexByteString
TPMUPublicId
TPMUPublicParms
TPMAlgId
tpmtpType :: TPMAlgId
tpmtpNameAlg :: TPMAlgId
tpmtpNameAlgRaw :: Word16
tpmtpObjectAttributes :: Word32
tpmtpAuthPolicy :: PrettyHexByteString
tpmtpParameters :: TPMUPublicParms
tpmtpUnique :: TPMUPublicId
tpmtpType :: TPMAlgId
tpmtpNameAlgRaw :: Word16
tpmtpNameAlg :: TPMAlgId
tpmtpObjectAttributes :: Word32
tpmtpAuthPolicy :: PrettyHexByteString
tpmtpParameters :: TPMUPublicParms
tpmtpUnique :: TPMUPublicId
..}
getTPMAObject :: Get.Get TPMAObject
getTPMAObject :: Get Word32
getTPMAObject = Get Word32
Get.getWord32be
getTPMUPublicParms :: TPMAlgId -> Get.Get TPMUPublicParms
getTPMUPublicParms :: TPMAlgId -> Get TPMUPublicParms
getTPMUPublicParms TPMAlgId
TPMAlgRSA = do
Word16
tpmsrpSymmetric <- Get Word16
Get.getWord16be
Word16
tpmsrpScheme <- Get Word16
Get.getWord16be
Word16
tpmsrpKeyBits <- Get Word16
Get.getWord16be
Word32
tpmsrpExponent <- (\Word32
e -> if Word32
e Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 then Word32
65537 else Word32
e) (Word32 -> Word32) -> Get Word32 -> Get Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
Get.getWord32be
pure TPMSRSAParms {Word16
Word32
tpmsrpSymmetric :: Word16
tpmsrpScheme :: Word16
tpmsrpKeyBits :: Word16
tpmsrpExponent :: Word32
tpmsrpSymmetric :: Word16
tpmsrpScheme :: Word16
tpmsrpKeyBits :: Word16
tpmsrpExponent :: Word32
..}
getTPMUPublicParms TPMAlgId
TPMAlgSHA1 = [Char] -> Get TPMUPublicParms
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"SHA1 does not have public key parameters"
getTPMUPublicParms TPMAlgId
TPMAlgSHA256 = [Char] -> Get TPMUPublicParms
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"SHA256 does not have public key parameters"
getTPMUPublicParms TPMAlgId
TPMAlgECC = do
Word16
tpmsepSymmetric <- Get Word16
Get.getWord16be
Word16
tpmsepScheme <- Get Word16
Get.getWord16be
CoseCurveECDSA
tpmsepCurveId <- Word16 -> Get CoseCurveECDSA
forall (m :: * -> *). MonadFail m => Word16 -> m CoseCurveECDSA
toCurveId (Word16 -> Get CoseCurveECDSA) -> Get Word16 -> Get CoseCurveECDSA
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word16
Get.getWord16be
Word16
tpmsepkdf <- Get Word16
Get.getWord16be
pure TPMSECCParms {Word16
CoseCurveECDSA
tpmsepSymmetric :: Word16
tpmsepScheme :: Word16
tpmsepCurveId :: CoseCurveECDSA
tpmsepkdf :: Word16
tpmsepSymmetric :: Word16
tpmsepScheme :: Word16
tpmsepCurveId :: CoseCurveECDSA
tpmsepkdf :: Word16
..}
getTPMUPublicId :: TPMAlgId -> Get.Get TPMUPublicId
getTPMUPublicId :: TPMAlgId -> Get TPMUPublicId
getTPMUPublicId TPMAlgId
TPMAlgRSA = PrettyHexByteString -> TPMUPublicId
TPM2BPublicKeyRSA (PrettyHexByteString -> TPMUPublicId)
-> Get PrettyHexByteString -> Get TPMUPublicId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PrettyHexByteString
getTPMByteString
getTPMUPublicId TPMAlgId
TPMAlgSHA1 = [Char] -> Get TPMUPublicId
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"SHA1 does not have a public id"
getTPMUPublicId TPMAlgId
TPMAlgSHA256 = [Char] -> Get TPMUPublicId
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"SHA256 does not have a public id"
getTPMUPublicId TPMAlgId
TPMAlgECC = do
PrettyHexByteString
tpmseX <- Get PrettyHexByteString
getTPMByteString
PrettyHexByteString
tpmseY <- Get PrettyHexByteString
getTPMByteString
pure TPMSECCPoint {PrettyHexByteString
tpmseX :: PrettyHexByteString
tpmseY :: PrettyHexByteString
tpmseX :: PrettyHexByteString
tpmseY :: PrettyHexByteString
..}
extractPublicKey :: TPMTPublic -> Either Text Cose.PublicKey
extractPublicKey :: TPMTPublic -> Either Text PublicKey
extractPublicKey
TPMTPublic
{ tpmtpType :: TPMTPublic -> TPMAlgId
tpmtpType = TPMAlgId
TPMAlgRSA,
tpmtpParameters :: TPMTPublic -> TPMUPublicParms
tpmtpParameters = TPMSRSAParms {Word16
Word32
tpmsrpSymmetric :: TPMUPublicParms -> Word16
tpmsrpScheme :: TPMUPublicParms -> Word16
tpmsrpKeyBits :: TPMUPublicParms -> Word16
tpmsrpExponent :: TPMUPublicParms -> Word32
tpmsrpSymmetric :: Word16
tpmsrpScheme :: Word16
tpmsrpKeyBits :: Word16
tpmsrpExponent :: Word32
..},
tpmtpUnique :: TPMTPublic -> TPMUPublicId
tpmtpUnique = TPM2BPublicKeyRSA (PrettyHexByteString ByteString
nb)
} =
UncheckedPublicKey -> Either Text PublicKey
Cose.checkPublicKey
Cose.PublicKeyRSA
{ rsaN :: Integer
rsaN = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
nb,
rsaE :: Integer
rsaE = Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
tpmsrpExponent
}
extractPublicKey
TPMTPublic
{ tpmtpType :: TPMTPublic -> TPMAlgId
tpmtpType = TPMAlgId
TPMAlgECC,
tpmtpParameters :: TPMTPublic -> TPMUPublicParms
tpmtpParameters = TPMSECCParms {Word16
CoseCurveECDSA
tpmsepSymmetric :: TPMUPublicParms -> Word16
tpmsepScheme :: TPMUPublicParms -> Word16
tpmsepCurveId :: TPMUPublicParms -> CoseCurveECDSA
tpmsepkdf :: TPMUPublicParms -> Word16
tpmsepSymmetric :: Word16
tpmsepScheme :: Word16
tpmsepCurveId :: CoseCurveECDSA
tpmsepkdf :: Word16
..},
tpmtpUnique :: TPMTPublic -> TPMUPublicId
tpmtpUnique = TPMSECCPoint {tpmseX :: TPMUPublicId -> PrettyHexByteString
tpmseX = PrettyHexByteString ByteString
tpmseX, tpmseY :: TPMUPublicId -> PrettyHexByteString
tpmseY = PrettyHexByteString ByteString
tpmseY}
} =
UncheckedPublicKey -> Either Text PublicKey
Cose.checkPublicKey
Cose.PublicKeyECDSA
{ ecdsaCurve :: CoseCurveECDSA
ecdsaCurve = CoseCurveECDSA
tpmsepCurveId,
ecdsaX :: Integer
ecdsaX = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
tpmseX,
ecdsaY :: Integer
ecdsaY = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
tpmseY
}
extractPublicKey TPMTPublic
key = Text -> Either Text PublicKey
forall a b. a -> Either a b
Left (Text -> Either Text PublicKey) -> Text -> Either Text PublicKey
forall a b. (a -> b) -> a -> b
$ Text
"Unsupported TPM public key: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (TPMTPublic -> [Char]
forall a. Show a => a -> [Char]
show TPMTPublic
key)
asfEncode :: Format -> AttStmt Format -> Term
asfEncode Format
_ Statement {Bool
[ExtKeyUsagePurpose]
Maybe IdFidoGenCeAAGUID
NonEmpty SignedCertificate
Certificate
PublicKey
Signature
PublicKeyWithSignAlg
PubAreaBytes
CertInfoBytes
SubjectAlternativeName
TPMTPublic
TPMSAttest
x5c :: Statement -> NonEmpty SignedCertificate
aikCert :: Statement -> Certificate
aikPubKeyAndAlg :: Statement -> PublicKeyWithSignAlg
subjectAlternativeName :: Statement -> SubjectAlternativeName
aaguidExt :: Statement -> Maybe IdFidoGenCeAAGUID
extendedKeyUsage :: Statement -> [ExtKeyUsagePurpose]
basicConstraintsCA :: Statement -> Bool
sig :: Statement -> Signature
certInfo :: Statement -> TPMSAttest
certInfoRaw :: Statement -> CertInfoBytes
pubArea :: Statement -> TPMTPublic
pubAreaRaw :: Statement -> PubAreaBytes
pubAreaKey :: Statement -> PublicKey
x5c :: NonEmpty SignedCertificate
aikCert :: Certificate
aikPubKeyAndAlg :: PublicKeyWithSignAlg
subjectAlternativeName :: SubjectAlternativeName
aaguidExt :: Maybe IdFidoGenCeAAGUID
extendedKeyUsage :: [ExtKeyUsagePurpose]
basicConstraintsCA :: Bool
sig :: Signature
certInfo :: TPMSAttest
certInfoRaw :: CertInfoBytes
pubArea :: TPMTPublic
pubAreaRaw :: PubAreaBytes
pubAreaKey :: PublicKey
..} =
[(Term, Term)] -> Term
CBOR.TMap
[ (Text -> Term
CBOR.TString Text
"ver", Text -> Term
CBOR.TString Text
"2.0"),
(Text -> Term
CBOR.TString Text
"alg", Int -> Term
CBOR.TInt (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ CoseSignAlg -> Int
forall p. Num p => CoseSignAlg -> p
Cose.fromCoseSignAlg (CoseSignAlg -> Int) -> CoseSignAlg -> Int
forall a b. (a -> b) -> a -> b
$ PublicKeyWithSignAlg -> CoseSignAlg
Cose.signAlg PublicKeyWithSignAlg
aikPubKeyAndAlg),
( Text -> Term
CBOR.TString Text
"x5c",
[Term] -> Term
CBOR.TList ([Term] -> Term) -> [Term] -> Term
forall a b. (a -> b) -> a -> b
$ (SignedCertificate -> Term) -> [SignedCertificate] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Term
CBOR.TBytes (ByteString -> Term)
-> (SignedCertificate -> ByteString) -> SignedCertificate -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedCertificate -> ByteString
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
X509.encodeSignedObject) ([SignedCertificate] -> [Term]) -> [SignedCertificate] -> [Term]
forall a b. (a -> b) -> a -> b
$ NonEmpty SignedCertificate -> [SignedCertificate]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty SignedCertificate
x5c
),
(Text -> Term
CBOR.TString Text
"sig", ByteString -> Term
CBOR.TBytes (ByteString -> Term) -> ByteString -> Term
forall a b. (a -> b) -> a -> b
$ Signature -> ByteString
Cose.unSignature Signature
sig),
(Text -> Term
CBOR.TString Text
"certInfo", ByteString -> Term
CBOR.TBytes (ByteString -> Term) -> ByteString -> Term
forall a b. (a -> b) -> a -> b
$ CertInfoBytes -> ByteString
unCertInfoBytes CertInfoBytes
certInfoRaw),
(Text -> Term
CBOR.TString Text
"pubArea", ByteString -> Term
CBOR.TBytes (ByteString -> Term) -> ByteString -> Term
forall a b. (a -> b) -> a -> b
$ PubAreaBytes -> ByteString
unPubAreaBytes PubAreaBytes
pubAreaRaw)
]
type AttStmtVerificationError Format = VerificationError
asfVerify :: Format
-> DateTime
-> AttStmt Format
-> AuthenticatorData 'Registration 'True
-> ClientDataHash
-> Validation
(NonEmpty (AttStmtVerificationError Format)) SomeAttestationType
asfVerify
Format
_
DateTime
_
Statement {Bool
[ExtKeyUsagePurpose]
Maybe IdFidoGenCeAAGUID
NonEmpty SignedCertificate
Certificate
PublicKey
Signature
PublicKeyWithSignAlg
PubAreaBytes
CertInfoBytes
SubjectAlternativeName
TPMTPublic
TPMSAttest
x5c :: Statement -> NonEmpty SignedCertificate
aikCert :: Statement -> Certificate
aikPubKeyAndAlg :: Statement -> PublicKeyWithSignAlg
subjectAlternativeName :: Statement -> SubjectAlternativeName
aaguidExt :: Statement -> Maybe IdFidoGenCeAAGUID
extendedKeyUsage :: Statement -> [ExtKeyUsagePurpose]
basicConstraintsCA :: Statement -> Bool
sig :: Statement -> Signature
certInfo :: Statement -> TPMSAttest
certInfoRaw :: Statement -> CertInfoBytes
pubArea :: Statement -> TPMTPublic
pubAreaRaw :: Statement -> PubAreaBytes
pubAreaKey :: Statement -> PublicKey
x5c :: NonEmpty SignedCertificate
aikCert :: Certificate
aikPubKeyAndAlg :: PublicKeyWithSignAlg
subjectAlternativeName :: SubjectAlternativeName
aaguidExt :: Maybe IdFidoGenCeAAGUID
extendedKeyUsage :: [ExtKeyUsagePurpose]
basicConstraintsCA :: Bool
sig :: Signature
certInfo :: TPMSAttest
certInfoRaw :: CertInfoBytes
pubArea :: TPMTPublic
pubAreaRaw :: PubAreaBytes
pubAreaKey :: PublicKey
..}
M.AuthenticatorData {adRawData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RawField raw
adRawData = M.WithRaw ByteString
adRawData, Maybe AuthenticatorExtensionOutputs
AttestedCredentialData 'Registration 'True
AuthenticatorDataFlags
SignatureCounter
RpIdHash
adRpIdHash :: RpIdHash
adFlags :: AuthenticatorDataFlags
adSignCount :: SignatureCounter
adAttestedCredentialData :: AttestedCredentialData 'Registration 'True
adExtensions :: Maybe AuthenticatorExtensionOutputs
adRpIdHash :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RpIdHash
adFlags :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AuthenticatorDataFlags
adSignCount :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> SignatureCounter
adAttestedCredentialData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AttestedCredentialData c raw
adExtensions :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> Maybe AuthenticatorExtensionOutputs
..}
ClientDataHash
clientDataHash = do
let pubKey :: PublicKey
pubKey = PublicKeyWithSignAlg -> PublicKey
Cose.publicKey (PublicKeyWithSignAlg -> PublicKey)
-> PublicKeyWithSignAlg -> PublicKey
forall a b. (a -> b) -> a -> b
$ AttestedCredentialData 'Registration 'True -> PublicKeyWithSignAlg
forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> PublicKeyWithSignAlg
M.acdCredentialPublicKey AttestedCredentialData 'Registration 'True
adAttestedCredentialData
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PublicKey
pubAreaKey PublicKey -> PublicKey -> Bool
forall a. Eq a => a -> a -> Bool
== PublicKey
pubKey) (Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> (VerificationError
-> Validation (NonEmpty VerificationError) ())
-> VerificationError
-> Validation (NonEmpty VerificationError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey -> VerificationError
PublicKeyMismatch PublicKey
pubAreaKey PublicKey
pubKey
let attToBeSigned :: ByteString
attToBeSigned = ByteString
adRawData ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ClientDataHash -> Digest SHA256
M.unClientDataHash ClientDataHash
clientDataHash)
let magic :: Word32
magic = TPMSAttest -> Word32
tpmsaMagic TPMSAttest
certInfo
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
magic Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
tpmGeneratedValue) (Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> (VerificationError
-> Validation (NonEmpty VerificationError) ())
-> VerificationError
-> Validation (NonEmpty VerificationError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> VerificationError
MagicNumberInvalid Word32
magic
let typ :: Word16
typ = TPMSAttest -> Word16
tpmsaType TPMSAttest
certInfo
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word16
typ Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
tpmStAttestCertify) (Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> (VerificationError
-> Validation (NonEmpty VerificationError) ())
-> VerificationError
-> Validation (NonEmpty VerificationError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ Word16 -> VerificationError
TypeInvalid Word16
typ
case CoseSignAlg -> ByteString -> Maybe ByteString
forall ba bout.
(ByteArrayAccess ba, ByteArray bout) =>
CoseSignAlg -> ba -> Maybe bout
hashWithCorrectAlgorithm (PublicKeyWithSignAlg -> CoseSignAlg
Cose.signAlg PublicKeyWithSignAlg
aikPubKeyAndAlg) ByteString
attToBeSigned of
Just ByteString
attHash -> do
let PrettyHexByteString ByteString
extraData = TPMSAttest -> PrettyHexByteString
tpmsaExtraData TPMSAttest
certInfo
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
attHash ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
extraData) (Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> (VerificationError
-> Validation (NonEmpty VerificationError) ())
-> VerificationError
-> Validation (NonEmpty VerificationError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> VerificationError
HashMismatch ByteString
attHash ByteString
extraData
pure ()
Maybe ByteString
Nothing -> VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure VerificationError
HashFunctionUnknown
let mPubAreaHash :: Either TPMAlgId ByteString
mPubAreaHash = case TPMTPublic -> TPMAlgId
tpmtpNameAlg TPMTPublic
pubArea of
TPMAlgId
TPMAlgSHA1 -> ByteString -> Either TPMAlgId ByteString
forall a b. b -> Either a b
Right (ByteString -> Either TPMAlgId ByteString)
-> ByteString -> Either TPMAlgId ByteString
forall a b. (a -> b) -> a -> b
$ Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest SHA1 -> ByteString) -> Digest SHA1 -> ByteString
forall a b. (a -> b) -> a -> b
$ SHA1 -> ByteString -> Digest SHA1
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA1
SHA1 (ByteString -> Digest SHA1) -> ByteString -> Digest SHA1
forall a b. (a -> b) -> a -> b
$ PubAreaBytes -> ByteString
unPubAreaBytes PubAreaBytes
pubAreaRaw
TPMAlgId
TPMAlgSHA256 -> ByteString -> Either TPMAlgId ByteString
forall a b. b -> Either a b
Right (ByteString -> Either TPMAlgId ByteString)
-> ByteString -> Either TPMAlgId ByteString
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest SHA256 -> ByteString) -> Digest SHA256 -> ByteString
forall a b. (a -> b) -> a -> b
$ SHA256 -> ByteString -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256 (ByteString -> Digest SHA256) -> ByteString -> Digest SHA256
forall a b. (a -> b) -> a -> b
$ PubAreaBytes -> ByteString
unPubAreaBytes PubAreaBytes
pubAreaRaw
TPMAlgId
TPMAlgECC -> TPMAlgId -> Either TPMAlgId ByteString
forall a b. a -> Either a b
Left TPMAlgId
TPMAlgECC
TPMAlgId
TPMAlgRSA -> TPMAlgId -> Either TPMAlgId ByteString
forall a b. a -> Either a b
Left TPMAlgId
TPMAlgRSA
case Either TPMAlgId ByteString
mPubAreaHash of
Right ByteString
pubAreaHash -> do
let pubName :: ByteString
pubName = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
Put -> ByteString
Put.runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
Word16 -> Put
Put.putWord16be (TPMTPublic -> Word16
tpmtpNameAlgRaw TPMTPublic
pubArea)
ByteString -> Put
Put.putByteString ByteString
pubAreaHash
let PrettyHexByteString ByteString
name = TPMSCertifyInfo -> PrettyHexByteString
tpmsciName (TPMSAttest -> TPMSCertifyInfo
tpmsaAttested TPMSAttest
certInfo)
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
pubName) (Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> (VerificationError
-> Validation (NonEmpty VerificationError) ())
-> VerificationError
-> Validation (NonEmpty VerificationError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> VerificationError
NameMismatch ByteString
pubName ByteString
name
pure ()
Left TPMAlgId
alg -> VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ TPMAlgId -> VerificationError
NameAlgorithmInvalid TPMAlgId
alg
case PublicKeyWithSignAlg -> Message -> Signature -> Either Text ()
Cose.verify PublicKeyWithSignAlg
aikPubKeyAndAlg (ByteString -> Message
Cose.Message (ByteString -> Message) -> ByteString -> Message
forall a b. (a -> b) -> a -> b
$ CertInfoBytes -> ByteString
unCertInfoBytes CertInfoBytes
certInfoRaw) Signature
sig of
Right () -> () -> Validation (NonEmpty VerificationError) ()
forall a. a -> Validation (NonEmpty VerificationError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Left Text
err -> VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ Text -> VerificationError
VerificationFailure Text
err
let version :: Int
version = Certificate -> Int
X509.certVersion Certificate
aikCert
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
version Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2) (Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> (VerificationError
-> Validation (NonEmpty VerificationError) ())
-> VerificationError
-> Validation (NonEmpty VerificationError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ Int -> VerificationError
CertificateVersionInvalid Int
version
let subject :: [(OID, ASN1CharacterString)]
subject = DistinguishedName -> [(OID, ASN1CharacterString)]
X509.getDistinguishedElements (DistinguishedName -> [(OID, ASN1CharacterString)])
-> DistinguishedName -> [(OID, ASN1CharacterString)]
forall a b. (a -> b) -> a -> b
$ Certificate -> DistinguishedName
X509.certSubjectDN Certificate
aikCert
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(OID, ASN1CharacterString)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(OID, ASN1CharacterString)]
subject) (Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> (VerificationError
-> Validation (NonEmpty VerificationError) ())
-> VerificationError
-> Validation (NonEmpty VerificationError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ [(OID, ASN1CharacterString)] -> VerificationError
SubjectFieldNotEmpty [(OID, ASN1CharacterString)]
subject
let vendor :: Text
vendor = SubjectAlternativeName -> Text
tpmManufacturer SubjectAlternativeName
subjectAlternativeName
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Text
vendor Set Text
tpmManufacturers) (Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> (VerificationError
-> Validation (NonEmpty VerificationError) ())
-> VerificationError
-> Validation (NonEmpty VerificationError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ Text -> VerificationError
VendorUnknown Text
vendor
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (OID -> ExtKeyUsagePurpose
X509.KeyUsagePurpose_Unknown [Integer
2, Integer
23, Integer
133, Integer
8, Integer
3] ExtKeyUsagePurpose -> [ExtKeyUsagePurpose] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ExtKeyUsagePurpose]
extendedKeyUsage) (Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure VerificationError
ExtKeyOIDMissing
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
basicConstraintsCA (Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure VerificationError
BasicConstraintsTrue
let credentialAAGUID :: AAGUID
credentialAAGUID = AttestedCredentialData 'Registration 'True -> AAGUID
forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> AAGUID
M.acdAaguid AttestedCredentialData 'Registration 'True
adAttestedCredentialData
case Maybe IdFidoGenCeAAGUID
aaguidExt of
Just (IdFidoGenCeAAGUID AAGUID
aaguid) -> do
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AAGUID
aaguid AAGUID -> AAGUID -> Bool
forall a. Eq a => a -> a -> Bool
== AAGUID
credentialAAGUID) (Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> (VerificationError
-> Validation (NonEmpty VerificationError) ())
-> VerificationError
-> Validation (NonEmpty VerificationError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ AAGUID -> AAGUID -> VerificationError
CertificateAAGUIDMismatch AAGUID
aaguid AAGUID
credentialAAGUID
Maybe IdFidoGenCeAAGUID
Nothing -> () -> Validation (NonEmpty VerificationError) ()
forall a. a -> Validation (NonEmpty VerificationError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
pure $
AttestationType ('Verifiable 'Fido2) -> SomeAttestationType
forall (k :: AttestationKind).
AttestationType k -> SomeAttestationType
M.SomeAttestationType (AttestationType ('Verifiable 'Fido2) -> SomeAttestationType)
-> AttestationType ('Verifiable 'Fido2) -> SomeAttestationType
forall a b. (a -> b) -> a -> b
$
VerifiableAttestationType
-> AttestationChain 'Fido2 -> AttestationType ('Verifiable 'Fido2)
forall (p :: ProtocolKind).
VerifiableAttestationType
-> AttestationChain p -> AttestationType ('Verifiable p)
M.AttestationTypeVerifiable VerifiableAttestationType
M.VerifiableAttestationTypeUncertain (NonEmpty SignedCertificate -> AttestationChain 'Fido2
M.Fido2Chain NonEmpty SignedCertificate
x5c)
where
hashWithCorrectAlgorithm :: (BA.ByteArrayAccess ba, BA.ByteArray bout) => Cose.CoseSignAlg -> ba -> Maybe bout
hashWithCorrectAlgorithm :: forall ba bout.
(ByteArrayAccess ba, ByteArray bout) =>
CoseSignAlg -> ba -> Maybe bout
hashWithCorrectAlgorithm CoseSignAlg
Cose.CoseSignAlgEdDSA ba
_ =
Maybe bout
forall a. Maybe a
Nothing
hashWithCorrectAlgorithm (Cose.CoseSignAlgECDSA CoseHashAlgECDSA
Cose.CoseHashAlgECDSASHA256) ba
bytes =
bout -> Maybe bout
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (bout -> Maybe bout) -> bout -> Maybe bout
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> bout
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA256 -> ba -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Hash.hashWith SHA256
Hash.SHA256 ba
bytes)
hashWithCorrectAlgorithm (Cose.CoseSignAlgECDSA CoseHashAlgECDSA
Cose.CoseHashAlgECDSASHA384) ba
bytes =
bout -> Maybe bout
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (bout -> Maybe bout) -> bout -> Maybe bout
forall a b. (a -> b) -> a -> b
$ Digest SHA384 -> bout
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA384 -> ba -> Digest SHA384
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Hash.hashWith SHA384
Hash.SHA384 ba
bytes)
hashWithCorrectAlgorithm (Cose.CoseSignAlgECDSA CoseHashAlgECDSA
Cose.CoseHashAlgECDSASHA512) ba
bytes =
bout -> Maybe bout
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (bout -> Maybe bout) -> bout -> Maybe bout
forall a b. (a -> b) -> a -> b
$ Digest SHA512 -> bout
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA512 -> ba -> Digest SHA512
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Hash.hashWith SHA512
Hash.SHA512 ba
bytes)
hashWithCorrectAlgorithm (Cose.CoseSignAlgRSA CoseHashAlgRSA
Cose.CoseHashAlgRSASHA1) ba
bytes =
bout -> Maybe bout
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (bout -> Maybe bout) -> bout -> Maybe bout
forall a b. (a -> b) -> a -> b
$ Digest SHA1 -> bout
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA1 -> ba -> Digest SHA1
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Hash.hashWith SHA1
Hash.SHA1 ba
bytes)
hashWithCorrectAlgorithm (Cose.CoseSignAlgRSA CoseHashAlgRSA
Cose.CoseHashAlgRSASHA256) ba
bytes =
bout -> Maybe bout
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (bout -> Maybe bout) -> bout -> Maybe bout
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> bout
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA256 -> ba -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Hash.hashWith SHA256
Hash.SHA256 ba
bytes)
hashWithCorrectAlgorithm (Cose.CoseSignAlgRSA CoseHashAlgRSA
Cose.CoseHashAlgRSASHA384) ba
bytes =
bout -> Maybe bout
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (bout -> Maybe bout) -> bout -> Maybe bout
forall a b. (a -> b) -> a -> b
$ Digest SHA384 -> bout
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA384 -> ba -> Digest SHA384
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Hash.hashWith SHA384
Hash.SHA384 ba
bytes)
hashWithCorrectAlgorithm (Cose.CoseSignAlgRSA CoseHashAlgRSA
Cose.CoseHashAlgRSASHA512) ba
bytes =
bout -> Maybe bout
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (bout -> Maybe bout) -> bout -> Maybe bout
forall a b. (a -> b) -> a -> b
$ Digest SHA512 -> bout
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SHA512 -> ba -> Digest SHA512
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Hash.hashWith SHA512
Hash.SHA512 ba
bytes)
asfTrustAnchors :: Format -> VerifiableAttestationType -> CertificateStore
asfTrustAnchors Format
_ VerifiableAttestationType
_ = CertificateStore
rootCertificateStore
rootCertificateStore :: X509.CertificateStore
rootCertificateStore :: CertificateStore
rootCertificateStore = [SignedCertificate] -> CertificateStore
X509.makeCertificateStore ([SignedCertificate] -> CertificateStore)
-> [SignedCertificate] -> CertificateStore
forall a b. (a -> b) -> a -> b
$ ((Text, SignedCertificate) -> SignedCertificate)
-> [(Text, SignedCertificate)] -> [SignedCertificate]
forall a b. (a -> b) -> [a] -> [b]
map (Text, SignedCertificate) -> SignedCertificate
forall a b. (a, b) -> b
snd [(Text, SignedCertificate)]
rootCertificates
rootCertificates :: [(Text, X509.SignedCertificate)]
rootCertificates :: [(Text, SignedCertificate)]
rootCertificates = ([Char], ByteString) -> (Text, SignedCertificate)
processEntry (([Char], ByteString) -> (Text, SignedCertificate))
-> [([Char], ByteString)] -> [(Text, SignedCertificate)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> $(embedDir "root-certs/tpm")
where
processEntry :: (FilePath, BS.ByteString) -> (Text, X509.SignedCertificate)
processEntry :: ([Char], ByteString) -> (Text, SignedCertificate)
processEntry ([Char]
path, ByteString
bytes) = case ByteString -> Either [Char] SignedCertificate
X509.decodeSignedCertificate ByteString
bytes of
Right SignedCertificate
cert -> ((Char -> Bool) -> Text -> Text
Text.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') ([Char] -> Text
Text.pack [Char]
path), SignedCertificate
cert)
Left [Char]
err -> [Char] -> (Text, SignedCertificate)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Text, SignedCertificate))
-> [Char] -> (Text, SignedCertificate)
forall a b. (a -> b) -> a -> b
$ [Char]
"Error while decoding certificate " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
path [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
": " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
err
format :: M.SomeAttestationStatementFormat
format :: SomeAttestationStatementFormat
format = Format -> SomeAttestationStatementFormat
forall a.
AttestationStatementFormat a =>
a -> SomeAttestationStatementFormat
M.SomeAttestationStatementFormat Format
Format