WebAuthn Registration Options classification

webauthnRegistrationOptions.hs

data Attachment = NoAttachment | Platform | CrossPlatform deriving (Show)
data ResidentKey = RKNotSpecified | RKDiscouraged | RKPreferred | RKRequired deriving (Show)
data UserVerification = UVDiscouraged | UVPreferred | UVRequired deriving (Show)

allCreateOptions = do
  attachment <- [NoAttachment, Platform, CrossPlatform]
  rk <- [RKNotSpecified, RKDiscouraged, RKPreferred, RKRequired]
  uv <- [UVDiscouraged, UVPreferred, UVRequired]

  return (attachment, rk, uv)

data CreateType =
  SecondFactor |
  SecondFactorUpgrade |  -- Potentially for 2nd-factor with optional multi-factor in the future
  Reauthentication |
  FirstFactor |
  Passwordless |  -- A potential mode where the user enters a username only.
  Nonsense |  -- Chrome considers this nonsense and maps it to something else
  Future |    -- We haven't figured these out yet
  Unclassified deriving (Show, Eq)

classifyCreation :: (Attachment, ResidentKey, UserVerification) -> CreateType
-- There's no default value for |residentKey|, but it has to be “discouraged”, I think.
classifyCreation (attachment, RKNotSpecified, uv) = classifyCreation (attachment, RKDiscouraged, uv)

classifyCreation (NoAttachment, RKDiscouraged, UVDiscouraged) = SecondFactor
classifyCreation (CrossPlatform, RKDiscouraged, UVDiscouraged) = SecondFactor

classifyCreation (NoAttachment, RKPreferred, UVDiscouraged) = SecondFactorUpgrade
classifyCreation (NoAttachment, RKPreferred, UVPreferred) = SecondFactorUpgrade

classifyCreation (NoAttachment, RKDiscouraged, UVRequired) = Reauthentication
classifyCreation (Platform, RKDiscouraged, UVRequired) = Reauthentication

classifyCreation (NoAttachment, RKRequired, UVRequired) = FirstFactor
classifyCreation (CrossPlatform, RKRequired, UVRequired) = FirstFactor

classifyCreation (_, RKDiscouraged, UVRequired) = Passwordless
classifyCreation (_, RKPreferred, UVRequired) = Passwordless

classifyCreation (_, RKRequired, UVDiscouraged) = Nonsense
classifyCreation (_, RKRequired, UVPreferred) = Nonsense

classifyCreation (_, RKPreferred, _) = Future

classifyCreation _ = Unclassified

unclassified = filter ((==) Unclassified . classifyCreation) allCreateOptions
main = mapM_ (putStrLn . show) unclassified