{-# 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.Activation
  ( -- * ActivationTarget
    ActivationTarget (..),
    ActivationKey (..),

    -- * ActivationCode
    ActivationCode (..),

    -- * Activate
    Activate (..),
    ActivationResponse (..),

    -- * SendActivationCode
    SendActivationCode (..),
  )
where

import Cassandra qualified as C
import Control.Lens ((?~))
import Data.Aeson qualified as A
import Data.Aeson.Types (Parser)
import Data.ByteString.Conversion
import Data.Data (Proxy (Proxy))
import Data.OpenApi (ToParamSchema)
import Data.OpenApi qualified as S
import Data.Schema
import Data.Text.Ascii
import Imports
import Servant (FromHttpApiData (..))
import Wire.API.Locale
import Wire.API.User.Identity
import Wire.Arbitrary (Arbitrary, GenericUniform (..))

--------------------------------------------------------------------------------
-- ActivationTarget

-- | The target of an activation request.
data ActivationTarget
  = -- | An opaque key for some email awaiting activation.
    ActivateKey ActivationKey
  | -- | A known email address awaiting activation.
    ActivateEmail EmailAddress
  deriving stock (ActivationTarget -> ActivationTarget -> Bool
(ActivationTarget -> ActivationTarget -> Bool)
-> (ActivationTarget -> ActivationTarget -> Bool)
-> Eq ActivationTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActivationTarget -> ActivationTarget -> Bool
== :: ActivationTarget -> ActivationTarget -> Bool
$c/= :: ActivationTarget -> ActivationTarget -> Bool
/= :: ActivationTarget -> ActivationTarget -> Bool
Eq, Int -> ActivationTarget -> ShowS
[ActivationTarget] -> ShowS
ActivationTarget -> String
(Int -> ActivationTarget -> ShowS)
-> (ActivationTarget -> String)
-> ([ActivationTarget] -> ShowS)
-> Show ActivationTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivationTarget -> ShowS
showsPrec :: Int -> ActivationTarget -> ShowS
$cshow :: ActivationTarget -> String
show :: ActivationTarget -> String
$cshowList :: [ActivationTarget] -> ShowS
showList :: [ActivationTarget] -> ShowS
Show, (forall x. ActivationTarget -> Rep ActivationTarget x)
-> (forall x. Rep ActivationTarget x -> ActivationTarget)
-> Generic ActivationTarget
forall x. Rep ActivationTarget x -> ActivationTarget
forall x. ActivationTarget -> Rep ActivationTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActivationTarget -> Rep ActivationTarget x
from :: forall x. ActivationTarget -> Rep ActivationTarget x
$cto :: forall x. Rep ActivationTarget x -> ActivationTarget
to :: forall x. Rep ActivationTarget x -> ActivationTarget
Generic)
  deriving (Gen ActivationTarget
Gen ActivationTarget
-> (ActivationTarget -> [ActivationTarget])
-> Arbitrary ActivationTarget
ActivationTarget -> [ActivationTarget]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ActivationTarget
arbitrary :: Gen ActivationTarget
$cshrink :: ActivationTarget -> [ActivationTarget]
shrink :: ActivationTarget -> [ActivationTarget]
Arbitrary) via (GenericUniform ActivationTarget)

instance ToByteString ActivationTarget where
  builder :: ActivationTarget -> Builder
builder (ActivateKey ActivationKey
k) = ActivationKey -> Builder
forall a. ToByteString a => a -> Builder
builder ActivationKey
k
  builder (ActivateEmail EmailAddress
e) = EmailAddress -> Builder
forall a. ToByteString a => a -> Builder
builder EmailAddress
e

-- | An opaque identifier of a 'UserKey' awaiting activation.
newtype ActivationKey = ActivationKey
  {ActivationKey -> AsciiBase64Url
fromActivationKey :: AsciiBase64Url}
  deriving stock (ActivationKey -> ActivationKey -> Bool
(ActivationKey -> ActivationKey -> Bool)
-> (ActivationKey -> ActivationKey -> Bool) -> Eq ActivationKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActivationKey -> ActivationKey -> Bool
== :: ActivationKey -> ActivationKey -> Bool
$c/= :: ActivationKey -> ActivationKey -> Bool
/= :: ActivationKey -> ActivationKey -> Bool
Eq, Int -> ActivationKey -> ShowS
[ActivationKey] -> ShowS
ActivationKey -> String
(Int -> ActivationKey -> ShowS)
-> (ActivationKey -> String)
-> ([ActivationKey] -> ShowS)
-> Show ActivationKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivationKey -> ShowS
showsPrec :: Int -> ActivationKey -> ShowS
$cshow :: ActivationKey -> String
show :: ActivationKey -> String
$cshowList :: [ActivationKey] -> ShowS
showList :: [ActivationKey] -> ShowS
Show, (forall x. ActivationKey -> Rep ActivationKey x)
-> (forall x. Rep ActivationKey x -> ActivationKey)
-> Generic ActivationKey
forall x. Rep ActivationKey x -> ActivationKey
forall x. ActivationKey -> Rep ActivationKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActivationKey -> Rep ActivationKey x
from :: forall x. ActivationKey -> Rep ActivationKey x
$cto :: forall x. Rep ActivationKey x -> ActivationKey
to :: forall x. Rep ActivationKey x -> ActivationKey
Generic)
  deriving newtype (ValueSchema NamedSwaggerDoc ActivationKey
ValueSchema NamedSwaggerDoc ActivationKey -> ToSchema ActivationKey
forall a. ValueSchema NamedSwaggerDoc a -> ToSchema a
$cschema :: ValueSchema NamedSwaggerDoc ActivationKey
schema :: ValueSchema NamedSwaggerDoc ActivationKey
ToSchema, ActivationKey -> Builder
(ActivationKey -> Builder) -> ToByteString ActivationKey
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: ActivationKey -> Builder
builder :: ActivationKey -> Builder
ToByteString, Parser ActivationKey
Parser ActivationKey -> FromByteString ActivationKey
forall a. Parser a -> FromByteString a
$cparser :: Parser ActivationKey
parser :: Parser ActivationKey
FromByteString, [ActivationKey] -> Value
[ActivationKey] -> Encoding
ActivationKey -> Value
ActivationKey -> Encoding
(ActivationKey -> Value)
-> (ActivationKey -> Encoding)
-> ([ActivationKey] -> Value)
-> ([ActivationKey] -> Encoding)
-> ToJSON ActivationKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ActivationKey -> Value
toJSON :: ActivationKey -> Value
$ctoEncoding :: ActivationKey -> Encoding
toEncoding :: ActivationKey -> Encoding
$ctoJSONList :: [ActivationKey] -> Value
toJSONList :: [ActivationKey] -> Value
$ctoEncodingList :: [ActivationKey] -> Encoding
toEncodingList :: [ActivationKey] -> Encoding
A.ToJSON, Value -> Parser [ActivationKey]
Value -> Parser ActivationKey
(Value -> Parser ActivationKey)
-> (Value -> Parser [ActivationKey]) -> FromJSON ActivationKey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ActivationKey
parseJSON :: Value -> Parser ActivationKey
$cparseJSONList :: Value -> Parser [ActivationKey]
parseJSONList :: Value -> Parser [ActivationKey]
A.FromJSON, Gen ActivationKey
Gen ActivationKey
-> (ActivationKey -> [ActivationKey]) -> Arbitrary ActivationKey
ActivationKey -> [ActivationKey]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ActivationKey
arbitrary :: Gen ActivationKey
$cshrink :: ActivationKey -> [ActivationKey]
shrink :: ActivationKey -> [ActivationKey]
Arbitrary)

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

instance FromHttpApiData ActivationKey where
  parseUrlPiece :: Text -> Either Text ActivationKey
parseUrlPiece = (AsciiBase64Url -> ActivationKey)
-> Either Text AsciiBase64Url -> Either Text ActivationKey
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 -> ActivationKey
ActivationKey (Either Text AsciiBase64Url -> Either Text ActivationKey)
-> (Text -> Either Text AsciiBase64Url)
-> Text
-> Either Text ActivationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text AsciiBase64Url
forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece

deriving instance C.Cql ActivationKey

--------------------------------------------------------------------------------
-- ActivationCode

-- | A random code for use with an 'ActivationKey' that is usually transmitted
-- out-of-band, e.g. via email or sms.
-- FUTUREWORK(leif): rename to VerificationCode
newtype ActivationCode = ActivationCode
  {ActivationCode -> AsciiBase64Url
fromActivationCode :: AsciiBase64Url}
  deriving stock (ActivationCode -> ActivationCode -> Bool
(ActivationCode -> ActivationCode -> Bool)
-> (ActivationCode -> ActivationCode -> Bool) -> Eq ActivationCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActivationCode -> ActivationCode -> Bool
== :: ActivationCode -> ActivationCode -> Bool
$c/= :: ActivationCode -> ActivationCode -> Bool
/= :: ActivationCode -> ActivationCode -> Bool
Eq, Int -> ActivationCode -> ShowS
[ActivationCode] -> ShowS
ActivationCode -> String
(Int -> ActivationCode -> ShowS)
-> (ActivationCode -> String)
-> ([ActivationCode] -> ShowS)
-> Show ActivationCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivationCode -> ShowS
showsPrec :: Int -> ActivationCode -> ShowS
$cshow :: ActivationCode -> String
show :: ActivationCode -> String
$cshowList :: [ActivationCode] -> ShowS
showList :: [ActivationCode] -> ShowS
Show, (forall x. ActivationCode -> Rep ActivationCode x)
-> (forall x. Rep ActivationCode x -> ActivationCode)
-> Generic ActivationCode
forall x. Rep ActivationCode x -> ActivationCode
forall x. ActivationCode -> Rep ActivationCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActivationCode -> Rep ActivationCode x
from :: forall x. ActivationCode -> Rep ActivationCode x
$cto :: forall x. Rep ActivationCode x -> ActivationCode
to :: forall x. Rep ActivationCode x -> ActivationCode
Generic)
  deriving newtype (ActivationCode -> Builder
(ActivationCode -> Builder) -> ToByteString ActivationCode
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: ActivationCode -> Builder
builder :: ActivationCode -> Builder
ToByteString, Parser ActivationCode
Parser ActivationCode -> FromByteString ActivationCode
forall a. Parser a -> FromByteString a
$cparser :: Parser ActivationCode
parser :: Parser ActivationCode
FromByteString, ValueSchema NamedSwaggerDoc ActivationCode
ValueSchema NamedSwaggerDoc ActivationCode
-> ToSchema ActivationCode
forall a. ValueSchema NamedSwaggerDoc a -> ToSchema a
$cschema :: ValueSchema NamedSwaggerDoc ActivationCode
schema :: ValueSchema NamedSwaggerDoc ActivationCode
ToSchema, Gen ActivationCode
Gen ActivationCode
-> (ActivationCode -> [ActivationCode]) -> Arbitrary ActivationCode
ActivationCode -> [ActivationCode]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ActivationCode
arbitrary :: Gen ActivationCode
$cshrink :: ActivationCode -> [ActivationCode]
shrink :: ActivationCode -> [ActivationCode]
Arbitrary)
  deriving ([ActivationCode] -> Value
[ActivationCode] -> Encoding
ActivationCode -> Value
ActivationCode -> Encoding
(ActivationCode -> Value)
-> (ActivationCode -> Encoding)
-> ([ActivationCode] -> Value)
-> ([ActivationCode] -> Encoding)
-> ToJSON ActivationCode
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ActivationCode -> Value
toJSON :: ActivationCode -> Value
$ctoEncoding :: ActivationCode -> Encoding
toEncoding :: ActivationCode -> Encoding
$ctoJSONList :: [ActivationCode] -> Value
toJSONList :: [ActivationCode] -> Value
$ctoEncodingList :: [ActivationCode] -> Encoding
toEncodingList :: [ActivationCode] -> Encoding
A.ToJSON, Value -> Parser [ActivationCode]
Value -> Parser ActivationCode
(Value -> Parser ActivationCode)
-> (Value -> Parser [ActivationCode]) -> FromJSON ActivationCode
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ActivationCode
parseJSON :: Value -> Parser ActivationCode
$cparseJSONList :: Value -> Parser [ActivationCode]
parseJSONList :: Value -> Parser [ActivationCode]
A.FromJSON, Typeable ActivationCode
Typeable ActivationCode =>
(Proxy ActivationCode -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ActivationCode
Proxy ActivationCode -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ActivationCode -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ActivationCode -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ActivationCode

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

instance FromHttpApiData ActivationCode where
  parseQueryParam :: Text -> Either Text ActivationCode
parseQueryParam = (AsciiBase64Url -> ActivationCode)
-> Either Text AsciiBase64Url -> Either Text ActivationCode
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 -> ActivationCode
ActivationCode (Either Text AsciiBase64Url -> Either Text ActivationCode)
-> (Text -> Either Text AsciiBase64Url)
-> Text
-> Either Text ActivationCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text AsciiBase64Url
forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece

deriving instance C.Cql ActivationCode

--------------------------------------------------------------------------------
-- Activate

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

instance ToSchema Activate where
  schema :: ValueSchema NamedSwaggerDoc Activate
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc Activate
-> ValueSchema NamedSwaggerDoc Activate
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"Activate" NamedSwaggerDoc -> NamedSwaggerDoc
objectDocs (ObjectSchema SwaggerDoc Activate
 -> ValueSchema NamedSwaggerDoc Activate)
-> ObjectSchema SwaggerDoc Activate
-> ValueSchema NamedSwaggerDoc Activate
forall a b. (a -> b) -> a -> b
$
      ActivationTarget -> ActivationCode -> Bool -> Activate
Activate
        (ActivationTarget -> ActivationCode -> Bool -> Activate)
-> SchemaP SwaggerDoc Object [Pair] Activate ActivationTarget
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Activate
     (ActivationCode -> Bool -> Activate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ActivationTarget -> (Maybe ActivationKey, Maybe EmailAddress)
maybeActivationTargetToTuple (ActivationTarget -> (Maybe ActivationKey, Maybe EmailAddress))
-> (Activate -> ActivationTarget)
-> Activate
-> (Maybe ActivationKey, Maybe EmailAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Activate -> ActivationTarget
activateTarget) (Activate -> (Maybe ActivationKey, Maybe EmailAddress))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationKey, Maybe EmailAddress)
     ActivationTarget
-> SchemaP SwaggerDoc Object [Pair] Activate ActivationTarget
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe ActivationKey, Maybe EmailAddress)
  ActivationTarget
maybeActivationTargetObjectSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Activate
  (ActivationCode -> Bool -> Activate)
-> SchemaP SwaggerDoc Object [Pair] Activate ActivationCode
-> SchemaP SwaggerDoc Object [Pair] Activate (Bool -> Activate)
forall a b.
SchemaP SwaggerDoc Object [Pair] Activate (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Activate a
-> SchemaP SwaggerDoc Object [Pair] Activate b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Activate -> ActivationCode
activateCode (Activate -> ActivationCode)
-> SchemaP SwaggerDoc Object [Pair] ActivationCode ActivationCode
-> SchemaP SwaggerDoc Object [Pair] Activate ActivationCode
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc ActivationCode
-> SchemaP SwaggerDoc Object [Pair] ActivationCode ActivationCode
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 ValueSchema NamedSwaggerDoc ActivationCode
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP SwaggerDoc Object [Pair] Activate (Bool -> Activate)
-> SchemaP SwaggerDoc Object [Pair] Activate Bool
-> ObjectSchema SwaggerDoc Activate
forall a b.
SchemaP SwaggerDoc Object [Pair] Activate (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Activate a
-> SchemaP SwaggerDoc Object [Pair] Activate b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Activate -> Bool
activateDryrun (Activate -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Activate Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
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
"dryrun" NamedSwaggerDoc -> NamedSwaggerDoc
dryRunDocs SchemaP NamedSwaggerDoc Value Value Bool Bool
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 for an activation request."

      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
"The activation code."

      dryRunDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
      dryRunDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
dryRunDocs =
        (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
"At least one of key, email, or phone has to be present \
             \while key takes precedence over email, and email takes precedence over phone. \
             \Whether to perform a dryrun, i.e. to only check whether \
             \activation would succeed. Dry-runs never issue access \
             \cookies or tokens on success but failures still count \
             \towards the maximum failure count."

      maybeActivationTargetObjectSchema :: ObjectSchemaP SwaggerDoc (Maybe ActivationKey, Maybe EmailAddress) ActivationTarget
      maybeActivationTargetObjectSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe ActivationKey, Maybe EmailAddress)
  ActivationTarget
maybeActivationTargetObjectSchema =
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe ActivationKey, Maybe EmailAddress)
  (Maybe ActivationKey, Maybe EmailAddress)
-> ((Maybe ActivationKey, Maybe EmailAddress)
    -> Parser ActivationTarget)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationKey, Maybe EmailAddress)
     ActivationTarget
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 ActivationKey, Maybe EmailAddress)
  (Maybe ActivationKey, Maybe EmailAddress)
activationTargetTupleObjectSchema (Maybe ActivationKey, Maybe EmailAddress)
-> Parser ActivationTarget
maybeActivationTargetTargetFromTuple
        where
          activationTargetTupleObjectSchema :: ObjectSchema SwaggerDoc (Maybe ActivationKey, Maybe EmailAddress)
          activationTargetTupleObjectSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe ActivationKey, Maybe EmailAddress)
  (Maybe ActivationKey, Maybe EmailAddress)
activationTargetTupleObjectSchema =
            (,)
              (Maybe ActivationKey
 -> Maybe EmailAddress -> (Maybe ActivationKey, Maybe EmailAddress))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationKey, Maybe EmailAddress)
     (Maybe ActivationKey)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationKey, Maybe EmailAddress)
     (Maybe EmailAddress -> (Maybe ActivationKey, Maybe EmailAddress))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe ActivationKey, Maybe EmailAddress) -> Maybe ActivationKey
