{-# LANGUAGE OverloadedStrings, RecordWildCards, TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}


{- |
= WebAuthn

This domain allows configuring virtual authenticators to test the WebAuthn
API.
-}


module CDP.Domains.WebAuthn (module CDP.Domains.WebAuthn) where

import           Control.Applicative  ((<$>))
import           Control.Monad
import           Control.Monad.Loops
import           Control.Monad.Trans  (liftIO)
import qualified Data.Map             as M
import           Data.Maybe          
import Data.Functor.Identity
import Data.String
import qualified Data.Text as T
import qualified Data.List as List
import qualified Data.Text.IO         as TI
import qualified Data.Vector          as V
import Data.Aeson.Types (Parser(..))
import           Data.Aeson           (FromJSON (..), ToJSON (..), (.:), (.:?), (.=), (.!=), (.:!))
import qualified Data.Aeson           as A
import qualified Network.HTTP.Simple as Http
import qualified Network.URI          as Uri
import qualified Network.WebSockets as WS
import Control.Concurrent
import qualified Data.ByteString.Lazy as BS
import qualified Data.Map as Map
import Data.Proxy
import System.Random
import GHC.Generics
import Data.Char
import Data.Default

import CDP.Internal.Utils




-- | Type 'WebAuthn.AuthenticatorId'.
type WebAuthnAuthenticatorId = T.Text

-- | Type 'WebAuthn.AuthenticatorProtocol'.
data WebAuthnAuthenticatorProtocol = WebAuthnAuthenticatorProtocolU2f | WebAuthnAuthenticatorProtocolCtap2
  deriving (Eq WebAuthnAuthenticatorProtocol
Eq WebAuthnAuthenticatorProtocol
-> (WebAuthnAuthenticatorProtocol
    -> WebAuthnAuthenticatorProtocol -> Ordering)
-> (WebAuthnAuthenticatorProtocol
    -> WebAuthnAuthenticatorProtocol -> Bool)
-> (WebAuthnAuthenticatorProtocol
    -> WebAuthnAuthenticatorProtocol -> Bool)
-> (WebAuthnAuthenticatorProtocol
    -> WebAuthnAuthenticatorProtocol -> Bool)
-> (WebAuthnAuthenticatorProtocol
    -> WebAuthnAuthenticatorProtocol -> Bool)
-> (WebAuthnAuthenticatorProtocol
    -> WebAuthnAuthenticatorProtocol -> WebAuthnAuthenticatorProtocol)
-> (WebAuthnAuthenticatorProtocol
    -> WebAuthnAuthenticatorProtocol -> WebAuthnAuthenticatorProtocol)
-> Ord WebAuthnAuthenticatorProtocol
WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Ordering
WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> WebAuthnAuthenticatorProtocol
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> WebAuthnAuthenticatorProtocol
$cmin :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> WebAuthnAuthenticatorProtocol
max :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> WebAuthnAuthenticatorProtocol
$cmax :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> WebAuthnAuthenticatorProtocol
>= :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
$c>= :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
> :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
$c> :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
<= :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
$c<= :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
< :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
$c< :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
compare :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Ordering
$ccompare :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Ordering
$cp1Ord :: Eq WebAuthnAuthenticatorProtocol
Ord, WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
(WebAuthnAuthenticatorProtocol
 -> WebAuthnAuthenticatorProtocol -> Bool)
-> (WebAuthnAuthenticatorProtocol
    -> WebAuthnAuthenticatorProtocol -> Bool)
-> Eq WebAuthnAuthenticatorProtocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
$c/= :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
== :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
$c== :: WebAuthnAuthenticatorProtocol
-> WebAuthnAuthenticatorProtocol -> Bool
Eq, Int -> WebAuthnAuthenticatorProtocol -> ShowS
[WebAuthnAuthenticatorProtocol] -> ShowS
WebAuthnAuthenticatorProtocol -> String
(Int -> WebAuthnAuthenticatorProtocol -> ShowS)
-> (WebAuthnAuthenticatorProtocol -> String)
-> ([WebAuthnAuthenticatorProtocol] -> ShowS)
-> Show WebAuthnAuthenticatorProtocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAuthnAuthenticatorProtocol] -> ShowS
$cshowList :: [WebAuthnAuthenticatorProtocol] -> ShowS
show :: WebAuthnAuthenticatorProtocol -> String
$cshow :: WebAuthnAuthenticatorProtocol -> String
showsPrec :: Int -> WebAuthnAuthenticatorProtocol -> ShowS
$cshowsPrec :: Int -> WebAuthnAuthenticatorProtocol -> ShowS
Show, ReadPrec [WebAuthnAuthenticatorProtocol]
ReadPrec WebAuthnAuthenticatorProtocol
Int -> ReadS WebAuthnAuthenticatorProtocol
ReadS [WebAuthnAuthenticatorProtocol]
(Int -> ReadS WebAuthnAuthenticatorProtocol)
-> ReadS [WebAuthnAuthenticatorProtocol]
-> ReadPrec WebAuthnAuthenticatorProtocol
-> ReadPrec [WebAuthnAuthenticatorProtocol]
-> Read WebAuthnAuthenticatorProtocol
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebAuthnAuthenticatorProtocol]
$creadListPrec :: ReadPrec [WebAuthnAuthenticatorProtocol]
readPrec :: ReadPrec WebAuthnAuthenticatorProtocol
$creadPrec :: ReadPrec WebAuthnAuthenticatorProtocol
readList :: ReadS [WebAuthnAuthenticatorProtocol]
$creadList :: ReadS [WebAuthnAuthenticatorProtocol]
readsPrec :: Int -> ReadS WebAuthnAuthenticatorProtocol
$creadsPrec :: Int -> ReadS WebAuthnAuthenticatorProtocol
Read)
instance FromJSON WebAuthnAuthenticatorProtocol where
  parseJSON :: Value -> Parser WebAuthnAuthenticatorProtocol
parseJSON = String
-> (Text -> Parser WebAuthnAuthenticatorProtocol)
-> Value
-> Parser WebAuthnAuthenticatorProtocol
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"WebAuthnAuthenticatorProtocol" ((Text -> Parser WebAuthnAuthenticatorProtocol)
 -> Value -> Parser WebAuthnAuthenticatorProtocol)
-> (Text -> Parser WebAuthnAuthenticatorProtocol)
-> Value
-> Parser WebAuthnAuthenticatorProtocol
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"u2f" -> WebAuthnAuthenticatorProtocol
-> Parser WebAuthnAuthenticatorProtocol
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAuthnAuthenticatorProtocol
WebAuthnAuthenticatorProtocolU2f
    Text
"ctap2" -> WebAuthnAuthenticatorProtocol
-> Parser WebAuthnAuthenticatorProtocol
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAuthnAuthenticatorProtocol
WebAuthnAuthenticatorProtocolCtap2
    Text
"_" -> String -> Parser WebAuthnAuthenticatorProtocol
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse WebAuthnAuthenticatorProtocol"
instance ToJSON WebAuthnAuthenticatorProtocol where
  toJSON :: WebAuthnAuthenticatorProtocol -> Value
toJSON WebAuthnAuthenticatorProtocol
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case WebAuthnAuthenticatorProtocol
v of
    WebAuthnAuthenticatorProtocol
WebAuthnAuthenticatorProtocolU2f -> Text
"u2f"
    WebAuthnAuthenticatorProtocol
WebAuthnAuthenticatorProtocolCtap2 -> Text
"ctap2"

-- | Type 'WebAuthn.Ctap2Version'.
data WebAuthnCtap2Version = WebAuthnCtap2VersionCtap2_0 | WebAuthnCtap2VersionCtap2_1
  deriving (Eq WebAuthnCtap2Version
Eq WebAuthnCtap2Version
-> (WebAuthnCtap2Version -> WebAuthnCtap2Version -> Ordering)
-> (WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool)
-> (WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool)
-> (WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool)
-> (WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool)
-> (WebAuthnCtap2Version
    -> WebAuthnCtap2Version -> WebAuthnCtap2Version)
-> (WebAuthnCtap2Version
    -> WebAuthnCtap2Version -> WebAuthnCtap2Version)
-> Ord WebAuthnCtap2Version
WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
WebAuthnCtap2Version -> WebAuthnCtap2Version -> Ordering
WebAuthnCtap2Version
-> WebAuthnCtap2Version -> WebAuthnCtap2Version
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WebAuthnCtap2Version
-> WebAuthnCtap2Version -> WebAuthnCtap2Version
$cmin :: WebAuthnCtap2Version
-> WebAuthnCtap2Version -> WebAuthnCtap2Version
max :: WebAuthnCtap2Version
-> WebAuthnCtap2Version -> WebAuthnCtap2Version
$cmax :: WebAuthnCtap2Version
-> WebAuthnCtap2Version -> WebAuthnCtap2Version
>= :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
$c>= :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
> :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
$c> :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
<= :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
$c<= :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
< :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
$c< :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
compare :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Ordering
$ccompare :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Ordering
$cp1Ord :: Eq WebAuthnCtap2Version
Ord, WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
(WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool)
-> (WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool)
-> Eq WebAuthnCtap2Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
$c/= :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
== :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
$c== :: WebAuthnCtap2Version -> WebAuthnCtap2Version -> Bool
Eq, Int -> WebAuthnCtap2Version -> ShowS
[WebAuthnCtap2Version] -> ShowS
WebAuthnCtap2Version -> String
(Int -> WebAuthnCtap2Version -> ShowS)
-> (WebAuthnCtap2Version -> String)
-> ([WebAuthnCtap2Version] -> ShowS)
-> Show WebAuthnCtap2Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAuthnCtap2Version] -> ShowS
$cshowList :: [WebAuthnCtap2Version] -> ShowS
show :: WebAuthnCtap2Version -> String
$cshow :: WebAuthnCtap2Version -> String
showsPrec :: Int -> WebAuthnCtap2Version -> ShowS
$cshowsPrec :: Int -> WebAuthnCtap2Version -> ShowS
Show, ReadPrec [WebAuthnCtap2Version]
ReadPrec WebAuthnCtap2Version
Int -> ReadS WebAuthnCtap2Version
ReadS [WebAuthnCtap2Version]
(Int -> ReadS WebAuthnCtap2Version)
-> ReadS [WebAuthnCtap2Version]
-> ReadPrec WebAuthnCtap2Version
-> ReadPrec [WebAuthnCtap2Version]
-> Read WebAuthnCtap2Version
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebAuthnCtap2Version]
$creadListPrec :: ReadPrec [WebAuthnCtap2Version]
readPrec :: ReadPrec WebAuthnCtap2Version
$creadPrec :: ReadPrec WebAuthnCtap2Version
readList :: ReadS [WebAuthnCtap2Version]
$creadList :: ReadS [WebAuthnCtap2Version]
readsPrec :: Int -> ReadS WebAuthnCtap2Version
$creadsPrec :: Int -> ReadS WebAuthnCtap2Version
Read)
instance FromJSON WebAuthnCtap2Version where
  parseJSON :: Value -> Parser WebAuthnCtap2Version
