{-# 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 -> [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
l (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Maybe [Char]
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 -> [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
l (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
prefix [Char]
l,
constructorTagModifier :: [Char] -> [Char]
Aeson.constructorTagModifier = \[Char]
l -> (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ([Char] -> [Char])
-> (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
l (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Maybe [Char]
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 = NonEmpty e -> Validation (NonEmpty e) a
forall err a. err -> Validation err a
Failure (NonEmpty e -> Validation (NonEmpty e) a)
-> (e -> NonEmpty e) -> e -> Validation (NonEmpty e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> NonEmpty e
forall (f :: * -> *) a. Applicative f => a -> f a
pure
certificateSubjectKeyIdentifier :: X509.Certificate -> SubjectKeyIdentifier
certificateSubjectKeyIdentifier :: Certificate -> SubjectKeyIdentifier
certificateSubjectKeyIdentifier Certificate
cert = Digest SHA1 -> SubjectKeyIdentifier
SubjectKeyIdentifier (Digest SHA1 -> SubjectKeyIdentifier)
-> (ByteString -> Digest SHA1)
-> ByteString
-> SubjectKeyIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash (ByteString -> SubjectKeyIdentifier)
-> ByteString -> SubjectKeyIdentifier
forall a b. (a -> b) -> a -> b
$ ByteString
publicKeyBytes
where
asns :: [ASN1]
asns = PubKey -> ASN1S
forall a. ASN1Object a => a -> ASN1S
ASN1.toASN1 (Certificate -> PubKey
X509.certPubKey Certificate
cert) []
err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to decode the public key from the ASN.1 object generated: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [ASN1] -> [Char]
forall a. Show a => a -> [Char]
show [ASN1]
asns
publicKeyBytes :: ByteString
publicKeyBytes = ([Char] -> ByteString)
-> (ByteString -> ByteString)
-> Either [Char] ByteString
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> ByteString
forall {a}. a
err ByteString -> ByteString
forall a. a -> a
id (Either [Char] ByteString -> ByteString)
-> Either [Char] ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ParseASN1 ByteString -> [ASN1] -> Either [Char] ByteString
forall a. ParseASN1 a -> [ASN1] -> Either [Char] a
ASN1.runParseASN1 ParseASN1 ByteString
parsePublicKeyBytes [ASN1]
asns
parsePublicKeyBytes :: ASN1.ParseASN1 BS.ByteString
parsePublicKeyBytes :: ParseASN1 ByteString
parsePublicKeyBytes = ASN1ConstructionType
-> ParseASN1 ByteString -> ParseASN1 ByteString
forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
ASN1.onNextContainer ASN1ConstructionType
ASN1.Sequence (ParseASN1 ByteString -> ParseASN1 ByteString)
-> ParseASN1 ByteString -> ParseASN1 ByteString
forall a b. (a -> b) -> a -> b
$ do
ParseASN1 [ASN1] -> ParseASN1 ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParseASN1 [ASN1] -> ParseASN1 ())
-> ParseASN1 [ASN1] -> ParseASN1 ()
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 Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`mod` Word64
8 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
then ByteString -> ParseASN1 ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ParseASN1 ByteString)
-> ByteString -> ParseASN1 ByteString
forall a b. (a -> b) -> a -> b
$ BitArray -> ByteString
ASN1.bitArrayGetData BitArray
bitArray
else
[Char] -> ParseASN1 ByteString
forall a. [Char] -> ParseASN1 a
ASN1.throwParseError [Char]
"subjectPublicKey is not 8-bit aligned!"
newtype IdFidoGenCeAAGUID = IdFidoGenCeAAGUID AAGUID
deriving (IdFidoGenCeAAGUID -> IdFidoGenCeAAGUID -> Bool
(IdFidoGenCeAAGUID -> IdFidoGenCeAAGUID -> Bool)
-> (IdFidoGenCeAAGUID -> IdFidoGenCeAAGUID -> Bool)
-> Eq IdFidoGenCeAAGUID
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]
(Int -> IdFidoGenCeAAGUID -> [Char] -> [Char])
-> (IdFidoGenCeAAGUID -> [Char])
-> ([IdFidoGenCeAAGUID] -> [Char] -> [Char])
-> Show IdFidoGenCeAAGUID
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 = OID -> IdFidoGenCeAAGUID -> OID
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 = Bool -> Proxy IdFidoGenCeAAGUID -> Bool
forall a b. a -> b -> a
const Bool
True
extEncode :: IdFidoGenCeAAGUID -> [ASN1]
extEncode = [Char] -> IdFidoGenCeAAGUID -> [ASN1]
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 =
([Char] -> [Char])
-> Either [Char] IdFidoGenCeAAGUID
-> Either [Char] IdFidoGenCeAAGUID
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: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) (Either [Char] IdFidoGenCeAAGUID
-> Either [Char] IdFidoGenCeAAGUID)
-> Either [Char] IdFidoGenCeAAGUID
-> Either [Char] IdFidoGenCeAAGUID
forall a b. (a -> b) -> a -> b
$
ParseASN1 IdFidoGenCeAAGUID
-> [ASN1] -> Either [Char] IdFidoGenCeAAGUID
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 (ByteString -> Maybe UUID) -> ByteString -> Maybe UUID
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.fromStrict ByteString
bytes of
Just UUID
aaguid -> IdFidoGenCeAAGUID -> ParseASN1 IdFidoGenCeAAGUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdFidoGenCeAAGUID -> ParseASN1 IdFidoGenCeAAGUID)
-> IdFidoGenCeAAGUID -> ParseASN1 IdFidoGenCeAAGUID
forall a b. (a -> b) -> a -> b
$ AAGUID -> IdFidoGenCeAAGUID
IdFidoGenCeAAGUID (AAGUID -> IdFidoGenCeAAGUID) -> AAGUID -> IdFidoGenCeAAGUID
forall a b. (a -> b) -> a -> b
$ UUID -> AAGUID
AAGUID UUID
aaguid
Maybe UUID
Nothing -> [Char] -> ParseASN1 IdFidoGenCeAAGUID
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Could not extract aaguid"