forall a b. (a, b) -> a
fst ((Maybe ActivationKey, Maybe EmailAddress) -> Maybe ActivationKey)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationKey)
     (Maybe ActivationKey)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationKey, Maybe EmailAddress)
     (Maybe ActivationKey)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] ActivationKey (Maybe ActivationKey)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationKey)
     (Maybe ActivationKey)
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)
-> ValueSchema NamedSwaggerDoc ActivationKey
-> SchemaP
     SwaggerDoc Object [Pair] ActivationKey (Maybe ActivationKey)
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 ValueSchema NamedSwaggerDoc ActivationKey
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
              SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe ActivationKey, Maybe EmailAddress)
  (Maybe EmailAddress -> (Maybe ActivationKey, Maybe EmailAddress))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationKey, Maybe EmailAddress)
     (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationKey, Maybe EmailAddress)
     (Maybe ActivationKey, Maybe EmailAddress)
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe ActivationKey, Maybe EmailAddress)
  (a -> b)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationKey, Maybe EmailAddress)
     a
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationKey, Maybe EmailAddress)
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe ActivationKey, Maybe EmailAddress) -> Maybe EmailAddress
forall a b. (a, b) -> b
snd ((Maybe ActivationKey, Maybe EmailAddress) -> Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress) (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationKey, Maybe EmailAddress)
     (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)
            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 to activate, as it was sent by the API."
              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 address to activate."

          maybeActivationTargetTargetFromTuple :: (Maybe ActivationKey, Maybe EmailAddress) -> Parser ActivationTarget
          maybeActivationTargetTargetFromTuple :: (Maybe ActivationKey, Maybe EmailAddress)
