{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
module Crypto.WebAuthn.Internal.Utils
( jsonEncodingOptions,
enumJSONEncodingOptions,
failure,
certificateSubjectKeyIdentifier,
IdFidoGenCeAAGUID (..),
)
where
import Control.Monad (void)
import Crypto.Hash (hash)
import Crypto.WebAuthn.Model.Identifier (AAGUID (AAGUID), SubjectKeyIdentifier (SubjectKeyIdentifier))
import qualified Data.ASN1.BitArray as ASN1
import Data.ASN1.Parse (ParseASN1, getNext, runParseASN1)
import qualified Data.ASN1.Parse as ASN1
import Data.ASN1.Prim (ASN1 (OctetString))
import qualified Data.ASN1.Types as ASN1
import qualified Data.Aeson as Aeson
import Data.Bifunctor (first)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Char (toLower)
import Data.List (stripPrefix)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromMaybe)
import qualified Data.UUID as UUID
import Data.Validation (Validation (Failure))
import Data.X509 (Extension)
import qualified Data.X509 as X509
jsonEncodingOptions :: Aeson.Options
jsonEncodingOptions :: Options
jsonEncodingOptions =
Options
Aeson.defaultOptions
{ omitNothingFields :: Bool
Aeson.omitNothingFields = Bool
True,
fieldLabelModifier :: [Char] -> [Char]
Aeson.fieldLabelModifier = \[Char]
l -> forall a. a -> Maybe a -> a
fromMaybe [Char]
l forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"lit" [Char]
l
}
enumJSONEncodingOptions :: String -> Aeson.Options
enumJSONEncodingOptions :: [Char] -> Options
enumJSONEncodingOptions [Char]
prefix =
Options
Aeson.defaultOptions
{ omitNothingFields :: Bool
Aeson.omitNothingFields = Bool
True,
fieldLabelModifier :: [Char] -> [Char]
Aeson.fieldLabelModifier = \[Char]
l -> forall a. a -> Maybe a -> a
fromMaybe [Char]
l forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
prefix [Char]
l,
constructorTagModifier :: [Char] -> [Char]
Aeson.constructorTagModifier = \[Char]
l -> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe [Char]
l forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
prefix [Char]
l
}
failure :: e -> Validation (NonEmpty e) a
failure :: forall e a. e -> Validation (NonEmpty e) a
failure = forall err a. err -> Validation err a
Failure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
certificateSubjectKeyIdentifier :: X509.Certificate -> SubjectKeyIdentifier
certificateSubjectKeyIdentifier :: Certificate -> SubjectKeyIdentifier
certificateSubjectKeyIdentifier Certificate
cert = Digest SHA1 -> SubjectKeyIdentifier
SubjectKeyIdentifier forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash forall a b. (a -> b) -> a -> b
$ ByteString
publicKeyBytes
where
asns :: [ASN1]
asns = forall a. ASN1Object a => a -> ASN1S
ASN1.toASN1 (Certificate -> PubKey
X509.certPubKey Certificate
cert) []
err :: a
err = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to decode the public key from the ASN.1 object generated: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show [ASN1]
asns
publicKeyBytes :: ByteString
publicKeyBytes = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. a
err forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. ParseASN1 a -> [ASN1] -> Either [Char] a
ASN1.runParseASN1 ParseASN1 ByteString
parsePublicKeyBytes [ASN1]
asns
parsePublicKeyBytes :: ASN1.ParseASN1 BS.ByteString
parsePublicKeyBytes :: ParseASN1 ByteString
parsePublicKeyBytes = forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
ASN1.onNextContainer ASN1ConstructionType
ASN1.Sequence forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ ASN1ConstructionType -> ParseASN1 [ASN1]
ASN1.getNextContainer ASN1ConstructionType
ASN1.Sequence
ASN1.BitString BitArray
bitArray <- ParseASN1 ASN1
ASN1.getNext
if BitArray -> Word64
ASN1.bitArrayLength BitArray
bitArray forall a. Integral a => a -> a -> a
`mod` Word64
8 forall a. Eq a => a -> a -> Bool
== Word64
0
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ BitArray -> ByteString
ASN1.bitArrayGetData BitArray
bitArray
else
forall a. [Char] -> ParseASN1 a
ASN1.throwParseError [Char]
"subjectPublicKey is not 8-bit aligned!"
newtype IdFidoGenCeAAGUID = IdFidoGenCeAAGUID AAGUID
deriving (IdFidoGenCeAAGUID -> IdFidoGenCeAAGUID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdFidoGenCeAAGUID -> IdFidoGenCeAAGUID -> Bool
$c/= :: IdFidoGenCeAAGUID -> IdFidoGenCeAAGUID -> Bool
== :: IdFidoGenCeAAGUID -> IdFidoGenCeAAGUID -> Bool
$c== :: IdFidoGenCeAAGUID -> IdFidoGenCeAAGUID -> Bool
Eq, Int -> IdFidoGenCeAAGUID -> [Char] -> [Char]
[IdFidoGenCeAAGUID] -> [Char] -> [Char]
IdFidoGenCeAAGUID -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [IdFidoGenCeAAGUID] -> [Char] -> [Char]
$cshowList :: [IdFidoGenCeAAGUID] -> [Char] -> [Char]
show :: IdFidoGenCeAAGUID -> [Char]
$cshow :: IdFidoGenCeAAGUID -> [Char]
showsPrec :: Int -> IdFidoGenCeAAGUID -> [Char] -> [Char]
$cshowsPrec :: Int -> IdFidoGenCeAAGUID -> [Char] -> [Char]
Show)
instance Extension IdFidoGenCeAAGUID where
extOID :: IdFidoGenCeAAGUID -> OID
extOID = forall a b. a -> b -> a
const [Integer
1, Integer
3, Integer
6, Integer
1, Integer
4, Integer
1, Integer
45724, Integer
1, Integer
1, Integer
4]
extHasNestedASN1 :: Proxy IdFidoGenCeAAGUID -> Bool
extHasNestedASN1 = forall a b. a -> b -> a
const Bool
True
extEncode :: IdFidoGenCeAAGUID -> [ASN1]
extEncode = forall a. HasCallStack => [Char] -> a
error [Char]
"Unimplemented: This library does not implement encoding the ID_FIDO_GEN_CE_AAGUID extension"
extDecode :: [ASN1] -> Either [Char] IdFidoGenCeAAGUID
extDecode [ASN1]
asn1 =
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Char]
"Could not decode ASN1 id-fido-gen-ce-aaguid extension: " forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$
forall a. ParseASN1 a -> [ASN1] -> Either [Char] a
runParseASN1 ParseASN1 IdFidoGenCeAAGUID
decodeFidoAAGUID [ASN1]
asn1
where
decodeFidoAAGUID :: ParseASN1 IdFidoGenCeAAGUID
decodeFidoAAGUID :: ParseASN1 IdFidoGenCeAAGUID
decodeFidoAAGUID = do
OctetString ByteString
bytes <- ParseASN1 ASN1
getNext
case ByteString -> Maybe UUID
UUID.fromByteString forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.fromStrict ByteString
bytes of
Just UUID
aaguid -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ AAGUID -> IdFidoGenCeAAGUID
IdFidoGenCeAAGUID forall a b. (a -> b) -> a -> b
$ UUID -> AAGUID
AAGUID UUID
aaguid
Maybe UUID
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Could not extract aaguid"