parseJSON = String
-> (Text -> Parser WebAuthnCtap2Version)
-> Value
-> Parser WebAuthnCtap2Version
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"WebAuthnCtap2Version" ((Text -> Parser WebAuthnCtap2Version)
 -> Value -> Parser WebAuthnCtap2Version)
-> (Text -> Parser WebAuthnCtap2Version)
-> Value
-> Parser WebAuthnCtap2Version
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"ctap2_0" -> WebAuthnCtap2Version -> Parser WebAuthnCtap2Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAuthnCtap2Version
WebAuthnCtap2VersionCtap2_0
    Text
"ctap2_1" -> WebAuthnCtap2Version -> Parser WebAuthnCtap2Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAuthnCtap2Version
WebAuthnCtap2VersionCtap2_1
    Text
"_" -> String -> Parser WebAuthnCtap2Version
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse WebAuthnCtap2Version"
instance ToJSON WebAuthnCtap2Version where
  toJSON :: WebAuthnCtap2Version -> Value
toJSON WebAuthnCtap2Version
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case WebAuthnCtap2Version
v of
    WebAuthnCtap2Version
WebAuthnCtap2VersionCtap2_0 -> Text
"ctap2_0"
    WebAuthnCtap2Version
WebAuthnCtap2VersionCtap2_1 -> Text
"ctap2_1"

-- | Type 'WebAuthn.AuthenticatorTransport'.
data WebAuthnAuthenticatorTransport = WebAuthnAuthenticatorTransportUsb | WebAuthnAuthenticatorTransportNfc | WebAuthnAuthenticatorTransportBle | WebAuthnAuthenticatorTransportCable | WebAuthnAuthenticatorTransportInternal
  deriving (Eq WebAuthnAuthenticatorTransport
Eq WebAuthnAuthenticatorTransport
-> (WebAuthnAuthenticatorTransport
    -> WebAuthnAuthenticatorTransport -> Ordering)
-> (WebAuthnAuthenticatorTransport
    -> WebAuthnAuthenticatorTransport -> Bool)
-> (WebAuthnAuthenticatorTransport
    -> WebAuthnAuthenticatorTransport -> Bool)
-> (WebAuthnAuthenticatorTransport
    -> WebAuthnAuthenticatorTransport -> Bool)
-> (WebAuthnAuthenticatorTransport
    -> WebAuthnAuthenticatorTransport -> Bool)
-> (WebAuthnAuthenticatorTransport
    -> WebAuthnAuthenticatorTransport
    -> WebAuthnAuthenticatorTransport)
-> (WebAuthnAuthenticatorTransport
    -> WebAuthnAuthenticatorTransport
    -> WebAuthnAuthenticatorTransport)
-> Ord WebAuthnAuthenticatorTransport
WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Ordering
WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> WebAuthnAuthenticatorTransport
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> WebAuthnAuthenticatorTransport
$cmin :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> WebAuthnAuthenticatorTransport
max :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> WebAuthnAuthenticatorTransport
$cmax :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> WebAuthnAuthenticatorTransport
>= :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
$c>= :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
> :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
$c> :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
<= :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
$c<= :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
< :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
$c< :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
compare :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Ordering
$ccompare :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Ordering
$cp1Ord :: Eq WebAuthnAuthenticatorTransport
Ord, WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
(WebAuthnAuthenticatorTransport
 -> WebAuthnAuthenticatorTransport -> Bool)
-> (WebAuthnAuthenticatorTransport
    -> WebAuthnAuthenticatorTransport -> Bool)
-> Eq WebAuthnAuthenticatorTransport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
$c/= :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
== :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
$c== :: WebAuthnAuthenticatorTransport
-> WebAuthnAuthenticatorTransport -> Bool
Eq, Int -> WebAuthnAuthenticatorTransport -> ShowS
[WebAuthnAuthenticatorTransport] -> ShowS
WebAuthnAuthenticatorTransport -> String
(Int -> WebAuthnAuthenticatorTransport -> ShowS)
-> (WebAuthnAuthenticatorTransport -> String)
-> ([WebAuthnAuthenticatorTransport] -> ShowS)
-> Show WebAuthnAuthenticatorTransport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAuthnAuthenticatorTransport] -> ShowS
$cshowList :: [WebAuthnAuthenticatorTransport] -> ShowS
show :: WebAuthnAuthenticatorTransport -> String
$cshow :: WebAuthnAuthenticatorTransport -> String
showsPrec :: Int -> WebAuthnAuthenticatorTransport -> ShowS
$cshowsPrec :: Int -> WebAuthnAuthenticatorTransport -> ShowS
Show, ReadPrec [WebAuthnAuthenticatorTransport]
ReadPrec WebAuthnAuthenticatorTransport
Int -> ReadS WebAuthnAuthenticatorTransport
ReadS [WebAuthnAuthenticatorTransport]
(Int -> ReadS WebAuthnAuthenticatorTransport)
-> ReadS [WebAuthnAuthenticatorTransport]
-> ReadPrec WebAuthnAuthenticatorTransport
-> ReadPrec [WebAuthnAuthenticatorTransport]
-> Read WebAuthnAuthenticatorTransport
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebAuthnAuthenticatorTransport]
$creadListPrec :: ReadPrec [WebAuthnAuthenticatorTransport]
readPrec :: ReadPrec WebAuthnAuthenticatorTransport
$creadPrec :: ReadPrec WebAuthnAuthenticatorTransport
readList :: ReadS [WebAuthnAuthenticatorTransport]
$creadList :: ReadS [WebAuthnAuthenticatorTransport]
readsPrec :: Int -> ReadS WebAuthnAuthenticatorTransport
$creadsPrec :: Int -> ReadS WebAuthnAuthenticatorTransport
Read)
instance FromJSON WebAuthnAuthenticatorTransport where
  parseJSON :: Value -> Parser WebAuthnAuthenticatorTransport
parseJSON = String
-> (Text -> Parser WebAuthnAuthenticatorTransport)
-> Value
-> Parser WebAuthnAuthenticatorTransport
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"WebAuthnAuthenticatorTransport" ((Text -> Parser WebAuthnAuthenticatorTransport)
 -> Value -> Parser WebAuthnAuthenticatorTransport)
-> (Text -> Parser WebAuthnAuthenticatorTransport)
-> Value
-> Parser WebAuthnAuthenticatorTransport
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"usb" -> WebAuthnAuthenticatorTransport
-> Parser WebAuthnAuthenticatorTransport
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAuthnAuthenticatorTransport
WebAuthnAuthenticatorTransportUsb
    Text
"nfc" -> WebAuthnAuthenticatorTransport
-> Parser WebAuthnAuthenticatorTransport
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAuthnAuthenticatorTransport
WebAuthnAuthenticatorTransportNfc
    Text
"ble" -> WebAuthnAuthenticatorTransport
-> Parser WebAuthnAuthenticatorTransport
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAuthnAuthenticatorTransport
WebAuthnAuthenticatorTransportBle
    Text
"cable" -> WebAuthnAuthenticatorTransport
-> Parser WebAuthnAuthenticatorTransport
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAuthnAuthenticatorTransport
WebAuthnAuthenticatorTransportCable
    Text
"internal" -> WebAuthnAuthenticatorTransport
-> Parser WebAuthnAuthenticatorTransport
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebAuthnAuthenticatorTransport
WebAuthnAuthenticatorTransportInternal
    Text
"_" -> String -> Parser WebAuthnAuthenticatorTransport
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse WebAuthnAuthenticatorTransport"
instance ToJSON WebAuthnAuthenticatorTransport where
  toJSON :: WebAuthnAuthenticatorTransport -> Value
toJSON WebAuthnAuthenticatorTransport
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case WebAuthnAuthenticatorTransport
v of
    WebAuthnAuthenticatorTransport
WebAuthnAuthenticatorTransportUsb -> Text
"usb"
    WebAuthnAuthenticatorTransport
WebAuthnAuthenticatorTransportNfc -> Text
"nfc"
    WebAuthnAuthenticatorTransport
WebAuthnAuthenticatorTransportBle -> Text
"ble"
    WebAuthnAuthenticatorTransport
WebAuthnAuthenticatorTransportCable -> Text
"cable"
    WebAuthnAuthenticatorTransport
WebAuthnAuthenticatorTransportInternal -> Text
"internal"