-> Parser ActivationTarget
maybeActivationTargetTargetFromTuple = \case
            (Just ActivationKey
key, Maybe EmailAddress
_) -> ActivationTarget -> Parser ActivationTarget
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActivationTarget -> Parser ActivationTarget)
-> ActivationTarget -> Parser ActivationTarget
forall a b. (a -> b) -> a -> b
$ ActivationKey -> ActivationTarget
ActivateKey ActivationKey
key
            (Maybe ActivationKey
_, Just EmailAddress
email) -> ActivationTarget -> Parser ActivationTarget
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActivationTarget -> Parser ActivationTarget)
-> ActivationTarget -> Parser ActivationTarget
forall a b. (a -> b) -> a -> b
$ EmailAddress -> ActivationTarget
ActivateEmail EmailAddress
email
            (Maybe ActivationKey, Maybe EmailAddress)
_ -> String -> Parser ActivationTarget
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"key or email must be present"

      maybeActivationTargetToTuple :: ActivationTarget -> (Maybe ActivationKey, Maybe EmailAddress)
      maybeActivationTargetToTuple :: ActivationTarget -> (Maybe ActivationKey, Maybe EmailAddress)
maybeActivationTargetToTuple = \case
        ActivateKey ActivationKey
key -> (ActivationKey -> Maybe ActivationKey
forall a. a -> Maybe a
Just ActivationKey
key, Maybe EmailAddress
forall a. Maybe a
Nothing)
        ActivateEmail EmailAddress
