Fix build issues and add PublicKeyCredentialRequestOptions

fumieval · Oct 20, 2020 · c710c15 · c710c15
1 parent 208fe41
commit c710c15
Show file tree

Hide file tree

Showing 5 changed files with 231 additions and 159 deletions.
diff --git a/src/Web/WebAuthn.hs b/src/Web/WebAuthn.hs
@@ -209,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) == rpIdHash ad ?? MismatchedRPID
+  hash (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
@@ -1,86 +1,85 @@
- {-# LANGUAGE OverloadedStrings #-} 
-module Web.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 Web.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 Control.Monad.Fail (MonadFail)
-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 Web.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) /= "RS256" then fail ("android-safetynet: Unknown signature alg " <> (show $ alg jth)) 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
+ {-# LANGUAGE OverloadedStrings #-} 
+module Web.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 Web.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 Web.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) /= "RS256" then fail ("android-safetynet: Unknown signature alg " <> (show $ alg jth)) 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
diff --git a/src/Web/WebAuthn/Types.hs b/src/Web/WebAuthn/Types.hs
@@ -26,29 +26,58 @@ module Web.WebAuthn.Types (
   , StmtSafetyNet(..)
   , JWTHeader(..)
   , Base64ByteString(..)
+  , PublicKeyCredentialRequestOptions(..)
+  , PublicKeyCredentialDescriptor(..)
+  , AuthenticatorTransport(..)
+  , PublicKeyCredentialType(..)
   ) where
 
 import Prelude hiding (fail)
 import Data.Aeson as J
+    (Value(..),  
+      (.:),
+      (.:?),
+      withObject,
+      withText,
+      constructorTagModifier,
+      FromJSON(..),
+      ToJSON(..),
+      Options(..) )
 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 Data.ByteString.Base16 as Base16 (decodeLenient, encode )
 import qualified Data.Hashable as H
 import qualified Data.Map as Map
 import Data.Text (Text)
-import Data.Text.Encoding
+import Data.Text.Encoding ( decodeUtf8, encodeUtf8 )
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.Read as T
-import Crypto.Hash
-import Crypto.Hash.Algorithms (SHA256(..))
+import Crypto.Hash ( SHA256, Digest )
 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 Control.Monad.Fail ( MonadFail(fail) )
 import GHC.Generics (Generic)
 import qualified Data.X509 as X509
+import Data.Aeson.Types (typeMismatch)
+import Data.Aeson (genericToEncoding)
+import Data.Aeson (defaultOptions)
+import Data.Char ( toLower )
+
+newtype Base64ByteString = Base64ByteString { unBase64ByteString :: ByteString } deriving (Generic, Show, Eq)
+
+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)
+    case eth of
+      Left err -> typeMismatch ("Base64: " <> err) s
+      Right str -> pure (Base64ByteString str)
+  parseJSON oth = typeMismatch "Expecting String" oth
 
 newtype Challenge = Challenge { rawChallenge :: ByteString }
   deriving (Show, Eq, Ord, H.Hashable, CBOR.Serialise)
@@ -71,7 +100,7 @@ instance FromJSON CollectedClientData where
     <$> obj .: "type"
     <*> obj .: "challenge"
     <*> obj .: "origin"
-    <*> fmap (maybe TokenBindingUnsupported id) (obj .:? "tokenBinding")
+    <*> fmap (maybe TokenBindingUnsupported Prelude.id) (obj .:? "tokenBinding")
 
 data TokenBinding = TokenBindingUnsupported
   | TokenBindingSupported
@@ -149,7 +178,7 @@ instance ToJSON CredentialPublicKey where
 newtype AAGUID = AAGUID { unAAGUID :: ByteString } deriving (Show, Eq)
 
 instance FromJSON AAGUID where
-  parseJSON v = AAGUID . fst . Base16.decode . T.encodeUtf8 <$> parseJSON v
+  parseJSON v = AAGUID . Base16.decodeLenient . T.encodeUtf8 <$> parseJSON v
 
 instance ToJSON AAGUID where
   toJSON = toJSON . T.decodeUtf8 . Base16.encode . unAAGUID
@@ -211,8 +240,6 @@ data AndroidSafetyNet = AndroidSafetyNet {
 
 instance  FromJSON AndroidSafetyNet
 
-newtype Base64ByteString = Base64ByteString {unBase64ByteString :: ByteString} deriving (Show)
-
 data StmtSafetyNet = StmtSafetyNet {
   header :: Base64ByteString
   , payload :: Base64ByteString
@@ -225,4 +252,38 @@ data JWTHeader = JWTHeader {
   , x5c :: [Text]
 } deriving (Show, Generic)
 
-instance FromJSON JWTHeader
+instance FromJSON JWTHeader
+
+
+data PublicKeyCredentialType = PublicKey deriving (Eq, Show)
+
+instance ToJSON PublicKeyCredentialType where
+  toJSON PublicKey = String "public-key"
+
+data AuthenticatorTransport = USB -- usb
+    | NFC -- nfc
+    | BLE -- ble
+    | Internal -- internal
+  deriving (Eq, Show, Generic)
+
+instance ToJSON AuthenticatorTransport where
+  toEncoding = genericToEncoding defaultOptions { constructorTagModifier = fmap toLower }
+
+data PublicKeyCredentialDescriptor = PublicKeyCredentialDescriptor {
+  tipe :: PublicKeyCredentialType
+  , id :: Base64ByteString
+  , transports :: [AuthenticatorTransport]
+} deriving (Eq, Show, Generic)
+
+instance ToJSON PublicKeyCredentialDescriptor where
+  toEncoding = genericToEncoding defaultOptions { omitNothingFields = True}
+
+data PublicKeyCredentialRequestOptions =  PublicKeyCredentialRequestOptions {
+  challenge :: Base64ByteString
+  , timeout :: Maybe Integer
+  , rpId :: Maybe Text
+  , allowCredentials :: Maybe PublicKeyCredentialDescriptor
+} deriving (Eq, Show, Generic)
+
+instance ToJSON PublicKeyCredentialRequestOptions where
+  toEncoding = genericToEncoding defaultOptions { omitNothingFields = True}