-- | Type 'WebAuthn.VirtualAuthenticatorOptions'.
data WebAuthnVirtualAuthenticatorOptions = WebAuthnVirtualAuthenticatorOptions
  {
    WebAuthnVirtualAuthenticatorOptions
-> WebAuthnAuthenticatorProtocol
webAuthnVirtualAuthenticatorOptionsProtocol :: WebAuthnAuthenticatorProtocol,
    -- | Defaults to ctap2_0. Ignored if |protocol| == u2f.
    WebAuthnVirtualAuthenticatorOptions -> Maybe WebAuthnCtap2Version
webAuthnVirtualAuthenticatorOptionsCtap2Version :: Maybe WebAuthnCtap2Version,
    WebAuthnVirtualAuthenticatorOptions
-> WebAuthnAuthenticatorTransport
webAuthnVirtualAuthenticatorOptionsTransport :: WebAuthnAuthenticatorTransport,
    -- | Defaults to false.
    WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsHasResidentKey :: Maybe Bool,
    -- | Defaults to false.
    WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsHasUserVerification :: Maybe Bool,
    -- | If set to true, the authenticator will support the largeBlob extension.
    --   https://w3c.github.io/webauthn#largeBlob
    --   Defaults to false.
    WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsHasLargeBlob :: Maybe Bool,
    -- | If set to true, the authenticator will support the credBlob extension.
    --   https://fidoalliance.org/specs/fido-v2.1-rd-20201208/fido-client-to-authenticator-protocol-v2.1-rd-20201208.html#sctn-credBlob-extension
    --   Defaults to false.
    WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsHasCredBlob :: Maybe Bool,
    -- | If set to true, the authenticator will support the minPinLength extension.
    --   https://fidoalliance.org/specs/fido-v2.1-ps-20210615/fido-client-to-authenticator-protocol-v2.1-ps-20210615.html#sctn-minpinlength-extension
    --   Defaults to false.
    WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsHasMinPinLength :: Maybe Bool,
    -- | If set to true, tests of user presence will succeed immediately.
    --   Otherwise, they will not be resolved. Defaults to true.
    WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsAutomaticPresenceSimulation :: Maybe Bool,
    -- | Sets whether User Verification succeeds or fails for an authenticator.
    --   Defaults to false.
    WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsIsUserVerified :: Maybe Bool
  }
  deriving (WebAuthnVirtualAuthenticatorOptions
-> WebAuthnVirtualAuthenticatorOptions -> Bool
(WebAuthnVirtualAuthenticatorOptions
 -> WebAuthnVirtualAuthenticatorOptions -> Bool)
-> (WebAuthnVirtualAuthenticatorOptions
    -> WebAuthnVirtualAuthenticatorOptions -> Bool)
-> Eq WebAuthnVirtualAuthenticatorOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAuthnVirtualAuthenticatorOptions
-> WebAuthnVirtualAuthenticatorOptions -> Bool
$c/= :: WebAuthnVirtualAuthenticatorOptions
-> WebAuthnVirtualAuthenticatorOptions -> Bool
== :: WebAuthnVirtualAuthenticatorOptions
-> WebAuthnVirtualAuthenticatorOptions -> Bool
$c== :: WebAuthnVirtualAuthenticatorOptions
-> WebAuthnVirtualAuthenticatorOptions -> Bool
Eq, Int -> WebAuthnVirtualAuthenticatorOptions -> ShowS
[WebAuthnVirtualAuthenticatorOptions] -> ShowS
WebAuthnVirtualAuthenticatorOptions -> String
(Int -> WebAuthnVirtualAuthenticatorOptions -> ShowS)
-> (WebAuthnVirtualAuthenticatorOptions -> String)
-> ([WebAuthnVirtualAuthenticatorOptions] -> ShowS)
-> Show WebAuthnVirtualAuthenticatorOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAuthnVirtualAuthenticatorOptions] -> ShowS
$cshowList :: [WebAuthnVirtualAuthenticatorOptions] -> ShowS
show :: WebAuthnVirtualAuthenticatorOptions -> String
$cshow :: WebAuthnVirtualAuthenticatorOptions -> String
showsPrec :: Int -> WebAuthnVirtualAuthenticatorOptions -> ShowS
$cshowsPrec :: Int -> WebAuthnVirtualAuthenticatorOptions -> ShowS
Show)
instance FromJSON WebAuthnVirtualAuthenticatorOptions where
  parseJSON :: Value -> Parser WebAuthnVirtualAuthenticatorOptions
parseJSON = String
-> (Object -> Parser WebAuthnVirtualAuthenticatorOptions)
-> Value
-> Parser WebAuthnVirtualAuthenticatorOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAuthnVirtualAuthenticatorOptions" ((Object -> Parser WebAuthnVirtualAuthenticatorOptions)
 -> Value -> Parser WebAuthnVirtualAuthenticatorOptions)
-> (Object -> Parser WebAuthnVirtualAuthenticatorOptions)
-> Value
-> Parser WebAuthnVirtualAuthenticatorOptions
forall a b. (a -> b) -> a -> b
$ \Object
o -> WebAuthnAuthenticatorProtocol
-> Maybe WebAuthnCtap2Version
-> WebAuthnAuthenticatorTransport
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> WebAuthnVirtualAuthenticatorOptions
WebAuthnVirtualAuthenticatorOptions
    (WebAuthnAuthenticatorProtocol
 -> Maybe WebAuthnCtap2Version
 -> WebAuthnAuthenticatorTransport
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> WebAuthnVirtualAuthenticatorOptions)
-> Parser WebAuthnAuthenticatorProtocol
-> Parser
     (Maybe WebAuthnCtap2Version
      -> WebAuthnAuthenticatorTransport
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> WebAuthnVirtualAuthenticatorOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser WebAuthnAuthenticatorProtocol
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"protocol"
    Parser
  (Maybe WebAuthnCtap2Version
   -> WebAuthnAuthenticatorTransport
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> WebAuthnVirtualAuthenticatorOptions)
-> Parser (Maybe WebAuthnCtap2Version)
-> Parser
     (WebAuthnAuthenticatorTransport
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> WebAuthnVirtualAuthenticatorOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe WebAuthnCtap2Version)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"ctap2Version"
    Parser
  (WebAuthnAuthenticatorTransport
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> WebAuthnVirtualAuthenticatorOptions)
-> Parser WebAuthnAuthenticatorTransport
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> WebAuthnVirtualAuthenticatorOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser WebAuthnAuthenticatorTransport
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"transport"
    Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> WebAuthnVirtualAuthenticatorOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> WebAuthnVirtualAuthenticatorOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"hasResidentKey"
    Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> WebAuthnVirtualAuthenticatorOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> WebAuthnVirtualAuthenticatorOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"hasUserVerification"
    Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> WebAuthnVirtualAuthenticatorOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> WebAuthnVirtualAuthenticatorOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"hasLargeBlob"
    Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> WebAuthnVirtualAuthenticatorOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool -> Maybe Bool -> WebAuthnVirtualAuthenticatorOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"hasCredBlob"
    Parser
  (Maybe Bool
   -> Maybe Bool -> Maybe Bool -> WebAuthnVirtualAuthenticatorOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool -> Maybe Bool -> WebAuthnVirtualAuthenticatorOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"hasMinPinLength"
    Parser
  (Maybe Bool -> Maybe Bool -> WebAuthnVirtualAuthenticatorOptions)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> WebAuthnVirtualAuthenticatorOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"automaticPresenceSimulation"
    Parser (Maybe Bool -> WebAuthnVirtualAuthenticatorOptions)
-> Parser (Maybe Bool)
-> Parser WebAuthnVirtualAuthenticatorOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"isUserVerified"
instance ToJSON WebAuthnVirtualAuthenticatorOptions where
  toJSON :: WebAuthnVirtualAuthenticatorOptions -> Value
toJSON WebAuthnVirtualAuthenticatorOptions
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"protocol" Text -> WebAuthnAuthenticatorProtocol -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (WebAuthnAuthenticatorProtocol -> Pair)
-> Maybe WebAuthnAuthenticatorProtocol -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebAuthnAuthenticatorProtocol
-> Maybe WebAuthnAuthenticatorProtocol
forall a. a -> Maybe a
Just (WebAuthnVirtualAuthenticatorOptions
-> WebAuthnAuthenticatorProtocol
webAuthnVirtualAuthenticatorOptionsProtocol WebAuthnVirtualAuthenticatorOptions
p),
    (Text
"ctap2Version" Text -> WebAuthnCtap2Version -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (WebAuthnCtap2Version -> Pair)
-> Maybe WebAuthnCtap2Version -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WebAuthnVirtualAuthenticatorOptions -> Maybe WebAuthnCtap2Version
webAuthnVirtualAuthenticatorOptionsCtap2Version WebAuthnVirtualAuthenticatorOptions
p),
    (Text
"transport" Text -> WebAuthnAuthenticatorTransport -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (WebAuthnAuthenticatorTransport -> Pair)
-> Maybe WebAuthnAuthenticatorTransport -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebAuthnAuthenticatorTransport
-> Maybe WebAuthnAuthenticatorTransport
forall a. a -> Maybe a
Just (WebAuthnVirtualAuthenticatorOptions
-> WebAuthnAuthenticatorTransport
webAuthnVirtualAuthenticatorOptionsTransport WebAuthnVirtualAuthenticatorOptions
p),
    (Text
"hasResidentKey" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsHasResidentKey WebAuthnVirtualAuthenticatorOptions
p),
    (Text
"hasUserVerification" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsHasUserVerification WebAuthnVirtualAuthenticatorOptions
p),
    (Text
"hasLargeBlob" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsHasLargeBlob WebAuthnVirtualAuthenticatorOptions
p),
    (Text
"hasCredBlob" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsHasCredBlob WebAuthnVirtualAuthenticatorOptions
p),
    (Text
"hasMinPinLength" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsHasMinPinLength WebAuthnVirtualAuthenticatorOptions
p),
    (Text
"automaticPresenceSimulation" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsAutomaticPresenceSimulation WebAuthnVirtualAuthenticatorOptions
p),
    (Text
"isUserVerified" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WebAuthnVirtualAuthenticatorOptions -> Maybe Bool
webAuthnVirtualAuthenticatorOptionsIsUserVerified WebAuthnVirtualAuthenticatorOptions
p)
    ]

-- | Type 'WebAuthn.Credential'.
data WebAuthnCredential = WebAuthnCredential
  {
    WebAuthnCredential -> Text
webAuthnCredentialCredentialId :: T.Text,
    WebAuthnCredential -> Bool
webAuthnCredentialIsResidentCredential :: Bool,
    -- | Relying Party ID the credential is scoped to. Must be set when adding a
    --   credential.
    WebAuthnCredential -> Maybe Text
webAuthnCredentialRpId :: Maybe T.Text,
    -- | The ECDSA P-256 private key in PKCS#8 format. (Encoded as a base64 string when passed over JSON)
    WebAuthnCredential -> Text
webAuthnCredentialPrivateKey :: T.Text,
    -- | An opaque byte sequence with a maximum size of 64 bytes mapping the
    --   credential to a specific user. (Encoded as a base64 string when passed over JSON)
    WebAuthnCredential -> Maybe Text
webAuthnCredentialUserHandle :: Maybe T.Text,
    -- | Signature counter. This is incremented by one for each successful
    --   assertion.
    --   See https://w3c.github.io/webauthn/#signature-counter
    WebAuthnCredential -> Int
webAuthnCredentialSignCount :: Int,
    -- | The large blob associated with the credential.
    --   See https://w3c.github.io/webauthn/#sctn-large-blob-extension (Encoded as a base64 string when passed over JSON)
    WebAuthnCredential -> Maybe Text
webAuthnCredentialLargeBlob :: Maybe T.Text
  }
  deriving (WebAuthnCredential -> WebAuthnCredential -> Bool
(WebAuthnCredential -> WebAuthnCredential -> Bool)
-> (WebAuthnCredential -> WebAuthnCredential -> Bool)
-> Eq WebAuthnCredential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAuthnCredential -> WebAuthnCredential -> Bool
$c/= :: WebAuthnCredential -> WebAuthnCredential -> Bool
== :: WebAuthnCredential -> WebAuthnCredential -> Bool
$c== :: WebAuthnCredential -> WebAuthnCredential -> Bool
Eq, Int -> WebAuthnCredential -> ShowS
[WebAuthnCredential] -> ShowS
WebAuthnCredential -> String
(Int -> WebAuthnCredential -> ShowS)
-> (WebAuthnCredential -> String)
-> ([WebAuthnCredential] -> ShowS)
-> Show WebAuthnCredential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAuthnCredential] -> ShowS
$cshowList :: [WebAuthnCredential] -> ShowS
show :: WebAuthnCredential -> String
$cshow :: WebAuthnCredential -> String
showsPrec :: Int -> WebAuthnCredential -> ShowS
$cshowsPrec :: Int -> WebAuthnCredential -> ShowS
Show)
instance FromJSON WebAuthnCredential where
  parseJSON :: Value -> Parser WebAuthnCredential
parseJSON = String
-> (Object -> Parser WebAuthnCredential)
-> Value
-> Parser WebAuthnCredential
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAuthnCredential" ((Object -> Parser WebAuthnCredential)
 -> Value -> Parser WebAuthnCredential)
