Rework types using NoFieldSelectors

src/WebAuthn.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -143,19 +144,19 @@ encodeAttestation attestationObject = CBOR.encodeMapLen 3
       AF_None -> CBOR.encodeString "none"
 
 -- | 7.1. Registering a New Credential
-registerCredential :: MonadIO m => X509.CertificateStore
+registerCredential :: forall m. MonadIO m => X509.CertificateStore
   -> CredentialCreationOptions
   -> ByteString -- ^ clientDataJSON
   -> ByteString -- ^ attestationObject
   -> Maybe DateTime
   -> m (Either VerificationFailure AttestedCredentialData)
-registerCredential certStore opts clientDataJSON attestationObjectBS maybeNow = runExceptT $ do
+registerCredential certStore opts@CredentialCreationOptions{..} clientDataJSON attestationObjectBS maybeNow = runExceptT $ do
   _ <- hoistEither runAttestationCheck
   attestationObject <- hoistEither $ either (Left . CBORDecodeError "registerCredential") (pure . snd)
         $ CBOR.deserialiseFromBytes decodeAttestation
         $ BL.fromStrict
         $ attestationObjectBS
-  ad <- hoistEither $ extractAuthData attestationObject
+  ad@AuthenticatorData{..} <- hoistEither $ extractAuthData attestationObject
   mAdPubKey <- verifyPubKey ad
   -- TODO: extensions here
   case attStmt attestationObject of
@@ -166,38 +167,37 @@ registerCredential certStore opts clientDataJSON attestationObjectBS maybeNow =
     AF_None -> pure ()
     _ -> throwE (UnsupportedAttestationFormat (pack $ show (attStmt attestationObject)))
 
-  case attestedCredentialData ad of
+  case attestedCredentialData of
     Nothing -> throwE MalformedAuthenticatorData
     Just c -> pure c
   where
-    RelyingParty rpOrigin rpId _ _ = ccoRelyingParty opts
     clientDataHash = hash clientDataJSON :: Digest SHA256
     runAttestationCheck = do
-      CollectedClientData{..} <- either
+      ccd :: CollectedClientData <- either
         (Left . JSONDecodeError) Right $ J.eitherDecode $ BL.fromStrict clientDataJSON
-      clientType == Create ?? InvalidType
-      ccoChallenge opts == clientChallenge ?? MismatchedChallenge (ccoChallenge opts) clientChallenge
-      rpOrigin == clientOrigin ?? MismatchedOrigin rpOrigin clientOrigin
-      case clientTokenBinding of
+      ccd._type == Create ?? InvalidType
+      challenge == ccd.challenge ?? MismatchedChallenge challenge ccd.challenge
+      relyingParty.origin == ccd.origin ?? MismatchedOrigin relyingParty.origin ccd.origin
+      case ccd.tokenBinding of
         TokenBindingUnsupported -> pure ()
         TokenBindingSupported -> pure ()
-        TokenBindingPresent t -> case ccoTokenBindingID opts of
+        TokenBindingPresent t -> case opts.tokenBindingID 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 (ccoRequireUserVerification opts) || userVerified ad ?? UserUnverified
+      hash (encodeUtf8 relyingParty.id) == ad.rpIdHash ?? MismatchedRPID
+      ad.userPresent ?? UserNotPresent
+      not opts.requireUserVerification || ad.userVerified ?? UserUnverified
       pure ad
+    verifyPubKey :: AuthenticatorData -> ExceptT VerificationFailure m (Maybe PublicKey)
     verifyPubKey ad = do
-      let pubKey = credentialPublicKey <$> attestedCredentialData ad
-      case pubKey of
+      case ad.attestedCredentialData of
         Just k -> do
-          parsedPubKey <- either throwE return $ parsePublicKey k
-          unless (any (hasMatchingAlg parsedPubKey) $ ccoCredParams opts) $ throwE MalformedAuthenticatorData
+          parsedPubKey <- either throwE return $ parsePublicKey k.credentialPublicKey
+          unless (any (hasMatchingAlg parsedPubKey) credParams) $ throwE MalformedAuthenticatorData
           return $ Just parsedPubKey
         -- non present public key will fail anyway or the fmt == 'none'
         Nothing -> return Nothing
@@ -222,11 +222,11 @@ verify challenge rp tbi verificationRequired clientDataJSON adRaw sig pub = do
 
 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 challenge (clientChallenge ccd)
-  rpOrigin rp == clientOrigin ccd ?? MismatchedOrigin (rpOrigin rp) (clientOrigin ccd)
-  verifyClientTokenBinding tbi (clientTokenBinding ccd)
+  ccd :: CollectedClientData <- first JSONDecodeError (J.eitherDecode $ BL.fromStrict clientDataJSON)
+  ccd._type == ctype ?? InvalidType
+  challenge == ccd.challenge ?? MismatchedChallenge challenge ccd.challenge
+  rp.origin == ccd.origin ?? MismatchedOrigin rp.origin ccd.origin
+  verifyClientTokenBinding tbi ccd.tokenBinding
 
 verifyClientTokenBinding :: Maybe Text -> TokenBinding -> Either VerificationFailure ()
 verifyClientTokenBinding tbi (TokenBindingPresent t) = case tbi of
@@ -238,10 +238,10 @@ verifyClientTokenBinding _ _ = pure ()
 
 verifyAuthenticatorData :: RelyingParty -> ByteString -> Bool -> Either VerificationFailure AuthenticatorData
 verifyAuthenticatorData rp adRaw verificationRequired = do
