{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Wire.API.User.Password
  ( NewPasswordReset (..),
    CompletePasswordReset (..),
    PasswordResetIdentity (..),
    PasswordResetKey (..),
    mkPasswordResetKey,
    PasswordResetCode (..),

    -- * deprecated
    PasswordReset (..),
  )
where

import Cassandra qualified as C
import Control.Lens ((?~))
import Crypto.Hash
import Data.Aeson qualified as A
import Data.Aeson.Types (Parser)
import Data.ByteArray qualified as ByteArray
import Data.ByteString qualified as BS
import Data.ByteString.Conversion
import Data.Id
import Data.Misc (PlainTextPassword8)
import Data.OpenApi qualified as S
import Data.OpenApi.ParamSchema
import Data.Proxy (Proxy (Proxy))
import Data.Range (Ranged (..))
import Data.Schema as Schema
import Data.Text.Ascii
import Data.Tuple.Extra
import Imports
import Servant (FromHttpApiData (..))
import Wire.API.User.EmailAddress
import Wire.API.User.Phone
import Wire.Arbitrary (Arbitrary, GenericUniform (..))

--------------------------------------------------------------------------------
-- NewPasswordReset

-- | The payload for initiating a password reset.
data NewPasswordReset
  = NewPasswordReset EmailAddress
  | -- | Resetting via phone is not really supported anymore, but this is still
    -- here to support older versions of the endpoint.
    NewPasswordResetUnsupportedPhone
  deriving stock (NewPasswordReset -> NewPasswordReset -> Bool
(NewPasswordReset -> NewPasswordReset -> Bool)
-> (NewPasswordReset -> NewPasswordReset -> Bool)
-> Eq NewPasswordReset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewPasswordReset -> NewPasswordReset -> Bool
== :: NewPasswordReset -> NewPasswordReset -> Bool
$c/= :: NewPasswordReset -> NewPasswordReset -> Bool
/= :: NewPasswordReset -> NewPasswordReset -> Bool
Eq, Int -> NewPasswordReset -> ShowS
[NewPasswordReset] -> ShowS
NewPasswordReset -> String
(Int -> NewPasswordReset -> ShowS)
-> (NewPasswordReset -> String)
-> ([NewPasswordReset] -> ShowS)
-> Show NewPasswordReset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewPasswordReset -> ShowS
showsPrec :: Int -> NewPasswordReset -> ShowS
$cshow :: NewPasswordReset -> String
show :: NewPasswordReset -> String
$cshowList :: [NewPasswordReset] -> ShowS
showList :: [NewPasswordReset] -> ShowS
Show, (forall x. NewPasswordReset -> Rep NewPasswordReset x)
-> (forall x. Rep NewPasswordReset x -> NewPasswordReset)
-> Generic NewPasswordReset
forall x. Rep NewPasswordReset x -> NewPasswordReset
forall x. NewPasswordReset -> Rep NewPasswordReset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewPasswordReset -> Rep NewPasswordReset x
from :: forall x. NewPasswordReset -> Rep NewPasswordReset x
$cto :: forall x. Rep NewPasswordReset x -> NewPasswordReset
to :: forall x. Rep NewPasswordReset x -> NewPasswordReset
Generic)
  deriving (Gen NewPasswordReset
Gen NewPasswordReset
-> (NewPasswordReset -> [NewPasswordReset])
-> Arbitrary NewPasswordReset
NewPasswordReset -> [NewPasswordReset]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen NewPasswordReset
arbitrary :: Gen NewPasswordReset
$cshrink :: NewPasswordReset -> [NewPasswordReset]
shrink :: NewPasswordReset -> [NewPasswordReset]
Arbitrary) via (GenericUniform NewPasswordReset)
  deriving ([NewPasswordReset] -> Value
[NewPasswordReset] -> Encoding
NewPasswordReset -> Value
NewPasswordReset -> Encoding
(NewPasswordReset -> Value)
-> (NewPasswordReset -> Encoding)
-> ([NewPasswordReset] -> Value)
-> ([NewPasswordReset] -> Encoding)
-> ToJSON NewPasswordReset
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NewPasswordReset -> Value
toJSON :: NewPasswordReset -> Value
$ctoEncoding :: NewPasswordReset -> Encoding
toEncoding :: NewPasswordReset -> Encoding
$ctoJSONList :: [NewPasswordReset] -> Value
toJSONList :: [NewPasswordReset] -> Value
$ctoEncodingList :: [NewPasswordReset] -> Encoding
toEncodingList :: [NewPasswordReset] -> Encoding
A.ToJSON, Value -> Parser [NewPasswordReset]
Value -> Parser NewPasswordReset
(Value -> Parser NewPasswordReset)
-> (Value -> Parser [NewPasswordReset])
-> FromJSON NewPasswordReset
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NewPasswordReset
parseJSON :: Value -> Parser NewPasswordReset
$cparseJSONList :: Value -> Parser [NewPasswordReset]
parseJSONList :: Value -> Parser [NewPasswordReset]
A.FromJSON, Typeable NewPasswordReset
Typeable NewPasswordReset =>
(Proxy NewPasswordReset
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NewPasswordReset
Proxy NewPasswordReset -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy NewPasswordReset -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy NewPasswordReset -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema NewPasswordReset

instance ToSchema NewPasswordReset where
  schema :: ValueSchema NamedSwaggerDoc NewPasswordReset
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc NewPasswordReset
-> ValueSchema NamedSwaggerDoc NewPasswordReset
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"NewPasswordReset" NamedSwaggerDoc -> NamedSwaggerDoc
objectDesc (ObjectSchema SwaggerDoc NewPasswordReset
 -> ValueSchema NamedSwaggerDoc NewPasswordReset)
-> ObjectSchema SwaggerDoc NewPasswordReset
-> ValueSchema NamedSwaggerDoc NewPasswordReset
forall a b. (a -> b) -> a -> b
$
      (NewPasswordReset -> (Maybe EmailAddress, Maybe Text)
toTuple (NewPasswordReset -> (Maybe EmailAddress, Maybe Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Text)
     (Maybe EmailAddress, Maybe Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewPasswordReset
     (Maybe EmailAddress, Maybe Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe EmailAddress, Maybe Text)
  (Maybe EmailAddress, Maybe Text)
newPasswordResetTupleObjectSchema) SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewPasswordReset
  (Maybe EmailAddress, Maybe Text)
-> ((Maybe EmailAddress, Maybe Text) -> Parser NewPasswordReset)
-> ObjectSchema SwaggerDoc NewPasswordReset
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
`withParser` (Maybe EmailAddress, Maybe Text) -> Parser NewPasswordReset
forall a. (Maybe EmailAddress, Maybe a) -> Parser NewPasswordReset
fromTuple
    where
      objectDesc :: NamedSwaggerDoc -> NamedSwaggerDoc
      objectDesc :: NamedSwaggerDoc -> NamedSwaggerDoc
objectDesc = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Data to initiate a password reset"

      newPasswordResetTupleObjectSchema :: ObjectSchema SwaggerDoc (Maybe EmailAddress, Maybe Text)
      newPasswordResetTupleObjectSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe EmailAddress, Maybe Text)
  (Maybe EmailAddress, Maybe Text)
newPasswordResetTupleObjectSchema =
        (,)
          (Maybe EmailAddress
 -> Maybe Text -> (Maybe EmailAddress, Maybe Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Text)
     (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Text)
     (Maybe Text -> (Maybe EmailAddress, Maybe Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe EmailAddress, Maybe Text) -> Maybe EmailAddress
forall a b. (a, b) -> a
fst ((Maybe EmailAddress, Maybe Text) -> Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress) (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Text)
     (Maybe EmailAddress)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] EmailAddress (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress) (Maybe EmailAddress)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
-> SchemaP
     SwaggerDoc Object [Pair] EmailAddress (Maybe EmailAddress)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier Text
"email" NamedSwaggerDoc -> NamedSwaggerDoc
phoneDocs SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
          SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe EmailAddress, Maybe Text)
  (Maybe Text -> (Maybe EmailAddress, Maybe Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Text)
     (Maybe Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Text)
     (Maybe EmailAddress, Maybe Text)
forall a b.
SchemaP
  SwaggerDoc Object [Pair] (Maybe EmailAddress, Maybe Text) (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress, Maybe Text) a
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress, Maybe Text) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe EmailAddress, Maybe Text) -> Maybe Text
forall a b. (a, b) -> b
snd ((Maybe EmailAddress, Maybe Text) -> Maybe Text)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Text) (Maybe Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Text)
     (Maybe Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Text (Maybe Text)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Text) (Maybe Text)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text (Maybe Text)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier Text
"phone" NamedSwaggerDoc -> NamedSwaggerDoc
emailDocs SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        where
          emailDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
          emailDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
emailDocs = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Email"

          phoneDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
          phoneDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
phoneDocs = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Phone"

      fromTuple :: (Maybe EmailAddress, Maybe a) -> Parser NewPasswordReset
      fromTuple :: forall a. (Maybe EmailAddress, Maybe a) -> Parser NewPasswordReset
fromTuple = \case
        (Just EmailAddress
_, Just a
_) -> String -> Parser NewPasswordReset
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Only one of 'email' or 'phone' allowed."
        (Just EmailAddress
email, Maybe a
Nothing) -> NewPasswordReset -> Parser NewPasswordReset
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewPasswordReset -> Parser NewPasswordReset)
-> NewPasswordReset -> Parser NewPasswordReset
forall a b. (a -> b) -> a -> b
$ EmailAddress -> NewPasswordReset
NewPasswordReset EmailAddress
email
        (Maybe EmailAddress
Nothing, Just a
_) -> NewPasswordReset -> Parser NewPasswordReset
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NewPasswordReset
NewPasswordResetUnsupportedPhone
        (Maybe EmailAddress
Nothing, Maybe a
Nothing) -> String -> Parser NewPasswordReset
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"One of 'email' or 'phone' required."

      toTuple :: NewPasswordReset -> (Maybe EmailAddress, Maybe Text)
      toTuple :: NewPasswordReset -> (Maybe EmailAddress, Maybe Text)
toTuple = \case
        NewPasswordReset EmailAddress
e -> (EmailAddress -> Maybe EmailAddress
forall a. a -> Maybe a
Just EmailAddress
e, Maybe Text
forall a. Maybe a
Nothing)
        NewPasswordReset
NewPasswordResetUnsupportedPhone -> (Maybe EmailAddress
forall a. Maybe a
Nothing, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"")

--------------------------------------------------------------------------------
-- CompletePasswordReset

-- | The payload for completing a password reset.
data CompletePasswordReset = CompletePasswordReset
  { CompletePasswordReset -> PasswordResetIdentity
cpwrIdent :: PasswordResetIdentity,
    CompletePasswordReset -> PasswordResetCode
cpwrCode :: PasswordResetCode,
    CompletePasswordReset -> PlainTextPassword8
cpwrPassword :: PlainTextPassword8
  }
  deriving stock (CompletePasswordReset -> CompletePasswordReset -> Bool
(CompletePasswordReset -> CompletePasswordReset -> Bool)
-> (CompletePasswordReset -> CompletePasswordReset -> Bool)
-> Eq CompletePasswordReset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletePasswordReset -> CompletePasswordReset -> Bool
== :: CompletePasswordReset -> CompletePasswordReset -> Bool
$c/= :: CompletePasswordReset -> CompletePasswordReset -> Bool
/= :: CompletePasswordReset -> CompletePasswordReset -> Bool
Eq, Int -> CompletePasswordReset -> ShowS
[CompletePasswordReset] -> ShowS
CompletePasswordReset -> String
(Int -> CompletePasswordReset -> ShowS)
-> (CompletePasswordReset -> String)
-> ([CompletePasswordReset] -> ShowS)
-> Show CompletePasswordReset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompletePasswordReset -> ShowS
showsPrec :: Int -> CompletePasswordReset -> ShowS
$cshow :: CompletePasswordReset -> String
show :: CompletePasswordReset -> String
$cshowList :: [CompletePasswordReset] -> ShowS
showList :: [CompletePasswordReset] -> ShowS
Show, (forall x. CompletePasswordReset -> Rep CompletePasswordReset x)
-> (forall x. Rep CompletePasswordReset x -> CompletePasswordReset)
-> Generic CompletePasswordReset
forall x. Rep CompletePasswordReset x -> CompletePasswordReset
forall x. CompletePasswordReset -> Rep CompletePasswordReset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompletePasswordReset -> Rep CompletePasswordReset x
from :: forall x. CompletePasswordReset -> Rep CompletePasswordReset x
$cto :: forall x. Rep CompletePasswordReset x -> CompletePasswordReset
to :: forall x. Rep CompletePasswordReset x -> CompletePasswordReset
Generic)
  deriving (Gen CompletePasswordReset
Gen CompletePasswordReset
-> (CompletePasswordReset -> [CompletePasswordReset])
-> Arbitrary CompletePasswordReset
CompletePasswordReset -> [CompletePasswordReset]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen CompletePasswordReset
arbitrary :: Gen CompletePasswordReset
$cshrink :: CompletePasswordReset -> [CompletePasswordReset]
shrink :: CompletePasswordReset -> [CompletePasswordReset]
Arbitrary) via (GenericUniform CompletePasswordReset)
  deriving ([CompletePasswordReset] -> Value
[CompletePasswordReset] -> Encoding
CompletePasswordReset -> Value
CompletePasswordReset -> Encoding
(CompletePasswordReset -> Value)
-> (CompletePasswordReset -> Encoding)
-> ([CompletePasswordReset] -> Value)
-> ([CompletePasswordReset] -> Encoding)
-> ToJSON CompletePasswordReset
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: CompletePasswordReset -> Value
toJSON :: CompletePasswordReset -> Value
$ctoEncoding :: CompletePasswordReset -> Encoding
toEncoding :: CompletePasswordReset -> Encoding
$ctoJSONList :: [CompletePasswordReset] -> Value
toJSONList :: [CompletePasswordReset] -> Value
$ctoEncodingList :: [CompletePasswordReset] -> Encoding
toEncodingList :: [CompletePasswordReset] -> Encoding
A.ToJSON, Value -> Parser [CompletePasswordReset]
Value -> Parser CompletePasswordReset
(Value -> Parser CompletePasswordReset)
-> (Value -> Parser [CompletePasswordReset])
-> FromJSON CompletePasswordReset
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser CompletePasswordReset
parseJSON :: Value -> Parser CompletePasswordReset
$cparseJSONList :: Value -> Parser [CompletePasswordReset]
parseJSONList :: Value -> Parser [CompletePasswordReset]
A.FromJSON, Typeable CompletePasswordReset
Typeable CompletePasswordReset =>
(Proxy CompletePasswordReset
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema CompletePasswordReset
Proxy CompletePasswordReset
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy CompletePasswordReset
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy CompletePasswordReset
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema CompletePasswordReset

instance ToSchema CompletePasswordReset where
  schema :: ValueSchema NamedSwaggerDoc CompletePasswordReset
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc CompletePasswordReset
-> ValueSchema NamedSwaggerDoc CompletePasswordReset
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"CompletePasswordReset" NamedSwaggerDoc -> NamedSwaggerDoc
objectDocs (ObjectSchema SwaggerDoc CompletePasswordReset
 -> ValueSchema NamedSwaggerDoc CompletePasswordReset)
-> ObjectSchema SwaggerDoc CompletePasswordReset
-> ValueSchema NamedSwaggerDoc CompletePasswordReset
forall a b. (a -> b) -> a -> b
$
      PasswordResetIdentity
-> PasswordResetCode -> PlainTextPassword8 -> CompletePasswordReset
CompletePasswordReset
        (PasswordResetIdentity
 -> PasswordResetCode
 -> PlainTextPassword8
 -> CompletePasswordReset)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CompletePasswordReset
     PasswordResetIdentity
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CompletePasswordReset
     (PasswordResetCode -> PlainTextPassword8 -> CompletePasswordReset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PasswordResetIdentity
-> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
maybePasswordResetIdentityToTuple (PasswordResetIdentity
 -> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone))
-> (CompletePasswordReset -> PasswordResetIdentity)
-> CompletePasswordReset
-> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompletePasswordReset -> PasswordResetIdentity
cpwrIdent) (CompletePasswordReset
 -> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     PasswordResetIdentity
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CompletePasswordReset
     PasswordResetIdentity
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
  PasswordResetIdentity
maybePasswordResetIdentityObjectSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  CompletePasswordReset
  (PasswordResetCode -> PlainTextPassword8 -> CompletePasswordReset)
-> SchemaP
     SwaggerDoc Object [Pair] CompletePasswordReset PasswordResetCode
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CompletePasswordReset
     (PlainTextPassword8 -> CompletePasswordReset)
forall a b.
SchemaP SwaggerDoc Object [Pair] CompletePasswordReset (a -> b)
-> SchemaP SwaggerDoc Object [Pair] CompletePasswordReset a
-> SchemaP SwaggerDoc Object [Pair] CompletePasswordReset b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CompletePasswordReset -> PasswordResetCode
cpwrCode (CompletePasswordReset -> PasswordResetCode)
-> SchemaP
     SwaggerDoc Object [Pair] PasswordResetCode PasswordResetCode
-> SchemaP
     SwaggerDoc Object [Pair] CompletePasswordReset PasswordResetCode
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value PasswordResetCode PasswordResetCode
-> SchemaP
     SwaggerDoc Object [Pair] PasswordResetCode PasswordResetCode
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"code" NamedSwaggerDoc -> NamedSwaggerDoc
codeDocs SchemaP
  NamedSwaggerDoc Value Value PasswordResetCode PasswordResetCode
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  CompletePasswordReset
  (PlainTextPassword8 -> CompletePasswordReset)
-> SchemaP
     SwaggerDoc Object [Pair] CompletePasswordReset PlainTextPassword8
-> ObjectSchema SwaggerDoc CompletePasswordReset
forall a b.
SchemaP SwaggerDoc Object [Pair] CompletePasswordReset (a -> b)
-> SchemaP SwaggerDoc Object [Pair] CompletePasswordReset a
-> SchemaP SwaggerDoc Object [Pair] CompletePasswordReset b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CompletePasswordReset -> PlainTextPassword8
cpwrPassword (CompletePasswordReset -> PlainTextPassword8)
-> SchemaP
     SwaggerDoc Object [Pair] PlainTextPassword8 PlainTextPassword8
-> SchemaP
     SwaggerDoc Object [Pair] CompletePasswordReset PlainTextPassword8
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value PlainTextPassword8 PlainTextPassword8
-> SchemaP
     SwaggerDoc Object [Pair] PlainTextPassword8 PlainTextPassword8
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"password" NamedSwaggerDoc -> NamedSwaggerDoc
pwDocs SchemaP
  NamedSwaggerDoc Value Value PlainTextPassword8 PlainTextPassword8
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    where
      objectDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
      objectDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
objectDocs = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Data to complete a password reset"

      codeDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
      codeDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
codeDocs = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Password reset code"

      pwDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
      pwDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
pwDocs = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"New password (6 - 1024 characters)"

      maybePasswordResetIdentityObjectSchema :: ObjectSchemaP SwaggerDoc (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone) PasswordResetIdentity
      maybePasswordResetIdentityObjectSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
  PasswordResetIdentity
maybePasswordResetIdentityObjectSchema =
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
  (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
-> ((Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
    -> Parser PasswordResetIdentity)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     PasswordResetIdentity
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
withParser SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
  (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
passwordResetIdentityTupleObjectSchema (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
-> Parser PasswordResetIdentity
maybePasswordResetIdentityTargetFromTuple
        where
          passwordResetIdentityTupleObjectSchema :: ObjectSchema SwaggerDoc (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
          passwordResetIdentityTupleObjectSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
  (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
passwordResetIdentityTupleObjectSchema =
            (,,)
              (Maybe PasswordResetKey
 -> Maybe EmailAddress
 -> Maybe Phone
 -> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     (Maybe PasswordResetKey)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     (Maybe EmailAddress
      -> Maybe Phone
      -> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
-> Maybe PasswordResetKey
forall a b c. (a, b, c) -> a
fst3 ((Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
 -> Maybe PasswordResetKey)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey)
     (Maybe PasswordResetKey)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     (Maybe PasswordResetKey)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] PasswordResetKey (Maybe PasswordResetKey)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey)
     (Maybe PasswordResetKey)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value PasswordResetKey PasswordResetKey
-> SchemaP
     SwaggerDoc Object [Pair] PasswordResetKey (Maybe PasswordResetKey)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier Text
"key" NamedSwaggerDoc -> NamedSwaggerDoc
keyDocs SchemaP
  NamedSwaggerDoc Value Value PasswordResetKey PasswordResetKey
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
              SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
  (Maybe EmailAddress
   -> Maybe Phone
   -> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     (Maybe Phone
      -> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone))
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
  (a -> b)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     a
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
-> Maybe EmailAddress
forall a b c. (a, b, c) -> b
snd3 ((Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
 -> Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress) (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     (Maybe EmailAddress)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] EmailAddress (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress) (Maybe EmailAddress)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
-> SchemaP
     SwaggerDoc Object [Pair] EmailAddress (Maybe EmailAddress)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier Text
"email" NamedSwaggerDoc -> NamedSwaggerDoc
emailDocs SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
              SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
  (Maybe Phone
   -> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     (Maybe Phone)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
  (a -> b)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     a
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
-> Maybe Phone
forall a b c. (a, b, c) -> c
thd3 ((Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
 -> Maybe Phone)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Phone) (Maybe Phone)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
     (Maybe Phone)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Phone (Maybe Phone)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Phone) (Maybe Phone)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Phone Phone
-> SchemaP SwaggerDoc Object [Pair] Phone (Maybe Phone)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier Text
"phone" NamedSwaggerDoc -> NamedSwaggerDoc
phoneDocs SchemaP NamedSwaggerDoc Value Value Phone Phone
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
            where
              keyDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
keyDocs = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"An opaque key for a pending password reset."
              emailDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
emailDocs = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"A known email with a pending password reset."
              phoneDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
phoneDocs = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"A known phone number with a pending password reset."

          maybePasswordResetIdentityTargetFromTuple :: (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone) -> Parser PasswordResetIdentity
          maybePasswordResetIdentityTargetFromTuple :: (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
-> Parser PasswordResetIdentity
maybePasswordResetIdentityTargetFromTuple = \case
            (Just PasswordResetKey
key, Maybe EmailAddress
_, Maybe Phone
_) -> PasswordResetIdentity -> Parser PasswordResetIdentity
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PasswordResetIdentity -> Parser PasswordResetIdentity)
-> PasswordResetIdentity -> Parser PasswordResetIdentity
forall a b. (a -> b) -> a -> b
$ PasswordResetKey -> PasswordResetIdentity
PasswordResetIdentityKey PasswordResetKey
key
            (Maybe PasswordResetKey
_, Just EmailAddress
email, Maybe Phone
_) -> PasswordResetIdentity -> Parser PasswordResetIdentity
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PasswordResetIdentity -> Parser PasswordResetIdentity)
-> PasswordResetIdentity -> Parser PasswordResetIdentity
forall a b. (a -> b) -> a -> b
$ EmailAddress -> PasswordResetIdentity
PasswordResetEmailIdentity EmailAddress
email
            (Maybe PasswordResetKey
_, Maybe EmailAddress
_, Just Phone
phone) -> PasswordResetIdentity -> Parser PasswordResetIdentity
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PasswordResetIdentity -> Parser PasswordResetIdentity)
-> PasswordResetIdentity -> Parser PasswordResetIdentity
forall a b. (a -> b) -> a -> b
$ Phone -> PasswordResetIdentity
PasswordResetPhoneIdentity Phone
phone
            (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
_ -> String -> Parser PasswordResetIdentity
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"key, email or phone must be present"

      maybePasswordResetIdentityToTuple :: PasswordResetIdentity -> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
      maybePasswordResetIdentityToTuple :: PasswordResetIdentity
-> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
maybePasswordResetIdentityToTuple = \case
        PasswordResetIdentityKey PasswordResetKey
key -> (PasswordResetKey -> Maybe PasswordResetKey
forall a. a -> Maybe a
Just PasswordResetKey
key, Maybe EmailAddress
forall a. Maybe a
Nothing, Maybe Phone
forall a. Maybe a
Nothing)
        PasswordResetEmailIdentity EmailAddress
email -> (Maybe PasswordResetKey
forall a. Maybe a
Nothing, EmailAddress -> Maybe EmailAddress
forall a. a -> Maybe a
Just EmailAddress
email, Maybe Phone
forall a. Maybe a
Nothing)
        PasswordResetPhoneIdentity Phone
phone -> (Maybe PasswordResetKey
forall a. Maybe a
Nothing, Maybe EmailAddress
forall a. Maybe a
Nothing, Phone -> Maybe Phone
forall a. a -> Maybe a
Just Phone
phone)

--------------------------------------------------------------------------------
-- PasswordResetIdentity

-- | The target identity of a password reset.
data PasswordResetIdentity
  = -- | An opaque identity key for a pending password reset.
    PasswordResetIdentityKey PasswordResetKey
  | -- | A known email address with a pending password reset.
    PasswordResetEmailIdentity EmailAddress
  | -- | A known phone number with a pending password reset.
    PasswordResetPhoneIdentity Phone
  deriving stock (PasswordResetIdentity -> PasswordResetIdentity -> Bool
(PasswordResetIdentity -> PasswordResetIdentity -> Bool)
-> (PasswordResetIdentity -> PasswordResetIdentity -> Bool)
-> Eq PasswordResetIdentity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PasswordResetIdentity -> PasswordResetIdentity -> Bool
== :: PasswordResetIdentity -> PasswordResetIdentity -> Bool
$c/= :: PasswordResetIdentity -> PasswordResetIdentity -> Bool
/= :: PasswordResetIdentity -> PasswordResetIdentity -> Bool
Eq, Int -> PasswordResetIdentity -> ShowS
[PasswordResetIdentity] -> ShowS
PasswordResetIdentity -> String
(Int -> PasswordResetIdentity -> ShowS)
-> (PasswordResetIdentity -> String)
-> ([PasswordResetIdentity] -> ShowS)
-> Show PasswordResetIdentity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PasswordResetIdentity -> ShowS
showsPrec :: Int -> PasswordResetIdentity -> ShowS
$cshow :: PasswordResetIdentity -> String
show :: PasswordResetIdentity -> String
$cshowList :: [PasswordResetIdentity] -> ShowS
showList :: [PasswordResetIdentity] -> ShowS
Show, (forall x. PasswordResetIdentity -> Rep PasswordResetIdentity x)
-> (forall x. Rep PasswordResetIdentity x -> PasswordResetIdentity)
-> Generic PasswordResetIdentity
forall x. Rep PasswordResetIdentity x -> PasswordResetIdentity
forall x. PasswordResetIdentity -> Rep PasswordResetIdentity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PasswordResetIdentity -> Rep PasswordResetIdentity x
from :: forall x. PasswordResetIdentity -> Rep PasswordResetIdentity x
$cto :: forall x. Rep PasswordResetIdentity x -> PasswordResetIdentity
to :: forall x. Rep PasswordResetIdentity x -> PasswordResetIdentity
Generic)
  deriving (Gen PasswordResetIdentity
Gen PasswordResetIdentity
-> (PasswordResetIdentity -> [PasswordResetIdentity])
-> Arbitrary PasswordResetIdentity
PasswordResetIdentity -> [PasswordResetIdentity]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen PasswordResetIdentity
arbitrary :: Gen PasswordResetIdentity
$cshrink :: PasswordResetIdentity -> [PasswordResetIdentity]
shrink :: PasswordResetIdentity -> [PasswordResetIdentity]
Arbitrary) via (GenericUniform PasswordResetIdentity)

-- | Opaque identifier per user (SHA256 of the user ID).
newtype PasswordResetKey = PasswordResetKey
  {PasswordResetKey -> AsciiBase64Url
fromPasswordResetKey :: AsciiBase64Url}
  deriving stock (PasswordResetKey -> PasswordResetKey -> Bool
(PasswordResetKey -> PasswordResetKey -> Bool)
-> (PasswordResetKey -> PasswordResetKey -> Bool)
-> Eq PasswordResetKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PasswordResetKey -> PasswordResetKey -> Bool
== :: PasswordResetKey -> PasswordResetKey -> Bool
$c/= :: PasswordResetKey -> PasswordResetKey -> Bool
/= :: PasswordResetKey -> PasswordResetKey -> Bool
Eq, Int -> PasswordResetKey -> ShowS
[PasswordResetKey] -> ShowS
PasswordResetKey -> String
(Int -> PasswordResetKey -> ShowS)
-> (PasswordResetKey -> String)
-> ([PasswordResetKey] -> ShowS)
-> Show PasswordResetKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PasswordResetKey -> ShowS
showsPrec :: Int -> PasswordResetKey -> ShowS
$cshow :: PasswordResetKey -> String
show :: PasswordResetKey -> String
$cshowList :: [PasswordResetKey] -> ShowS
showList :: [PasswordResetKey] -> ShowS
Show, Eq PasswordResetKey
Eq PasswordResetKey =>
(PasswordResetKey -> PasswordResetKey -> Ordering)
-> (PasswordResetKey -> PasswordResetKey -> Bool)
-> (PasswordResetKey -> PasswordResetKey -> Bool)
-> (PasswordResetKey -> PasswordResetKey -> Bool)
-> (PasswordResetKey -> PasswordResetKey -> Bool)
-> (PasswordResetKey -> PasswordResetKey -> PasswordResetKey)
-> (PasswordResetKey -> PasswordResetKey -> PasswordResetKey)
-> Ord PasswordResetKey
PasswordResetKey -> PasswordResetKey -> Bool
PasswordResetKey -> PasswordResetKey -> Ordering
PasswordResetKey -> PasswordResetKey -> PasswordResetKey
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
$ccompare :: PasswordResetKey -> PasswordResetKey -> Ordering
compare :: PasswordResetKey -> PasswordResetKey -> Ordering
$c< :: PasswordResetKey -> PasswordResetKey -> Bool
< :: PasswordResetKey -> PasswordResetKey -> Bool
$c<= :: PasswordResetKey -> PasswordResetKey -> Bool
<= :: PasswordResetKey -> PasswordResetKey -> Bool
$c> :: PasswordResetKey -> PasswordResetKey -> Bool
> :: PasswordResetKey -> PasswordResetKey -> Bool
$c>= :: PasswordResetKey -> PasswordResetKey -> Bool
>= :: PasswordResetKey -> PasswordResetKey -> Bool
$cmax :: PasswordResetKey -> PasswordResetKey -> PasswordResetKey
max :: PasswordResetKey -> PasswordResetKey -> PasswordResetKey
$cmin :: PasswordResetKey -> PasswordResetKey -> PasswordResetKey
min :: PasswordResetKey -> PasswordResetKey -> PasswordResetKey
Ord)
  deriving newtype (SchemaP
  NamedSwaggerDoc Value Value PasswordResetKey PasswordResetKey
SchemaP
  NamedSwaggerDoc Value Value PasswordResetKey PasswordResetKey
-> ToSchema PasswordResetKey
forall a. ValueSchema NamedSwaggerDoc a -> ToSchema a
$cschema :: SchemaP
  NamedSwaggerDoc Value Value PasswordResetKey PasswordResetKey
schema :: SchemaP
  NamedSwaggerDoc Value Value PasswordResetKey PasswordResetKey
ToSchema, Parser PasswordResetKey
Parser PasswordResetKey -> FromByteString PasswordResetKey
forall a. Parser a -> FromByteString a
$cparser :: Parser PasswordResetKey
parser :: Parser PasswordResetKey
FromByteString, PasswordResetKey -> Builder
(PasswordResetKey -> Builder) -> ToByteString PasswordResetKey
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: PasswordResetKey -> Builder
builder :: PasswordResetKey -> Builder
ToByteString, Value -> Parser [PasswordResetKey]
Value -> Parser PasswordResetKey
(Value -> Parser PasswordResetKey)
-> (Value -> Parser [PasswordResetKey])
-> FromJSON PasswordResetKey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PasswordResetKey
parseJSON :: Value -> Parser PasswordResetKey
$cparseJSONList :: Value -> Parser [PasswordResetKey]
parseJSONList :: Value -> Parser [PasswordResetKey]
A.FromJSON, [PasswordResetKey] -> Value
[PasswordResetKey] -> Encoding
PasswordResetKey -> Value
PasswordResetKey -> Encoding
(PasswordResetKey -> Value)
-> (PasswordResetKey -> Encoding)
-> ([PasswordResetKey] -> Value)
-> ([PasswordResetKey] -> Encoding)
-> ToJSON PasswordResetKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PasswordResetKey -> Value
toJSON :: PasswordResetKey -> Value
$ctoEncoding :: PasswordResetKey -> Encoding
toEncoding :: PasswordResetKey -> Encoding
$ctoJSONList :: [PasswordResetKey] -> Value
toJSONList :: [PasswordResetKey] -> Value
$ctoEncodingList :: [PasswordResetKey] -> Encoding
toEncodingList :: [PasswordResetKey] -> Encoding
A.ToJSON, Gen PasswordResetKey
Gen PasswordResetKey
-> (PasswordResetKey -> [PasswordResetKey])
-> Arbitrary PasswordResetKey
PasswordResetKey -> [PasswordResetKey]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen PasswordResetKey
arbitrary :: Gen PasswordResetKey
$cshrink :: PasswordResetKey -> [PasswordResetKey]
shrink :: PasswordResetKey -> [PasswordResetKey]
Arbitrary)

mkPasswordResetKey :: UserId -> PasswordResetKey
mkPasswordResetKey :: UserId -> PasswordResetKey
mkPasswordResetKey UserId
userId =
  AsciiBase64Url -> PasswordResetKey
PasswordResetKey
    (AsciiBase64Url -> PasswordResetKey)
-> (Digest SHA256 -> AsciiBase64Url)
-> Digest SHA256
-> PasswordResetKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AsciiBase64Url
encodeBase64Url
    (ByteString -> AsciiBase64Url)
-> (Digest SHA256 -> ByteString) -> Digest SHA256 -> AsciiBase64Url
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack
    ([Word8] -> ByteString)
-> (Digest SHA256 -> [Word8]) -> Digest SHA256 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
ByteArray.unpack
    (Digest SHA256 -> PasswordResetKey)
-> Digest SHA256 -> PasswordResetKey
forall a b. (a -> b) -> a -> b
$ SHA256 -> ByteString -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256 (UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' UserId
userId)

instance ToParamSchema PasswordResetKey where
  toParamSchema :: Proxy PasswordResetKey -> Schema
toParamSchema Proxy PasswordResetKey
_ = Proxy Text -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)

instance FromHttpApiData PasswordResetKey where
  parseQueryParam :: Text -> Either Text PasswordResetKey
parseQueryParam = (AsciiBase64Url -> PasswordResetKey)
-> Either Text AsciiBase64Url -> Either Text PasswordResetKey
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AsciiBase64Url -> PasswordResetKey
PasswordResetKey (Either Text AsciiBase64Url -> Either Text PasswordResetKey)
-> (Text -> Either Text AsciiBase64Url)
-> Text
-> Either Text PasswordResetKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text AsciiBase64Url
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam

deriving instance C.Cql PasswordResetKey

--------------------------------------------------------------------------------
-- PasswordResetCode

-- | Random code, acting as a very short-lived, single-use password.
newtype PasswordResetCode = PasswordResetCode
  {PasswordResetCode -> AsciiBase64Url
fromPasswordResetCode :: AsciiBase64Url}
  deriving stock (PasswordResetCode -> PasswordResetCode -> Bool
(PasswordResetCode -> PasswordResetCode -> Bool)
-> (PasswordResetCode -> PasswordResetCode -> Bool)
-> Eq PasswordResetCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PasswordResetCode -> PasswordResetCode -> Bool
== :: PasswordResetCode -> PasswordResetCode -> Bool
$c/= :: PasswordResetCode -> PasswordResetCode -> Bool
/= :: PasswordResetCode -> PasswordResetCode -> Bool
Eq, Int -> PasswordResetCode -> ShowS
[PasswordResetCode] -> ShowS
PasswordResetCode -> String
(Int -> PasswordResetCode -> ShowS)
-> (PasswordResetCode -> String)
-> ([PasswordResetCode] -> ShowS)
-> Show PasswordResetCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PasswordResetCode -> ShowS
showsPrec :: Int -> PasswordResetCode -> ShowS
$cshow :: PasswordResetCode -> String
show :: PasswordResetCode -> String
$cshowList :: [PasswordResetCode] -> ShowS
showList :: [PasswordResetCode] -> ShowS
Show, (forall x. PasswordResetCode -> Rep PasswordResetCode x)
-> (forall x. Rep PasswordResetCode x -> PasswordResetCode)
-> Generic PasswordResetCode
forall x. Rep PasswordResetCode x -> PasswordResetCode
forall x. PasswordResetCode -> Rep PasswordResetCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PasswordResetCode -> Rep PasswordResetCode x
from :: forall x. PasswordResetCode -> Rep PasswordResetCode x
$cto :: forall x. Rep PasswordResetCode x -> PasswordResetCode
to :: forall x. Rep PasswordResetCode x -> PasswordResetCode
Generic)
  deriving newtype (SchemaP
  NamedSwaggerDoc Value Value PasswordResetCode PasswordResetCode
SchemaP
  NamedSwaggerDoc Value Value PasswordResetCode PasswordResetCode
-> ToSchema PasswordResetCode
forall a. ValueSchema NamedSwaggerDoc a -> ToSchema a
$cschema :: SchemaP
  NamedSwaggerDoc Value Value PasswordResetCode PasswordResetCode
schema :: SchemaP
  NamedSwaggerDoc Value Value PasswordResetCode PasswordResetCode
ToSchema, Parser PasswordResetCode
Parser PasswordResetCode -> FromByteString PasswordResetCode
forall a. Parser a -> FromByteString a
$cparser :: Parser PasswordResetCode
parser :: Parser PasswordResetCode
FromByteString, PasswordResetCode -> Builder
(PasswordResetCode -> Builder) -> ToByteString PasswordResetCode
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: PasswordResetCode -> Builder
builder :: PasswordResetCode -> Builder
ToByteString, Value -> Parser [PasswordResetCode]
Value -> Parser PasswordResetCode
(Value -> Parser PasswordResetCode)
-> (Value -> Parser [PasswordResetCode])
-> FromJSON PasswordResetCode
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PasswordResetCode
parseJSON :: Value -> Parser PasswordResetCode
$cparseJSONList :: Value -> Parser [PasswordResetCode]
parseJSONList :: Value -> Parser [PasswordResetCode]
A.FromJSON, [PasswordResetCode] -> Value
[PasswordResetCode] -> Encoding
PasswordResetCode -> Value
PasswordResetCode -> Encoding
(PasswordResetCode -> Value)
-> (PasswordResetCode -> Encoding)
-> ([PasswordResetCode] -> Value)
-> ([PasswordResetCode] -> Encoding)
-> ToJSON PasswordResetCode
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PasswordResetCode -> Value
toJSON :: PasswordResetCode -> Value
$ctoEncoding :: PasswordResetCode -> Encoding
toEncoding :: PasswordResetCode -> Encoding
$ctoJSONList :: [PasswordResetCode] -> Value
toJSONList :: [PasswordResetCode] -> Value
$ctoEncodingList :: [PasswordResetCode] -> Encoding
toEncodingList :: [PasswordResetCode] -> Encoding
A.ToJSON)
  deriving (Gen PasswordResetCode
Gen PasswordResetCode
-> (PasswordResetCode -> [PasswordResetCode])
-> Arbitrary PasswordResetCode
PasswordResetCode -> [PasswordResetCode]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen PasswordResetCode
arbitrary :: Gen PasswordResetCode
$cshrink :: PasswordResetCode -> [PasswordResetCode]
shrink :: PasswordResetCode -> [PasswordResetCode]
Arbitrary) via (Ranged 6 1024 AsciiBase64Url)

deriving instance C.Cql PasswordResetCode

--------------------------------------------------------------------------------
-- DEPRECATED

data PasswordReset = PasswordReset
  { PasswordReset -> PasswordResetCode
pwrCode :: PasswordResetCode,
    PasswordReset -> PlainTextPassword8
pwrPassword :: PlainTextPassword8
  }
  deriving stock (PasswordReset -> PasswordReset -> Bool
(PasswordReset -> PasswordReset -> Bool)
-> (PasswordReset -> PasswordReset -> Bool) -> Eq PasswordReset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PasswordReset -> PasswordReset -> Bool
== :: PasswordReset -> PasswordReset -> Bool
$c/= :: PasswordReset -> PasswordReset -> Bool
/= :: PasswordReset -> PasswordReset -> Bool
Eq, Int -> PasswordReset -> ShowS
[PasswordReset] -> ShowS
PasswordReset -> String
(Int -> PasswordReset -> ShowS)
-> (PasswordReset -> String)
-> ([PasswordReset] -> ShowS)
-> Show PasswordReset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PasswordReset -> ShowS
showsPrec :: Int -> PasswordReset -> ShowS
$cshow :: PasswordReset -> String
show :: PasswordReset -> String
$cshowList :: [PasswordReset] -> ShowS
showList :: [PasswordReset] -> ShowS
Show, (forall x. PasswordReset -> Rep PasswordReset x)
-> (forall x. Rep PasswordReset x -> PasswordReset)
-> Generic PasswordReset
forall x. Rep PasswordReset x -> PasswordReset
forall x. PasswordReset -> Rep PasswordReset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PasswordReset -> Rep PasswordReset x
from :: forall x. PasswordReset -> Rep PasswordReset x
$cto :: forall x. Rep PasswordReset x -> PasswordReset
to :: forall x. Rep PasswordReset x -> PasswordReset
Generic)
  deriving (Gen PasswordReset
Gen PasswordReset
-> (PasswordReset -> [PasswordReset]) -> Arbitrary PasswordReset
PasswordReset -> [PasswordReset]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen PasswordReset
arbitrary :: Gen PasswordReset
$cshrink :: PasswordReset -> [PasswordReset]
shrink :: PasswordReset -> [PasswordReset]
Arbitrary) via (GenericUniform PasswordReset)
  deriving ([PasswordReset] -> Value
[PasswordReset] -> Encoding
PasswordReset -> Value
PasswordReset -> Encoding
(PasswordReset -> Value)
-> (PasswordReset -> Encoding)
-> ([PasswordReset] -> Value)
-> ([PasswordReset] -> Encoding)
-> ToJSON PasswordReset
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PasswordReset -> Value
toJSON :: PasswordReset -> Value
$ctoEncoding :: PasswordReset -> Encoding
toEncoding :: PasswordReset -> Encoding
$ctoJSONList :: [PasswordReset] -> Value
toJSONList :: [PasswordReset] -> Value
$ctoEncodingList :: [PasswordReset] -> Encoding
toEncodingList :: [PasswordReset] -> Encoding
A.ToJSON, Value -> Parser [PasswordReset]
Value -> Parser PasswordReset
(Value -> Parser PasswordReset)
-> (Value -> Parser [PasswordReset]) -> FromJSON PasswordReset
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PasswordReset
parseJSON :: Value -> Parser PasswordReset
$cparseJSONList :: Value -> Parser [PasswordReset]
parseJSONList :: Value -> Parser [PasswordReset]
A.FromJSON, Typeable PasswordReset
Typeable PasswordReset =>
(Proxy PasswordReset -> Declare (Definitions Schema) NamedSchema)
-> ToSchema PasswordReset
Proxy PasswordReset -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy PasswordReset -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy PasswordReset -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema PasswordReset

instance ToSchema PasswordReset where
  schema :: ValueSchema NamedSwaggerDoc PasswordReset
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc PasswordReset
-> ValueSchema NamedSwaggerDoc PasswordReset
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"PasswordReset" NamedSwaggerDoc -> NamedSwaggerDoc
objectDocs (ObjectSchema SwaggerDoc PasswordReset
 -> ValueSchema NamedSwaggerDoc PasswordReset)
-> ObjectSchema SwaggerDoc PasswordReset
-> ValueSchema NamedSwaggerDoc PasswordReset
forall a b. (a -> b) -> a -> b
$
      PasswordResetCode -> PlainTextPassword8 -> PasswordReset
PasswordReset
        (PasswordResetCode -> PlainTextPassword8 -> PasswordReset)
-> SchemaP SwaggerDoc Object [Pair] PasswordReset PasswordResetCode
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PasswordReset
     (PlainTextPassword8 -> PasswordReset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PasswordReset -> PasswordResetCode
pwrCode (PasswordReset -> PasswordResetCode)
-> SchemaP
     SwaggerDoc Object [Pair] PasswordResetCode PasswordResetCode
-> SchemaP SwaggerDoc Object [Pair] PasswordReset PasswordResetCode
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value PasswordResetCode PasswordResetCode
-> SchemaP
     SwaggerDoc Object [Pair] PasswordResetCode PasswordResetCode
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"code" NamedSwaggerDoc -> NamedSwaggerDoc
codeDocs SchemaP
  NamedSwaggerDoc Value Value PasswordResetCode PasswordResetCode
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  PasswordReset
  (PlainTextPassword8 -> PasswordReset)
-> SchemaP
     SwaggerDoc Object [Pair] PasswordReset PlainTextPassword8
-> ObjectSchema SwaggerDoc PasswordReset
forall a b.
SchemaP SwaggerDoc Object [Pair] PasswordReset (a -> b)
-> SchemaP SwaggerDoc Object [Pair] PasswordReset a
-> SchemaP SwaggerDoc Object [Pair] PasswordReset b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PasswordReset -> PlainTextPassword8
pwrPassword (PasswordReset -> PlainTextPassword8)
-> SchemaP
     SwaggerDoc Object [Pair] PlainTextPassword8 PlainTextPassword8
-> SchemaP
     SwaggerDoc Object [Pair] PasswordReset PlainTextPassword8
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value PlainTextPassword8 PlainTextPassword8
-> SchemaP
     SwaggerDoc Object [Pair] PlainTextPassword8 PlainTextPassword8
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"password" NamedSwaggerDoc -> NamedSwaggerDoc
pwDocs SchemaP
  NamedSwaggerDoc Value Value PlainTextPassword8 PlainTextPassword8
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    where
      objectDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
      objectDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
objectDocs = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Data to complete a password reset"

      codeDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
      codeDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
codeDocs = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Password reset code"

      pwDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
      pwDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
pwDocs = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"New password (6 - 1024 characters)"