-> (Object -> Parser WebAuthnCredential)
-> Value
-> Parser WebAuthnCredential
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Bool
-> Maybe Text
-> Text
-> Maybe Text
-> Int
-> Maybe Text
-> WebAuthnCredential
WebAuthnCredential
    (Text
 -> Bool
 -> Maybe Text
 -> Text
 -> Maybe Text
 -> Int
 -> Maybe Text
 -> WebAuthnCredential)
-> Parser Text
-> Parser
     (Bool
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Int
      -> Maybe Text
      -> WebAuthnCredential)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"credentialId"
    Parser
  (Bool
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Int
   -> Maybe Text
   -> WebAuthnCredential)
-> Parser Bool
-> Parser
     (Maybe Text
      -> Text -> Maybe Text -> Int -> Maybe Text -> WebAuthnCredential)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"isResidentCredential"
    Parser
  (Maybe Text
   -> Text -> Maybe Text -> Int -> Maybe Text -> WebAuthnCredential)
-> Parser (Maybe Text)
-> Parser
     (Text -> Maybe Text -> Int -> Maybe Text -> WebAuthnCredential)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"rpId"
    Parser
  (Text -> Maybe Text -> Int -> Maybe Text -> WebAuthnCredential)
-> Parser Text
-> Parser (Maybe Text -> Int -> Maybe Text -> WebAuthnCredential)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"privateKey"
    Parser (Maybe Text -> Int -> Maybe Text -> WebAuthnCredential)
-> Parser (Maybe Text)
-> Parser (Int -> Maybe Text -> WebAuthnCredential)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"userHandle"
    Parser (Int -> Maybe Text -> WebAuthnCredential)
-> Parser Int -> Parser (Maybe Text -> WebAuthnCredential)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"signCount"
    Parser (Maybe Text -> WebAuthnCredential)
-> Parser (Maybe Text) -> Parser WebAuthnCredential
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"largeBlob"
instance ToJSON WebAuthnCredential where
  toJSON :: WebAuthnCredential -> Value
toJSON WebAuthnCredential
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"credentialId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (WebAuthnCredential -> Text
webAuthnCredentialCredentialId WebAuthnCredential
p),
    (Text
"isResidentCredential" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (WebAuthnCredential -> Bool
webAuthnCredentialIsResidentCredential WebAuthnCredential
p),
    (Text
"rpId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WebAuthnCredential -> Maybe Text
webAuthnCredentialRpId WebAuthnCredential
p),
    (Text
"privateKey" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (WebAuthnCredential -> Text
webAuthnCredentialPrivateKey WebAuthnCredential
p),
    (Text
"userHandle" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WebAuthnCredential -> Maybe Text
webAuthnCredentialUserHandle WebAuthnCredential
p),
    (Text
"signCount" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (WebAuthnCredential -> Int
webAuthnCredentialSignCount WebAuthnCredential
p),
    (Text
"largeBlob" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WebAuthnCredential -> Maybe Text
webAuthnCredentialLargeBlob WebAuthnCredential
p)
    ]

-- | Enable the WebAuthn domain and start intercepting credential storage and
--   retrieval with a virtual authenticator.

-- | Parameters of the 'WebAuthn.enable' command.
data PWebAuthnEnable = PWebAuthnEnable
  {
    -- | Whether to enable the WebAuthn user interface. Enabling the UI is
    --   recommended for debugging and demo purposes, as it is closer to the real
    --   experience. Disabling the UI is recommended for automated testing.
    --   Supported at the embedder's discretion if UI is available.
    --   Defaults to false.
    PWebAuthnEnable -> Maybe Bool
pWebAuthnEnableEnableUI :: Maybe Bool
  }
  deriving (PWebAuthnEnable -> PWebAuthnEnable -> Bool
(PWebAuthnEnable -> PWebAuthnEnable -> Bool)
-> (PWebAuthnEnable -> PWebAuthnEnable -> Bool)
-> Eq PWebAuthnEnable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWebAuthnEnable -> PWebAuthnEnable -> Bool
$c/= :: PWebAuthnEnable -> PWebAuthnEnable -> Bool
== :: PWebAuthnEnable -> PWebAuthnEnable -> Bool
$c== :: PWebAuthnEnable -> PWebAuthnEnable -> Bool
Eq, Int -> PWebAuthnEnable -> ShowS
[PWebAuthnEnable] -> ShowS
PWebAuthnEnable -> String
(Int -> PWebAuthnEnable -> ShowS)
-> (PWebAuthnEnable -> String)
-> ([PWebAuthnEnable] -> ShowS)
-> Show PWebAuthnEnable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWebAuthnEnable] -> ShowS
$cshowList :: [PWebAuthnEnable] -> ShowS
show :: PWebAuthnEnable -> String
$cshow :: PWebAuthnEnable -> String
showsPrec :: Int -> PWebAuthnEnable -> ShowS
$cshowsPrec :: Int -> PWebAuthnEnable -> ShowS
Show)
pWebAuthnEnable
  :: PWebAuthnEnable
pWebAuthnEnable :: PWebAuthnEnable
pWebAuthnEnable
  = Maybe Bool -> PWebAuthnEnable
PWebAuthnEnable
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PWebAuthnEnable where
  toJSON :: PWebAuthnEnable -> Value
toJSON PWebAuthnEnable
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"enableUI" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PWebAuthnEnable -> Maybe Bool
pWebAuthnEnableEnableUI PWebAuthnEnable
p)
    ]
instance Command PWebAuthnEnable where
  type CommandResponse PWebAuthnEnable = ()
  commandName :: Proxy PWebAuthnEnable -> String
commandName Proxy PWebAuthnEnable
_ = String
"WebAuthn.enable"
  fromJSON :: Proxy PWebAuthnEnable
-> Value -> Result (CommandResponse PWebAuthnEnable)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PWebAuthnEnable -> Result ())
-> Proxy PWebAuthnEnable
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PWebAuthnEnable -> ())
-> Proxy PWebAuthnEnable
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PWebAuthnEnable -> ()
forall a b. a -> b -> a
const ()

-- | Disable the WebAuthn domain.

-- | Parameters of the 'WebAuthn.disable' command.
data PWebAuthnDisable = PWebAuthnDisable
  deriving (PWebAuthnDisable -> PWebAuthnDisable -> Bool
(PWebAuthnDisable -> PWebAuthnDisable -> Bool)
-> (PWebAuthnDisable -> PWebAuthnDisable -> Bool)
-> Eq PWebAuthnDisable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWebAuthnDisable -> PWebAuthnDisable -> Bool
$c/= :: PWebAuthnDisable -> PWebAuthnDisable -> Bool
== :: PWebAuthnDisable -> PWebAuthnDisable -> Bool
$c== :: PWebAuthnDisable -> PWebAuthnDisable -> Bool
Eq, Int -> PWebAuthnDisable -> ShowS
[PWebAuthnDisable] -> ShowS
PWebAuthnDisable -> String
(Int -> PWebAuthnDisable -> ShowS)
-> (PWebAuthnDisable -> String)
-> ([PWebAuthnDisable] -> ShowS)
-> Show PWebAuthnDisable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWebAuthnDisable] -> ShowS
$cshowList :: [PWebAuthnDisable] -> ShowS
show :: PWebAuthnDisable -> String
$cshow :: PWebAuthnDisable -> String
showsPrec :: Int -> PWebAuthnDisable -> ShowS
$cshowsPrec :: Int -> PWebAuthnDisable -> ShowS
Show)
pWebAuthnDisable
  :: PWebAuthnDisable
pWebAuthnDisable :: PWebAuthnDisable
pWebAuthnDisable
  = PWebAuthnDisable
PWebAuthnDisable
instance ToJSON PWebAuthnDisable where
  toJSON :: PWebAuthnDisable -> Value
toJSON PWebAuthnDisable
_ = Value
A.Null
instance Command PWebAuthnDisable where
  type CommandResponse PWebAuthnDisable = ()
  commandName :: Proxy PWebAuthnDisable -> String
commandName Proxy PWebAuthnDisable
_ = String
"WebAuthn.disable"
  fromJSON :: Proxy PWebAuthnDisable
-> Value -> Result (CommandResponse PWebAuthnDisable)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PWebAuthnDisable -> Result ())
-> Proxy PWebAuthnDisable
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PWebAuthnDisable -> ())
-> Proxy PWebAuthnDisable
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PWebAuthnDisable -> ()
forall a b. a -> b -> a
const ()

-- | Creates and adds a virtual authenticator.

