From 4b8f0a3e49774fe7881bc77c4935403aa62e2814 Mon Sep 17 00:00:00 2001 From: Sumit Raja Date: Sat, 1 Aug 2020 19:38:28 +1000 Subject: [PATCH] PublicKeyCredentialCreationOptions for device registration --- src/Web/WebAuthn.hs | 7 +- src/Web/WebAuthn/AndroidSafetyNet.hs | 14 +-- src/Web/WebAuthn/Types.hs | 168 +++++++++++++++++++++++---- test/Tests.hs | 51 ++++++-- 4 files changed, 195 insertions(+), 45 deletions(-) diff --git a/src/Web/WebAuthn.hs b/src/Web/WebAuthn.hs index 5cd0d37..f9bcf3e 100644 --- a/src/Web/WebAuthn.hs +++ b/src/Web/WebAuthn.hs @@ -55,6 +55,7 @@ import Control.Monad.Trans.Except (runExceptT, ExceptT(..), throwE) import Data.Text (pack) import qualified Data.X509.CertificateStore as X509 import Data.Bifunctor (first) +import Data.Text.Encoding (encodeUtf8) generateChallenge :: Int -> IO Challenge generateChallenge len = Challenge <$> getRandomBytes len @@ -130,7 +131,7 @@ registerCredential :: MonadIO m => X509.CertificateStore -> ByteString -- ^ clientDataJSON -> ByteString -- ^ attestationObject -> m (Either VerificationFailure CredentialData) -registerCredential cs challenge RelyingParty{..} tbi verificationRequired clientDataJSON attestationObjectBS = runExceptT $ do +registerCredential cs challenge (RelyingParty rpOrigin rpId _ _) tbi verificationRequired clientDataJSON attestationObjectBS = runExceptT $ do _ <- hoistEither runAttestationCheck attestationObject <- hoistEither $ either (Left . CBORDecodeError "registerCredential") (pure . snd) $ CBOR.deserialiseFromBytes decodeAttestation @@ -167,7 +168,7 @@ registerCredential cs challenge RelyingParty{..} tbi verificationRequired client | otherwise -> Left MismatchedTokenBinding extractAuthData attestationObject = do ad <- either (const $ Left MalformedAuthenticatorData) pure $ C.runGet parseAuthenticatorData (authData attestationObject) - hash rpId == rpIdHash ad ?? MismatchedRPID + hash (encodeUtf8 rpId) == rpIdHash ad ?? MismatchedRPID userPresent ad ?? UserNotPresent not verificationRequired || userVerified ad ?? UserUnverified pure ad @@ -208,7 +209,7 @@ verifyClientTokenBinding _ _ = pure () verifyAuthenticatorData :: RelyingParty -> ByteString -> Bool -> Either VerificationFailure AuthenticatorData verifyAuthenticatorData rp adRaw verificationRequired = do ad <- first (const MalformedAuthenticatorData) (C.runGet parseAuthenticatorData adRaw) - hash (rpId (rp :: RelyingParty)) == rpIdHash ad ?? MismatchedRPID + hash (encodeUtf8 $ rpId (rp :: RelyingParty)) == rpIdHash ad ?? MismatchedRPID userPresent ad ?? UserNotPresent not verificationRequired || userVerified ad ?? UserUnverified pure ad diff --git a/src/Web/WebAuthn/AndroidSafetyNet.hs b/src/Web/WebAuthn/AndroidSafetyNet.hs index 75322f0..097f987 100644 --- a/src/Web/WebAuthn/AndroidSafetyNet.hs +++ b/src/Web/WebAuthn/AndroidSafetyNet.hs @@ -35,18 +35,18 @@ decode :: CBOR.Term -> CBOR.Decoder s StmtSafetyNet decode (CBOR.TMap xs) = do let m = Map.fromList xs let CBOR.TBytes response = fromMaybe (CBOR.TString "response") (Map.lookup (CBOR.TString "response") m) - case (B.split (fromIntegral . ord $ '.') response) of + case B.split (fromIntegral . ord $ '.') response of (h : p : s : _) -> StmtSafetyNet (Base64ByteString h) (Base64ByteString p) (Base64URL.decodeLenient s) <$> getCertificateChain h - _ -> fail ("decodeSafetyNet: response was not a JWT") + _ -> fail "decodeSafetyNet: response was not a JWT" decode _ = fail "decodeSafetyNet: expected a Map" getCertificateChain :: MonadFail m => ByteString -> m X509.CertificateChain getCertificateChain h = do let bs = BL.fromStrict $ Base64URL.decodeLenient h - case (J.eitherDecode bs) of - Left e -> fail ("android-safetynet: Response header decode failed: " <> (show e)) + case J.eitherDecode bs of + Left e -> fail ("android-safetynet: Response header decode failed: " <> show e) Right jth -> do - if (alg jth) /= "RS256" then fail ("android-safetynet: Unknown signature alg " <> (show $ alg jth)) else do + if alg (jth ::JWTHeader) /= "RS256" then fail ("android-safetynet: Unknown signature alg " <> show (alg (jth :: JWTHeader))) else do let x5cbs = Base64.decodeLenient . encodeUtf8 <$> x5c jth case X509.decodeCertificateChain (X509.CertificateChainRaw x5cbs) of Left e -> fail ("Certificate chain decode failed: " <> show e) @@ -62,12 +62,12 @@ verify cs sf authDataRaw clientDataHash = do let dat = authDataRaw <> BA.convert clientDataHash as <- extractAndroidSafetyNet let nonceCheck = Base64.encode (BA.convert (hash dat :: Digest SHA256)) - if nonceCheck /= (BL.toStrict $ BL.pack (nonce as)) then throwE NonceCheckFailure else pure () + if nonceCheck /= BL.toStrict (BL.pack (nonce as)) then throwE NonceCheckFailure else pure () where extractAndroidSafetyNet = ExceptT $ pure $ first JSONDecodeError $ J.eitherDecode (BL.fromStrict . Base64URL.decodeLenient . unBase64ByteString $ payload sf) verifyJWS = do - let dat = (unBase64ByteString $ header sf) <> "." <> (unBase64ByteString $ payload sf) + let dat = unBase64ByteString (header sf) <> "." <> unBase64ByteString (payload sf) res <- liftIO $ X509.validateDefault cs (X509.exceptionValidationCache []) ("attest.android.com", "") (certificates sf) case res of [] -> pure () diff --git a/src/Web/WebAuthn/Types.hs b/src/Web/WebAuthn/Types.hs index 9db10e9..6fa3c88 100644 --- a/src/Web/WebAuthn/Types.hs +++ b/src/Web/WebAuthn/Types.hs @@ -30,6 +30,12 @@ module Web.WebAuthn.Types ( , PublicKeyCredentialDescriptor(..) , AuthenticatorTransport(..) , PublicKeyCredentialType(..) + , PublicKeyCredentialCreationOptions(..) + , PubKeyCredParam (..) + , Attestation (..) + , Extensions (..) + , AuthenticatorSelection (..) + , PubKeyCredAlg (..) ) where import Prelude hiding (fail) @@ -42,9 +48,13 @@ import Data.Aeson as J constructorTagModifier, FromJSON(..), ToJSON(..), - Options(..) ) + Options(..) + , genericToEncoding + , defaultOptions + , object + , (.=) + ) import Data.ByteString (ByteString) -import qualified Data.ByteString as B import qualified Data.ByteString.Base64.URL as Base64 import Data.ByteString.Base16 as Base16 (decodeLenient, encode ) import qualified Data.Hashable as H @@ -61,18 +71,20 @@ import qualified Codec.Serialise as CBOR import Control.Monad.Fail ( MonadFail(fail) ) import GHC.Generics (Generic) import qualified Data.X509 as X509 -import Data.Aeson.Types (typeMismatch) -import Data.Aeson (genericToEncoding, defaultOptions) -import Data.Char ( toLower ) +import Data.Aeson.Types (Pair, typeMismatch) +import Data.Char ( toLower, toUpper ) +import Data.ByteArray (ByteArrayAccess) +import Data.Aeson (SumEncoding(UntaggedValue)) +import Data.List.NonEmpty -newtype Base64ByteString = Base64ByteString { unBase64ByteString :: ByteString } deriving (Generic, Show, Eq) +newtype Base64ByteString = Base64ByteString { unBase64ByteString :: ByteString } deriving (Generic, Show, Eq, ByteArrayAccess) instance ToJSON Base64ByteString where toJSON (Base64ByteString bs) = String $ decodeUtf8 $ Base64.encode bs instance FromJSON Base64ByteString where parseJSON s@(String v) = do - eth <- pure $ Base64.decode (encodeUtf8 v) + let eth = Base64.decode (encodeUtf8 v) case eth of Left err -> typeMismatch ("Base64: " <> err) s Right str -> pure (Base64ByteString str) @@ -129,19 +141,29 @@ data Origin = Origin instance ToJSON Origin where toJSON origin = String (originScheme origin <> "://" <> originHost origin <> (port $ originPort origin)) where - port (Just int) = ":" <> (T.pack $ show int) + port (Just int) = ":" <> T.pack (show int) port Nothing = "" data RelyingParty = RelyingParty { rpOrigin :: Origin - , rpId :: ByteString - , rpAllowSelfAttestation :: Bool - , rpAllowNoAttestation :: Bool + , rpId :: Text + , icon :: Maybe Base64ByteString + , name :: Maybe Base64ByteString } - deriving (Show, Eq, Ord) + deriving (Show, Eq, Generic) + +instance ToJSON RelyingParty where + toJSON rpo = object (["id" .= toJSON (rpId (rpo :: RelyingParty))] + <> maybeToPair "icon" (icon rpo) + <> maybeToPair "name" (name (rpo :: RelyingParty))) + +maybeToPair :: Text -> Maybe Base64ByteString -> [Pair] +maybeToPair _ Nothing = [] +maybeToPair lbl (Just bs) = [lbl .= toJSON bs] + defaultRelyingParty :: Origin -> RelyingParty -defaultRelyingParty orig = RelyingParty orig (encodeUtf8 $ originHost orig) False False +defaultRelyingParty orig = RelyingParty orig (originHost orig) Nothing Nothing instance FromJSON Origin where parseJSON = withText "Origin" $ \str -> case T.break (==':') str of @@ -198,20 +220,31 @@ instance J.FromJSON CredentialData instance J.ToJSON CredentialData data User = User - { userId :: B.ByteString - , userName :: T.Text - , userDisplayName :: T.Text + { id :: Base64ByteString + , name :: Maybe T.Text + , displayName :: Maybe T.Text } deriving (Generic, Show, Eq) +instance ToJSON User where + toEncoding = genericToEncoding defaultOptions { omitNothingFields = True} + instance CBOR.Serialise User where encode (User i n d) = CBOR.encode $ Map.fromList - [("id" :: Text, CBOR.TBytes i), ("name", CBOR.TString n), ("displayName", CBOR.TString d)] + ([("id" :: Text, CBOR.TBytes (unBase64ByteString i))] <> maybeToCBORString "name" n <> maybeToCBORString "displayName" d) decode = do m <- CBOR.decode CBOR.TBytes i <- maybe (fail "id") pure $ Map.lookup ("id" :: Text) m - CBOR.TString n <- maybe (fail "name") pure $ Map.lookup "name" m - CBOR.TString d <- maybe (fail "displayName") pure $ Map.lookup "displayName" m - return $ User i n d + let mayn = Map.lookup "name" m + let mayd = Map.lookup "displayName" m + return $ User (Base64ByteString i) (maybeCBORTStringToText mayn) (maybeCBORTStringToText mayd) + +maybeCBORTStringToText :: Maybe CBOR.Term -> Maybe Text +maybeCBORTStringToText (Just (CBOR.TString txt)) = Just txt +maybeCBORTStringToText _ = Nothing + +maybeToCBORString :: Text -> Maybe Text -> [(Text, CBOR.Term)] +maybeToCBORString _ Nothing = [] +maybeToCBORString lbl (Just txt) = [(lbl, CBOR.TString txt)] data VerificationFailure = InvalidType @@ -259,7 +292,6 @@ data JWTHeader = JWTHeader { instance FromJSON JWTHeader - data PublicKeyCredentialType = PublicKey deriving (Eq, Show) instance ToJSON PublicKeyCredentialType where @@ -272,12 +304,12 @@ data AuthenticatorTransport = USB -- usb deriving (Eq, Show, Generic) instance ToJSON AuthenticatorTransport where - toEncoding = genericToEncoding defaultOptions { constructorTagModifier = fmap toLower } + toEncoding = genericToEncoding defaultOptions { sumEncoding = UntaggedValue, constructorTagModifier = fmap toLower } data PublicKeyCredentialDescriptor = PublicKeyCredentialDescriptor { tipe :: PublicKeyCredentialType , id :: Base64ByteString - , transports :: [AuthenticatorTransport] + , transports :: Maybe (NonEmpty AuthenticatorTransport) } deriving (Eq, Show, Generic) instance ToJSON PublicKeyCredentialDescriptor where @@ -286,12 +318,98 @@ instance ToJSON PublicKeyCredentialDescriptor where mapTipe :: String -> String mapTipe str = if str == "tipe" then "type" else str +data UserVerification = Required | Preferred | Discouraged deriving (Show, Eq, Generic) + +instance ToJSON UserVerification where + toEncoding = genericToEncoding defaultOptions { sumEncoding = UntaggedValue, constructorTagModifier = fmap toLower } + data PublicKeyCredentialRequestOptions = PublicKeyCredentialRequestOptions { challenge :: Base64ByteString , timeout :: Maybe Integer , rpId :: Maybe Text - , allowCredentials :: Maybe PublicKeyCredentialDescriptor + , allowCredentials ::Maybe (NonEmpty PublicKeyCredentialDescriptor) + , userVerification :: Maybe UserVerification + -- extensions omitted as support is minimal https://developer.mozilla.org/en-US/docs/Web/API/PublicKeyCredentialRequestOptions/extensions } deriving (Eq, Show, Generic) instance ToJSON PublicKeyCredentialRequestOptions where - toEncoding = genericToEncoding defaultOptions { omitNothingFields = True} \ No newline at end of file + toEncoding = genericToEncoding defaultOptions { omitNothingFields = True} + +data PubKeyCredAlg = ES256 -- -7 + | RS256 -- (-257) + | PS256 -- (-37) + deriving (Show, Eq) + +instance ToJSON PubKeyCredAlg where + toJSON ES256 = Number (-7) + toJSON RS256 = Number (-257) + toJSON PS256 = Number (-37) + +data PubKeyCredParam = PubKeyCredParam { + tipe :: PublicKeyCredentialType + , alg :: PubKeyCredAlg +} deriving (Show, Eq, Generic) + +instance ToJSON PubKeyCredParam where + toEncoding = genericToEncoding defaultOptions { omitNothingFields = True, fieldLabelModifier = mapTipe} + +data Attestation = None | Direct | Indirect deriving (Eq, Show, Generic) + +instance ToJSON Attestation where + toEncoding = genericToEncoding defaultOptions { sumEncoding = UntaggedValue, constructorTagModifier = fmap toLower } + +newtype AuthnSel = AuthnSel [Base64ByteString] deriving (Show, Eq, Generic) + +instance ToJSON AuthnSel where + toEncoding = genericToEncoding defaultOptions { unwrapUnaryRecords = True } + +data BiometricPerfBounds = BiometricPerfBounds { + far :: Double + , frr :: Double +} deriving (Show, Eq, Generic) + +instance ToJSON BiometricPerfBounds where + toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = fmap toUpper } + +data Extensions = Extensions { + uvi :: Bool + , loc :: Bool + , uvm :: Bool + , exts :: Bool + , authnSel :: Maybe AuthnSel + , biometricPerfBounds :: Maybe BiometricPerfBounds +} deriving (Show, Eq, Generic) + +instance ToJSON Extensions where + toEncoding = genericToEncoding defaultOptions { omitNothingFields = True } + +data AuthenticatorAttachment = Platform | CrossPlatform deriving (Eq, Show) + +instance ToJSON AuthenticatorAttachment where + toJSON Platform = String "platform" + toJSON CrossPlatform = String "cross-platform" + +data AuthenticatorSelection = AuthenticatorSelection { + authenticatorAttachment :: Maybe AuthenticatorAttachment + , requireResidentKey :: Maybe Bool + , userVerification :: Maybe UserVerification +} deriving (Show, Eq, Generic) + +instance ToJSON AuthenticatorSelection where + toEncoding = genericToEncoding defaultOptions { omitNothingFields = True } + +data PublicKeyCredentialCreationOptions = PublicKeyCredentialCreationOptions { + rp :: RelyingParty + , challenge :: Base64ByteString + , user :: User + , pubKeyCredParams :: NonEmpty PubKeyCredParam + , timeout :: Maybe Integer + , attestation :: Maybe Attestation + , extensions :: Maybe Extensions + , authenticatorSelection :: Maybe AuthenticatorSelection + , excludeCredentials :: Maybe (NonEmpty PublicKeyCredentialDescriptor) +} deriving (Eq, Show, Generic) + +instance ToJSON PublicKeyCredentialCreationOptions where + toEncoding = genericToEncoding defaultOptions { omitNothingFields = True } + diff --git a/test/Tests.hs b/test/Tests.hs index 23b88f3..e5a1ba2 100644 --- a/test/Tests.hs +++ b/test/Tests.hs @@ -1,21 +1,32 @@ import Web.WebAuthn - ( CredentialData(credentialPublicKey), - RelyingParty, - Origin(Origin), - Challenge(Challenge), - defaultRelyingParty, - registerCredential, + ( registerCredential, verify ) import Test.Tasty ( defaultMain, testGroup, TestTree ) -import Test.Tasty.HUnit ( assertBool, testCaseSteps ) +import Test.Tasty.HUnit (assertEqual, assertBool, testCaseSteps ) import Data.String.Interpolate () import Data.ByteString.Base64.URL as BS (decodeLenient) -import Data.Aeson as A (eitherDecode, FromJSON) +import Data.Aeson as A (toJSON, eitherDecode, FromJSON) import URI.ByteString () import Data.X509.CertificateStore ( readCertificateStore ) import Data.ByteString ( ByteString ) import Data.Either ( isRight ) import qualified Data.ByteString.Lazy as BL +import Web.WebAuthn.Types + ( PublicKeyCredentialCreationOptions(PublicKeyCredentialCreationOptions), + PubKeyCredParam(PubKeyCredParam), + PubKeyCredAlg(ES256), + PublicKeyCredentialDescriptor(PublicKeyCredentialDescriptor), + AuthenticatorTransport(BLE), + PublicKeyCredentialType(PublicKey), + User(User), + CredentialData(credentialPublicKey), + RelyingParty, + Origin(Origin), + Challenge(Challenge), + Base64ByteString(Base64ByteString), + defaultRelyingParty ) +import Data.Aeson.QQ.Simple ( aesonQQ ) +import Data.List.NonEmpty ( NonEmpty((:|)) ) main :: IO () main = defaultMain tests @@ -40,11 +51,31 @@ androidCredentialTest = testCaseSteps "Android Test" $ \step -> do let eth = verify androidGetChallenge defRp Nothing False androidGetClientDataJSON androidGetAuthenticatorData androidGetSignature (credentialPublicKey cdata) assertBool (show eth) (isRight eth) +registrationTest :: TestTree +registrationTest = testCaseSteps "Credentials Test" $ \step -> do + step "Credential creation" + let pkcco = PublicKeyCredentialCreationOptions (defaultRelyingParty (Origin "https" "webauthn.biz" Nothing)) (Base64ByteString "12343434") (User (Base64ByteString "id") Nothing Nothing) (PubKeyCredParam PublicKey ES256 :| []) Nothing Nothing Nothing Nothing (Just (PublicKeyCredentialDescriptor PublicKey (Base64ByteString "1234") (Just (BLE :| [])) :| [])) + let ref = [aesonQQ| { + "rp":{"id":"matrixpay.biz"}, + "challenge":"MTIzNDM0MzQ=", + "user":{"id":"aWQ="}, + "pubKeyCredParams":[ + { + "type":"public-key", + "alg":-7 + }], + "excludeCredentials":[ + {"type":"public-key", "id": "MTIzNA==", "transports ":["ble"]} + ] + } + |] + assertEqual "TOJSON not equal" ref (toJSON pkcco) + defRp :: RelyingParty -defRp = defaultRelyingParty $ (Origin "https" "psteniusubi.github.io" Nothing) +defRp = defaultRelyingParty (Origin "https" "psteniusubi.github.io" Nothing) decodePanic :: FromJSON a => ByteString -> a -decodePanic s = either (error) id (A.eitherDecode (BL.fromStrict s)) +decodePanic s = either error Prelude.id (A.eitherDecode (BL.fromStrict s)) androidClientDataJSON :: ByteString androidClientDataJSON = BS.decodeLenient "eyJ0eXBlIjoid2ViYXV0aG4uY3JlYXRlIiwiY2hhbGxlbmdlIjoiWkIyQVJraDZ3RVBoZkdjSFBRWWpWNXNidmxoa3liVlN1ZFQ4Q0VzNTBsNCIsIm9yaWdpbiI6Imh0dHBzOlwvXC9wc3Rlbml1c3ViaS5naXRodWIuaW8iLCJhbmRyb2lkUGFja2FnZU5hbWUiOiJjb20uYW5kcm9pZC5jaHJvbWUifQ"