-  ad <- first (const MalformedAuthenticatorData) (C.runGet parseAuthenticatorData adRaw)
-  hash (case rp of RelyingParty{ rpId } -> encodeUtf8 rpId) == rpIdHash ad ?? MismatchedRPID
-  userPresent ad ?? UserNotPresent
-  not verificationRequired || userVerified ad ?? UserUnverified
+  ad@AuthenticatorData{..} <- first (const MalformedAuthenticatorData) (C.runGet parseAuthenticatorData adRaw)
+  hash (encodeUtf8 rp.id) == rpIdHash ?? MismatchedRPID
+  userPresent ?? UserNotPresent
+  not verificationRequired || userVerified ?? UserUnverified
   pure ad
 
 (??) :: Bool -> e -> Either e ()

src/WebAuthn/AndroidSafetyNet.hs

@@ -1,5 +1,6 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
 module WebAuthn.AndroidSafetyNet (
   decode,
   verify
@@ -15,8 +16,8 @@ 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.Char8 as B8
 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
@@ -47,9 +48,9 @@ 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
+    Right (jth :: JWTHeader) -> do
+      if jth.alg /= "RS256" then fail ("android-safetynet: Unknown signature alg " <> show jth.alg) else do
+        let x5cbs = Base64.decodeLenient . encodeUtf8 <$> jth.x5c
         case X509.decodeCertificateChain (X509.CertificateChainRaw x5cbs) of
           Left e -> fail ("Certificate chain decode failed: " <> show e)
           Right cc -> pure cc
@@ -63,21 +64,21 @@ verify :: MonadIO m => X509.CertificateStore
 verify cs sf authDataRaw clientDataHash maybeNow = do
   verifyJWS
   let dat = authDataRaw <> BA.convert clientDataHash
-  as <- extractAndroidSafetyNet
+  as :: AndroidSafetyNet <- 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 /= B8.pack as.nonce then throwE NonceCheckFailure else pure ()
   where
     extractAndroidSafetyNet = ExceptT $ pure $ first JSONDecodeError
-      $ J.eitherDecode (BL.fromStrict . Base64URL.decodeLenient . unBase64ByteString $ payload sf)
+      $ J.eitherDecode (BL.fromStrict . Base64URL.decodeLenient $ unBase64ByteString sf.payload)
     verifyJWS = do
-      let dat = unBase64ByteString (header sf) <> "." <> unBase64ByteString (payload sf)
-      res <- liftIO $ validateCert cs (X509.exceptionValidationCache []) ("attest.android.com", "") (certificates sf)
+      let dat = unBase64ByteString sf.header <> "." <> unBase64ByteString sf.payload
+      res <- liftIO $ validateCert cs (X509.exceptionValidationCache []) ("attest.android.com", "") sf.certificates
       case res of
         [] -> pure ()
         es -> throwE (MalformedX509Certificate (pack $ show es))
-      cert <- failWith MalformedPublicKey (signCert $ certificates sf)
+      cert <- failWith MalformedPublicKey $ signCert sf.certificates
       let pub = X509.certPubKey $ X509.getCertificate cert
-      hoistEither $ verifyX509Sig rs256 pub dat (signature sf) "AndroidSafetyNet"
+      hoistEither $ verifyX509Sig rs256 pub dat sf.signature_ "AndroidSafetyNet"
     signCert (X509.CertificateChain cschain) = headMay cschain
     validateCert = X509.validate X509.HashSHA256 X509.defaultHooks (X509.defaultChecks { X509.checkAtTime = maybeNow})
 

src/WebAuthn/Packed.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 module WebAuthn.Packed where
 
@@ -44,11 +45,11 @@ verify :: Stmt
   -> BS.ByteString
   -> Digest SHA256
   -> Either VerificationFailure ()
-verify (Stmt algo sig cert) mAdPubKey ad adRaw clientDataHash = do
+verify (Stmt algo sig cert) mAdPubKey AuthenticatorData{..} adRaw clientDataHash = do
   let dat = adRaw <> BA.convert clientDataHash
   case cert of
     Just x509 -> do
-        let x509Cert = X509.getCertificate x509 
+        let x509Cert = X509.getCertificate x509
             pub = X509.certPubKey x509Cert
         verifyX509Sig (X509.SignatureALG X509.HashSHA256 X509.PubKeyALG_EC) pub dat sig "Packed"
         certMeetsCriteria x509Cert
@@ -62,10 +63,10 @@ verify (Stmt algo sig cert) mAdPubKey ad adRaw clientDataHash = do
             let (X509.Extensions mX509Exts) = X509.certExtensions c
                 mX509Ext = mX509Exts >>= findProperExtension [1,3,6,1,4,1,45724,1,1,4]
                 dnElements = X509.getDistinguishedElements $ X509.certSubjectDN c
-            adAAGUID <- maybe (Left $ MalformedX509Certificate "No AAGUID provided in attested credential data") (return . unAAGUID . aaguid) $ attestedCredentialData ad
+            adAAGUID <- maybe (Left $ MalformedX509Certificate "No AAGUID provided in attested credential data") (return . unAAGUID . (.aaguid)) attestedCredentialData
             certAAGUID <- maybe (Left $ MalformedX509Certificate "No AAGUID present in x509 extensions") (decodeAAGUID . X509.extRawContent) mX509Ext
             unless (certAAGUID == adAAGUID) . Left . MalformedX509Certificate $ "AAGUID in attested credential data doesn't match the one in x509 extensions"
-            unless ( 
+            unless (
                 (hasDnElement X509.DnCountry dnElements)
                 &&
                 (hasDnElement X509.DnOrganization dnElements)