-- | Parameters of the 'WebAuthn.addVirtualAuthenticator' command.
data PWebAuthnAddVirtualAuthenticator = PWebAuthnAddVirtualAuthenticator
  {
    PWebAuthnAddVirtualAuthenticator
-> WebAuthnVirtualAuthenticatorOptions
pWebAuthnAddVirtualAuthenticatorOptions :: WebAuthnVirtualAuthenticatorOptions
  }
  deriving (PWebAuthnAddVirtualAuthenticator
-> PWebAuthnAddVirtualAuthenticator -> Bool
(PWebAuthnAddVirtualAuthenticator
 -> PWebAuthnAddVirtualAuthenticator -> Bool)
-> (PWebAuthnAddVirtualAuthenticator
    -> PWebAuthnAddVirtualAuthenticator -> Bool)
-> Eq PWebAuthnAddVirtualAuthenticator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWebAuthnAddVirtualAuthenticator
-> PWebAuthnAddVirtualAuthenticator -> Bool
$c/= :: PWebAuthnAddVirtualAuthenticator
-> PWebAuthnAddVirtualAuthenticator -> Bool
== :: PWebAuthnAddVirtualAuthenticator
-> PWebAuthnAddVirtualAuthenticator -> Bool
$c== :: PWebAuthnAddVirtualAuthenticator
-> PWebAuthnAddVirtualAuthenticator -> Bool
Eq, Int -> PWebAuthnAddVirtualAuthenticator -> ShowS
[PWebAuthnAddVirtualAuthenticator] -> ShowS
PWebAuthnAddVirtualAuthenticator -> String
(Int -> PWebAuthnAddVirtualAuthenticator -> ShowS)
-> (PWebAuthnAddVirtualAuthenticator -> String)
-> ([PWebAuthnAddVirtualAuthenticator] -> ShowS)
-> Show PWebAuthnAddVirtualAuthenticator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWebAuthnAddVirtualAuthenticator] -> ShowS
$cshowList :: [PWebAuthnAddVirtualAuthenticator] -> ShowS
show :: PWebAuthnAddVirtualAuthenticator -> String
$cshow :: PWebAuthnAddVirtualAuthenticator -> String
showsPrec :: Int -> PWebAuthnAddVirtualAuthenticator -> ShowS
$cshowsPrec :: Int -> PWebAuthnAddVirtualAuthenticator -> ShowS
Show)
pWebAuthnAddVirtualAuthenticator
  :: WebAuthnVirtualAuthenticatorOptions
  -> PWebAuthnAddVirtualAuthenticator
pWebAuthnAddVirtualAuthenticator :: WebAuthnVirtualAuthenticatorOptions
-> PWebAuthnAddVirtualAuthenticator
pWebAuthnAddVirtualAuthenticator
  WebAuthnVirtualAuthenticatorOptions
arg_pWebAuthnAddVirtualAuthenticatorOptions
  = WebAuthnVirtualAuthenticatorOptions
-> PWebAuthnAddVirtualAuthenticator
PWebAuthnAddVirtualAuthenticator
    WebAuthnVirtualAuthenticatorOptions
arg_pWebAuthnAddVirtualAuthenticatorOptions
instance ToJSON PWebAuthnAddVirtualAuthenticator where
  toJSON :: PWebAuthnAddVirtualAuthenticator -> Value
toJSON PWebAuthnAddVirtualAuthenticator
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"options" Text -> WebAuthnVirtualAuthenticatorOptions -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (WebAuthnVirtualAuthenticatorOptions -> Pair)
-> Maybe WebAuthnVirtualAuthenticatorOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebAuthnVirtualAuthenticatorOptions
-> Maybe WebAuthnVirtualAuthenticatorOptions
forall a. a -> Maybe a
Just (PWebAuthnAddVirtualAuthenticator
-> WebAuthnVirtualAuthenticatorOptions
pWebAuthnAddVirtualAuthenticatorOptions PWebAuthnAddVirtualAuthenticator
p)
    ]
data WebAuthnAddVirtualAuthenticator = WebAuthnAddVirtualAuthenticator
  {
    WebAuthnAddVirtualAuthenticator -> Text
webAuthnAddVirtualAuthenticatorAuthenticatorId :: WebAuthnAuthenticatorId
  }
  deriving (WebAuthnAddVirtualAuthenticator
-> WebAuthnAddVirtualAuthenticator -> Bool
(WebAuthnAddVirtualAuthenticator
 -> WebAuthnAddVirtualAuthenticator -> Bool)
-> (WebAuthnAddVirtualAuthenticator
    -> WebAuthnAddVirtualAuthenticator -> Bool)
-> Eq WebAuthnAddVirtualAuthenticator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAuthnAddVirtualAuthenticator
-> WebAuthnAddVirtualAuthenticator -> Bool
$c/= :: WebAuthnAddVirtualAuthenticator
-> WebAuthnAddVirtualAuthenticator -> Bool
== :: WebAuthnAddVirtualAuthenticator
-> WebAuthnAddVirtualAuthenticator -> Bool
$c== :: WebAuthnAddVirtualAuthenticator
-> WebAuthnAddVirtualAuthenticator -> Bool
Eq, Int -> WebAuthnAddVirtualAuthenticator -> ShowS
[WebAuthnAddVirtualAuthenticator] -> ShowS
WebAuthnAddVirtualAuthenticator -> String
(Int -> WebAuthnAddVirtualAuthenticator -> ShowS)
-> (WebAuthnAddVirtualAuthenticator -> String)
-> ([WebAuthnAddVirtualAuthenticator] -> ShowS)
-> Show WebAuthnAddVirtualAuthenticator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAuthnAddVirtualAuthenticator] -> ShowS
$cshowList :: [WebAuthnAddVirtualAuthenticator] -> ShowS
show :: WebAuthnAddVirtualAuthenticator -> String
$cshow :: WebAuthnAddVirtualAuthenticator -> String
showsPrec :: Int -> WebAuthnAddVirtualAuthenticator -> ShowS
$cshowsPrec :: Int -> WebAuthnAddVirtualAuthenticator -> ShowS
Show)
instance FromJSON WebAuthnAddVirtualAuthenticator where
  parseJSON :: Value -> Parser WebAuthnAddVirtualAuthenticator
parseJSON = String
-> (Object -> Parser WebAuthnAddVirtualAuthenticator)
-> Value
-> Parser WebAuthnAddVirtualAuthenticator
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAuthnAddVirtualAuthenticator" ((Object -> Parser WebAuthnAddVirtualAuthenticator)
 -> Value -> Parser WebAuthnAddVirtualAuthenticator)
-> (Object -> Parser WebAuthnAddVirtualAuthenticator)
-> Value
-> Parser WebAuthnAddVirtualAuthenticator
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> WebAuthnAddVirtualAuthenticator
WebAuthnAddVirtualAuthenticator
    (Text -> WebAuthnAddVirtualAuthenticator)
-> Parser Text -> Parser WebAuthnAddVirtualAuthenticator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"authenticatorId"
instance Command PWebAuthnAddVirtualAuthenticator where
  type CommandResponse PWebAuthnAddVirtualAuthenticator = WebAuthnAddVirtualAuthenticator
  commandName :: Proxy PWebAuthnAddVirtualAuthenticator -> String
commandName Proxy PWebAuthnAddVirtualAuthenticator
_ = String
"WebAuthn.addVirtualAuthenticator"

-- | Removes the given authenticator.

-- | Parameters of the 'WebAuthn.removeVirtualAuthenticator' command.
data PWebAuthnRemoveVirtualAuthenticator = PWebAuthnRemoveVirtualAuthenticator
  {
    PWebAuthnRemoveVirtualAuthenticator -> Text
pWebAuthnRemoveVirtualAuthenticatorAuthenticatorId :: WebAuthnAuthenticatorId
  }
  deriving (PWebAuthnRemoveVirtualAuthenticator
-> PWebAuthnRemoveVirtualAuthenticator -> Bool
(PWebAuthnRemoveVirtualAuthenticator
 -> PWebAuthnRemoveVirtualAuthenticator -> Bool)
-> (PWebAuthnRemoveVirtualAuthenticator
    -> PWebAuthnRemoveVirtualAuthenticator -> Bool)
-> Eq PWebAuthnRemoveVirtualAuthenticator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWebAuthnRemoveVirtualAuthenticator
-> PWebAuthnRemoveVirtualAuthenticator -> Bool
$c/= :: PWebAuthnRemoveVirtualAuthenticator
-> PWebAuthnRemoveVirtualAuthenticator -> Bool
== :: PWebAuthnRemoveVirtualAuthenticator
-> PWebAuthnRemoveVirtualAuthenticator -> Bool
$c== :: PWebAuthnRemoveVirtualAuthenticator
-> PWebAuthnRemoveVirtualAuthenticator -> Bool
Eq, Int -> PWebAuthnRemoveVirtualAuthenticator -> ShowS
[PWebAuthnRemoveVirtualAuthenticator] -> ShowS
PWebAuthnRemoveVirtualAuthenticator -> String
(Int -> PWebAuthnRemoveVirtualAuthenticator -> ShowS)
-> (PWebAuthnRemoveVirtualAuthenticator -> String)
-> ([PWebAuthnRemoveVirtualAuthenticator] -> ShowS)
-> Show PWebAuthnRemoveVirtualAuthenticator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWebAuthnRemoveVirtualAuthenticator] -> ShowS
$cshowList :: [PWebAuthnRemoveVirtualAuthenticator] -> ShowS
show :: PWebAuthnRemoveVirtualAuthenticator -> String
$cshow :: PWebAuthnRemoveVirtualAuthenticator -> String
showsPrec :: Int -> PWebAuthnRemoveVirtualAuthenticator -> ShowS
$cshowsPrec :: Int -> PWebAuthnRemoveVirtualAuthenticator -> ShowS
Show)
pWebAuthnRemoveVirtualAuthenticator
  :: WebAuthnAuthenticatorId
  -> PWebAuthnRemoveVirtualAuthenticator
pWebAuthnRemoveVirtualAuthenticator :: Text -> PWebAuthnRemoveVirtualAuthenticator
pWebAuthnRemoveVirtualAuthenticator
  Text
arg_pWebAuthnRemoveVirtualAuthenticatorAuthenticatorId
  = Text -> PWebAuthnRemoveVirtualAuthenticator
PWebAuthnRemoveVirtualAuthenticator
    Text
arg_pWebAuthnRemoveVirtualAuthenticatorAuthenticatorId
instance ToJSON PWebAuthnRemoveVirtualAuthenticator where
  toJSON :: PWebAuthnRemoveVirtualAuthenticator -> Value
toJSON PWebAuthnRemoveVirtualAuthenticator
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"authenticatorId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PWebAuthnRemoveVirtualAuthenticator -> Text
pWebAuthnRemoveVirtualAuthenticatorAuthenticatorId PWebAuthnRemoveVirtualAuthenticator
p)
    ]
instance Command PWebAuthnRemoveVirtualAuthenticator where
  type CommandResponse PWebAuthnRemoveVirtualAuthenticator = ()
  commandName :: Proxy PWebAuthnRemoveVirtualAuthenticator -> String
commandName Proxy PWebAuthnRemoveVirtualAuthenticator
_ = String
"WebAuthn.removeVirtualAuthenticator"
  fromJSON :: Proxy PWebAuthnRemoveVirtualAuthenticator
-> Value
-> Result (CommandResponse PWebAuthnRemoveVirtualAuthenticator)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PWebAuthnRemoveVirtualAuthenticator -> Result ())
-> Proxy PWebAuthnRemoveVirtualAuthenticator
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PWebAuthnRemoveVirtualAuthenticator -> ())
-> Proxy PWebAuthnRemoveVirtualAuthenticator
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PWebAuthnRemoveVirtualAuthenticator -> ()
forall a b. a -> b -> a
const ()

