Android Safetyet support

src/WebAuthn.hs

@@ -33,6 +33,7 @@ module WebAuthn (
   , VerificationFailure(..)
   , registerCredential
   , verify
+  , encodeAttestation
   ) where
 
 import Prelude hiding (fail)
@@ -50,14 +51,21 @@ 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.CBOR.Encoding 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
+import qualified WebAuthn.AndroidSafetyNet as Android
+import Control.Monad.IO.Class (MonadIO)
+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)
 
 -- | Generate a cryptographic challenge (13.1).
 generateChallenge :: Int -> IO Challenge
@@ -84,15 +92,22 @@ parseAuthenticatorData = do
   return AuthenticatorData{..}
 
 -- | Attestation (6.4) provided by authenticators
+
+data AttestationObject = AttestationObject {
+  fmt :: Text
+  , attStmt :: AttestationStatement
+  , authData :: ByteString
+}
+
 data AttestationStatement = AF_Packed Packed.Stmt
   | AF_TPM TPM.Stmt
   | AF_AndroidKey
-  | AF_AndroidSafetyNet
+  | AF_AndroidSafetyNet StmtSafetyNet
   | AF_FIDO_U2F U2F.Stmt
   | AF_None
   deriving Show
 
-decodeAttestation :: CBOR.Decoder s (ByteString, AttestationStatement)
+decodeAttestation :: CBOR.Decoder s AttestationObject
 decodeAttestation = do
   m :: Map.Map Text CBOR.Term <- CBOR.decode
   CBOR.TString fmt <- maybe (fail "fmt") pure $ Map.lookup "fmt" m
@@ -101,53 +116,76 @@ decodeAttestation = do
     "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
+    "android-safetynet" -> AF_AndroidSafetyNet <$> Android.decode stmtTerm
     _ -> fail $ "decodeAttestation: Unsupported format: " ++ show fmt
   CBOR.TBytes adRaw <- maybe (fail "authData") pure $ Map.lookup "authData" m
-  return (adRaw, stmt)
+  return (AttestationObject fmt stmt adRaw)
+
+encodeAttestation :: AttestationObject -> CBOR.Encoding 
+encodeAttestation attestationObject = CBOR.encodeMapLen 3 
+  <> CBOR.encodeString "fmt"
+  <> encodeAttestationFmt
+  <> CBOR.encodeString  "attStmt"
+  where
+    encodeAttestationFmt :: CBOR.Encoding
+    encodeAttestationFmt =  case (attStmt attestationObject) of
+      AF_FIDO_U2F _ -> CBOR.encodeString "fido-u2f"
+      AF_Packed _ -> CBOR.encodeString "packed"
+      AF_TPM _ -> CBOR.encodeString "tpm"
+      AF_AndroidKey -> CBOR.encodeString "android-key"
+      AF_AndroidSafetyNet _ -> CBOR.encodeString "android-safetynet"
+      AF_None -> CBOR.encodeString ""
 
 -- | 7.1. Registering a New Credential
-registerCredential :: Challenge
+registerCredential :: MonadIO m => X509.CertificateStore
+  -> 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
+  -> m (Either VerificationFailure AttestedCredentialData)
+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
+        $ BL.fromStrict 
+        $ attestationObjectBS
+  ad <- hoistEither $ extractAuthData attestationObject
+    -- TODO: extensions here
+  case (attStmt attestationObject) of
+    AF_FIDO_U2F s -> hoistEither $ U2F.verify s ad clientDataHash
+    AF_Packed s -> hoistEither $ Packed.verify s ad (authData attestationObject) clientDataHash
+    AF_TPM s -> hoistEither $ TPM.verify s ad (authData attestationObject) clientDataHash
+    AF_AndroidSafetyNet s -> Android.verify cs s (authData attestationObject) clientDataHash
     AF_None -> pure ()
-    _ -> error $ "registerCredential: unsupported format: " ++ show stmt
+    _ -> throwE (UnsupportedAttestationFormat (pack $ show (attStmt attestationObject)))
 
   case attestedCredentialData ad of
-    Nothing -> Left MalformedAuthenticatorData
+    Nothing -> throwE MalformedAuthenticatorData
     Just c -> pure c
+  where
+    clientDataHash = hash clientDataJSON :: Digest SHA256
+    runAttestationCheck = 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
+    extractAuthData attestationObject = do
+      ad <- either (const $ Left MalformedAuthenticatorData) pure $ C.runGet parseAuthenticatorData (authData attestationObject)
+      hash (encodeUtf8 rpId) == rpIdHash ad ?? MismatchedRPID
+      userPresent ad ?? UserNotPresent
+      not verificationRequired || userVerified ad ?? UserUnverified
+      pure ad
 
 -- | 7.2. Verifying an Authentication Assertion
 verify :: Challenge
@@ -159,35 +197,42 @@ verify :: Challenge
   -> 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