email -> (Maybe ActivationKey
forall a. Maybe a
Nothing, EmailAddress -> Maybe EmailAddress
forall a. a -> Maybe a
Just EmailAddress
email)

-- | Information returned as part of a successful activation.
data ActivationResponse = ActivationResponse
  { -- | The activated / verified user identity.
    ActivationResponse -> UserIdentity
activatedIdentity :: UserIdentity,
    -- | Whether this is the first verified identity of the account.
    ActivationResponse -> Bool
activatedFirst :: Bool
  }
  deriving stock (ActivationResponse -> ActivationResponse -> Bool
(ActivationResponse -> ActivationResponse -> Bool)
-> (ActivationResponse -> ActivationResponse -> Bool)
-> Eq ActivationResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActivationResponse -> ActivationResponse -> Bool
== :: ActivationResponse -> ActivationResponse -> Bool
$c/= :: ActivationResponse -> ActivationResponse -> Bool
/= :: ActivationResponse -> ActivationResponse -> Bool
Eq, Int -> ActivationResponse -> ShowS
[ActivationResponse] -> ShowS
ActivationResponse -> String
(Int -> ActivationResponse -> ShowS)
-> (ActivationResponse -> String)
-> ([ActivationResponse] -> ShowS)
-> Show ActivationResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivationResponse -> ShowS
showsPrec :: Int -> ActivationResponse -> ShowS
$cshow :: ActivationResponse -> String
show :: ActivationResponse -> String
$cshowList :: [ActivationResponse] -> ShowS
showList :: [ActivationResponse] -> ShowS
Show, (forall x. ActivationResponse -> Rep ActivationResponse x)
-> (forall x. Rep ActivationResponse x -> ActivationResponse)
-> Generic ActivationResponse
forall x. Rep ActivationResponse x -> ActivationResponse
forall x. ActivationResponse -> Rep ActivationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActivationResponse -> Rep ActivationResponse x
from :: forall x. ActivationResponse -> Rep ActivationResponse x
$cto :: forall x. Rep ActivationResponse x -> ActivationResponse
to :: forall x. Rep ActivationResponse x -> ActivationResponse
Generic)
  deriving (Gen ActivationResponse
Gen ActivationResponse
-> (ActivationResponse -> [ActivationResponse])
-> Arbitrary ActivationResponse
ActivationResponse -> [ActivationResponse]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ActivationResponse
arbitrary :: Gen ActivationResponse
$cshrink :: ActivationResponse -> [ActivationResponse]
shrink :: ActivationResponse -> [ActivationResponse]
Arbitrary) via (GenericUniform ActivationResponse)
  deriving ([ActivationResponse] -> Value
[ActivationResponse] -> Encoding
ActivationResponse -> Value
ActivationResponse -> Encoding
(ActivationResponse -> Value)
-> (ActivationResponse -> Encoding)
-> ([ActivationResponse] -> Value)
-> ([ActivationResponse] -> Encoding)
-> ToJSON ActivationResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ActivationResponse -> Value
toJSON :: ActivationResponse -> Value
$ctoEncoding :: ActivationResponse -> Encoding
toEncoding :: ActivationResponse -> Encoding
$ctoJSONList :: [ActivationResponse] -> Value
toJSONList :: [ActivationResponse] -> Value
$ctoEncodingList :: [ActivationResponse] -> Encoding
toEncodingList :: [ActivationResponse] -> Encoding
A.ToJSON, Value -> Parser [ActivationResponse]
Value -> Parser ActivationResponse
(Value -> Parser ActivationResponse)
-> (Value -> Parser [ActivationResponse])
-> FromJSON ActivationResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ActivationResponse
parseJSON :: Value -> Parser ActivationResponse
$cparseJSONList :: Value -> Parser [ActivationResponse]
parseJSONList :: Value -> Parser [ActivationResponse]
A.FromJSON, Typeable ActivationResponse
Typeable ActivationResponse =>
(Proxy ActivationResponse
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ActivationResponse
Proxy ActivationResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ActivationResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ActivationResponse
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ActivationResponse

instance ToSchema ActivationResponse where
  schema :: ValueSchema NamedSwaggerDoc ActivationResponse
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc ActivationResponse
-> ValueSchema NamedSwaggerDoc ActivationResponse
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"ActivationResponse" ((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
"Response body of a successful activation request") (ObjectSchema SwaggerDoc ActivationResponse
 -> ValueSchema NamedSwaggerDoc ActivationResponse)
-> ObjectSchema SwaggerDoc ActivationResponse
-> ValueSchema NamedSwaggerDoc ActivationResponse
forall a b. (a -> b) -> a -> b
$
      UserIdentity -> Bool -> ActivationResponse
ActivationResponse
        (UserIdentity -> Bool -> ActivationResponse)
-> SchemaP SwaggerDoc Object [Pair] ActivationResponse UserIdentity
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ActivationResponse
     (Bool -> ActivationResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActivationResponse -> UserIdentity
activatedIdentity (ActivationResponse -> UserIdentity)
-> SchemaP SwaggerDoc Object [Pair] UserIdentity UserIdentity
-> SchemaP SwaggerDoc Object [Pair] ActivationResponse UserIdentity
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] UserIdentity UserIdentity
userIdentityObjectSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ActivationResponse
  (Bool -> ActivationResponse)
-> SchemaP SwaggerDoc Object [Pair] ActivationResponse Bool
-> ObjectSchema SwaggerDoc ActivationResponse
forall a b.
SchemaP SwaggerDoc Object [Pair] ActivationResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ActivationResponse a
-> SchemaP SwaggerDoc Object [Pair] ActivationResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActivationResponse -> Bool
activatedFirst (ActivationResponse -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] ActivationResponse Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
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
"first" ((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
"Whether this is the first successful activation (i.e. account activation).") SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

--------------------------------------------------------------------------------
-- SendActivationCode

-- | Payload for a request to (re-)send an activation code for an e-mail
-- address.
data SendActivationCode = SendActivationCode
  { SendActivationCode -> EmailAddress
emailKey :: EmailAddress,
    SendActivationCode -> Maybe Locale
locale :: Maybe Locale
  }
  deriving stock (SendActivationCode -> SendActivationCode -> Bool
(SendActivationCode -> SendActivationCode -> Bool)
-> (SendActivationCode -> SendActivationCode -> Bool)
-> Eq SendActivationCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SendActivationCode -> SendActivationCode -> Bool
== :: SendActivationCode -> SendActivationCode -> Bool
$c/= :: SendActivationCode -> SendActivationCode -> Bool
/= :: SendActivationCode -> SendActivationCode -> Bool
Eq, Int -> SendActivationCode -> ShowS
[SendActivationCode] -> ShowS
SendActivationCode -> String
(Int -> SendActivationCode -> ShowS)
-> (SendActivationCode -> String)
-> ([SendActivationCode] -> ShowS)
-> Show SendActivationCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SendActivationCode -> ShowS
showsPrec :: Int -> SendActivationCode -> ShowS
$cshow :: SendActivationCode -> String
show :: SendActivationCode -> String
$cshowList :: [SendActivationCode] -> ShowS
showList :: [SendActivationCode] -> ShowS
Show, (forall x. SendActivationCode -> Rep SendActivationCode x)
-> (forall x. Rep SendActivationCode x -> SendActivationCode)
-> Generic SendActivationCode
forall x. Rep SendActivationCode x -> SendActivationCode
forall x. SendActivationCode -> Rep SendActivationCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SendActivationCode -> Rep SendActivationCode x
from :: forall x. SendActivationCode -> Rep SendActivationCode x
$cto :: forall x. Rep SendActivationCode x -> SendActivationCode
to :: forall x. Rep SendActivationCode x -> SendActivationCode
Generic)
  deriving (Gen SendActivationCode
Gen SendActivationCode
-> (SendActivationCode -> [SendActivationCode])
-> Arbitrary SendActivationCode
SendActivationCode -> [SendActivationCode]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SendActivationCode
arbitrary :: Gen SendActivationCode
$cshrink :: SendActivationCode -> [SendActivationCode]
shrink :: SendActivationCode -> [SendActivationCode]
Arbitrary) via (GenericUniform SendActivationCode)
  deriving ([SendActivationCode] -> Value
[SendActivationCode] -> Encoding
SendActivationCode -> Value
SendActivationCode -> Encoding
(SendActivationCode -> Value)
-> (SendActivationCode -> Encoding)
-> ([SendActivationCode] -> Value)
-> ([SendActivationCode] -> Encoding)
-> ToJSON SendActivationCode
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SendActivationCode -> Value
toJSON :: SendActivationCode -> Value
$ctoEncoding :: SendActivationCode -> Encoding
toEncoding :: SendActivationCode -> Encoding
$ctoJSONList :: [SendActivationCode] -> Value
toJSONList :: [SendActivationCode] -> Value
$ctoEncodingList :: [SendActivationCode] -> Encoding
toEncodingList :: [SendActivationCode] -> Encoding
A.ToJSON, Value -> Parser [SendActivationCode]
Value -> Parser SendActivationCode
(Value -> Parser SendActivationCode)
-> (Value -> Parser [SendActivationCode])
-> FromJSON SendActivationCode
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SendActivationCode
parseJSON :: Value -> Parser SendActivationCode
$cparseJSONList :: Value -> Parser [SendActivationCode]
parseJSONList :: Value -> Parser [SendActivationCode]
A.FromJSON, Typeable SendActivationCode
Typeable SendActivationCode =>
(Proxy SendActivationCode
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SendActivationCode
Proxy SendActivationCode
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy SendActivationCode
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy SendActivationCode
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema SendActivationCode

instance ToSchema SendActivationCode where
  schema :: ValueSchema NamedSwaggerDoc SendActivationCode
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc SendActivationCode
-> ValueSchema NamedSwaggerDoc SendActivationCode
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"SendActivationCode" NamedSwaggerDoc -> NamedSwaggerDoc
objectDesc (ObjectSchema SwaggerDoc SendActivationCode
 -> ValueSchema NamedSwaggerDoc SendActivationCode)
-> ObjectSchema SwaggerDoc SendActivationCode
-> ValueSchema NamedSwaggerDoc SendActivationCode
forall a b. (a -> b) -> a -> b
$
      EmailAddress -> Maybe Locale -> SendActivationCode
SendActivationCode
        (EmailAddress -> Maybe Locale -> SendActivationCode)
-> SchemaP SwaggerDoc Object [Pair] SendActivationCode EmailAddress
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SendActivationCode
     (Maybe Locale -> SendActivationCode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SendActivationCode -> EmailAddress
emailKey (SendActivationCode -> EmailAddress)
-> SchemaP SwaggerDoc Object [Pair] EmailAddress EmailAddress
-> SchemaP SwaggerDoc Object [Pair] SendActivationCode EmailAddress
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
-> SchemaP SwaggerDoc Object [Pair] EmailAddress EmailAddress
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"email" SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  SendActivationCode
  (Maybe Locale -> SendActivationCode)
-> SchemaP
     SwaggerDoc Object [Pair] SendActivationCode (Maybe Locale)
-> ObjectSchema SwaggerDoc SendActivationCode
forall a b.
SchemaP SwaggerDoc Object [Pair] SendActivationCode (a -> b)
-> SchemaP SwaggerDoc Object [Pair] SendActivationCode a
-> SchemaP SwaggerDoc Object [Pair] SendActivationCode b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SendActivationCode -> Maybe Locale
locale
          (SendActivationCode -> Maybe Locale)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Locale) (Maybe Locale)
-> SchemaP
     SwaggerDoc Object [Pair] SendActivationCode (Maybe Locale)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Locale (Maybe Locale)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Locale) (Maybe Locale)
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 Locale Locale
-> SchemaP SwaggerDoc Object [Pair] Locale (Maybe Locale)
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
"locale"
                ( (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
"Locale to use for the activation code template."
                )
                SchemaP NamedSwaggerDoc Value Value Locale Locale
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
            )
    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 for requesting an email code to be sent. 'email' must be present."