webauthn (empty) → 0
raw patch · 10 files changed
+713/−0 lines, 10 filesdep +aesondep +asn1-encodingdep +asn1-typessetup-changed
Dependencies added: aeson, asn1-encoding, asn1-types, base, base16-bytestring, base64-bytestring, bytestring, cborg, cereal, containers, cryptonite, hashable, memory, serialise, text, x509, x509-validation
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- src/WebAuthn.hs +193/−0
- src/WebAuthn/FIDOU2F.hs +50/−0
- src/WebAuthn/Packed.hs +50/−0
- src/WebAuthn/Signature.hs +89/−0
- src/WebAuthn/TPM.hs +45/−0
- src/WebAuthn/Types.hs +203/−0
- webauthn.cabal +46/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for webauthn++## 0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, Fumiaki Kinoshita++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Fumiaki Kinoshita nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/WebAuthn.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-----------------------------------------------------------------------+-- |+-- Module : WebAuthn+-- License : BSD3+--+-- Maintainer : Fumiaki Kinoshita <fumiexcel@gmail.com>+--+-- <https://www.w3.org/TR/webauthn/ Web Authentication API> Verification library+-----------------------------------------------------------------------++module WebAuthn (+ -- * Basic+ TokenBinding(..)+ , Origin(..)+ , RelyingParty(..)+ , defaultRelyingParty+ , User(..)+ -- Challenge+ , Challenge(..)+ , generateChallenge+ , WebAuthnType(..)+ , CollectedClientData(..)+ , AuthenticatorData(..)+ , AttestedCredentialData(..)+ , AAGUID(..)+ , CredentialPublicKey(..)+ , CredentialId(..)+ -- * verfication+ , VerificationFailure(..)+ , registerCredential+ , verify+ ) where++import Prelude hiding (fail)+import Data.Aeson as J+import Data.Bits+import Data.ByteString (ByteString)+import qualified Data.Serialize as C+import qualified Data.ByteArray as BA+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Map as Map+import Data.Text (Text)+import Crypto.Random+import Crypto.Hash+import qualified Codec.CBOR.Term as CBOR+import qualified Codec.CBOR.Read as CBOR+import qualified Codec.CBOR.Decoding as CBOR+import qualified Codec.Serialise as CBOR+import Control.Monad.Fail++import WebAuthn.Signature+import WebAuthn.Types+import qualified WebAuthn.TPM as TPM+import qualified WebAuthn.FIDOU2F as U2F+import qualified WebAuthn.Packed as Packed++-- | Generate a cryptographic challenge (13.1).+generateChallenge :: Int -> IO Challenge+generateChallenge len = Challenge <$> getRandomBytes len++parseAuthenticatorData :: C.Get AuthenticatorData+parseAuthenticatorData = do+ rpIdHash' <- C.getBytes 32+ rpIdHash <- maybe (fail "impossible") pure $ digestFromByteString rpIdHash'+ flags <- C.getWord8+ _counter <- C.getBytes 4+ attestedCredentialData <- if testBit flags 6+ then do+ aaguid <- AAGUID <$> C.getBytes 16+ len <- C.getWord16be+ credentialId <- CredentialId <$> C.getBytes (fromIntegral len)+ n <- C.remaining+ credentialPublicKey <- CredentialPublicKey <$> C.getBytes n+ pure $ Just AttestedCredentialData{..}+ else pure Nothing+ let authenticatorDataExtension = B.empty --FIXME+ let userPresent = testBit flags 0+ let userVerified = testBit flags 2+ return AuthenticatorData{..}++-- | Attestation (6.4) provided by authenticators+data AttestationStatement = AF_Packed Packed.Stmt+ | AF_TPM TPM.Stmt+ | AF_AndroidKey+ | AF_AndroidSafetyNet+ | AF_FIDO_U2F U2F.Stmt+ | AF_None+ deriving Show++decodeAttestation :: CBOR.Decoder s (ByteString, AttestationStatement)+decodeAttestation = do+ m :: Map.Map Text CBOR.Term <- CBOR.decode+ CBOR.TString fmt <- maybe (fail "fmt") pure $ Map.lookup "fmt" m+ stmtTerm <- maybe (fail "stmt") pure $ Map.lookup "attStmt" m+ stmt <- case fmt of+ "fido-u2f" -> maybe (fail "fido-u2f") (pure . AF_FIDO_U2F) $ U2F.decode stmtTerm+ "packed" -> AF_Packed <$> Packed.decode stmtTerm+ "tpm" -> AF_TPM <$> TPM.decode stmtTerm+ _ -> fail $ "decodeAttestation: Unsupported format: " ++ show fmt+ CBOR.TBytes adRaw <- maybe (fail "authData") pure $ Map.lookup "authData" m+ return (adRaw, stmt)++-- | 7.1. Registering a New Credential+registerCredential :: Challenge+ -> RelyingParty+ -> Maybe Text -- ^ Token Binding ID in base64+ -> Bool -- ^ require user verification?+ -> ByteString -- ^ clientDataJSON+ -> ByteString -- ^ attestationObject+ -> Either VerificationFailure AttestedCredentialData+registerCredential challenge RelyingParty{..} tbi verificationRequired clientDataJSON attestationObject = do+ CollectedClientData{..} <- either+ (Left . JSONDecodeError) Right $ J.eitherDecode $ BL.fromStrict clientDataJSON+ clientType == Create ?? InvalidType+ challenge == clientChallenge ?? MismatchedChallenge+ rpOrigin == clientOrigin ?? MismatchedOrigin+ case clientTokenBinding of+ TokenBindingUnsupported -> pure ()+ TokenBindingSupported -> pure ()+ TokenBindingPresent t -> case tbi of+ Nothing -> Left UnexpectedPresenceOfTokenBinding+ Just t'+ | t == t' -> pure ()+ | otherwise -> Left MismatchedTokenBinding+ (adRaw, stmt) <- either (Left . CBORDecodeError "registerCredential") (pure . snd)+ $ CBOR.deserialiseFromBytes decodeAttestation+ $ BL.fromStrict $ attestationObject+ ad <- either (const $ Left MalformedAuthenticatorData) pure $ C.runGet parseAuthenticatorData adRaw+ let clientDataHash = hash clientDataJSON :: Digest SHA256+ hash rpId == rpIdHash ad ?? MismatchedRPID+ userPresent ad ?? UserNotPresent+ not verificationRequired || userVerified ad ?? UserUnverified++ -- TODO: extensions here++ case stmt of+ AF_FIDO_U2F s -> U2F.verify s ad clientDataHash+ AF_Packed s -> Packed.verify s ad adRaw clientDataHash+ AF_TPM s -> TPM.verify s ad adRaw clientDataHash+ AF_None -> pure ()+ _ -> error $ "registerCredential: unsupported format: " ++ show stmt++ case attestedCredentialData ad of+ Nothing -> Left MalformedAuthenticatorData+ Just c -> pure c++-- | 7.2. Verifying an Authentication Assertion+verify :: Challenge+ -> RelyingParty+ -> Maybe Text -- ^ Token Binding ID in base64+ -> Bool -- ^ require user verification?+ -> ByteString -- ^ clientDataJSON+ -> ByteString -- ^ authenticatorData+ -> ByteString -- ^ signature+ -> CredentialPublicKey -- ^ public key+ -> Either VerificationFailure ()+verify challenge RelyingParty{..} tbi verificationRequired clientDataJSON adRaw sig pub = do+ CollectedClientData{..} <- either+ (Left . JSONDecodeError) Right $ J.eitherDecode $ BL.fromStrict clientDataJSON+ clientType == Get ?? InvalidType+ challenge == clientChallenge ?? MismatchedChallenge+ rpOrigin == clientOrigin ?? MismatchedOrigin+ case clientTokenBinding of+ TokenBindingUnsupported -> pure ()+ TokenBindingSupported -> pure ()+ TokenBindingPresent t -> case tbi of+ Nothing -> Left UnexpectedPresenceOfTokenBinding+ Just t'+ | t == t' -> pure ()+ | otherwise -> Left MismatchedTokenBinding++ ad <- either (const $ Left MalformedAuthenticatorData) pure+ $ C.runGet parseAuthenticatorData adRaw++ let clientDataHash = hash clientDataJSON :: Digest SHA256+ hash rpId == rpIdHash ad ?? MismatchedRPID+ userPresent ad ?? UserNotPresent+ not verificationRequired || userVerified ad ?? UserUnverified++ let dat = adRaw <> BA.convert clientDataHash++ pub' <- parsePublicKey pub+ verifySig pub' sig dat++(??) :: Bool -> e -> Either e ()+False ?? e = Left e+True ?? _ = Right ()+infix 1 ??
+ src/WebAuthn/FIDOU2F.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module WebAuthn.FIDOU2F where++import Crypto.Hash+import Data.ByteString (ByteString)+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as BL+import qualified Codec.CBOR.Term as CBOR+import qualified Codec.Serialise as CBOR+import qualified Data.ByteArray as BA+import qualified Data.Map as Map+import qualified Data.X509 as X509+import qualified Data.X509.Validation as X509+import WebAuthn.Types++data Stmt = Stmt (X509.SignedExact X509.Certificate) ByteString+ deriving Show++decode :: CBOR.Term -> Maybe Stmt+decode (CBOR.TMap xs) = do+ let m = Map.fromList xs+ CBOR.TBytes sig <- Map.lookup (CBOR.TString "sig") m+ CBOR.TList [CBOR.TBytes certBS] <- Map.lookup (CBOR.TString "x5c") m+ cert <- either fail pure $ X509.decodeSignedCertificate certBS+ return (Stmt cert sig)+decode _ = Nothing++verify :: Stmt+ -> AuthenticatorData+ -> Digest SHA256+ -> Either VerificationFailure ()+verify (Stmt cert sig) AuthenticatorData{..} clientDataHash = do+ AttestedCredentialData{..} <- maybe (Left MalformedAuthenticatorData) pure attestedCredentialData+ m <- either (Left . CBORDecodeError "verifyFIDOU2F") pure+ $ CBOR.deserialiseOrFail $ BL.fromStrict $ unCredentialPublicKey credentialPublicKey+ pubU2F <- maybe (Left MalformedPublicKey) pure $ do+ CBOR.TBytes x <- Map.lookup (-2 :: Int) m+ CBOR.TBytes y <- Map.lookup (-3) m+ return $ BB.word8 0x04 <> BB.byteString x <> BB.byteString y+ let dat = BL.toStrict $ BB.toLazyByteString $ mconcat+ [ BB.word8 0x00+ , BB.byteString $ BA.convert rpIdHash+ , BB.byteString $ BA.convert clientDataHash+ , BB.byteString $ unCredentialId credentialId+ , pubU2F]+ let pub = X509.certPubKey $ X509.getCertificate cert+ case X509.verifySignature (X509.SignatureALG X509.HashSHA256 X509.PubKeyALG_EC) pub dat sig of+ X509.SignaturePass -> return ()+ X509.SignatureFailed _ -> Left $ SignatureFailure "FIDOU2F"
+ src/WebAuthn/Packed.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+module WebAuthn.Packed where++import Crypto.Hash+import Data.ByteString (ByteString)+import qualified Data.ByteArray as BA+import qualified Data.X509 as X509+import qualified Data.X509.Validation as X509+import qualified Codec.CBOR.Term as CBOR+import qualified Codec.CBOR.Decoding as CBOR+import qualified Data.Map as Map+import WebAuthn.Signature+import WebAuthn.Types++data Stmt = Stmt Int ByteString (Maybe (X509.SignedExact X509.Certificate))+ deriving Show++decode :: CBOR.Term -> CBOR.Decoder s Stmt+decode (CBOR.TMap xs) = do+ let m = Map.fromList xs+ CBOR.TInt alg <- Map.lookup (CBOR.TString "alg") m ??? "alg"+ CBOR.TBytes sig <- Map.lookup (CBOR.TString "sig") m ??? "sig"+ cert <- case Map.lookup (CBOR.TString "x5c") m of+ Just (CBOR.TList (CBOR.TBytes certBS : _)) ->+ either fail (pure . Just) $ X509.decodeSignedCertificate certBS+ _ -> pure Nothing+ return $ Stmt alg sig cert+ where+ Nothing ??? e = fail e+ Just a ??? _ = pure a+decode _ = fail "Packed.decode: expected a Map"++verify :: Stmt+ -> AuthenticatorData+ -> ByteString+ -> Digest SHA256+ -> Either VerificationFailure ()+verify (Stmt _ sig cert) ad adRaw clientDataHash = do+ let dat = adRaw <> BA.convert clientDataHash+ case cert of+ Just x509 -> do+ let pub = X509.certPubKey $ X509.getCertificate x509+ case X509.verifySignature (X509.SignatureALG X509.HashSHA256 X509.PubKeyALG_EC) pub dat sig of+ X509.SignaturePass -> return ()+ X509.SignatureFailed _ -> Left $ SignatureFailure "Packed"+ Nothing -> do+ pub <- case attestedCredentialData ad of+ Nothing -> Left MalformedAuthenticatorData+ Just c -> parsePublicKey $ credentialPublicKey c+ verifySig pub sig dat
+ src/WebAuthn/Signature.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE OverloadedStrings #-}+module WebAuthn.Signature (PublicKey(..)+ , parsePublicKey+ , verifySig+ ) where++import Control.Monad+import Data.Bits+import qualified Data.ByteArray as BA+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Crypto.Hash+import qualified Crypto.PubKey.ECC.ECDSA as EC+import qualified Crypto.PubKey.ECC.Types as EC+import qualified Crypto.PubKey.RSA.Types as RSA+import qualified Crypto.PubKey.RSA.Prim as RSA+import qualified Codec.CBOR.Term as CBOR+import qualified Codec.Serialise as CBOR+import qualified Data.Map as Map+import Data.ASN1.BinaryEncoding+import Data.ASN1.Encoding+import Data.ASN1.Types+import WebAuthn.Types++data PublicKey = PubEC EC.PublicKey | PubRSA RSA.PublicKey++verifySig :: PublicKey+ -> B.ByteString -- ^ signature+ -> B.ByteString -- ^ data+ -> Either VerificationFailure ()+verifySig (PubEC pub) sig dat = do+ sig' <- maybe (Left MalformedSignature) pure $ parseECSignature sig+ case EC.verify SHA256 pub sig' dat of+ True -> pure ()+ False -> Left $ SignatureFailure "EC256"+verifySig (PubRSA pub) sig dat+ | Just dat' <- parseRS256Signature (RSA.ep pub sig), dat' == BA.convert (hashWith SHA256 dat) = pure ()+ | otherwise = Left $ SignatureFailure "RS256"++parsePublicKey :: CredentialPublicKey -> Either VerificationFailure PublicKey+parsePublicKey pub = do+ m <- either (Left . CBORDecodeError "parsePublicKey") pure+ $ CBOR.deserialiseOrFail $ BL.fromStrict $ unCredentialPublicKey pub+ maybe (Left $ MalformedPublicKey) pure $ do+ CBOR.TInt ty <- Map.lookup 3 m+ case ty of+ -7 -> do+ CBOR.TInt crv <- Map.lookup (-1) m+ CBOR.TBytes x <- Map.lookup (-2 :: Int) m+ CBOR.TBytes y <- Map.lookup (-3) m+ c <- case crv of+ 1 -> pure EC.SEC_p256r1+ _ -> fail $ "parsePublicKey: unknown curve: " ++ show crv+ return $ PubEC $ EC.PublicKey (EC.getCurveByName c) (EC.Point (fromOctet x) (fromOctet y))+ -257 -> do+ CBOR.TBytes n <- Map.lookup (-1) m+ CBOR.TBytes e <- Map.lookup (-2) m+ return $ PubRSA $ RSA.PublicKey 256 (fromOctet n) (fromOctet e)+ _ -> fail $ "parsePublicKey: unknown algorithm"++fromOctet :: B.ByteString -> Integer+fromOctet = B.foldl' (\r x -> r `unsafeShiftL` 8 .|. fromIntegral x) 0++parseECSignature :: B.ByteString -> Maybe EC.Signature+parseECSignature b = case decodeASN1' BER b of+ Left _ -> Nothing+ Right asn1 -> case asn1 of+ Start Sequence:IntVal r:IntVal s:End Sequence:_ -> Just $ EC.Signature r s+ _ -> Nothing++parseRS256Signature :: B.ByteString -> Maybe B.ByteString+parseRS256Signature = unpad >=> \b -> case decodeASN1' BER b of+ Left _ -> Nothing+ Right asn1 -> case asn1 of+ Start Sequence:Start Sequence:_:_:End Sequence:OctetString sig:_ -> Just sig+ _ -> Nothing++unpad :: B.ByteString -> Maybe B.ByteString+unpad packed+ | paddingSuccess = Just m+ | otherwise = Nothing+ where+ (zt, ps0m) = B.splitAt 2 packed+ (ps, zm) = B.span (/= 0) ps0m+ (z, m) = B.splitAt 1 zm+ paddingSuccess = and [ zt == "\NUL\SOH"+ , z == "\NUL"+ , B.length ps >= 8+ ]
+ src/WebAuthn/TPM.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}+module WebAuthn.TPM where++import Data.ByteString (ByteString)+import Crypto.Hash (Digest, SHA256)+import qualified Data.X509 as X509+import qualified Data.X509.Validation as X509+import qualified Codec.CBOR.Term as CBOR+import qualified Codec.CBOR.Decoding as CBOR+import qualified Data.Map as Map+import WebAuthn.Types (VerificationFailure(..), AuthenticatorData)++data Stmt = Stmt Int ByteString (X509.SignedExact X509.Certificate) ByteString deriving Show++decode :: CBOR.Term -> CBOR.Decoder s Stmt+decode (CBOR.TMap xs) = do+ let m = Map.fromList xs+ CBOR.TInt alg <- Map.lookup (CBOR.TString "alg") m ??? "alg"+ CBOR.TBytes sig <- Map.lookup (CBOR.TString "sig") m ??? "sig"+ CBOR.TList (CBOR.TBytes certBS : _) <- Map.lookup (CBOR.TString "x5c") m ??? "x5c"+ aikCert <- either fail pure $ X509.decodeSignedCertificate certBS+ CBOR.TBytes certInfo <- Map.lookup (CBOR.TString "certInfo") m ??? "certInfo"+ -- pubArea <- Map.lookup (CBOR.TString "pubArea") ?? "pubArea"+ return $ Stmt alg sig aikCert certInfo+ where+ Nothing ??? e = fail e+ Just a ??? _ = pure a+decode _ = fail "TPM.decode: expected a Map"++verify :: Stmt+ -> AuthenticatorData+ -> ByteString+ -> Digest SHA256+ -> Either VerificationFailure ()+verify (Stmt alg sig x509 certInfo) _ad _adRaw _clientDataHash = do+ -- TODO Verify that the public key specified by the parameters and unique fields of pubArea is identical to the credentialPublicKey in the attestedCredentialData in authenticatorData.+ let pub = X509.certPubKey $ X509.getCertificate x509+ -- let attToBeSigned = adRaw <> BA.convert clientDataHash+ -- https://www.iana.org/assignments/cose/cose.xhtml#algorithms+ case alg of+ -65535 -> do+ case X509.verifySignature (X509.SignatureALG X509.HashSHA1 X509.PubKeyALG_RSA) pub certInfo sig of+ X509.SignaturePass -> return ()+ X509.SignatureFailed _ -> Left $ SignatureFailure "TPM"+ _ -> Left $ UnsupportedAlgorithm alg
+ src/WebAuthn/Types.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE StrictData #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+module WebAuthn.Types (+ -- * Relying party+ RelyingParty(..)+ , Origin(..)+ , defaultRelyingParty+ , TokenBinding(..)+ -- Challenge+ , Challenge(..)+ , WebAuthnType(..)+ , CollectedClientData(..)+ , AuthenticatorData(..)+ -- * Credential+ , AttestedCredentialData(..)+ , AAGUID(..)+ , CredentialPublicKey(..)+ , CredentialId(..)+ , User(..)+ -- * Exception+ , VerificationFailure(..)+ ) where++import Prelude hiding (fail)+import Data.Aeson as J+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Base64.URL as Base64+import Data.ByteString.Base16 as Base16+import qualified Data.Hashable as H+import qualified Data.Map as Map+import Data.Text (Text)+import Data.Text.Encoding+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Read as T+import Crypto.Hash+import qualified Codec.CBOR.Term as CBOR+import qualified Codec.CBOR.Read as CBOR+import qualified Codec.Serialise as CBOR+import Control.Monad.Fail+import GHC.Generics (Generic)++-- | 13.1. Cryptographic Challenges+newtype Challenge = Challenge { rawChallenge :: ByteString }+ deriving (Show, Eq, Ord, H.Hashable, CBOR.Serialise)++instance ToJSON Challenge where+ toJSON = toJSON . decodeUtf8 . Base64.encode . rawChallenge++instance FromJSON Challenge where+ parseJSON = withText "Challenge" $ pure . Challenge+ . Base64.decodeLenient . encodeUtf8++-- | 5.10.1. Client Data Used in WebAuthn Signatures (dictionary CollectedClientData)+data CollectedClientData = CollectedClientData+ { clientType :: WebAuthnType+ , clientChallenge :: Challenge+ , clientOrigin :: Origin+ , clientTokenBinding :: TokenBinding+ }+instance FromJSON CollectedClientData where+ parseJSON = withObject "CollectedClientData" $ \obj -> CollectedClientData+ <$> obj .: "type"+ <*> obj .: "challenge"+ <*> obj .: "origin"+ <*> fmap (maybe TokenBindingUnsupported id) (obj .:? "tokenBinding")+ +-- | state of the Token Binding protocol (unsupported)+data TokenBinding = TokenBindingUnsupported+ | TokenBindingSupported+ | TokenBindingPresent !Text++instance FromJSON TokenBinding where+ parseJSON = withText "TokenBinding" $ \case+ "supported" -> pure TokenBindingSupported -- FIXME+ _ -> fail "unknown TokenBinding"++data WebAuthnType = Create | Get+ deriving (Show, Eq, Ord)++instance FromJSON WebAuthnType where+ parseJSON = withText "WebAuthnType" $ \case+ "webauthn.create" -> pure Create+ "webauthn.get" -> pure Get+ _ -> fail "unknown WebAuthnType"++data Origin = Origin+ { originScheme :: Text+ , originHost :: Text+ , originPort :: Maybe Int+ }+ deriving (Show, Eq, Ord)++-- | WebAuthn Relying Party+data RelyingParty = RelyingParty+ { rpOrigin :: Origin+ , rpId :: ByteString+ , rpAllowSelfAttestation :: Bool+ , rpAllowNoAttestation :: Bool+ }+ deriving (Show, Eq, Ord)++defaultRelyingParty :: Origin -> RelyingParty+defaultRelyingParty orig = RelyingParty orig (encodeUtf8 $ originHost orig) False False++instance FromJSON Origin where+ parseJSON = withText "Origin" $ \str -> case T.break (==':') str of+ (sch, url) -> case T.break (==':') $ T.drop 3 url of+ (host, portStr)+ | T.null portStr -> pure $ Origin sch host Nothing+ | otherwise -> case T.decimal $ T.drop 1 portStr of+ Left e -> fail e+ Right (port, _) -> pure $ Origin sch host $ Just port++-- | 6.1. Authenticator Data+data AuthenticatorData = AuthenticatorData+ { rpIdHash :: Digest SHA256+ , userPresent :: Bool+ , userVerified :: Bool+ , attestedCredentialData :: Maybe AttestedCredentialData+ , authenticatorDataExtension :: ByteString+ }++-- | A probabilistically-unique byte sequence identifying a public key credential source and its authentication assertions.+newtype CredentialId = CredentialId { unCredentialId :: ByteString }+ deriving (Show, Eq, H.Hashable, CBOR.Serialise)++instance FromJSON CredentialId where+ parseJSON = fmap (CredentialId . Base64.decodeLenient . T.encodeUtf8) . parseJSON++instance ToJSON CredentialId where+ toJSON = toJSON . T.decodeUtf8 . Base64.encode . unCredentialId++-- | credential public key encoded in COSE_Key format+newtype CredentialPublicKey = CredentialPublicKey { unCredentialPublicKey :: ByteString }+ deriving (Show, Eq, H.Hashable, CBOR.Serialise)++instance FromJSON CredentialPublicKey where+ parseJSON v = parseJSON v+ >>= either (const $ fail "failed to decode a public key") (pure . CredentialPublicKey)+ . Base64.decode . T.encodeUtf8++instance ToJSON CredentialPublicKey where+ toJSON = toJSON . T.decodeUtf8 . Base64.encode . unCredentialPublicKey++-- | AAGUID of the authenticator+newtype AAGUID = AAGUID { unAAGUID :: ByteString } deriving (Show, Eq)++instance FromJSON AAGUID where+ parseJSON v = parseJSON v+ >>= either fail (pure . AAGUID) . Base16.decode . T.encodeUtf8++instance ToJSON AAGUID where+ toJSON = toJSON . T.decodeUtf8 . Base16.encode . unAAGUID++-- | 6.4.1. Attested Credential Data+data AttestedCredentialData = AttestedCredentialData+ { aaguid :: AAGUID+ , credentialId :: CredentialId+ , credentialPublicKey :: CredentialPublicKey+ } deriving (Show, Eq, Generic)++instance J.FromJSON AttestedCredentialData+instance J.ToJSON AttestedCredentialData++-- | 5.4.3. User Account Parameters for Credential Generation+data User = User+ { userId :: B.ByteString+ , userDisplayName :: T.Text+ } deriving (Generic, Show, Eq)++instance CBOR.Serialise User where+ encode (User i d) = CBOR.encode $ Map.fromList+ [("id" :: Text, CBOR.TBytes i), ("displayName", CBOR.TString d)]+ decode = do+ m <- CBOR.decode+ CBOR.TBytes i <- maybe (fail "id") pure $ Map.lookup ("id" :: Text) m+ CBOR.TString d <- maybe (fail "displayName") pure $ Map.lookup "displayName" m+ return $ User i d++data VerificationFailure+ = InvalidType+ | MismatchedChallenge+ | MismatchedOrigin+ | UnexpectedPresenceOfTokenBinding+ | MismatchedTokenBinding+ | JSONDecodeError String+ | CBORDecodeError String CBOR.DeserialiseFailure+ | MismatchedRPID+ | UserNotPresent+ | UserUnverified+ | UnsupportedAttestationFormat+ | UnsupportedAlgorithm Int+ | MalformedPublicKey+ | MalformedAuthenticatorData+ | MalformedX509Certificate+ | MalformedSignature+ | SignatureFailure String+ deriving Show
+ webauthn.cabal view
@@ -0,0 +1,46 @@+cabal-version: 2.4+-- Initial package description 'webauthn.cabal' generated by 'cabal init'.+-- For further documentation, see http://haskell.org/cabal/users-guide/++name: webauthn+version: 0+synopsis: Web Authentication API+-- description:+homepage: https://github.com/fumieval/webauthn+-- bug-reports:+license: BSD-3-Clause+license-file: LICENSE+author: Fumiaki Kinoshita+maintainer: fumiexcel@gmail.com+-- copyright:+category: Web+extra-source-files: CHANGELOG.md++library+ exposed-modules:+ WebAuthn+ WebAuthn.Types+ WebAuthn.FIDOU2F+ WebAuthn.Packed+ WebAuthn.Signature+ WebAuthn.TPM+ build-depends: base == 4.*+ , containers+ , cryptonite+ , cborg+ , cereal+ , bytestring+ , hashable+ , aeson+ , asn1-types+ , asn1-encoding+ , text+ , x509+ , x509-validation+ , memory+ , serialise+ , base16-bytestring+ , base64-bytestring+ hs-source-dirs: src+ ghc-options: -Wall+ default-language: Haskell2010