-- | Adds the credential to the specified authenticator.

-- | Parameters of the 'WebAuthn.addCredential' command.
data PWebAuthnAddCredential = PWebAuthnAddCredential
  {
    PWebAuthnAddCredential -> Text
pWebAuthnAddCredentialAuthenticatorId :: WebAuthnAuthenticatorId,
    PWebAuthnAddCredential -> WebAuthnCredential
pWebAuthnAddCredentialCredential :: WebAuthnCredential
  }
  deriving (PWebAuthnAddCredential -> PWebAuthnAddCredential -> Bool
(PWebAuthnAddCredential -> PWebAuthnAddCredential -> Bool)
-> (PWebAuthnAddCredential -> PWebAuthnAddCredential -> Bool)
-> Eq PWebAuthnAddCredential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWebAuthnAddCredential -> PWebAuthnAddCredential -> Bool
$c/= :: PWebAuthnAddCredential -> PWebAuthnAddCredential -> Bool
== :: PWebAuthnAddCredential -> PWebAuthnAddCredential -> Bool
$c== :: PWebAuthnAddCredential -> PWebAuthnAddCredential -> Bool
Eq, Int -> PWebAuthnAddCredential -> ShowS
[PWebAuthnAddCredential] -> ShowS
PWebAuthnAddCredential -> String
(Int -> PWebAuthnAddCredential -> ShowS)
-> (PWebAuthnAddCredential -> String)
-> ([PWebAuthnAddCredential] -> ShowS)
-> Show PWebAuthnAddCredential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWebAuthnAddCredential] -> ShowS
$cshowList :: [PWebAuthnAddCredential] -> ShowS
show :: PWebAuthnAddCredential -> String
$cshow :: PWebAuthnAddCredential -> String
showsPrec :: Int -> PWebAuthnAddCredential -> ShowS
$cshowsPrec :: Int -> PWebAuthnAddCredential -> ShowS
Show)
pWebAuthnAddCredential
  :: WebAuthnAuthenticatorId
  -> WebAuthnCredential
  -> PWebAuthnAddCredential
pWebAuthnAddCredential :: Text -> WebAuthnCredential -> PWebAuthnAddCredential
pWebAuthnAddCredential
  Text
arg_pWebAuthnAddCredentialAuthenticatorId
  WebAuthnCredential
arg_pWebAuthnAddCredentialCredential
  = Text -> WebAuthnCredential -> PWebAuthnAddCredential
PWebAuthnAddCredential
    Text
arg_pWebAuthnAddCredentialAuthenticatorId
    WebAuthnCredential
arg_pWebAuthnAddCredentialCredential
instance ToJSON PWebAuthnAddCredential where
  toJSON :: PWebAuthnAddCredential -> Value
toJSON PWebAuthnAddCredential
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"authenticatorId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PWebAuthnAddCredential -> Text
pWebAuthnAddCredentialAuthenticatorId PWebAuthnAddCredential
p),
    (Text
"credential" Text -> WebAuthnCredential -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (WebAuthnCredential -> Pair)
-> Maybe WebAuthnCredential -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebAuthnCredential -> Maybe WebAuthnCredential
forall a. a -> Maybe a
Just (PWebAuthnAddCredential -> WebAuthnCredential
pWebAuthnAddCredentialCredential PWebAuthnAddCredential
p)
    ]
instance Command PWebAuthnAddCredential where
  type CommandResponse PWebAuthnAddCredential = ()
  commandName :: Proxy PWebAuthnAddCredential -> String
commandName Proxy PWebAuthnAddCredential
_ = String
"WebAuthn.addCredential"
  fromJSON :: Proxy PWebAuthnAddCredential
-> Value -> Result (CommandResponse PWebAuthnAddCredential)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PWebAuthnAddCredential -> Result ())
-> Proxy PWebAuthnAddCredential
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PWebAuthnAddCredential -> ())
-> Proxy PWebAuthnAddCredential
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PWebAuthnAddCredential -> ()
forall a b. a -> b -> a
const ()

-- | Returns a single credential stored in the given virtual authenticator that
--   matches the credential ID.

-- | Parameters of the 'WebAuthn.getCredential' command.
data PWebAuthnGetCredential = PWebAuthnGetCredential
  {
    PWebAuthnGetCredential -> Text
pWebAuthnGetCredentialAuthenticatorId :: WebAuthnAuthenticatorId,
    PWebAuthnGetCredential -> Text
pWebAuthnGetCredentialCredentialId :: T.Text
  }
  deriving (PWebAuthnGetCredential -> PWebAuthnGetCredential -> Bool
(PWebAuthnGetCredential -> PWebAuthnGetCredential -> Bool)
-> (PWebAuthnGetCredential -> PWebAuthnGetCredential -> Bool)
-> Eq PWebAuthnGetCredential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWebAuthnGetCredential -> PWebAuthnGetCredential -> Bool
$c/= :: PWebAuthnGetCredential -> PWebAuthnGetCredential -> Bool
== :: PWebAuthnGetCredential -> PWebAuthnGetCredential -> Bool
$c== :: PWebAuthnGetCredential -> PWebAuthnGetCredential -> Bool
Eq, Int -> PWebAuthnGetCredential -> ShowS
[PWebAuthnGetCredential] -> ShowS
PWebAuthnGetCredential -> String
(Int -> PWebAuthnGetCredential -> ShowS)
-> (PWebAuthnGetCredential -> String)
-> ([PWebAuthnGetCredential] -> ShowS)
-> Show PWebAuthnGetCredential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWebAuthnGetCredential] -> ShowS
$cshowList :: [PWebAuthnGetCredential] -> ShowS
show :: PWebAuthnGetCredential -> String
$cshow :: PWebAuthnGetCredential -> String
showsPrec :: Int -> PWebAuthnGetCredential -> ShowS
$cshowsPrec :: Int -> PWebAuthnGetCredential -> ShowS
Show)
pWebAuthnGetCredential
  :: WebAuthnAuthenticatorId
  -> T.Text
  -> PWebAuthnGetCredential
pWebAuthnGetCredential :: Text -> Text -> PWebAuthnGetCredential
pWebAuthnGetCredential
  Text
arg_pWebAuthnGetCredentialAuthenticatorId
  Text
arg_pWebAuthnGetCredentialCredentialId
  = Text -> Text -> PWebAuthnGetCredential
PWebAuthnGetCredential
    Text
arg_pWebAuthnGetCredentialAuthenticatorId
    Text
arg_pWebAuthnGetCredentialCredentialId
instance ToJSON PWebAuthnGetCredential where
  toJSON :: PWebAuthnGetCredential -> Value
toJSON PWebAuthnGetCredential
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"authenticatorId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PWebAuthnGetCredential -> Text
pWebAuthnGetCredentialAuthenticatorId PWebAuthnGetCredential
p),
    (Text
"credentialId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PWebAuthnGetCredential -> Text
pWebAuthnGetCredentialCredentialId PWebAuthnGetCredential
p)
    ]
data WebAuthnGetCredential = WebAuthnGetCredential
  {
    WebAuthnGetCredential -> WebAuthnCredential
webAuthnGetCredentialCredential :: WebAuthnCredential
  }
  deriving (WebAuthnGetCredential -> WebAuthnGetCredential -> Bool
(WebAuthnGetCredential -> WebAuthnGetCredential -> Bool)
-> (WebAuthnGetCredential -> WebAuthnGetCredential -> Bool)
-> Eq WebAuthnGetCredential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAuthnGetCredential -> WebAuthnGetCredential -> Bool
$c/= :: WebAuthnGetCredential -> WebAuthnGetCredential -> Bool
== :: WebAuthnGetCredential -> WebAuthnGetCredential -> Bool
$c== :: WebAuthnGetCredential -> WebAuthnGetCredential -> Bool
Eq, Int -> WebAuthnGetCredential -> ShowS
[WebAuthnGetCredential] -> ShowS
WebAuthnGetCredential -> String
(Int -> WebAuthnGetCredential -> ShowS)
-> (WebAuthnGetCredential -> String)
-> ([WebAuthnGetCredential] -> ShowS)
-> Show WebAuthnGetCredential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAuthnGetCredential] -> ShowS
$cshowList :: [WebAuthnGetCredential] -> ShowS
show :: WebAuthnGetCredential -> String
$cshow :: WebAuthnGetCredential -> String
showsPrec :: Int -> WebAuthnGetCredential -> ShowS
$cshowsPrec :: Int -> WebAuthnGetCredential -> ShowS
Show)
instance FromJSON WebAuthnGetCredential where
  parseJSON :: Value -> Parser WebAuthnGetCredential
parseJSON = String
-> (Object -> Parser WebAuthnGetCredential)
-> Value
-> Parser WebAuthnGetCredential
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAuthnGetCredential" ((Object -> Parser WebAuthnGetCredential)
 -> Value -> Parser WebAuthnGetCredential)
-> (Object -> Parser WebAuthnGetCredential)
-> Value
-> Parser WebAuthnGetCredential
forall a b. (a -> b) -> a -> b
$ \Object
o -> WebAuthnCredential -> WebAuthnGetCredential
WebAuthnGetCredential
    (WebAuthnCredential -> WebAuthnGetCredential)
-> Parser WebAuthnCredential -> Parser WebAuthnGetCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser WebAuthnCredential
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"credential"
instance Command PWebAuthnGetCredential where
  type CommandResponse PWebAuthnGetCredential = WebAuthnGetCredential
  commandName :: Proxy PWebAuthnGetCredential -> String
commandName Proxy PWebAuthnGetCredential
_ = String
"WebAuthn.getCredential"

-- | Returns all the credentials stored in the given virtual authenticator.