+verify challenge rp tbi verificationRequired clientDataJSON adRaw sig pub = do
+  clientDataCheck Get challenge clientDataJSON rp tbi
+  let clientDataHash = hash clientDataJSON :: Digest SHA256
+  _ <- verifyAuthenticatorData rp adRaw verificationRequired
+  let dat = adRaw <> BA.convert clientDataHash
+  pub' <- parsePublicKey pub
+  verifySig pub' sig dat
+
+clientDataCheck :: WebAuthnType -> Challenge -> ByteString -> RelyingParty -> Maybe Text -> Either VerificationFailure ()
+clientDataCheck ctype challenge clientDataJSON rp tbi = do 
+  ccd <-  first JSONDecodeError (J.eitherDecode $ BL.fromStrict clientDataJSON)
+  clientType ccd == ctype ?? InvalidType
+  challenge == clientChallenge ccd ?? MismatchedChallenge
+  rpOrigin rp == clientOrigin ccd ?? MismatchedOrigin
+  verifyClientTokenBinding tbi (clientTokenBinding ccd)
+
+verifyClientTokenBinding :: Maybe Text -> TokenBinding -> Either VerificationFailure ()
+verifyClientTokenBinding tbi (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
+        | otherwise -> Left MismatchedTokenBinding 
+verifyClientTokenBinding _ _ = pure ()
 
-  let clientDataHash = hash clientDataJSON :: Digest SHA256
-  hash rpId == rpIdHash ad ?? MismatchedRPID
+verifyAuthenticatorData :: RelyingParty -> ByteString -> Bool -> Either VerificationFailure AuthenticatorData
+verifyAuthenticatorData rp adRaw verificationRequired = do
+  ad <- first (const MalformedAuthenticatorData) (C.runGet parseAuthenticatorData adRaw)
+  hash (encodeUtf8 $ rpId (rp :: RelyingParty)) == rpIdHash ad ?? MismatchedRPID
   userPresent ad ?? UserNotPresent
   not verificationRequired || userVerified ad ?? UserUnverified
-
-  let dat = adRaw <> BA.convert clientDataHash
-
-  pub' <- parsePublicKey pub
-  verifySig pub' sig dat
+  pure ad
 
 (??) :: Bool -> e -> Either e ()
 False ?? e = Left e
 True ?? _ = Right ()
 infix 1 ??
+
+hoistEither :: Monad m => Either e a -> ExceptT e m a
+hoistEither = ExceptT . pure

src/WebAuthn/AndroidSafetyNet.hs

@@ -0,0 +1,85 @@
+ {-# LANGUAGE OverloadedStrings #-} 
+module WebAuthn.AndroidSafetyNet (
+  decode,
+  verify
+) where
+
+import qualified Data.Aeson as J
+import Data.ByteString (ByteString)
+import Data.Text (pack)
+import Data.Text.Encoding (encodeUtf8)
+import WebAuthn.Types
+import qualified Codec.CBOR.Term as CBOR
+import qualified Codec.CBOR.Decoding as CBOR
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL hiding (pack)
+import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString.Base64 as Base64
+import qualified Data.ByteString.Base64.URL as Base64URL
+import qualified Data.X509 as X509
+import qualified Data.X509.Validation as X509
+import qualified Data.X509.CertificateStore as X509
+import Crypto.Hash (Digest, hash)
+import Crypto.Hash.Algorithms (SHA256(..))
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Trans.Except (ExceptT(..), throwE)
+import Data.Char (ord)
+import Data.Bifunctor (first)
+import WebAuthn.Signature (verifyX509Sig)
+import Control.Error.Util (hoistEither, failWith)
+
+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 
+    (h : p : s : _) -> StmtSafetyNet (Base64ByteString h) (Base64ByteString p) (Base64URL.decodeLenient s) <$> getCertificateChain h
+    _ -> 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)
+    Right jth -> 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)
+          Right cc -> pure cc
+
+verify :: MonadIO m => X509.CertificateStore 
+  -> StmtSafetyNet 
+  -> B.ByteString
+  -> Digest SHA256
+  -> ExceptT VerificationFailure m ()
+verify cs sf authDataRaw clientDataHash = do
+  verifyJWS
+  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 ()
+  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)
+      res <- liftIO $ X509.validateDefault cs (X509.exceptionValidationCache []) ("attest.android.com", "") (certificates sf)
+      case res of
+        [] -> pure ()
+        es -> throwE (MalformedX509Certificate (pack $ show es))
+      cert <- failWith MalformedPublicKey (signCert $ certificates sf)
+      let pub = X509.certPubKey $ X509.getCertificate cert
+      hoistEither $ verifyX509Sig rs256 pub dat (signature sf) "AndroidSafetyNet"
+    signCert (X509.CertificateChain cschain) = headMay cschain
+
+rs256 :: X509.SignatureALG
+rs256 = X509.SignatureALG X509.HashSHA256 X509.PubKeyALG_RSA  
+
+headMay :: [a] -> Maybe a
+headMay [] = Nothing
+headMay (x : _) = Just x

src/WebAuthn/FIDOU2F.hs

@@ -11,8 +11,8 @@ 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
+import WebAuthn.Signature (verifyX509Sig)
 
 data Stmt = Stmt (X509.SignedExact X509.Certificate) ByteString
   deriving Show
@@ -45,6 +45,4 @@ verify (Stmt cert sig) AuthenticatorData{..} clientDataHash = do
         , 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"
+  verifyX509Sig (X509.SignatureALG X509.HashSHA256 X509.PubKeyALG_EC) pub dat sig "FIDOU2F"

src/WebAuthn/Packed.hs

@@ -5,7 +5,6 @@ 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
@@ -18,13 +17,13 @@ data Stmt = Stmt Int ByteString (Maybe (X509.SignedExact X509.Certificate))
 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.TInt algc <- 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
+  return $ Stmt algc sig cert
   where
     Nothing ??? e = fail e
     Just a ??? _ = pure a
@@ -40,9 +39,7 @@ verify (Stmt _ sig cert) ad adRaw clientDataHash = do
   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"
+      verifyX509Sig (X509.SignatureALG X509.HashSHA256 X509.PubKeyALG_EC) pub dat sig "Packed"
     Nothing -> do
       pub <- case attestedCredentialData ad of
           Nothing -> Left MalformedAuthenticatorData