packages feed

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 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