-- | Parameters of the 'WebAuthn.getCredentials' command.
data PWebAuthnGetCredentials = PWebAuthnGetCredentials
  {
    PWebAuthnGetCredentials -> Text
pWebAuthnGetCredentialsAuthenticatorId :: WebAuthnAuthenticatorId
  }
  deriving (PWebAuthnGetCredentials -> PWebAuthnGetCredentials -> Bool
(PWebAuthnGetCredentials -> PWebAuthnGetCredentials -> Bool)
-> (PWebAuthnGetCredentials -> PWebAuthnGetCredentials -> Bool)
-> Eq PWebAuthnGetCredentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWebAuthnGetCredentials -> PWebAuthnGetCredentials -> Bool
$c/= :: PWebAuthnGetCredentials -> PWebAuthnGetCredentials -> Bool
== :: PWebAuthnGetCredentials -> PWebAuthnGetCredentials -> Bool
$c== :: PWebAuthnGetCredentials -> PWebAuthnGetCredentials -> Bool
Eq, Int -> PWebAuthnGetCredentials -> ShowS
[PWebAuthnGetCredentials] -> ShowS
PWebAuthnGetCredentials -> String
(Int -> PWebAuthnGetCredentials -> ShowS)
-> (PWebAuthnGetCredentials -> String)
-> ([PWebAuthnGetCredentials] -> ShowS)
-> Show PWebAuthnGetCredentials
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWebAuthnGetCredentials] -> ShowS
$cshowList :: [PWebAuthnGetCredentials] -> ShowS
show :: PWebAuthnGetCredentials -> String
$cshow :: PWebAuthnGetCredentials -> String
showsPrec :: Int -> PWebAuthnGetCredentials -> ShowS
$cshowsPrec :: Int -> PWebAuthnGetCredentials -> ShowS
Show)
pWebAuthnGetCredentials
  :: WebAuthnAuthenticatorId
  -> PWebAuthnGetCredentials
pWebAuthnGetCredentials :: Text -> PWebAuthnGetCredentials
pWebAuthnGetCredentials
  Text
arg_pWebAuthnGetCredentialsAuthenticatorId
  = Text -> PWebAuthnGetCredentials
PWebAuthnGetCredentials
    Text
arg_pWebAuthnGetCredentialsAuthenticatorId
instance ToJSON PWebAuthnGetCredentials where
  toJSON :: PWebAuthnGetCredentials -> Value
toJSON PWebAuthnGetCredentials
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"authenticatorId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PWebAuthnGetCredentials -> Text
pWebAuthnGetCredentialsAuthenticatorId PWebAuthnGetCredentials
p)
    ]
data WebAuthnGetCredentials = WebAuthnGetCredentials
  {
    WebAuthnGetCredentials -> [WebAuthnCredential]
webAuthnGetCredentialsCredentials :: [WebAuthnCredential]
  }
  deriving (WebAuthnGetCredentials -> WebAuthnGetCredentials -> Bool
(WebAuthnGetCredentials -> WebAuthnGetCredentials -> Bool)
-> (WebAuthnGetCredentials -> WebAuthnGetCredentials -> Bool)
-> Eq WebAuthnGetCredentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebAuthnGetCredentials -> WebAuthnGetCredentials -> Bool
$c/= :: WebAuthnGetCredentials -> WebAuthnGetCredentials -> Bool
== :: WebAuthnGetCredentials -> WebAuthnGetCredentials -> Bool
$c== :: WebAuthnGetCredentials -> WebAuthnGetCredentials -> Bool
Eq, Int -> WebAuthnGetCredentials -> ShowS
[WebAuthnGetCredentials] -> ShowS
WebAuthnGetCredentials -> String
(Int -> WebAuthnGetCredentials -> ShowS)
-> (WebAuthnGetCredentials -> String)
-> ([WebAuthnGetCredentials] -> ShowS)
-> Show WebAuthnGetCredentials
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAuthnGetCredentials] -> ShowS
$cshowList :: [WebAuthnGetCredentials] -> ShowS
show :: WebAuthnGetCredentials -> String
$cshow :: WebAuthnGetCredentials -> String
showsPrec :: Int -> WebAuthnGetCredentials -> ShowS
$cshowsPrec :: Int -> WebAuthnGetCredentials -> ShowS
Show)
instance FromJSON WebAuthnGetCredentials where
  parseJSON :: Value -> Parser WebAuthnGetCredentials
parseJSON = String
-> (Object -> Parser WebAuthnGetCredentials)
-> Value
-> Parser WebAuthnGetCredentials
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebAuthnGetCredentials" ((Object -> Parser WebAuthnGetCredentials)
 -> Value -> Parser WebAuthnGetCredentials)
-> (Object -> Parser WebAuthnGetCredentials)
-> Value
-> Parser WebAuthnGetCredentials
forall a b. (a -> b) -> a -> b
$ \Object
o -> [WebAuthnCredential] -> WebAuthnGetCredentials
WebAuthnGetCredentials
    ([WebAuthnCredential] -> WebAuthnGetCredentials)
-> Parser [WebAuthnCredential] -> Parser WebAuthnGetCredentials
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [WebAuthnCredential]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"credentials"
instance Command PWebAuthnGetCredentials where
  type CommandResponse PWebAuthnGetCredentials = WebAuthnGetCredentials
  commandName :: Proxy PWebAuthnGetCredentials -> String
commandName Proxy PWebAuthnGetCredentials
_ = String
"WebAuthn.getCredentials"

-- | Removes a credential from the authenticator.

-- | Parameters of the 'WebAuthn.removeCredential' command.
data PWebAuthnRemoveCredential = PWebAuthnRemoveCredential
  {
    PWebAuthnRemoveCredential -> Text
pWebAuthnRemoveCredentialAuthenticatorId :: WebAuthnAuthenticatorId,
    PWebAuthnRemoveCredential -> Text
pWebAuthnRemoveCredentialCredentialId :: T.Text
  }
  deriving (PWebAuthnRemoveCredential -> PWebAuthnRemoveCredential -> Bool
(PWebAuthnRemoveCredential -> PWebAuthnRemoveCredential -> Bool)
-> (PWebAuthnRemoveCredential -> PWebAuthnRemoveCredential -> Bool)
-> Eq PWebAuthnRemoveCredential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWebAuthnRemoveCredential -> PWebAuthnRemoveCredential -> Bool
$c/= :: PWebAuthnRemoveCredential -> PWebAuthnRemoveCredential -> Bool
== :: PWebAuthnRemoveCredential -> PWebAuthnRemoveCredential -> Bool
$c== :: PWebAuthnRemoveCredential -> PWebAuthnRemoveCredential -> Bool
Eq, Int -> PWebAuthnRemoveCredential -> ShowS
[PWebAuthnRemoveCredential] -> ShowS
PWebAuthnRemoveCredential -> String
(Int -> PWebAuthnRemoveCredential -> ShowS)
-> (PWebAuthnRemoveCredential -> String)
-> ([PWebAuthnRemoveCredential] -> ShowS)
-> Show PWebAuthnRemoveCredential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWebAuthnRemoveCredential] -> ShowS
$cshowList :: [PWebAuthnRemoveCredential] -> ShowS
show :: PWebAuthnRemoveCredential -> String
$cshow :: PWebAuthnRemoveCredential -> String
showsPrec :: Int -> PWebAuthnRemoveCredential -> ShowS
$cshowsPrec :: Int -> PWebAuthnRemoveCredential -> ShowS
Show)
pWebAuthnRemoveCredential
  :: WebAuthnAuthenticatorId
  -> T.Text
  -> PWebAuthnRemoveCredential
pWebAuthnRemoveCredential :: Text -> Text -> PWebAuthnRemoveCredential
pWebAuthnRemoveCredential
  Text
arg_pWebAuthnRemoveCredentialAuthenticatorId
  Text
arg_pWebAuthnRemoveCredentialCredentialId
  = Text -> Text -> PWebAuthnRemoveCredential
PWebAuthnRemoveCredential
    Text
arg_pWebAuthnRemoveCredentialAuthenticatorId
    Text
arg_pWebAuthnRemoveCredentialCredentialId
instance ToJSON PWebAuthnRemoveCredential where
  toJSON :: PWebAuthnRemoveCredential -> Value
toJSON PWebAuthnRemoveCredential
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"authenticatorId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PWebAuthnRemoveCredential -> Text
pWebAuthnRemoveCredentialAuthenticatorId PWebAuthnRemoveCredential
p),
    (Text
"credentialId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PWebAuthnRemoveCredential -> Text
pWebAuthnRemoveCredentialCredentialId PWebAuthnRemoveCredential
p)
    ]
instance Command PWebAuthnRemoveCredential where
  type CommandResponse PWebAuthnRemoveCredential = ()
  commandName :: Proxy PWebAuthnRemoveCredential -> String
commandName Proxy PWebAuthnRemoveCredential
_ = String
"WebAuthn.removeCredential"
  fromJSON :: Proxy PWebAuthnRemoveCredential
-> Value -> Result (CommandResponse PWebAuthnRemoveCredential)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PWebAuthnRemoveCredential -> Result ())
-> Proxy PWebAuthnRemoveCredential
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PWebAuthnRemoveCredential -> ())
-> Proxy PWebAuthnRemoveCredential
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PWebAuthnRemoveCredential -> ()
forall a b. a -> b -> a
const ()

-- | Clears all the credentials from the specified device.

-- | Parameters of the 'WebAuthn.clearCredentials' command.
data PWebAuthnClearCredentials = PWebAuthnClearCredentials
  {
    PWebAuthnClearCredentials -> Text
pWebAuthnClearCredentialsAuthenticatorId :: WebAuthnAuthenticatorId
  }
  deriving (PWebAuthnClearCredentials -> PWebAuthnClearCredentials -> Bool
(PWebAuthnClearCredentials -> PWebAuthnClearCredentials -> Bool)
-> (PWebAuthnClearCredentials -> PWebAuthnClearCredentials -> Bool)
-> Eq PWebAuthnClearCredentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWebAuthnClearCredentials -> PWebAuthnClearCredentials -> Bool
$c/= :: PWebAuthnClearCredentials -> PWebAuthnClearCredentials -> Bool
== :: PWebAuthnClearCredentials -> PWebAuthnClearCredentials -> Bool
$c== :: PWebAuthnClearCredentials -> PWebAuthnClearCredentials -> Bool
Eq, Int -> PWebAuthnClearCredentials -> ShowS
[PWebAuthnClearCredentials] -> ShowS
PWebAuthnClearCredentials -> String
(Int -> PWebAuthnClearCredentials -> ShowS)
-> (PWebAuthnClearCredentials -> String)
-> ([PWebAuthnClearCredentials] -> ShowS)
-> Show PWebAuthnClearCredentials
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWebAuthnClearCredentials] -> ShowS
$cshowList :: [PWebAuthnClearCredentials] -> ShowS
show :: PWebAuthnClearCredentials -> String
$cshow :: PWebAuthnClearCredentials -> String
showsPrec :: Int -> PWebAuthnClearCredentials -> ShowS
$cshowsPrec :: Int -> PWebAuthnClearCredentials -> ShowS
Show)
pWebAuthnClearCredentials
  :: WebAuthnAuthenticatorId
  -> PWebAuthnClearCredentials
pWebAuthnClearCredentials :: Text -> PWebAuthnClearCredentials
pWebAuthnClearCredentials
  Text
arg_pWebAuthnClearCredentialsAuthenticatorId
  = Text -> PWebAuthnClearCredentials
PWebAuthnClearCredentials
    Text
arg_pWebAuthnClearCredentialsAuthenticatorId
instance ToJSON PWebAuthnClearCredentials where
  toJSON :: PWebAuthnClearCredentials -> Value
toJSON PWebAuthnClearCredentials
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"authenticatorId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PWebAuthnClearCredentials -> Text
pWebAuthnClearCredentialsAuthenticatorId PWebAuthnClearCredentials
p)
    ]
instance Command PWebAuthnClearCredentials where
  type CommandResponse PWebAuthnClearCredentials = ()
  commandName :: Proxy PWebAuthnClearCredentials -> String
commandName Proxy PWebAuthnClearCredentials
_ = String
"WebAuthn.clearCredentials"
  fromJSON :: Proxy PWebAuthnClearCredentials
-> Value -> Result (CommandResponse PWebAuthnClearCredentials)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PWebAuthnClearCredentials -> Result ())
-> Proxy PWebAuthnClearCredentials
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PWebAuthnClearCredentials -> ())
-> Proxy PWebAuthnClearCredentials
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PWebAuthnClearCredentials -> ()
forall a b. a -> b -> a
const ()

-- | Sets whether User Verification succeeds or fails for an authenticator.
--   The default is true.

-- | Parameters of the 'WebAuthn.setUserVerified' command.
data PWebAuthnSetUserVerified = PWebAuthnSetUserVerified
  {
    PWebAuthnSetUserVerified -> Text
pWebAuthnSetUserVerifiedAuthenticatorId :: WebAuthnAuthenticatorId,
    PWebAuthnSetUserVerified -> Bool
pWebAuthnSetUserVerifiedIsUserVerified :: Bool
  }
  deriving (PWebAuthnSetUserVerified -> PWebAuthnSetUserVerified -> Bool
(PWebAuthnSetUserVerified -> PWebAuthnSetUserVerified -> Bool)
-> (PWebAuthnSetUserVerified -> PWebAuthnSetUserVerified -> Bool)
-> Eq PWebAuthnSetUserVerified
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWebAuthnSetUserVerified -> PWebAuthnSetUserVerified -> Bool
$c/= :: PWebAuthnSetUserVerified -> PWebAuthnSetUserVerified -> Bool
== :: PWebAuthnSetUserVerified -> PWebAuthnSetUserVerified -> Bool
$c== :: PWebAuthnSetUserVerified -> PWebAuthnSetUserVerified -> Bool
Eq, Int -> PWebAuthnSetUserVerified -> ShowS
[PWebAuthnSetUserVerified] -> ShowS
PWebAuthnSetUserVerified -> String
(Int -> PWebAuthnSetUserVerified -> ShowS)
-> (PWebAuthnSetUserVerified -> String)
-> ([PWebAuthnSetUserVerified] -> ShowS)
-> Show PWebAuthnSetUserVerified
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWebAuthnSetUserVerified] -> ShowS
$cshowList :: [PWebAuthnSetUserVerified] -> ShowS
show :: PWebAuthnSetUserVerified -> String
$cshow :: PWebAuthnSetUserVerified -> String
showsPrec :: Int -> PWebAuthnSetUserVerified -> ShowS
$cshowsPrec :: Int -> PWebAuthnSetUserVerified -> ShowS
Show)
pWebAuthnSetUserVerified
  :: WebAuthnAuthenticatorId
  -> Bool
  -> PWebAuthnSetUserVerified
pWebAuthnSetUserVerified :: Text -> Bool -> PWebAuthnSetUserVerified
pWebAuthnSetUserVerified
  Text
arg_pWebAuthnSetUserVerifiedAuthenticatorId
  Bool
arg_pWebAuthnSetUserVerifiedIsUserVerified
  = Text -> Bool -> PWebAuthnSetUserVerified
PWebAuthnSetUserVerified
    Text
arg_pWebAuthnSetUserVerifiedAuthenticatorId
    Bool
arg_pWebAuthnSetUserVerifiedIsUserVerified
instance ToJSON PWebAuthnSetUserVerified where
  toJSON :: PWebAuthnSetUserVerified -> Value
toJSON PWebAuthnSetUserVerified
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"authenticatorId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PWebAuthnSetUserVerified -> Text
pWebAuthnSetUserVerifiedAuthenticatorId PWebAuthnSetUserVerified
p),
    (Text
"isUserVerified" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (PWebAuthnSetUserVerified -> Bool
pWebAuthnSetUserVerifiedIsUserVerified PWebAuthnSetUserVerified
p)
    ]
instance Command PWebAuthnSetUserVerified where
  type CommandResponse PWebAuthnSetUserVerified = ()
  commandName :: Proxy PWebAuthnSetUserVerified -> String
commandName Proxy PWebAuthnSetUserVerified
_ = String
"WebAuthn.setUserVerified"
  fromJSON :: Proxy PWebAuthnSetUserVerified
-> Value -> Result (CommandResponse PWebAuthnSetUserVerified)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PWebAuthnSetUserVerified -> Result ())
-> Proxy PWebAuthnSetUserVerified
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PWebAuthnSetUserVerified -> ())
-> Proxy PWebAuthnSetUserVerified
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PWebAuthnSetUserVerified -> ()
forall a b. a -> b -> a
const ()

-- | Sets whether tests of user presence will succeed immediately (if true) or fail to resolve (if false) for an authenticator.
--   The default is true.

-- | Parameters of the 'WebAuthn.setAutomaticPresenceSimulation' command.
data PWebAuthnSetAutomaticPresenceSimulation = PWebAuthnSetAutomaticPresenceSimulation
  {
    PWebAuthnSetAutomaticPresenceSimulation -> Text
pWebAuthnSetAutomaticPresenceSimulationAuthenticatorId :: WebAuthnAuthenticatorId,
    PWebAuthnSetAutomaticPresenceSimulation -> Bool
pWebAuthnSetAutomaticPresenceSimulationEnabled :: Bool
  }
  deriving (PWebAuthnSetAutomaticPresenceSimulation
-> PWebAuthnSetAutomaticPresenceSimulation -> Bool
(PWebAuthnSetAutomaticPresenceSimulation
 -> PWebAuthnSetAutomaticPresenceSimulation -> Bool)
-> (PWebAuthnSetAutomaticPresenceSimulation
    -> PWebAuthnSetAutomaticPresenceSimulation -> Bool)
-> Eq PWebAuthnSetAutomaticPresenceSimulation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWebAuthnSetAutomaticPresenceSimulation
-> PWebAuthnSetAutomaticPresenceSimulation -> Bool
$c/= :: PWebAuthnSetAutomaticPresenceSimulation
-> PWebAuthnSetAutomaticPresenceSimulation -> Bool
== :: PWebAuthnSetAutomaticPresenceSimulation
-> PWebAuthnSetAutomaticPresenceSimulation -> Bool
$c== :: PWebAuthnSetAutomaticPresenceSimulation
-> PWebAuthnSetAutomaticPresenceSimulation -> Bool
Eq, Int -> PWebAuthnSetAutomaticPresenceSimulation -> ShowS
[PWebAuthnSetAutomaticPresenceSimulation] -> ShowS
PWebAuthnSetAutomaticPresenceSimulation -> String
(Int -> PWebAuthnSetAutomaticPresenceSimulation -> ShowS)
-> (PWebAuthnSetAutomaticPresenceSimulation -> String)
-> ([PWebAuthnSetAutomaticPresenceSimulation] -> ShowS)
-> Show PWebAuthnSetAutomaticPresenceSimulation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWebAuthnSetAutomaticPresenceSimulation] -> ShowS
$cshowList :: [PWebAuthnSetAutomaticPresenceSimulation] -> ShowS
show :: PWebAuthnSetAutomaticPresenceSimulation -> String
$cshow :: PWebAuthnSetAutomaticPresenceSimulation -> String
showsPrec :: Int -> PWebAuthnSetAutomaticPresenceSimulation -> ShowS
$cshowsPrec :: Int -> PWebAuthnSetAutomaticPresenceSimulation -> ShowS
Show)
pWebAuthnSetAutomaticPresenceSimulation
  :: WebAuthnAuthenticatorId
  -> Bool
  -> PWebAuthnSetAutomaticPresenceSimulation
pWebAuthnSetAutomaticPresenceSimulation :: Text -> Bool -> PWebAuthnSetAutomaticPresenceSimulation
pWebAuthnSetAutomaticPresenceSimulation
  Text
arg_pWebAuthnSetAutomaticPresenceSimulationAuthenticatorId
  Bool
arg_pWebAuthnSetAutomaticPresenceSimulationEnabled
  = Text -> Bool -> PWebAuthnSetAutomaticPresenceSimulation
PWebAuthnSetAutomaticPresenceSimulation
    Text
arg_pWebAuthnSetAutomaticPresenceSimulationAuthenticatorId
    Bool
arg_pWebAuthnSetAutomaticPresenceSimulationEnabled
instance ToJSON PWebAuthnSetAutomaticPresenceSimulation where
  toJSON :: PWebAuthnSetAutomaticPresenceSimulation -> Value
toJSON PWebAuthnSetAutomaticPresenceSimulation
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"authenticatorId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PWebAuthnSetAutomaticPresenceSimulation -> Text
pWebAuthnSetAutomaticPresenceSimulationAuthenticatorId PWebAuthnSetAutomaticPresenceSimulation
p),
    (Text
"enabled" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (PWebAuthnSetAutomaticPresenceSimulation -> Bool
pWebAuthnSetAutomaticPresenceSimulationEnabled PWebAuthnSetAutomaticPresenceSimulation
p)
    ]
instance Command PWebAuthnSetAutomaticPresenceSimulation where
  type CommandResponse PWebAuthnSetAutomaticPresenceSimulation = ()
  commandName :: Proxy PWebAuthnSetAutomaticPresenceSimulation -> String
commandName Proxy PWebAuthnSetAutomaticPresenceSimulation
_ = String
"WebAuthn.setAutomaticPresenceSimulation"
  fromJSON :: Proxy PWebAuthnSetAutomaticPresenceSimulation
-> Value
-> Result (CommandResponse PWebAuthnSetAutomaticPresenceSimulation)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PWebAuthnSetAutomaticPresenceSimulation -> Result ())
-> Proxy PWebAuthnSetAutomaticPresenceSimulation
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PWebAuthnSetAutomaticPresenceSimulation -> ())
-> Proxy PWebAuthnSetAutomaticPresenceSimulation
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PWebAuthnSetAutomaticPresenceSimulation -> ()
forall a b. a -> b -> a
const ()