{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}

-- 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.Call.Config
  ( -- * RTCConfiguration
    RTCConfiguration,
    rtcConfiguration,
    rtcConfIceServers,
    rtcConfSftServers,
    rtcConfSftServersAll,
    rtcConfTTL,
    rtcConfIsFederating,

    -- * RTCIceServer
    RTCIceServer,
    rtcIceServer,
    iceURLs,
    iceUsername,
    iceCredential,

    -- * TurnURI
    TurnURI,
    turnURI,
    turiScheme,
    Scheme (..),
    turiHost,
    turiPort,
    turiTransport,
    Transport (..),
    TurnHost (..),

    -- * SFTUsername
    SFTUsername,
    mkSFTUsername,

    -- * TurnUsername
    TurnUsername,
    turnUsername,
    tuExpiresAt,
    tuVersion,
    tuKeyindex,
    tuT,
    tuRandom,

    -- * SFTServer
    SFTServer,
    sftServer,
    sftURL,

    -- * AuthSFTServer
    AuthSFTServer,
    authSFTServer,
    nauthSFTServer,
    authURL,
    authUsername,
    authCredential,

    -- * convenience
    isUdp,
    isTcp,
    isTls,
    limitServers,
  )
where

import Control.Applicative (optional)
import Control.Lens hiding (element, enum, (.=))
import Data.Aeson qualified as A hiding ((<?>))
import Data.Aeson.Types qualified as A
import Data.Attoparsec.Text hiding (Parser, parse)
import Data.Attoparsec.Text qualified as Text
import Data.ByteString (toStrict)
import Data.ByteString.Builder
import Data.ByteString.Conversion (toByteString)
import Data.ByteString.Conversion qualified as BC
import Data.IP qualified as IP
import Data.List.NonEmpty (NonEmpty)
import Data.Misc (HttpsUrl (..), IpAddr (IpAddr), Port (..))
import Data.OpenApi qualified as S
import Data.Schema
import Data.Text qualified as Text
import Data.Text.Ascii
import Data.Text.Encoding qualified as TE
import Data.Text.Encoding.Error
import Data.Text.Strict.Lens (utf8)
import Data.Time.Clock.POSIX
import Imports
import Test.QuickCheck qualified as QC
import Text.Hostname (validHostname)
import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))

--------------------------------------------------------------------------------
-- RTCConfiguration

-- | A configuration object resembling \"RTCConfiguration\"
--
-- The \"ttl\" field is a proprietary extension
-- The \"sft_servers\" field is a proprietary extension
--
-- cf. https://developer.mozilla.org/en-US/docs/Web/API/RTCPeerConnection/RTCPeerConnection#RTCConfiguration_dictionary
data RTCConfiguration = RTCConfiguration
  { RTCConfiguration -> NonEmpty RTCIceServer
_rtcConfIceServers :: NonEmpty RTCIceServer,
    RTCConfiguration -> Maybe (NonEmpty SFTServer)
_rtcConfSftServers :: Maybe (NonEmpty SFTServer),
    RTCConfiguration -> Word32
_rtcConfTTL :: Word32,
    RTCConfiguration -> Maybe [AuthSFTServer]
_rtcConfSftServersAll :: Maybe [AuthSFTServer],
    RTCConfiguration -> Maybe Bool
_rtcConfIsFederating :: Maybe Bool
  }
  deriving stock (RTCConfiguration -> RTCConfiguration -> Bool
(RTCConfiguration -> RTCConfiguration -> Bool)
-> (RTCConfiguration -> RTCConfiguration -> Bool)
-> Eq RTCConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RTCConfiguration -> RTCConfiguration -> Bool
== :: RTCConfiguration -> RTCConfiguration -> Bool
$c/= :: RTCConfiguration -> RTCConfiguration -> Bool
/= :: RTCConfiguration -> RTCConfiguration -> Bool
Eq, Int -> RTCConfiguration -> ShowS
[RTCConfiguration] -> ShowS
RTCConfiguration -> String
(Int -> RTCConfiguration -> ShowS)
-> (RTCConfiguration -> String)
-> ([RTCConfiguration] -> ShowS)
-> Show RTCConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RTCConfiguration -> ShowS
showsPrec :: Int -> RTCConfiguration -> ShowS
$cshow :: RTCConfiguration -> String
show :: RTCConfiguration -> String
$cshowList :: [RTCConfiguration] -> ShowS
showList :: [RTCConfiguration] -> ShowS
Show, (forall x. RTCConfiguration -> Rep RTCConfiguration x)
-> (forall x. Rep RTCConfiguration x -> RTCConfiguration)
-> Generic RTCConfiguration
forall x. Rep RTCConfiguration x -> RTCConfiguration
forall x. RTCConfiguration -> Rep RTCConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RTCConfiguration -> Rep RTCConfiguration x
from :: forall x. RTCConfiguration -> Rep RTCConfiguration x
$cto :: forall x. Rep RTCConfiguration x -> RTCConfiguration
to :: forall x. Rep RTCConfiguration x -> RTCConfiguration
Generic)
  deriving (Gen RTCConfiguration
Gen RTCConfiguration
-> (RTCConfiguration -> [RTCConfiguration])
-> Arbitrary RTCConfiguration
RTCConfiguration -> [RTCConfiguration]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen RTCConfiguration
arbitrary :: Gen RTCConfiguration
$cshrink :: RTCConfiguration -> [RTCConfiguration]
shrink :: RTCConfiguration -> [RTCConfiguration]
Arbitrary) via (GenericUniform RTCConfiguration)
  deriving ([RTCConfiguration] -> Value
[RTCConfiguration] -> Encoding
RTCConfiguration -> Value
RTCConfiguration -> Encoding
(RTCConfiguration -> Value)
-> (RTCConfiguration -> Encoding)
-> ([RTCConfiguration] -> Value)
-> ([RTCConfiguration] -> Encoding)
-> ToJSON RTCConfiguration
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RTCConfiguration -> Value
toJSON :: RTCConfiguration -> Value
$ctoEncoding :: RTCConfiguration -> Encoding
toEncoding :: RTCConfiguration -> Encoding
$ctoJSONList :: [RTCConfiguration] -> Value
toJSONList :: [RTCConfiguration] -> Value
$ctoEncodingList :: [RTCConfiguration] -> Encoding
toEncodingList :: [RTCConfiguration] -> Encoding
A.ToJSON, Value -> Parser [RTCConfiguration]
Value -> Parser RTCConfiguration
(Value -> Parser RTCConfiguration)
-> (Value -> Parser [RTCConfiguration])
-> FromJSON RTCConfiguration
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RTCConfiguration
parseJSON :: Value -> Parser RTCConfiguration
$cparseJSONList :: Value -> Parser [RTCConfiguration]
parseJSONList :: Value -> Parser [RTCConfiguration]
A.FromJSON, Typeable RTCConfiguration
Typeable RTCConfiguration =>
(Proxy RTCConfiguration
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema RTCConfiguration
Proxy RTCConfiguration -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy RTCConfiguration -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy RTCConfiguration -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema RTCConfiguration)

rtcConfiguration ::
  NonEmpty RTCIceServer ->
  Maybe (NonEmpty SFTServer) ->
  Word32 ->
  Maybe [AuthSFTServer] ->
  Maybe Bool ->
  RTCConfiguration
rtcConfiguration :: NonEmpty RTCIceServer
-> Maybe (NonEmpty SFTServer)
-> Word32
-> Maybe [AuthSFTServer]
-> Maybe Bool
-> RTCConfiguration
rtcConfiguration = NonEmpty RTCIceServer
-> Maybe (NonEmpty SFTServer)
-> Word32
-> Maybe [AuthSFTServer]
-> Maybe Bool
-> RTCConfiguration
RTCConfiguration

instance ToSchema RTCConfiguration where
  schema :: ValueSchema NamedSwaggerDoc RTCConfiguration
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc RTCConfiguration
-> ValueSchema NamedSwaggerDoc RTCConfiguration
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"RTCConfiguration" ((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 subset of the WebRTC 'RTCConfiguration' dictionary") (ObjectSchema SwaggerDoc RTCConfiguration
 -> ValueSchema NamedSwaggerDoc RTCConfiguration)
-> ObjectSchema SwaggerDoc RTCConfiguration
-> ValueSchema NamedSwaggerDoc RTCConfiguration
forall a b. (a -> b) -> a -> b
$
      NonEmpty RTCIceServer
-> Maybe (NonEmpty SFTServer)
-> Word32
-> Maybe [AuthSFTServer]
-> Maybe Bool
-> RTCConfiguration
RTCConfiguration
        (NonEmpty RTCIceServer
 -> Maybe (NonEmpty SFTServer)
 -> Word32
 -> Maybe [AuthSFTServer]
 -> Maybe Bool
 -> RTCConfiguration)
-> SchemaP
     SwaggerDoc Object [Pair] RTCConfiguration (NonEmpty RTCIceServer)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RTCConfiguration
     (Maybe (NonEmpty SFTServer)
      -> Word32
      -> Maybe [AuthSFTServer]
      -> Maybe Bool
      -> RTCConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RTCConfiguration -> NonEmpty RTCIceServer
_rtcConfIceServers
          (RTCConfiguration -> NonEmpty RTCIceServer)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NonEmpty RTCIceServer)
     (NonEmpty RTCIceServer)
-> SchemaP
     SwaggerDoc Object [Pair] RTCConfiguration (NonEmpty RTCIceServer)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP
     SwaggerDoc
     Value
     Value
     (NonEmpty RTCIceServer)
     (NonEmpty RTCIceServer)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NonEmpty RTCIceServer)
     (NonEmpty RTCIceServer)
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
"ice_servers" ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Array of 'RTCIceServer' objects") (ValueSchema NamedSwaggerDoc RTCIceServer
-> SchemaP
     SwaggerDoc
     Value
     Value
     (NonEmpty RTCIceServer)
     (NonEmpty RTCIceServer)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc,
 HasMinItems doc (Maybe Integer)) =>
ValueSchema ndoc a -> ValueSchema doc (NonEmpty a)
nonEmptyArray ValueSchema NamedSwaggerDoc RTCIceServer
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  RTCConfiguration
  (Maybe (NonEmpty SFTServer)
   -> Word32
   -> Maybe [AuthSFTServer]
   -> Maybe Bool
   -> RTCConfiguration)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RTCConfiguration
     (Maybe (NonEmpty SFTServer))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RTCConfiguration
     (Word32 -> Maybe [AuthSFTServer] -> Maybe Bool -> RTCConfiguration)
forall a b.
SchemaP SwaggerDoc Object [Pair] RTCConfiguration (a -> b)
-> SchemaP SwaggerDoc Object [Pair] RTCConfiguration a
-> SchemaP SwaggerDoc Object [Pair] RTCConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RTCConfiguration -> Maybe (NonEmpty SFTServer)
_rtcConfSftServers
          (RTCConfiguration -> Maybe (NonEmpty SFTServer))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (NonEmpty SFTServer))
     (Maybe (NonEmpty SFTServer))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RTCConfiguration
     (Maybe (NonEmpty SFTServer))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (NonEmpty SFTServer)
  (Maybe (NonEmpty SFTServer))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (NonEmpty SFTServer))
     (Maybe (NonEmpty SFTServer))
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP
     SwaggerDoc Value Value (NonEmpty SFTServer) (NonEmpty SFTServer)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NonEmpty SFTServer)
     (Maybe (NonEmpty SFTServer))
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
"sft_servers" ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Array of 'SFTServer' objects (optional)") (ValueSchema NamedSwaggerDoc SFTServer
-> SchemaP
     SwaggerDoc Value Value (NonEmpty SFTServer) (NonEmpty SFTServer)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc,
 HasMinItems doc (Maybe Integer)) =>
ValueSchema ndoc a -> ValueSchema doc (NonEmpty a)
nonEmptyArray ValueSchema NamedSwaggerDoc SFTServer
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  RTCConfiguration
  (Word32 -> Maybe [AuthSFTServer] -> Maybe Bool -> RTCConfiguration)
-> SchemaP SwaggerDoc Object [Pair] RTCConfiguration Word32
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RTCConfiguration
     (Maybe [AuthSFTServer] -> Maybe Bool -> RTCConfiguration)
forall a b.
SchemaP SwaggerDoc Object [Pair] RTCConfiguration (a -> b)
-> SchemaP SwaggerDoc Object [Pair] RTCConfiguration a
-> SchemaP SwaggerDoc Object [Pair] RTCConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RTCConfiguration -> Word32
_rtcConfTTL
          (RTCConfiguration -> Word32)
-> SchemaP SwaggerDoc Object [Pair] Word32 Word32
-> SchemaP SwaggerDoc Object [Pair] RTCConfiguration Word32
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Word32 Word32
-> SchemaP SwaggerDoc Object [Pair] Word32 Word32
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
"ttl" ((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
"Number of seconds after which the configuration should be refreshed (advisory)") SchemaP NamedSwaggerDoc Value Value Word32 Word32
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  RTCConfiguration
  (Maybe [AuthSFTServer] -> Maybe Bool -> RTCConfiguration)
-> SchemaP
     SwaggerDoc Object [Pair] RTCConfiguration (Maybe [AuthSFTServer])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RTCConfiguration
     (Maybe Bool -> RTCConfiguration)
forall a b.
SchemaP SwaggerDoc Object [Pair] RTCConfiguration (a -> b)
-> SchemaP SwaggerDoc Object [Pair] RTCConfiguration a
-> SchemaP SwaggerDoc Object [Pair] RTCConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RTCConfiguration -> Maybe [AuthSFTServer]
_rtcConfSftServersAll
          (RTCConfiguration -> Maybe [AuthSFTServer])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe [AuthSFTServer])
     (Maybe [AuthSFTServer])
-> SchemaP
     SwaggerDoc Object [Pair] RTCConfiguration (Maybe [AuthSFTServer])
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] [AuthSFTServer] (Maybe [AuthSFTServer])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe [AuthSFTServer])
     (Maybe [AuthSFTServer])
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP SwaggerDoc Value Value [AuthSFTServer] [AuthSFTServer]
-> SchemaP
     SwaggerDoc Object [Pair] [AuthSFTServer] (Maybe [AuthSFTServer])
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
"sft_servers_all" ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Array of all SFT servers") (ValueSchema NamedSwaggerDoc AuthSFTServer
-> SchemaP SwaggerDoc Value Value [AuthSFTServer] [AuthSFTServer]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc AuthSFTServer
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  RTCConfiguration
  (Maybe Bool -> RTCConfiguration)
-> SchemaP SwaggerDoc Object [Pair] RTCConfiguration (Maybe Bool)
-> ObjectSchema SwaggerDoc RTCConfiguration
forall a b.
SchemaP SwaggerDoc Object [Pair] RTCConfiguration (a -> b)
-> SchemaP SwaggerDoc Object [Pair] RTCConfiguration a
-> SchemaP SwaggerDoc Object [Pair] RTCConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RTCConfiguration -> Maybe Bool
_rtcConfIsFederating
          (RTCConfiguration -> Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] RTCConfiguration (Maybe Bool)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) (Maybe Bool)
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 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
"is_federating" ((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
"True if the client should connect to an SFT in the sft_servers_all and request it to federate") SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

--------------------------------------------------------------------------------
-- SFTServer

newtype SFTServer = SFTServer
  { SFTServer -> HttpsUrl
_sftURL :: HttpsUrl
  }
  deriving stock (SFTServer -> SFTServer -> Bool
(SFTServer -> SFTServer -> Bool)
-> (SFTServer -> SFTServer -> Bool) -> Eq SFTServer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SFTServer -> SFTServer -> Bool
== :: SFTServer -> SFTServer -> Bool
$c/= :: SFTServer -> SFTServer -> Bool
/= :: SFTServer -> SFTServer -> Bool
Eq, Int -> SFTServer -> ShowS
[SFTServer] -> ShowS
SFTServer -> String
(Int -> SFTServer -> ShowS)
-> (SFTServer -> String)
-> ([SFTServer] -> ShowS)
-> Show SFTServer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SFTServer -> ShowS
showsPrec :: Int -> SFTServer -> ShowS
$cshow :: SFTServer -> String
show :: SFTServer -> String
$cshowList :: [SFTServer] -> ShowS
showList :: [SFTServer] -> ShowS
Show, Eq SFTServer
Eq SFTServer =>
(SFTServer -> SFTServer -> Ordering)
-> (SFTServer -> SFTServer -> Bool)
-> (SFTServer -> SFTServer -> Bool)
-> (SFTServer -> SFTServer -> Bool)
-> (SFTServer -> SFTServer -> Bool)
-> (SFTServer -> SFTServer -> SFTServer)
-> (SFTServer -> SFTServer -> SFTServer)
-> Ord SFTServer
SFTServer -> SFTServer -> Bool
SFTServer -> SFTServer -> Ordering
SFTServer -> SFTServer -> SFTServer
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 :: SFTServer -> SFTServer -> Ordering
compare :: SFTServer -> SFTServer -> Ordering
$c< :: SFTServer -> SFTServer -> Bool
< :: SFTServer -> SFTServer -> Bool
$c<= :: SFTServer -> SFTServer -> Bool
<= :: SFTServer -> SFTServer -> Bool
$c> :: SFTServer -> SFTServer -> Bool
> :: SFTServer -> SFTServer -> Bool
$c>= :: SFTServer -> SFTServer -> Bool
>= :: SFTServer -> SFTServer -> Bool
$cmax :: SFTServer -> SFTServer -> SFTServer
max :: SFTServer -> SFTServer -> SFTServer
$cmin :: SFTServer -> SFTServer -> SFTServer
min :: SFTServer -> SFTServer -> SFTServer
Ord, (forall x. SFTServer -> Rep SFTServer x)
-> (forall x. Rep SFTServer x -> SFTServer) -> Generic SFTServer
forall x. Rep SFTServer x -> SFTServer
forall x. SFTServer -> Rep SFTServer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SFTServer -> Rep SFTServer x
from :: forall x. SFTServer -> Rep SFTServer x
$cto :: forall x. Rep SFTServer x -> SFTServer
to :: forall x. Rep SFTServer x -> SFTServer
Generic)
  deriving (Gen SFTServer
Gen SFTServer -> (SFTServer -> [SFTServer]) -> Arbitrary SFTServer
SFTServer -> [SFTServer]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SFTServer
arbitrary :: Gen SFTServer
$cshrink :: SFTServer -> [SFTServer]
shrink :: SFTServer -> [SFTServer]
Arbitrary) via (GenericUniform SFTServer)
  deriving ([SFTServer] -> Value
[SFTServer] -> Encoding
SFTServer -> Value
SFTServer -> Encoding
(SFTServer -> Value)
-> (SFTServer -> Encoding)
-> ([SFTServer] -> Value)
-> ([SFTServer] -> Encoding)
-> ToJSON SFTServer
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SFTServer -> Value
toJSON :: SFTServer -> Value
$ctoEncoding :: SFTServer -> Encoding
toEncoding :: SFTServer -> Encoding
$ctoJSONList :: [SFTServer] -> Value
toJSONList :: [SFTServer] -> Value
$ctoEncodingList :: [SFTServer] -> Encoding
toEncodingList :: [SFTServer] -> Encoding
A.ToJSON, Value -> Parser [SFTServer]
Value -> Parser SFTServer
(Value -> Parser SFTServer)
-> (Value -> Parser [SFTServer]) -> FromJSON SFTServer
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SFTServer
parseJSON :: Value -> Parser SFTServer
$cparseJSONList :: Value -> Parser [SFTServer]
parseJSONList :: Value -> Parser [SFTServer]
A.FromJSON, Typeable SFTServer
Typeable SFTServer =>
(Proxy SFTServer -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SFTServer
Proxy SFTServer -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy SFTServer -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy SFTServer -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema SFTServer)

instance ToSchema SFTServer where
  schema :: ValueSchema NamedSwaggerDoc SFTServer
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc SFTServer
-> ValueSchema NamedSwaggerDoc SFTServer
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"SftServer" ((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
"Inspired by WebRTC 'RTCIceServer' object, contains details of SFT servers") (ObjectSchema SwaggerDoc SFTServer
 -> ValueSchema NamedSwaggerDoc SFTServer)
-> ObjectSchema SwaggerDoc SFTServer
-> ValueSchema NamedSwaggerDoc SFTServer
forall a b. (a -> b) -> a -> b
$
      HttpsUrl -> SFTServer
SFTServer
        (HttpsUrl -> SFTServer)
-> SchemaP SwaggerDoc Object [Pair] SFTServer HttpsUrl
-> ObjectSchema SwaggerDoc SFTServer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HttpsUrl -> [HttpsUrl]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HttpsUrl -> [HttpsUrl])
-> (SFTServer -> HttpsUrl) -> SFTServer -> [HttpsUrl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SFTServer -> HttpsUrl
_sftURL)
          (SFTServer -> [HttpsUrl])
-> SchemaP SwaggerDoc Object [Pair] [HttpsUrl] HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] SFTServer HttpsUrl
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP SwaggerDoc Value Value [HttpsUrl] HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] [HttpsUrl] HttpsUrl
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
"urls" ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Array containing exactly one SFT server address of the form 'https://<addr>:<port>'") (SchemaP SwaggerDoc Value Value [HttpsUrl] [HttpsUrl]
-> ([HttpsUrl] -> Parser HttpsUrl)
-> SchemaP SwaggerDoc Value Value [HttpsUrl] HttpsUrl
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
withParser (ValueSchema NamedSwaggerDoc HttpsUrl
-> SchemaP SwaggerDoc Value Value [HttpsUrl] [HttpsUrl]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc HttpsUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema) [HttpsUrl] -> Parser HttpsUrl
p)
    where
      p :: [HttpsUrl] -> A.Parser HttpsUrl
      p :: [HttpsUrl] -> Parser HttpsUrl
p [HttpsUrl
url] = HttpsUrl -> Parser HttpsUrl
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HttpsUrl
url
      p [HttpsUrl]
xs = String -> Parser HttpsUrl
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser HttpsUrl) -> String -> Parser HttpsUrl
forall a b. (a -> b) -> a -> b
$ String
"SFTServer can only have exactly one URL, found " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([HttpsUrl] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HttpsUrl]
xs)

sftServer :: HttpsUrl -> SFTServer
sftServer :: HttpsUrl -> SFTServer
sftServer = HttpsUrl -> SFTServer
SFTServer

--------------------------------------------------------------------------------
-- AuthSFTServer

data AuthSFTServer = AuthSFTServer
  { AuthSFTServer -> HttpsUrl
_authURL :: HttpsUrl,
    AuthSFTServer -> Maybe SFTUsername
_authUsername :: Maybe SFTUsername,
    AuthSFTServer -> Maybe AsciiBase64
_authCredential :: Maybe AsciiBase64
  }
  deriving stock (AuthSFTServer -> AuthSFTServer -> Bool
(AuthSFTServer -> AuthSFTServer -> Bool)
-> (AuthSFTServer -> AuthSFTServer -> Bool) -> Eq AuthSFTServer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthSFTServer -> AuthSFTServer -> Bool
== :: AuthSFTServer -> AuthSFTServer -> Bool
$c/= :: AuthSFTServer -> AuthSFTServer -> Bool
/= :: AuthSFTServer -> AuthSFTServer -> Bool
Eq, Int -> AuthSFTServer -> ShowS
[AuthSFTServer] -> ShowS
AuthSFTServer -> String
(Int -> AuthSFTServer -> ShowS)
-> (AuthSFTServer -> String)
-> ([AuthSFTServer] -> ShowS)
-> Show AuthSFTServer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthSFTServer -> ShowS
showsPrec :: Int -> AuthSFTServer -> ShowS
$cshow :: AuthSFTServer -> String
show :: AuthSFTServer -> String
$cshowList :: [AuthSFTServer] -> ShowS
showList :: [AuthSFTServer] -> ShowS
Show, Eq AuthSFTServer
Eq AuthSFTServer =>
(AuthSFTServer -> AuthSFTServer -> Ordering)
-> (AuthSFTServer -> AuthSFTServer -> Bool)
-> (AuthSFTServer -> AuthSFTServer -> Bool)
-> (AuthSFTServer -> AuthSFTServer -> Bool)
-> (AuthSFTServer -> AuthSFTServer -> Bool)
-> (AuthSFTServer -> AuthSFTServer -> AuthSFTServer)
-> (AuthSFTServer -> AuthSFTServer -> AuthSFTServer)
-> Ord AuthSFTServer
AuthSFTServer -> AuthSFTServer -> Bool
AuthSFTServer -> AuthSFTServer -> Ordering
AuthSFTServer -> AuthSFTServer -> AuthSFTServer
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 :: AuthSFTServer -> AuthSFTServer -> Ordering
compare :: AuthSFTServer -> AuthSFTServer -> Ordering
$c< :: AuthSFTServer -> AuthSFTServer -> Bool
< :: AuthSFTServer -> AuthSFTServer -> Bool
$c<= :: AuthSFTServer -> AuthSFTServer -> Bool
<= :: AuthSFTServer -> AuthSFTServer -> Bool
$c> :: AuthSFTServer -> AuthSFTServer -> Bool
> :: AuthSFTServer -> AuthSFTServer -> Bool
$c>= :: AuthSFTServer -> AuthSFTServer -> Bool
>= :: AuthSFTServer -> AuthSFTServer -> Bool
$cmax :: AuthSFTServer -> AuthSFTServer -> AuthSFTServer
max :: AuthSFTServer -> AuthSFTServer -> AuthSFTServer
$cmin :: AuthSFTServer -> AuthSFTServer -> AuthSFTServer
min :: AuthSFTServer -> AuthSFTServer -> AuthSFTServer
Ord, (forall x. AuthSFTServer -> Rep AuthSFTServer x)
-> (forall x. Rep AuthSFTServer x -> AuthSFTServer)
-> Generic AuthSFTServer
forall x. Rep AuthSFTServer x -> AuthSFTServer
forall x. AuthSFTServer -> Rep AuthSFTServer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AuthSFTServer -> Rep AuthSFTServer x
from :: forall x. AuthSFTServer -> Rep AuthSFTServer x
$cto :: forall x. Rep AuthSFTServer x -> AuthSFTServer
to :: forall x. Rep AuthSFTServer x -> AuthSFTServer
Generic)
  deriving (Gen AuthSFTServer
Gen AuthSFTServer
-> (AuthSFTServer -> [AuthSFTServer]) -> Arbitrary AuthSFTServer
AuthSFTServer -> [AuthSFTServer]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen AuthSFTServer
arbitrary :: Gen AuthSFTServer
$cshrink :: AuthSFTServer -> [AuthSFTServer]
shrink :: AuthSFTServer -> [AuthSFTServer]
Arbitrary) via (GenericUniform AuthSFTServer)
  deriving ([AuthSFTServer] -> Value
[AuthSFTServer] -> Encoding
AuthSFTServer -> Value
AuthSFTServer -> Encoding
(AuthSFTServer -> Value)
-> (AuthSFTServer -> Encoding)
-> ([AuthSFTServer] -> Value)
-> ([AuthSFTServer] -> Encoding)
-> ToJSON AuthSFTServer
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AuthSFTServer -> Value
toJSON :: AuthSFTServer -> Value
$ctoEncoding :: AuthSFTServer -> Encoding
toEncoding :: AuthSFTServer -> Encoding
$ctoJSONList :: [AuthSFTServer] -> Value
toJSONList :: [AuthSFTServer] -> Value
$ctoEncodingList :: [AuthSFTServer] -> Encoding
toEncodingList :: [AuthSFTServer] -> Encoding
A.ToJSON, Value -> Parser [AuthSFTServer]
Value -> Parser AuthSFTServer
(Value -> Parser AuthSFTServer)
-> (Value -> Parser [AuthSFTServer]) -> FromJSON AuthSFTServer
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AuthSFTServer
parseJSON :: Value -> Parser AuthSFTServer
$cparseJSONList :: Value -> Parser [AuthSFTServer]
parseJSONList :: Value -> Parser [AuthSFTServer]
A.FromJSON, Typeable AuthSFTServer
Typeable AuthSFTServer =>
(Proxy AuthSFTServer -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AuthSFTServer
Proxy AuthSFTServer -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AuthSFTServer -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AuthSFTServer -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema AuthSFTServer)

instance ToSchema AuthSFTServer where
  schema :: ValueSchema NamedSwaggerDoc AuthSFTServer
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc AuthSFTServer
-> ValueSchema NamedSwaggerDoc AuthSFTServer
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"SftServer" ((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
"Inspired by WebRTC 'RTCIceServer' object, contains details of SFT servers") (ObjectSchema SwaggerDoc AuthSFTServer
 -> ValueSchema NamedSwaggerDoc AuthSFTServer)
-> ObjectSchema SwaggerDoc AuthSFTServer
-> ValueSchema NamedSwaggerDoc AuthSFTServer
forall a b. (a -> b) -> a -> b
$
      HttpsUrl -> Maybe SFTUsername -> Maybe AsciiBase64 -> AuthSFTServer
AuthSFTServer
        (HttpsUrl
 -> Maybe SFTUsername -> Maybe AsciiBase64 -> AuthSFTServer)
-> SchemaP SwaggerDoc Object [Pair] AuthSFTServer HttpsUrl
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     AuthSFTServer
     (Maybe SFTUsername -> Maybe AsciiBase64 -> AuthSFTServer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HttpsUrl -> [HttpsUrl]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HttpsUrl -> [HttpsUrl])
-> (AuthSFTServer -> HttpsUrl) -> AuthSFTServer -> [HttpsUrl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthSFTServer -> HttpsUrl
_authURL)
          (AuthSFTServer -> [HttpsUrl])
-> SchemaP SwaggerDoc Object [Pair] [HttpsUrl] HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] AuthSFTServer HttpsUrl
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP SwaggerDoc Value Value [HttpsUrl] HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] [HttpsUrl] HttpsUrl
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
"urls" ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Array containing exactly one SFT server address of the form 'https://<addr>:<port>'") (SchemaP SwaggerDoc Value Value [HttpsUrl] [HttpsUrl]
-> ([HttpsUrl] -> Parser HttpsUrl)
-> SchemaP SwaggerDoc Value Value [HttpsUrl] HttpsUrl
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
withParser (ValueSchema NamedSwaggerDoc HttpsUrl
-> SchemaP SwaggerDoc Value Value [HttpsUrl] [HttpsUrl]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc HttpsUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema) [HttpsUrl] -> Parser HttpsUrl
p)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  AuthSFTServer
  (Maybe SFTUsername -> Maybe AsciiBase64 -> AuthSFTServer)
-> SchemaP
     SwaggerDoc Object [Pair] AuthSFTServer (Maybe SFTUsername)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     AuthSFTServer
     (Maybe AsciiBase64 -> AuthSFTServer)
forall a b.
SchemaP SwaggerDoc Object [Pair] AuthSFTServer (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AuthSFTServer a
-> SchemaP SwaggerDoc Object [Pair] AuthSFTServer b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AuthSFTServer -> Maybe SFTUsername
_authUsername
          (AuthSFTServer -> Maybe SFTUsername)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe SFTUsername) (Maybe SFTUsername)
-> SchemaP
     SwaggerDoc Object [Pair] AuthSFTServer (Maybe SFTUsername)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] SFTUsername (Maybe SFTUsername)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe SFTUsername) (Maybe SFTUsername)
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 SFTUsername SFTUsername
-> SchemaP SwaggerDoc Object [Pair] SFTUsername (Maybe SFTUsername)
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
"username" ((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
"String containing the SFT username") SchemaP NamedSwaggerDoc Value Value SFTUsername SFTUsername
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  AuthSFTServer
  (Maybe AsciiBase64 -> AuthSFTServer)
-> SchemaP
     SwaggerDoc Object [Pair] AuthSFTServer (Maybe AsciiBase64)
-> ObjectSchema SwaggerDoc AuthSFTServer
forall a b.
SchemaP SwaggerDoc Object [Pair] AuthSFTServer (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AuthSFTServer a
-> SchemaP SwaggerDoc Object [Pair] AuthSFTServer b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AuthSFTServer -> Maybe AsciiBase64
_authCredential
          (AuthSFTServer -> Maybe AsciiBase64)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe AsciiBase64) (Maybe AsciiBase64)
-> SchemaP
     SwaggerDoc Object [Pair] AuthSFTServer (Maybe AsciiBase64)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] AsciiBase64 (Maybe AsciiBase64)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe AsciiBase64) (Maybe AsciiBase64)
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 AsciiBase64 AsciiBase64
-> SchemaP SwaggerDoc Object [Pair] AsciiBase64 (Maybe AsciiBase64)
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
"credential" ((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
"String containing the SFT credential") SchemaP NamedSwaggerDoc Value Value AsciiBase64 AsciiBase64
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    where
      p :: [HttpsUrl] -> A.Parser HttpsUrl
      p :: [HttpsUrl] -> Parser HttpsUrl
p [HttpsUrl
url] = HttpsUrl -> Parser HttpsUrl
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HttpsUrl
url
      p [HttpsUrl]
xs = String -> Parser HttpsUrl
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser HttpsUrl) -> String -> Parser HttpsUrl
forall a b. (a -> b) -> a -> b
$ String
"SFTServer can only have exactly one URL, found " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([HttpsUrl] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HttpsUrl]
xs)

nauthSFTServer :: SFTServer -> AuthSFTServer
nauthSFTServer :: SFTServer -> AuthSFTServer
nauthSFTServer = (\HttpsUrl
u -> HttpsUrl -> Maybe SFTUsername -> Maybe AsciiBase64 -> AuthSFTServer
AuthSFTServer HttpsUrl
u Maybe SFTUsername
forall a. Maybe a
Nothing Maybe AsciiBase64
forall a. Maybe a
Nothing) (HttpsUrl -> AuthSFTServer)
-> (SFTServer -> HttpsUrl) -> SFTServer -> AuthSFTServer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SFTServer -> HttpsUrl
_sftURL

authSFTServer :: SFTServer -> SFTUsername -> AsciiBase64 -> AuthSFTServer
authSFTServer :: SFTServer -> SFTUsername -> AsciiBase64 -> AuthSFTServer
authSFTServer SFTServer
svr SFTUsername
u = HttpsUrl -> Maybe SFTUsername -> Maybe AsciiBase64 -> AuthSFTServer
AuthSFTServer (SFTServer -> HttpsUrl
_sftURL SFTServer
svr) (SFTUsername -> Maybe SFTUsername
forall a. a -> Maybe a
Just SFTUsername
u) (Maybe AsciiBase64 -> AuthSFTServer)
-> (AsciiBase64 -> Maybe AsciiBase64)
-> AsciiBase64
-> AuthSFTServer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsciiBase64 -> Maybe AsciiBase64
forall a. a -> Maybe a
Just

--------------------------------------------------------------------------------
-- RTCIceServer

-- | A configuration object resembling \"RTCIceServer\"
--
-- cf. https://developer.mozilla.org/en-US/docs/Web/API/RTCIceServer
data RTCIceServer = RTCIceServer
  { RTCIceServer -> NonEmpty TurnURI
_iceURLs :: NonEmpty TurnURI,
    RTCIceServer -> TurnUsername
_iceUsername :: TurnUsername,
    RTCIceServer -> AsciiBase64
_iceCredential :: AsciiBase64
  }
  deriving stock (RTCIceServer -> RTCIceServer -> Bool
(RTCIceServer -> RTCIceServer -> Bool)
-> (RTCIceServer -> RTCIceServer -> Bool) -> Eq RTCIceServer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RTCIceServer -> RTCIceServer -> Bool
== :: RTCIceServer -> RTCIceServer -> Bool
$c/= :: RTCIceServer -> RTCIceServer -> Bool
/= :: RTCIceServer -> RTCIceServer -> Bool
Eq, Int -> RTCIceServer -> ShowS
[RTCIceServer] -> ShowS
RTCIceServer -> String
(Int -> RTCIceServer -> ShowS)
-> (RTCIceServer -> String)
-> ([RTCIceServer] -> ShowS)
-> Show RTCIceServer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RTCIceServer -> ShowS
showsPrec :: Int -> RTCIceServer -> ShowS
$cshow :: RTCIceServer -> String
show :: RTCIceServer -> String
$cshowList :: [RTCIceServer] -> ShowS
showList :: [RTCIceServer] -> ShowS
Show, (forall x. RTCIceServer -> Rep RTCIceServer x)
-> (forall x. Rep RTCIceServer x -> RTCIceServer)
-> Generic RTCIceServer
forall x. Rep RTCIceServer x -> RTCIceServer
forall x. RTCIceServer -> Rep RTCIceServer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RTCIceServer -> Rep RTCIceServer x
from :: forall x. RTCIceServer -> Rep RTCIceServer x
$cto :: forall x. Rep RTCIceServer x -> RTCIceServer
to :: forall x. Rep RTCIceServer x -> RTCIceServer
Generic)
  deriving (Gen RTCIceServer
Gen RTCIceServer
-> (RTCIceServer -> [RTCIceServer]) -> Arbitrary RTCIceServer
RTCIceServer -> [RTCIceServer]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen RTCIceServer
arbitrary :: Gen RTCIceServer
$cshrink :: RTCIceServer -> [RTCIceServer]
shrink :: RTCIceServer -> [RTCIceServer]
Arbitrary) via (GenericUniform RTCIceServer)
  deriving ([RTCIceServer] -> Value
[RTCIceServer] -> Encoding
RTCIceServer -> Value
RTCIceServer -> Encoding
(RTCIceServer -> Value)
-> (RTCIceServer -> Encoding)
-> ([RTCIceServer] -> Value)
-> ([RTCIceServer] -> Encoding)
-> ToJSON RTCIceServer
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RTCIceServer -> Value
toJSON :: RTCIceServer -> Value
$ctoEncoding :: RTCIceServer -> Encoding
toEncoding :: RTCIceServer -> Encoding
$ctoJSONList :: [RTCIceServer] -> Value
toJSONList :: [RTCIceServer] -> Value
$ctoEncodingList :: [RTCIceServer] -> Encoding
toEncodingList :: [RTCIceServer] -> Encoding
A.ToJSON, Value -> Parser [RTCIceServer]
Value -> Parser RTCIceServer
(Value -> Parser RTCIceServer)
-> (Value -> Parser [RTCIceServer]) -> FromJSON RTCIceServer
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RTCIceServer
parseJSON :: Value -> Parser RTCIceServer
$cparseJSONList :: Value -> Parser [RTCIceServer]
parseJSONList :: Value -> Parser [RTCIceServer]
A.FromJSON, Typeable RTCIceServer
Typeable RTCIceServer =>
(Proxy RTCIceServer -> Declare (Definitions Schema) NamedSchema)
-> ToSchema RTCIceServer
Proxy RTCIceServer -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy RTCIceServer -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy RTCIceServer -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema RTCIceServer)

rtcIceServer :: NonEmpty TurnURI -> TurnUsername -> AsciiBase64 -> RTCIceServer
rtcIceServer :: NonEmpty TurnURI -> TurnUsername -> AsciiBase64 -> RTCIceServer
rtcIceServer = NonEmpty TurnURI -> TurnUsername -> AsciiBase64 -> RTCIceServer
RTCIceServer

instance ToSchema RTCIceServer where
  schema :: ValueSchema NamedSwaggerDoc RTCIceServer
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc RTCIceServer
-> ValueSchema NamedSwaggerDoc RTCIceServer
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"RTCIceServer" ((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 subset of the WebRTC 'RTCIceServer' object") (ObjectSchema SwaggerDoc RTCIceServer
 -> ValueSchema NamedSwaggerDoc RTCIceServer)
-> ObjectSchema SwaggerDoc RTCIceServer
-> ValueSchema NamedSwaggerDoc RTCIceServer
forall a b. (a -> b) -> a -> b
$
      NonEmpty TurnURI -> TurnUsername -> AsciiBase64 -> RTCIceServer
RTCIceServer
        (NonEmpty TurnURI -> TurnUsername -> AsciiBase64 -> RTCIceServer)
-> SchemaP SwaggerDoc Object [Pair] RTCIceServer (NonEmpty TurnURI)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RTCIceServer
     (TurnUsername -> AsciiBase64 -> RTCIceServer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RTCIceServer -> NonEmpty TurnURI
_iceURLs
          (RTCIceServer -> NonEmpty TurnURI)
-> SchemaP
     SwaggerDoc Object [Pair] (NonEmpty TurnURI) (NonEmpty TurnURI)
-> SchemaP SwaggerDoc Object [Pair] RTCIceServer (NonEmpty TurnURI)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP
     SwaggerDoc Value Value (NonEmpty TurnURI) (NonEmpty TurnURI)
-> SchemaP
     SwaggerDoc Object [Pair] (NonEmpty TurnURI) (NonEmpty TurnURI)
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
"urls" ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Array of TURN server addresses of the form 'turn:<addr>:<port>'") (ValueSchema NamedSwaggerDoc TurnURI
-> SchemaP
     SwaggerDoc Value Value (NonEmpty TurnURI) (NonEmpty TurnURI)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc,
 HasMinItems doc (Maybe Integer)) =>
ValueSchema ndoc a -> ValueSchema doc (NonEmpty a)
nonEmptyArray ValueSchema NamedSwaggerDoc TurnURI
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  RTCIceServer
  (TurnUsername -> AsciiBase64 -> RTCIceServer)
-> SchemaP SwaggerDoc Object [Pair] RTCIceServer TurnUsername
-> SchemaP
     SwaggerDoc Object [Pair] RTCIceServer (AsciiBase64 -> RTCIceServer)
forall a b.
SchemaP SwaggerDoc Object [Pair] RTCIceServer (a -> b)
-> SchemaP SwaggerDoc Object [Pair] RTCIceServer a
-> SchemaP SwaggerDoc Object [Pair] RTCIceServer b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RTCIceServer -> TurnUsername
_iceUsername
          (RTCIceServer -> TurnUsername)
-> SchemaP SwaggerDoc Object [Pair] TurnUsername TurnUsername
-> SchemaP SwaggerDoc Object [Pair] RTCIceServer TurnUsername
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value TurnUsername TurnUsername
-> SchemaP SwaggerDoc Object [Pair] TurnUsername TurnUsername
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
"username" ((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
"Username to use for authenticating against the given TURN servers") SchemaP NamedSwaggerDoc Value Value TurnUsername TurnUsername
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc Object [Pair] RTCIceServer (AsciiBase64 -> RTCIceServer)
-> SchemaP SwaggerDoc Object [Pair] RTCIceServer AsciiBase64
-> ObjectSchema SwaggerDoc RTCIceServer
forall a b.
SchemaP SwaggerDoc Object [Pair] RTCIceServer (a -> b)
-> SchemaP SwaggerDoc Object [Pair] RTCIceServer a
-> SchemaP SwaggerDoc Object [Pair] RTCIceServer b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RTCIceServer -> AsciiBase64
_iceCredential
          (RTCIceServer -> AsciiBase64)
-> SchemaP SwaggerDoc Object [Pair] AsciiBase64 AsciiBase64
-> SchemaP SwaggerDoc Object [Pair] RTCIceServer AsciiBase64
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value AsciiBase64 AsciiBase64
-> SchemaP SwaggerDoc Object [Pair] AsciiBase64 AsciiBase64
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
"credential" ((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 to use for authenticating against the given TURN servers") SchemaP NamedSwaggerDoc Value Value AsciiBase64 AsciiBase64
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

--------------------------------------------------------------------------------
-- TurnURI

-- | TURN server URI as described in https://tools.ietf.org/html/rfc7065, minus ext
-- |
-- | turnURI       = scheme ":" host [ ":" port ]
-- |                 [ "?transport=" transport ]
-- | scheme        = "turn" / "turns"
-- | transport     = "udp" / "tcp" / transport-ext
-- | transport-ext = 1*unreserved
--
-- FUTUREWORK: Can contain, but refuses to deserialize IPv6 hosts, see 'parseTurnURI'
-- and the 'Arbitrary' instance. Please fix this.
data TurnURI = TurnURI
  { TurnURI -> Scheme
_turiScheme :: Scheme,
    TurnURI -> TurnHost
_turiHost :: TurnHost,
    TurnURI -> Port
_turiPort :: Port,
    TurnURI -> Maybe Transport
_turiTransport :: Maybe Transport
  }
  deriving stock (TurnURI -> TurnURI -> Bool
(TurnURI -> TurnURI -> Bool)
-> (TurnURI -> TurnURI -> Bool) -> Eq TurnURI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TurnURI -> TurnURI -> Bool
== :: TurnURI -> TurnURI -> Bool
$c/= :: TurnURI -> TurnURI -> Bool
/= :: TurnURI -> TurnURI -> Bool
Eq, Int -> TurnURI -> ShowS
[TurnURI] -> ShowS
TurnURI -> String
(Int -> TurnURI -> ShowS)
-> (TurnURI -> String) -> ([TurnURI] -> ShowS) -> Show TurnURI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TurnURI -> ShowS
showsPrec :: Int -> TurnURI -> ShowS
$cshow :: TurnURI -> String
show :: TurnURI -> String
$cshowList :: [TurnURI] -> ShowS
showList :: [TurnURI] -> ShowS
Show, Eq TurnURI
Eq TurnURI =>
(TurnURI -> TurnURI -> Ordering)
-> (TurnURI -> TurnURI -> Bool)
-> (TurnURI -> TurnURI -> Bool)
-> (TurnURI -> TurnURI -> Bool)
-> (TurnURI -> TurnURI -> Bool)
-> (TurnURI -> TurnURI -> TurnURI)
-> (TurnURI -> TurnURI -> TurnURI)
-> Ord TurnURI
TurnURI -> TurnURI -> Bool
TurnURI -> TurnURI -> Ordering
TurnURI -> TurnURI -> TurnURI
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 :: TurnURI -> TurnURI -> Ordering
compare :: TurnURI -> TurnURI -> Ordering
$c< :: TurnURI -> TurnURI -> Bool
< :: TurnURI -> TurnURI -> Bool
$c<= :: TurnURI -> TurnURI -> Bool
<= :: TurnURI -> TurnURI -> Bool
$c> :: TurnURI -> TurnURI -> Bool
> :: TurnURI -> TurnURI -> Bool
$c>= :: TurnURI -> TurnURI -> Bool
>= :: TurnURI -> TurnURI -> Bool
$cmax :: TurnURI -> TurnURI -> TurnURI
max :: TurnURI -> TurnURI -> TurnURI
$cmin :: TurnURI -> TurnURI -> TurnURI
min :: TurnURI -> TurnURI -> TurnURI
Ord, (forall x. TurnURI -> Rep TurnURI x)
-> (forall x. Rep TurnURI x -> TurnURI) -> Generic TurnURI
forall x. Rep TurnURI x -> TurnURI
forall x. TurnURI -> Rep TurnURI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TurnURI -> Rep TurnURI x
from :: forall x. TurnURI -> Rep TurnURI x
$cto :: forall x. Rep TurnURI x -> TurnURI
to :: forall x. Rep TurnURI x -> TurnURI
Generic)
  deriving ([TurnURI] -> Value
[TurnURI] -> Encoding
TurnURI -> Value
TurnURI -> Encoding
(TurnURI -> Value)
-> (TurnURI -> Encoding)
-> ([TurnURI] -> Value)
-> ([TurnURI] -> Encoding)
-> ToJSON TurnURI
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TurnURI -> Value
toJSON :: TurnURI -> Value
$ctoEncoding :: TurnURI -> Encoding
toEncoding :: TurnURI -> Encoding
$ctoJSONList :: [TurnURI] -> Value
toJSONList :: [TurnURI] -> Value
$ctoEncodingList :: [TurnURI] -> Encoding
toEncodingList :: [TurnURI] -> Encoding
A.ToJSON, Value -> Parser [TurnURI]
Value -> Parser TurnURI
(Value -> Parser TurnURI)
-> (Value -> Parser [TurnURI]) -> FromJSON TurnURI
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser TurnURI
parseJSON :: Value -> Parser TurnURI
$cparseJSONList :: Value -> Parser [TurnURI]
parseJSONList :: Value -> Parser [TurnURI]
A.FromJSON, Typeable TurnURI
Typeable TurnURI =>
(Proxy TurnURI -> Declare (Definitions Schema) NamedSchema)
-> ToSchema TurnURI
Proxy TurnURI -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy TurnURI -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy TurnURI -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema TurnURI)

instance ToSchema TurnURI where
  schema :: ValueSchema NamedSwaggerDoc TurnURI
schema =
    (OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text) -> (TurnURI -> ByteString) -> TurnURI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (TurnURI -> ByteString) -> TurnURI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurnURI -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString)
      (TurnURI -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text TurnURI
-> ValueSchema NamedSwaggerDoc TurnURI
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (Text -> Either String TurnURI)
-> SchemaP NamedSwaggerDoc Value Value Text TurnURI
forall a.
Text
-> (Text -> Either String a)
-> SchemaP NamedSwaggerDoc Value Value Text a
parsedText Text
"TurnURI" Text -> Either String TurnURI
parseTurnURI

turnURI :: Scheme -> TurnHost -> Port -> Maybe Transport -> TurnURI
turnURI :: Scheme -> TurnHost -> Port -> Maybe Transport -> TurnURI
turnURI = Scheme -> TurnHost -> Port -> Maybe Transport -> TurnURI
TurnURI

instance BC.ToByteString TurnURI where
  builder :: TurnURI -> Builder
builder (TurnURI Scheme
s TurnHost
h (Port Word16
p) Maybe Transport
tp) =
    Scheme -> Builder
forall a. ToByteString a => a -> Builder
BC.builder Scheme
s
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
":"
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TurnHost -> Builder
forall a. ToByteString a => a -> Builder
BC.builder TurnHost
h
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
":"
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
forall a. ToByteString a => a -> Builder
BC.builder Word16
p
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Transport -> Builder) -> Maybe Transport -> Builder
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((ByteString -> Builder
byteString ByteString
"?transport=" <>) (Builder -> Builder)
-> (Transport -> Builder) -> Transport -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transport -> Builder
forall a. ToByteString a => a -> Builder
BC.builder) Maybe Transport
tp

instance BC.FromByteString TurnURI where
  parser :: Parser TurnURI
parser = Parser Text
forall a. FromByteString a => Parser a
BC.parser Parser Text -> (Text -> Parser TurnURI) -> Parser TurnURI
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Parser TurnURI)
-> (TurnURI -> Parser TurnURI)
-> Either String TurnURI
-> Parser TurnURI
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser TurnURI
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail TurnURI -> Parser TurnURI
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String TurnURI -> Parser TurnURI)
-> (Text -> Either String TurnURI) -> Text -> Parser TurnURI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String TurnURI
parseTurnURI

parseTurnURI :: Text -> Either String TurnURI
parseTurnURI :: Text -> Either String TurnURI
parseTurnURI = Parser TurnURI -> Text -> Either String TurnURI
forall a. Parser a -> Text -> Either String a
parseOnly (Parser TurnURI
parser Parser TurnURI -> Parser Text () -> Parser TurnURI
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput)
  where
    parser :: Parser TurnURI
parser =
      Scheme -> TurnHost -> Port -> Maybe Transport -> TurnURI
TurnURI
        (Scheme -> TurnHost -> Port -> Maybe Transport -> TurnURI)
-> Parser Text Scheme
-> Parser Text (TurnHost -> Port -> Maybe Transport -> TurnURI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') Parser Text -> Parser Text Char -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
':' Parser Text -> (Text -> Parser Text Scheme) -> Parser Text Scheme
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Text Scheme
parseScheme) Parser Text Scheme -> String -> Parser Text Scheme
forall i a. Parser i a -> String -> Parser i a
<?> String
"parsingScheme")
        Parser Text (TurnHost -> Port -> Maybe Transport -> TurnURI)
-> Parser Text TurnHost
-> Parser Text (Port -> Maybe Transport -> TurnURI)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (((Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') Parser Text -> Parser Text Char -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
':' Parser Text
-> (Text -> Parser Text TurnHost) -> Parser Text TurnHost
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Text TurnHost
parseHost) Parser Text TurnHost -> String -> Parser Text TurnHost
forall i a. Parser i a -> String -> Parser i a
<?> String
"parsingHost")
        Parser Text (Port -> Maybe Transport -> TurnURI)
-> Parser Text Port -> Parser Text (Maybe Transport -> TurnURI)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text Port
forall a. Integral a => Parser a
decimal Parser Text Port -> String -> Parser Text Port
forall i a. Parser i a -> String -> Parser i a
<?> String
"parsingPort")
        Parser Text (Maybe Transport -> TurnURI)
-> Parser Text (Maybe Transport) -> Parser TurnURI
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text Transport -> Parser Text (Maybe Transport)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((Text -> Parser Text
string Text
"?transport=" Parser Text -> Parser Text -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
takeText) Parser Text
-> (Text -> Parser Text Transport) -> Parser Text Transport
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Text Transport
parseTransport) Parser Text (Maybe Transport)
-> String -> Parser Text (Maybe Transport)
forall i a. Parser i a -> String -> Parser i a
<?> String
"parsingTransport")
    parseScheme :: Text -> Parser Text Scheme
parseScheme = String -> Text -> Parser Text Scheme
forall b (m :: * -> *).
(FromByteString b, MonadFail m) =>
String -> Text -> m b
parse String
"parseScheme"
    parseHost :: Text -> Parser Text TurnHost
parseHost = String -> Text -> Parser Text TurnHost
forall b (m :: * -> *).
(FromByteString b, MonadFail m) =>
String -> Text -> m b
parse String
"parseHost"
    parseTransport :: Text -> Parser Text Transport
parseTransport = String -> Text -> Parser Text Transport
forall b (m :: * -> *).
(FromByteString b, MonadFail m) =>
String -> Text -> m b
parse String
"parseTransport"
    parse :: (BC.FromByteString b, MonadFail m) => String -> Text -> m b
    parse :: forall b (m :: * -> *).
(FromByteString b, MonadFail m) =>
String -> Text -> m b
parse String
err Text
x = case ByteString -> Maybe b
forall a. FromByteString a => ByteString -> Maybe a
BC.fromByteString (Text -> ByteString
TE.encodeUtf8 Text
x) of
      Just b
ok -> b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
ok
      Maybe b
Nothing -> String -> m b
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" failed when parsing: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
x)

instance Arbitrary TurnURI where
  arbitrary :: Gen TurnURI
arbitrary = (GenericUniform TurnURI -> TurnURI
forall a. GenericUniform a -> a
getGenericUniform (GenericUniform TurnURI -> TurnURI)
-> Gen (GenericUniform TurnURI) -> Gen TurnURI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (GenericUniform TurnURI)
forall a. Arbitrary a => Gen a
arbitrary) Gen TurnURI -> (TurnURI -> Bool) -> Gen TurnURI
forall a. Gen a -> (a -> Bool) -> Gen a
`QC.suchThat` (Bool -> Bool
not (Bool -> Bool) -> (TurnURI -> Bool) -> TurnURI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurnURI -> Bool
isIPv6)
    where
      isIPv6 :: TurnURI -> Bool
isIPv6 TurnURI
h = case TurnURI -> TurnHost
_turiHost TurnURI
h of
        TurnHostIp (IpAddr (IP.IPv6 IPv6
_)) -> Bool
True
        TurnHost
_ -> Bool
False

data Scheme
  = SchemeTurn
  | SchemeTurns
  deriving stock (Scheme -> Scheme -> Bool
(Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool) -> Eq Scheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scheme -> Scheme -> Bool
== :: Scheme -> Scheme -> Bool
$c/= :: Scheme -> Scheme -> Bool
/= :: Scheme -> Scheme -> Bool
Eq, Int -> Scheme -> ShowS
[Scheme] -> ShowS
Scheme -> String
(Int -> Scheme -> ShowS)
-> (Scheme -> String) -> ([Scheme] -> ShowS) -> Show Scheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scheme -> ShowS
showsPrec :: Int -> Scheme -> ShowS
$cshow :: Scheme -> String
show :: Scheme -> String
$cshowList :: [Scheme] -> ShowS
showList :: [Scheme] -> ShowS
Show, Eq Scheme
Eq Scheme =>
(Scheme -> Scheme -> Ordering)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Scheme)
-> (Scheme -> Scheme -> Scheme)
-> Ord Scheme
Scheme -> Scheme -> Bool
Scheme -> Scheme -> Ordering
Scheme -> Scheme -> Scheme
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 :: Scheme -> Scheme -> Ordering
compare :: Scheme -> Scheme -> Ordering
$c< :: Scheme -> Scheme -> Bool
< :: Scheme -> Scheme -> Bool
$c<= :: Scheme -> Scheme -> Bool
<= :: Scheme -> Scheme -> Bool
$c> :: Scheme -> Scheme -> Bool
> :: Scheme -> Scheme -> Bool
$c>= :: Scheme -> Scheme -> Bool
>= :: Scheme -> Scheme -> Bool
$cmax :: Scheme -> Scheme -> Scheme
max :: Scheme -> Scheme -> Scheme
$cmin :: Scheme -> Scheme -> Scheme
min :: Scheme -> Scheme -> Scheme
Ord, (forall x. Scheme -> Rep Scheme x)
-> (forall x. Rep Scheme x -> Scheme) -> Generic Scheme
forall x. Rep Scheme x -> Scheme
forall x. Scheme -> Rep Scheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Scheme -> Rep Scheme x
from :: forall x. Scheme -> Rep Scheme x
$cto :: forall x. Rep Scheme x -> Scheme
to :: forall x. Rep Scheme x -> Scheme
Generic)
  deriving (Gen Scheme
Gen Scheme -> (Scheme -> [Scheme]) -> Arbitrary Scheme
Scheme -> [Scheme]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Scheme
arbitrary :: Gen Scheme
$cshrink :: Scheme -> [Scheme]
shrink :: Scheme -> [Scheme]
Arbitrary) via (GenericUniform Scheme)
  deriving ([Scheme] -> Value
[Scheme] -> Encoding
Scheme -> Value
Scheme -> Encoding
(Scheme -> Value)
-> (Scheme -> Encoding)
-> ([Scheme] -> Value)
-> ([Scheme] -> Encoding)
-> ToJSON Scheme
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Scheme -> Value
toJSON :: Scheme -> Value
$ctoEncoding :: Scheme -> Encoding
toEncoding :: Scheme -> Encoding
$ctoJSONList :: [Scheme] -> Value
toJSONList :: [Scheme] -> Value
$ctoEncodingList :: [Scheme] -> Encoding
toEncodingList :: [Scheme] -> Encoding
A.ToJSON, Value -> Parser [Scheme]
Value -> Parser Scheme
(Value -> Parser Scheme)
-> (Value -> Parser [Scheme]) -> FromJSON Scheme
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Scheme
parseJSON :: Value -> Parser Scheme
$cparseJSONList :: Value -> Parser [Scheme]
parseJSONList :: Value -> Parser [Scheme]
A.FromJSON, Typeable Scheme
Typeable Scheme =>
(Proxy Scheme -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Scheme
Proxy Scheme -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Scheme -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Scheme -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema Scheme)

instance BC.ToByteString Scheme where
  builder :: Scheme -> Builder
builder Scheme
SchemeTurn = Builder
"turn"
  builder Scheme
SchemeTurns = Builder
"turns"

instance BC.FromByteString Scheme where
  parser :: Parser Scheme
parser =
    Parser ByteString
forall a. FromByteString a => Parser a
BC.parser Parser ByteString -> (ByteString -> Parser Scheme) -> Parser Scheme
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
t -> case (ByteString
t :: ByteString) of
      ByteString
"turn" -> Scheme -> Parser Scheme
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scheme
SchemeTurn
      ByteString
"turns" -> Scheme -> Parser Scheme
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scheme
SchemeTurns
      ByteString
_ -> String -> Parser Scheme
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Scheme) -> String -> Parser Scheme
forall a b. (a -> b) -> a -> b
$ String
"Invalid turn scheme: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
t

instance ToSchema Scheme where
  schema :: ValueSchema NamedSwaggerDoc Scheme
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"Scheme" (SchemaP [Value] Text (Alt Maybe Text) Scheme Scheme
 -> ValueSchema NamedSwaggerDoc Scheme)
-> SchemaP [Value] Text (Alt Maybe Text) Scheme Scheme
-> ValueSchema NamedSwaggerDoc Scheme
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Text (Alt Maybe Text) Scheme Scheme]
-> SchemaP [Value] Text (Alt Maybe Text) Scheme Scheme
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> Scheme -> SchemaP [Value] Text (Alt Maybe Text) Scheme Scheme
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"turn" Scheme
SchemeTurn,
          Text
-> Scheme -> SchemaP [Value] Text (Alt Maybe Text) Scheme Scheme
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"turns" Scheme
SchemeTurns
        ]

data TurnHost
  = TurnHostIp IpAddr
  | TurnHostName Text
  deriving stock (TurnHost -> TurnHost -> Bool
(TurnHost -> TurnHost -> Bool)
-> (TurnHost -> TurnHost -> Bool) -> Eq TurnHost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TurnHost -> TurnHost -> Bool
== :: TurnHost -> TurnHost -> Bool
$c/= :: TurnHost -> TurnHost -> Bool
/= :: TurnHost -> TurnHost -> Bool
Eq, Int -> TurnHost -> ShowS
[TurnHost] -> ShowS
TurnHost -> String
(Int -> TurnHost -> ShowS)
-> (TurnHost -> String) -> ([TurnHost] -> ShowS) -> Show TurnHost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TurnHost -> ShowS
showsPrec :: Int -> TurnHost -> ShowS
$cshow :: TurnHost -> String
show :: TurnHost -> String
$cshowList :: [TurnHost] -> ShowS
showList :: [TurnHost] -> ShowS
Show, Eq TurnHost
Eq TurnHost =>
(TurnHost -> TurnHost -> Ordering)
-> (TurnHost -> TurnHost -> Bool)
-> (TurnHost -> TurnHost -> Bool)
-> (TurnHost -> TurnHost -> Bool)
-> (TurnHost -> TurnHost -> Bool)
-> (TurnHost -> TurnHost -> TurnHost)
-> (TurnHost -> TurnHost -> TurnHost)
-> Ord TurnHost
TurnHost -> TurnHost -> Bool
TurnHost -> TurnHost -> Ordering
TurnHost -> TurnHost -> TurnHost
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 :: TurnHost -> TurnHost -> Ordering
compare :: TurnHost -> TurnHost -> Ordering
$c< :: TurnHost -> TurnHost -> Bool
< :: TurnHost -> TurnHost -> Bool
$c<= :: TurnHost -> TurnHost -> Bool
<= :: TurnHost -> TurnHost -> Bool
$c> :: TurnHost -> TurnHost -> Bool
> :: TurnHost -> TurnHost -> Bool
$c>= :: TurnHost -> TurnHost -> Bool
>= :: TurnHost -> TurnHost -> Bool
$cmax :: TurnHost -> TurnHost -> TurnHost
max :: TurnHost -> TurnHost -> TurnHost
$cmin :: TurnHost -> TurnHost -> TurnHost
min :: TurnHost -> TurnHost -> TurnHost
Ord, (forall x. TurnHost -> Rep TurnHost x)
-> (forall x. Rep TurnHost x -> TurnHost) -> Generic TurnHost
forall x. Rep TurnHost x -> TurnHost
forall x. TurnHost -> Rep TurnHost x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TurnHost -> Rep TurnHost x
from :: forall x. TurnHost -> Rep TurnHost x
$cto :: forall x. Rep TurnHost x -> TurnHost
to :: forall x. Rep TurnHost x -> TurnHost
Generic)
  deriving ([TurnHost] -> Value
[TurnHost] -> Encoding
TurnHost -> Value
TurnHost -> Encoding
(TurnHost -> Value)
-> (TurnHost -> Encoding)
-> ([TurnHost] -> Value)
-> ([TurnHost] -> Encoding)
-> ToJSON TurnHost
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TurnHost -> Value
toJSON :: TurnHost -> Value
$ctoEncoding :: TurnHost -> Encoding
toEncoding :: TurnHost -> Encoding
$ctoJSONList :: [TurnHost] -> Value
toJSONList :: [TurnHost] -> Value
$ctoEncodingList :: [TurnHost] -> Encoding
toEncodingList :: [TurnHost] -> Encoding
A.ToJSON, Value -> Parser [TurnHost]
Value -> Parser TurnHost
(Value -> Parser TurnHost)
-> (Value -> Parser [TurnHost]) -> FromJSON TurnHost
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser TurnHost
parseJSON :: Value -> Parser TurnHost
$cparseJSONList :: Value -> Parser [TurnHost]
parseJSONList :: Value -> Parser [TurnHost]
A.FromJSON, Typeable TurnHost
Typeable TurnHost =>
(Proxy TurnHost -> Declare (Definitions Schema) NamedSchema)
-> ToSchema TurnHost
Proxy TurnHost -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy TurnHost -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy TurnHost -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema TurnHost)

instance ToSchema TurnHost where
  schema :: ValueSchema NamedSwaggerDoc TurnHost
schema = ValueSchema NamedSwaggerDoc TurnHost
turnHostSchema

data TurnHostTag = TurnHostIpTag | TurnHostNameTag
  deriving (TurnHostTag -> TurnHostTag -> Bool
(TurnHostTag -> TurnHostTag -> Bool)
-> (TurnHostTag -> TurnHostTag -> Bool) -> Eq TurnHostTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TurnHostTag -> TurnHostTag -> Bool
== :: TurnHostTag -> TurnHostTag -> Bool
$c/= :: TurnHostTag -> TurnHostTag -> Bool
/= :: TurnHostTag -> TurnHostTag -> Bool
Eq, Int -> TurnHostTag
TurnHostTag -> Int
TurnHostTag -> [TurnHostTag]
TurnHostTag -> TurnHostTag
TurnHostTag -> TurnHostTag -> [TurnHostTag]
TurnHostTag -> TurnHostTag -> TurnHostTag -> [TurnHostTag]
(TurnHostTag -> TurnHostTag)
-> (TurnHostTag -> TurnHostTag)
-> (Int -> TurnHostTag)
-> (TurnHostTag -> Int)
-> (TurnHostTag -> [TurnHostTag])
-> (TurnHostTag -> TurnHostTag -> [TurnHostTag])
-> (TurnHostTag -> TurnHostTag -> [TurnHostTag])
-> (TurnHostTag -> TurnHostTag -> TurnHostTag -> [TurnHostTag])
-> Enum TurnHostTag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TurnHostTag -> TurnHostTag
succ :: TurnHostTag -> TurnHostTag
$cpred :: TurnHostTag -> TurnHostTag
pred :: TurnHostTag -> TurnHostTag
$ctoEnum :: Int -> TurnHostTag
toEnum :: Int -> TurnHostTag
$cfromEnum :: TurnHostTag -> Int
fromEnum :: TurnHostTag -> Int
$cenumFrom :: TurnHostTag -> [TurnHostTag]
enumFrom :: TurnHostTag -> [TurnHostTag]
$cenumFromThen :: TurnHostTag -> TurnHostTag -> [TurnHostTag]
enumFromThen :: TurnHostTag -> TurnHostTag -> [TurnHostTag]
$cenumFromTo :: TurnHostTag -> TurnHostTag -> [TurnHostTag]
enumFromTo :: TurnHostTag -> TurnHostTag -> [TurnHostTag]
$cenumFromThenTo :: TurnHostTag -> TurnHostTag -> TurnHostTag -> [TurnHostTag]
enumFromThenTo :: TurnHostTag -> TurnHostTag -> TurnHostTag -> [TurnHostTag]
Enum, TurnHostTag
TurnHostTag -> TurnHostTag -> Bounded TurnHostTag
forall a. a -> a -> Bounded a
$cminBound :: TurnHostTag
minBound :: TurnHostTag
$cmaxBound :: TurnHostTag
maxBound :: TurnHostTag
Bounded)

tagSchema :: ValueSchema NamedSwaggerDoc TurnHostTag
tagSchema :: ValueSchema NamedSwaggerDoc TurnHostTag
tagSchema =
  forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"TurnHostTag" (SchemaP [Value] Text (Alt Maybe Text) TurnHostTag TurnHostTag
 -> ValueSchema NamedSwaggerDoc TurnHostTag)
-> SchemaP [Value] Text (Alt Maybe Text) TurnHostTag TurnHostTag
-> ValueSchema NamedSwaggerDoc TurnHostTag
forall a b. (a -> b) -> a -> b
$
    [SchemaP [Value] Text (Alt Maybe Text) TurnHostTag TurnHostTag]
-> SchemaP [Value] Text (Alt Maybe Text) TurnHostTag TurnHostTag
forall a. Monoid a => [a] -> a
mconcat
      [ Text
-> TurnHostTag
-> SchemaP [Value] Text (Alt Maybe Text) TurnHostTag TurnHostTag
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"TurnHostIp" TurnHostTag
TurnHostIpTag,
        Text
-> TurnHostTag
-> SchemaP [Value] Text (Alt Maybe Text) TurnHostTag TurnHostTag
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"TurnHostName" TurnHostTag
TurnHostNameTag
      ]

turnHostSchema :: ValueSchema NamedSwaggerDoc TurnHost
turnHostSchema :: ValueSchema NamedSwaggerDoc TurnHost
turnHostSchema =
  Text
-> SchemaP SwaggerDoc Object [Pair] TurnHost TurnHost
-> ValueSchema NamedSwaggerDoc TurnHost
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"TurnHost" (SchemaP SwaggerDoc Object [Pair] TurnHost TurnHost
 -> ValueSchema NamedSwaggerDoc TurnHost)
-> SchemaP SwaggerDoc Object [Pair] TurnHost TurnHost
-> ValueSchema NamedSwaggerDoc TurnHost
forall a b. (a -> b) -> a -> b
$
    (TurnHostTag, TurnHost) -> TurnHost
fromTagged
      ((TurnHostTag, TurnHost) -> TurnHost)
-> SchemaP
     SwaggerDoc Object [Pair] TurnHost (TurnHostTag, TurnHost)
-> SchemaP SwaggerDoc Object [Pair] TurnHost TurnHost
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurnHost -> (TurnHostTag, TurnHost)
toTagged
        (TurnHost -> (TurnHostTag, TurnHost))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (TurnHostTag, TurnHost)
     (TurnHostTag, TurnHost)
-> SchemaP
     SwaggerDoc Object [Pair] TurnHost (TurnHostTag, TurnHost)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] (TurnHostTag, TurnHost) TurnHostTag
-> SchemaP
     SwaggerDoc
     (Object, TurnHostTag)
     [Pair]
     (TurnHostTag, TurnHost)
     TurnHost
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (TurnHostTag, TurnHost)
     (TurnHostTag, TurnHost)
forall d w v a b c.
(Monoid d, Monoid w) =>
SchemaP d v w a b
-> SchemaP d (v, b) w a c -> SchemaP d v w a (b, c)
bind
          ((TurnHostTag, TurnHost) -> TurnHostTag
forall a b. (a, b) -> a
fst ((TurnHostTag, TurnHost) -> TurnHostTag)
-> SchemaP SwaggerDoc Object [Pair] TurnHostTag TurnHostTag
-> SchemaP
     SwaggerDoc Object [Pair] (TurnHostTag, TurnHost) TurnHostTag
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc TurnHostTag
-> SchemaP SwaggerDoc Object [Pair] TurnHostTag TurnHostTag
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"tag" ValueSchema NamedSwaggerDoc TurnHostTag
tagSchema)
          ((TurnHostTag, TurnHost) -> TurnHost
forall a b. (a, b) -> b
snd ((TurnHostTag, TurnHost) -> TurnHost)
-> SchemaP
     SwaggerDoc (Object, TurnHostTag) [Pair] TurnHost TurnHost
-> SchemaP
     SwaggerDoc
     (Object, TurnHostTag)
     [Pair]
     (TurnHostTag, TurnHost)
     TurnHost
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Lens (Object, TurnHostTag) (Value, TurnHostTag) Object Value
-> Text
-> SchemaP SwaggerDoc (Value, TurnHostTag) Value TurnHost TurnHost
-> SchemaP
     SwaggerDoc (Object, TurnHostTag) [Pair] TurnHost TurnHost
forall doc' doc v v' a b.
HasField doc' doc =>
Lens v v' Object Value
-> Text -> SchemaP doc' v' Value a b -> SchemaP doc v [Pair] a b
fieldOver (Object -> f Value)
-> (Object, TurnHostTag) -> f (Value, TurnHostTag)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (Object, TurnHostTag) (Value, TurnHostTag) Object Value
_1 Text
"contents" SchemaP SwaggerDoc (Value, TurnHostTag) Value TurnHost TurnHost
untaggedSchema)
  where
    toTagged :: TurnHost -> (TurnHostTag, TurnHost)
    toTagged :: TurnHost -> (TurnHostTag, TurnHost)
toTagged d :: TurnHost
d@(TurnHostIp IpAddr
_) = (TurnHostTag
TurnHostIpTag, TurnHost
d)
    toTagged d :: TurnHost
d@(TurnHostName Text
_) = (TurnHostTag
TurnHostNameTag, TurnHost
d)

    fromTagged :: (TurnHostTag, TurnHost) -> TurnHost
    fromTagged :: (TurnHostTag, TurnHost) -> TurnHost
fromTagged = (TurnHostTag, TurnHost) -> TurnHost
forall a b. (a, b) -> b
snd

    untaggedSchema :: SchemaP SwaggerDoc (Value, TurnHostTag) Value TurnHost TurnHost
untaggedSchema = (TurnHostTag -> SchemaP SwaggerDoc Value Value TurnHost TurnHost)
-> SchemaP SwaggerDoc (Value, TurnHostTag) Value TurnHost TurnHost
forall t d v w a b.
(Bounded t, Enum t, Monoid d) =>
(t -> SchemaP d v w a b) -> SchemaP d (v, t) w a b
dispatch ((TurnHostTag -> SchemaP SwaggerDoc Value Value TurnHost TurnHost)
 -> SchemaP SwaggerDoc (Value, TurnHostTag) Value TurnHost TurnHost)
-> (TurnHostTag
    -> SchemaP SwaggerDoc Value Value TurnHost TurnHost)
-> SchemaP SwaggerDoc (Value, TurnHostTag) Value TurnHost TurnHost
forall a b. (a -> b) -> a -> b
$ \case
      TurnHostTag
TurnHostIpTag -> Prism TurnHost TurnHost IpAddr IpAddr
-> SchemaP SwaggerDoc Value Value IpAddr IpAddr
-> SchemaP SwaggerDoc Value Value TurnHost TurnHost
forall b b' a a' ss v m.
Prism b b' a a' -> SchemaP ss v m a a' -> SchemaP ss v m b b'
tag p IpAddr (f IpAddr) -> p TurnHost (f TurnHost)
Prism TurnHost TurnHost IpAddr IpAddr
_TurnHostIp (SchemaP NamedSwaggerDoc Value Value IpAddr IpAddr
-> SchemaP SwaggerDoc Value Value IpAddr IpAddr
forall doc doc' v m a b.
HasObject doc doc' =>
SchemaP doc' v m a b -> SchemaP doc v m a b
unnamed SchemaP NamedSwaggerDoc Value Value IpAddr IpAddr
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
      TurnHostTag
TurnHostNameTag -> Prism TurnHost TurnHost Text Text
-> SchemaP SwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Value Value TurnHost TurnHost
forall b b' a a' ss v m.
Prism b b' a a' -> SchemaP ss v m a a' -> SchemaP ss v m b b'
tag p Text (f Text) -> p TurnHost (f TurnHost)
Prism TurnHost TurnHost Text Text
_TurnHostName (SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Value Value Text Text
forall doc doc' v m a b.
HasObject doc doc' =>
SchemaP doc' v m a b -> SchemaP doc v m a b
unnamed SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

    _TurnHostIp :: Prism' TurnHost IpAddr
    _TurnHostIp :: Prism TurnHost TurnHost IpAddr IpAddr
_TurnHostIp = (IpAddr -> TurnHost)
-> (TurnHost -> Maybe IpAddr)
-> Prism TurnHost TurnHost IpAddr IpAddr
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' IpAddr -> TurnHost
TurnHostIp ((TurnHost -> Maybe IpAddr)
 -> Prism TurnHost TurnHost IpAddr IpAddr)
-> (TurnHost -> Maybe IpAddr)
-> Prism TurnHost TurnHost IpAddr IpAddr
forall a b. (a -> b) -> a -> b
$ \case
      TurnHostIp IpAddr
a -> IpAddr -> Maybe IpAddr
forall a. a -> Maybe a
Just IpAddr
a
      TurnHost
_ -> Maybe IpAddr
forall a. Maybe a
Nothing

    _TurnHostName :: Prism' TurnHost Text
    _TurnHostName :: Prism TurnHost TurnHost Text Text
_TurnHostName = (Text -> TurnHost)
-> (TurnHost -> Maybe Text) -> Prism TurnHost TurnHost Text Text
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Text -> TurnHost
TurnHostName ((TurnHost -> Maybe Text) -> Prism TurnHost TurnHost Text Text)
-> (TurnHost -> Maybe Text) -> Prism TurnHost TurnHost Text Text
forall a b. (a -> b) -> a -> b
$ \case
      TurnHostName Text
b -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
b
      TurnHost
_ -> Maybe Text
forall a. Maybe a
Nothing

instance BC.FromByteString TurnHost where
  parser :: Parser TurnHost
parser = Parser Text
forall a. FromByteString a => Parser a
BC.parser Parser Text -> (Text -> Parser TurnHost) -> Parser TurnHost
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser TurnHost
-> (TurnHost -> Parser TurnHost)
-> Maybe TurnHost
-> Parser TurnHost
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser TurnHost
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid turn host") TurnHost -> Parser TurnHost
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TurnHost -> Parser TurnHost)
-> (Text -> Maybe TurnHost) -> Text -> Parser TurnHost
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe TurnHost
parseTurnHost

instance BC.ToByteString TurnHost where
  builder :: TurnHost -> Builder
builder (TurnHostIp IpAddr
ip) = IpAddr -> Builder
forall a. ToByteString a => a -> Builder
BC.builder IpAddr
ip
  builder (TurnHostName Text
n) = Text -> Builder
forall a. ToByteString a => a -> Builder
BC.builder Text
n

instance Arbitrary TurnHost where
  arbitrary :: Gen TurnHost
arbitrary =
    [Gen TurnHost] -> Gen TurnHost
forall a. [Gen a] -> Gen a
QC.oneof
      [ IpAddr -> TurnHost
TurnHostIp (IpAddr -> TurnHost) -> Gen IpAddr -> Gen TurnHost
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen IpAddr
forall a. Arbitrary a => Gen a
arbitrary,
        Text -> TurnHost
TurnHostName (Text -> TurnHost) -> Gen Text -> Gen TurnHost
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
genHostName
      ]
    where
      -- values that should fulfill 'validHostname'
      genHostName :: Gen Text
genHostName =
        [Text] -> Gen Text
forall a. [a] -> Gen a
QC.elements
          [ Text
"host.name",
            Text
"a-c",
            Text
"123",
            Text
"007.com",
            Text
"xn--mgbh0fb.xn--kgbechtv"
          ]

parseTurnHost :: Text -> Maybe TurnHost
parseTurnHost :: Text -> Maybe TurnHost
parseTurnHost Text
h = case ByteString -> Maybe IpAddr
forall a. FromByteString a => ByteString -> Maybe a
BC.fromByteString ByteString
host of
  Just ip :: IpAddr
ip@(IpAddr IP
_) -> TurnHost -> Maybe TurnHost
forall a. a -> Maybe a
Just (TurnHost -> Maybe TurnHost) -> TurnHost -> Maybe TurnHost
forall a b. (a -> b) -> a -> b
$ IpAddr -> TurnHost
TurnHostIp IpAddr
ip
  Maybe IpAddr
Nothing | ByteString -> Bool
validHostname ByteString
host -> TurnHost -> Maybe TurnHost
forall a. a -> Maybe a
Just (TurnHost -> Maybe TurnHost) -> TurnHost -> Maybe TurnHost
forall a b. (a -> b) -> a -> b
$ Text -> TurnHost
TurnHostName Text
h -- NOTE: IP addresses are also valid hostnames
  Maybe IpAddr
_ -> Maybe TurnHost
forall a. Maybe a
Nothing
  where
    host :: ByteString
host = Text -> ByteString
TE.encodeUtf8 Text
h

data Transport
  = TransportUDP
  | TransportTCP
  deriving stock (Transport -> Transport -> Bool
(Transport -> Transport -> Bool)
-> (Transport -> Transport -> Bool) -> Eq Transport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Transport -> Transport -> Bool
== :: Transport -> Transport -> Bool
$c/= :: Transport -> Transport -> Bool
/= :: Transport -> Transport -> Bool
Eq, Int -> Transport -> ShowS
[Transport] -> ShowS
Transport -> String
(Int -> Transport -> ShowS)
-> (Transport -> String)
-> ([Transport] -> ShowS)
-> Show Transport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Transport -> ShowS
showsPrec :: Int -> Transport -> ShowS
$cshow :: Transport -> String
show :: Transport -> String
$cshowList :: [Transport] -> ShowS
showList :: [Transport] -> ShowS
Show, Eq Transport
Eq Transport =>
(Transport -> Transport -> Ordering)
-> (Transport -> Transport -> Bool)
-> (Transport -> Transport -> Bool)
-> (Transport -> Transport -> Bool)
-> (Transport -> Transport -> Bool)
-> (Transport -> Transport -> Transport)
-> (Transport -> Transport -> Transport)
-> Ord Transport
Transport -> Transport -> Bool
Transport -> Transport -> Ordering
Transport -> Transport -> Transport
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 :: Transport -> Transport -> Ordering
compare :: Transport -> Transport -> Ordering
$c< :: Transport -> Transport -> Bool
< :: Transport -> Transport -> Bool
$c<= :: Transport -> Transport -> Bool
<= :: Transport -> Transport -> Bool
$c> :: Transport -> Transport -> Bool
> :: Transport -> Transport -> Bool
$c>= :: Transport -> Transport -> Bool
>= :: Transport -> Transport -> Bool
$cmax :: Transport -> Transport -> Transport
max :: Transport -> Transport -> Transport
$cmin :: Transport -> Transport -> Transport
min :: Transport -> Transport -> Transport
Ord, (forall x. Transport -> Rep Transport x)
-> (forall x. Rep Transport x -> Transport) -> Generic Transport
forall x. Rep Transport x -> Transport
forall x. Transport -> Rep Transport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Transport -> Rep Transport x
from :: forall x. Transport -> Rep Transport x
$cto :: forall x. Rep Transport x -> Transport
to :: forall x. Rep Transport x -> Transport
Generic)
  deriving (Gen Transport
Gen Transport -> (Transport -> [Transport]) -> Arbitrary Transport
Transport -> [Transport]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Transport
arbitrary :: Gen Transport
$cshrink :: Transport -> [Transport]
shrink :: Transport -> [Transport]
Arbitrary) via (GenericUniform Transport)
  deriving ([Transport] -> Value
[Transport] -> Encoding
Transport -> Value
Transport -> Encoding
(Transport -> Value)
-> (Transport -> Encoding)
-> ([Transport] -> Value)
-> ([Transport] -> Encoding)
-> ToJSON Transport
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Transport -> Value
toJSON :: Transport -> Value
$ctoEncoding :: Transport -> Encoding
toEncoding :: Transport -> Encoding
$ctoJSONList :: [Transport] -> Value
toJSONList :: [Transport] -> Value
$ctoEncodingList :: [Transport] -> Encoding
toEncodingList :: [Transport] -> Encoding
A.ToJSON, Value -> Parser [Transport]
Value -> Parser Transport
(Value -> Parser Transport)
-> (Value -> Parser [Transport]) -> FromJSON Transport
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Transport
parseJSON :: Value -> Parser Transport
$cparseJSONList :: Value -> Parser [Transport]
parseJSONList :: Value -> Parser [Transport]
A.FromJSON, Typeable Transport
Typeable Transport =>
(Proxy Transport -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Transport
Proxy Transport -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Transport -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Transport -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema Transport)

instance BC.ToByteString Transport where
  builder :: Transport -> Builder
builder Transport
TransportUDP = Builder
"udp"
  builder Transport
TransportTCP = Builder
"tcp"

instance BC.FromByteString Transport where
  parser :: Parser Transport
parser =
    Parser ByteString
forall a. FromByteString a => Parser a
BC.parser Parser ByteString
-> (ByteString -> Parser Transport) -> Parser Transport
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
t -> case (ByteString
t :: ByteString) of
      ByteString
"udp" -> Transport -> Parser Transport
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Transport
TransportUDP
      ByteString
"tcp" -> Transport -> Parser Transport
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Transport
TransportTCP
      ByteString
_ -> String -> Parser Transport
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Transport) -> String -> Parser Transport
forall a b. (a -> b) -> a -> b
$ String
"Invalid turn transport: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
t

instance ToSchema Transport where
  schema :: ValueSchema NamedSwaggerDoc Transport
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"Transport" (SchemaP [Value] Text (Alt Maybe Text) Transport Transport
 -> ValueSchema NamedSwaggerDoc Transport)
-> SchemaP [Value] Text (Alt Maybe Text) Transport Transport
-> ValueSchema NamedSwaggerDoc Transport
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Text (Alt Maybe Text) Transport Transport]
-> SchemaP [Value] Text (Alt Maybe Text) Transport Transport
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> Transport
-> SchemaP [Value] Text (Alt Maybe Text) Transport Transport
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"udp" Transport
TransportUDP,
          Text
-> Transport
-> SchemaP [Value] Text (Alt Maybe Text) Transport Transport
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"tcp" Transport
TransportTCP
        ]

--------------------------------------------------------------------------------
-- SFTUsername

data SFTUsername = SFTUsername
  { -- | must be positive, integral number of seconds
    SFTUsername -> POSIXTime
_suExpiresAt :: POSIXTime,
    SFTUsername -> Word
_suVersion :: Word,
    -- | seems to large, but uint32_t is used in C
    SFTUsername -> Word32
_suKeyindex :: Word32,
    -- | whether the user is allowed to initialise an SFT conference
    SFTUsername -> Bool
_suShared :: Bool,
    -- | [a-z0-9]+
    SFTUsername -> Text
_suRandom :: Text
  }
  deriving stock (SFTUsername -> SFTUsername -> Bool
(SFTUsername -> SFTUsername -> Bool)
-> (SFTUsername -> SFTUsername -> Bool) -> Eq SFTUsername
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SFTUsername -> SFTUsername -> Bool
== :: SFTUsername -> SFTUsername -> Bool
$c/= :: SFTUsername -> SFTUsername -> Bool
/= :: SFTUsername -> SFTUsername -> Bool
Eq, Eq SFTUsername
Eq SFTUsername =>
(SFTUsername -> SFTUsername -> Ordering)
-> (SFTUsername -> SFTUsername -> Bool)
-> (SFTUsername -> SFTUsername -> Bool)
-> (SFTUsername -> SFTUsername -> Bool)
-> (SFTUsername -> SFTUsername -> Bool)
-> (SFTUsername -> SFTUsername -> SFTUsername)
-> (SFTUsername -> SFTUsername -> SFTUsername)
-> Ord SFTUsername
SFTUsername -> SFTUsername -> Bool
SFTUsername -> SFTUsername -> Ordering
SFTUsername -> SFTUsername -> SFTUsername
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 :: SFTUsername -> SFTUsername -> Ordering
compare :: SFTUsername -> SFTUsername -> Ordering
$c< :: SFTUsername -> SFTUsername -> Bool
< :: SFTUsername -> SFTUsername -> Bool
$c<= :: SFTUsername -> SFTUsername -> Bool
<= :: SFTUsername -> SFTUsername -> Bool
$c> :: SFTUsername -> SFTUsername -> Bool
> :: SFTUsername -> SFTUsername -> Bool
$c>= :: SFTUsername -> SFTUsername -> Bool
>= :: SFTUsername -> SFTUsername -> Bool
$cmax :: SFTUsername -> SFTUsername -> SFTUsername
max :: SFTUsername -> SFTUsername -> SFTUsername
$cmin :: SFTUsername -> SFTUsername -> SFTUsername
min :: SFTUsername -> SFTUsername -> SFTUsername
Ord, Int -> SFTUsername -> ShowS
[SFTUsername] -> ShowS
SFTUsername -> String
(Int -> SFTUsername -> ShowS)
-> (SFTUsername -> String)
-> ([SFTUsername] -> ShowS)
-> Show SFTUsername
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SFTUsername -> ShowS
showsPrec :: Int -> SFTUsername -> ShowS
$cshow :: SFTUsername -> String
show :: SFTUsername -> String
$cshowList :: [SFTUsername] -> ShowS
showList :: [SFTUsername] -> ShowS
Show, (forall x. SFTUsername -> Rep SFTUsername x)
-> (forall x. Rep SFTUsername x -> SFTUsername)
-> Generic SFTUsername
forall x. Rep SFTUsername x -> SFTUsername
forall x. SFTUsername -> Rep SFTUsername x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SFTUsername -> Rep SFTUsername x
from :: forall x. SFTUsername -> Rep SFTUsername x
$cto :: forall x. Rep SFTUsername x -> SFTUsername
to :: forall x. Rep SFTUsername x -> SFTUsername
Generic)
  deriving ([SFTUsername] -> Value
[SFTUsername] -> Encoding
SFTUsername -> Value
SFTUsername -> Encoding
(SFTUsername -> Value)
-> (SFTUsername -> Encoding)
-> ([SFTUsername] -> Value)
-> ([SFTUsername] -> Encoding)
-> ToJSON SFTUsername
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SFTUsername -> Value
toJSON :: SFTUsername -> Value
$ctoEncoding :: SFTUsername -> Encoding
toEncoding :: SFTUsername -> Encoding
$ctoJSONList :: [SFTUsername] -> Value
toJSONList :: [SFTUsername] -> Value
$ctoEncodingList :: [SFTUsername] -> Encoding
toEncodingList :: [SFTUsername] -> Encoding
A.ToJSON, Value -> Parser [SFTUsername]
Value -> Parser SFTUsername
(Value -> Parser SFTUsername)
-> (Value -> Parser [SFTUsername]) -> FromJSON SFTUsername
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SFTUsername
parseJSON :: Value -> Parser SFTUsername
$cparseJSONList :: Value -> Parser [SFTUsername]
parseJSONList :: Value -> Parser [SFTUsername]
A.FromJSON, Typeable SFTUsername
Typeable SFTUsername =>
(Proxy SFTUsername -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SFTUsername
Proxy SFTUsername -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy SFTUsername -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy SFTUsername -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema SFTUsername)

-- note that the random value is not checked for well-formedness
mkSFTUsername :: Bool -> POSIXTime -> Text -> SFTUsername
mkSFTUsername :: Bool -> POSIXTime -> Text -> SFTUsername
mkSFTUsername Bool
shared POSIXTime
expires Text
rnd =
  SFTUsername
    { $sel:_suExpiresAt:SFTUsername :: POSIXTime
_suExpiresAt = POSIXTime
expires,
      $sel:_suVersion:SFTUsername :: Word
_suVersion = Word
1,
      $sel:_suKeyindex:SFTUsername :: Word32
_suKeyindex = Word32
0,
      $sel:_suShared:SFTUsername :: Bool
_suShared = Bool
shared,
      $sel:_suRandom:SFTUsername :: Text
_suRandom = Text
rnd
    }

instance ToSchema SFTUsername where
  schema :: SchemaP NamedSwaggerDoc Value Value SFTUsername SFTUsername
schema = SFTUsername -> Text
toText (SFTUsername -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text SFTUsername
-> SchemaP NamedSwaggerDoc Value Value SFTUsername SFTUsername
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (Text -> Either String SFTUsername)
-> SchemaP NamedSwaggerDoc Value Value Text SFTUsername
forall a.
Text
-> (Text -> Either String a)
-> SchemaP NamedSwaggerDoc Value Value Text a
parsedText Text
"" Text -> Either String SFTUsername
fromText
    where
      fromText :: Text -> Either String SFTUsername
      fromText :: Text -> Either String SFTUsername
fromText = Parser SFTUsername -> Text -> Either String SFTUsername
forall a. Parser a -> Text -> Either String a
parseOnly (Parser SFTUsername
parseSFTUsername Parser SFTUsername -> Parser Text () -> Parser SFTUsername
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput)

      toText :: SFTUsername -> Text
      toText :: SFTUsername -> Text
toText = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text)
-> (SFTUsername -> ByteString) -> SFTUsername -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (SFTUsername -> ByteString) -> SFTUsername -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SFTUsername -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString

instance BC.ToByteString SFTUsername where
  builder :: SFTUsername -> Builder
builder SFTUsername
su =
    ShortByteString -> Builder
shortByteString ShortByteString
"d="
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
word64Dec (POSIXTime -> Word64
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (SFTUsername -> POSIXTime
_suExpiresAt SFTUsername
su))
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
shortByteString ShortByteString
".v="
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word -> Builder
wordDec (SFTUsername -> Word
_suVersion SFTUsername
su)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
shortByteString ShortByteString
".k="
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
word32Dec (SFTUsername -> Word32
_suKeyindex SFTUsername
su)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
shortByteString ShortByteString
".s="
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word -> Builder
wordDec (Bool -> Word
forall a. Num a => Bool -> a
boolToWord (Bool -> Word) -> Bool -> Word
forall a b. (a -> b) -> a -> b
$ SFTUsername -> Bool
_suShared SFTUsername
su)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
shortByteString ShortByteString
".r="
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString (Getting ByteString Text ByteString -> Text -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (AReview ByteString Text -> Getter Text ByteString
forall t b. AReview t b -> Getter b t
re AReview ByteString Text
Prism' ByteString Text
utf8) (SFTUsername -> Text
_suRandom SFTUsername
su))
    where
      boolToWord :: (Num a) => Bool -> a
      boolToWord :: forall a. Num a => Bool -> a
boolToWord Bool
False = a
0
      boolToWord Bool
True = a
1

parseSFTUsername :: Text.Parser SFTUsername
parseSFTUsername :: Parser SFTUsername
parseSFTUsername =
  POSIXTime -> Word -> Word32 -> Bool -> Text -> SFTUsername
SFTUsername
    (POSIXTime -> Word -> Word32 -> Bool -> Text -> SFTUsername)
-> Parser Text POSIXTime
-> Parser Text (Word -> Word32 -> Bool -> Text -> SFTUsername)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
string Text
"d=" Parser Text -> Parser Text POSIXTime -> Parser Text POSIXTime
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word64 -> POSIXTime)
-> Parser Text Word64 -> Parser Text POSIXTime
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> POSIXTime) Parser Text Word64
forall a. Integral a => Parser a
decimal)
    Parser Text (Word -> Word32 -> Bool -> Text -> SFTUsername)
-> Parser Text Word
-> Parser Text (Word32 -> Bool -> Text -> SFTUsername)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
string Text
".v=" Parser Text -> Parser Text Word -> Parser Text Word
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Word
forall a. Integral a => Parser a
decimal)
    Parser Text (Word32 -> Bool -> Text -> SFTUsername)
-> Parser Text Word32 -> Parser Text (Bool -> Text -> SFTUsername)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
string Text
".k=" Parser Text -> Parser Text Word32 -> Parser Text Word32
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Word32
forall a. Integral a => Parser a
decimal)
    Parser Text (Bool -> Text -> SFTUsername)
-> Parser Text Bool -> Parser Text (Text -> SFTUsername)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
string Text
".s=" Parser Text -> Parser Text Bool -> Parser Text Bool
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word -> Bool
wordToBool (Word -> Bool) -> Parser Text Word -> Parser Text Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Word
forall a. Integral a => Parser a
decimal))
    Parser Text (Text -> SFTUsername)
-> Parser Text -> Parser SFTUsername
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
string Text
".r=" Parser Text -> Parser Text -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text
takeWhile1 (String -> Char -> Bool
inClass String
"a-z0-9"))
  where
    wordToBool :: Word -> Bool
    wordToBool :: Word -> Bool
wordToBool = Word -> Bool
forall a. Integral a => a -> Bool
odd

instance Arbitrary SFTUsername where
  arbitrary :: Gen SFTUsername
arbitrary =
    POSIXTime -> Word -> Word32 -> Bool -> Text -> SFTUsername
SFTUsername
      (POSIXTime -> Word -> Word32 -> Bool -> Text -> SFTUsername)
-> Gen POSIXTime
-> Gen (Word -> Word32 -> Bool -> Text -> SFTUsername)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> POSIXTime) -> Gen Word64 -> Gen POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @Word64)
      Gen (Word -> Word32 -> Bool -> Text -> SFTUsername)
-> Gen Word -> Gen (Word32 -> Bool -> Text -> SFTUsername)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Word32 -> Bool -> Text -> SFTUsername)
-> Gen Word32 -> Gen (Bool -> Text -> SFTUsername)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Bool -> Text -> SFTUsername)
-> Gen Bool -> Gen (Text -> SFTUsername)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Text -> SFTUsername) -> Gen Text -> Gen SFTUsername
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Text
Text.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
QC.listOf1 Gen Char
genAlphaNum)
    where
      genAlphaNum :: Gen Char
genAlphaNum = String -> Gen Char
forall a. [a] -> Gen a
QC.elements (String -> Gen Char) -> String -> Gen Char
forall a b. (a -> b) -> a -> b
$ [Char
'a' .. Char
'z'] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'0' .. Char
'9']

--------------------------------------------------------------------------------
-- TurnUsername

data TurnUsername = TurnUsername
  { -- | must be positive, integral number of seconds
    TurnUsername -> POSIXTime
_tuExpiresAt :: POSIXTime,
    TurnUsername -> Word
_tuVersion :: Word,
    -- | seems to large, but uint32_t is used in C
    TurnUsername -> Word32
_tuKeyindex :: Word32,
    -- | undocumented, always 's'
    TurnUsername -> Char
_tuT :: Char,
    -- | [a-z0-9]+
    TurnUsername -> Text
_tuRandom :: Text
  }
  deriving stock (TurnUsername -> TurnUsername -> Bool
(TurnUsername -> TurnUsername -> Bool)
-> (TurnUsername -> TurnUsername -> Bool) -> Eq TurnUsername
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TurnUsername -> TurnUsername -> Bool
== :: TurnUsername -> TurnUsername -> Bool
$c/= :: TurnUsername -> TurnUsername -> Bool
/= :: TurnUsername -> TurnUsername -> Bool
Eq, Int -> TurnUsername -> ShowS
[TurnUsername] -> ShowS
TurnUsername -> String
(Int -> TurnUsername -> ShowS)
-> (TurnUsername -> String)
-> ([TurnUsername] -> ShowS)
-> Show TurnUsername
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TurnUsername -> ShowS
showsPrec :: Int -> TurnUsername -> ShowS
$cshow :: TurnUsername -> String
show :: TurnUsername -> String
$cshowList :: [TurnUsername] -> ShowS
showList :: [TurnUsername] -> ShowS
Show, (forall x. TurnUsername -> Rep TurnUsername x)
-> (forall x. Rep TurnUsername x -> TurnUsername)
-> Generic TurnUsername
forall x. Rep TurnUsername x -> TurnUsername
forall x. TurnUsername -> Rep TurnUsername x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TurnUsername -> Rep TurnUsername x
from :: forall x. TurnUsername -> Rep TurnUsername x
$cto :: forall x. Rep TurnUsername x -> TurnUsername
to :: forall x. Rep TurnUsername x -> TurnUsername
Generic)
  deriving ([TurnUsername] -> Value
[TurnUsername] -> Encoding
TurnUsername -> Value
TurnUsername -> Encoding
(TurnUsername -> Value)
-> (TurnUsername -> Encoding)
-> ([TurnUsername] -> Value)
-> ([TurnUsername] -> Encoding)
-> ToJSON TurnUsername
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TurnUsername -> Value
toJSON :: TurnUsername -> Value
$ctoEncoding :: TurnUsername -> Encoding
toEncoding :: TurnUsername -> Encoding
$ctoJSONList :: [TurnUsername] -> Value
toJSONList :: [TurnUsername] -> Value
$ctoEncodingList :: [TurnUsername] -> Encoding
toEncodingList :: [TurnUsername] -> Encoding
A.ToJSON, Value -> Parser [TurnUsername]
Value -> Parser TurnUsername
(Value -> Parser TurnUsername)
-> (Value -> Parser [TurnUsername]) -> FromJSON TurnUsername
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser TurnUsername
parseJSON :: Value -> Parser TurnUsername
$cparseJSONList :: Value -> Parser [TurnUsername]
parseJSONList :: Value -> Parser [TurnUsername]
A.FromJSON, Typeable TurnUsername
Typeable TurnUsername =>
(Proxy TurnUsername -> Declare (Definitions Schema) NamedSchema)
-> ToSchema TurnUsername
Proxy TurnUsername -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy TurnUsername -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy TurnUsername -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema TurnUsername)

-- note that the random value is not checked for well-formedness
turnUsername :: POSIXTime -> Text -> TurnUsername
turnUsername :: POSIXTime -> Text -> TurnUsername
turnUsername POSIXTime
expires Text
rnd =
  TurnUsername
    { $sel:_tuExpiresAt:TurnUsername :: POSIXTime
_tuExpiresAt = POSIXTime
expires,
      $sel:_tuVersion:TurnUsername :: Word
_tuVersion = Word
1,
      $sel:_tuKeyindex:TurnUsername :: Word32
_tuKeyindex = Word32
0,
      $sel:_tuT:TurnUsername :: Char
_tuT = Char
's',
      $sel:_tuRandom:TurnUsername :: Text
_tuRandom = Text
rnd
    }

instance ToSchema TurnUsername where
  schema :: SchemaP NamedSwaggerDoc Value Value TurnUsername TurnUsername
schema = TurnUsername -> Text
toText (TurnUsername -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text TurnUsername
-> SchemaP NamedSwaggerDoc Value Value TurnUsername TurnUsername
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (Text -> Either String TurnUsername)
-> SchemaP NamedSwaggerDoc Value Value Text TurnUsername
forall a.
Text
-> (Text -> Either String a)
-> SchemaP NamedSwaggerDoc Value Value Text a
parsedText Text
"" Text -> Either String TurnUsername
fromText
    where
      fromText :: Text -> Either String TurnUsername
      fromText :: Text -> Either String TurnUsername
fromText = Parser TurnUsername -> Text -> Either String TurnUsername
forall a. Parser a -> Text -> Either String a
parseOnly (Parser TurnUsername
parseTurnUsername Parser TurnUsername -> Parser Text () -> Parser TurnUsername
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput)

      toText :: TurnUsername -> Text
      toText :: TurnUsername -> Text
toText = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text)
-> (TurnUsername -> ByteString) -> TurnUsername -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (TurnUsername -> ByteString) -> TurnUsername -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurnUsername -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString

instance BC.ToByteString TurnUsername where
  builder :: TurnUsername -> Builder
builder TurnUsername
tu =
    ShortByteString -> Builder
shortByteString ShortByteString
"d="
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
word64Dec (POSIXTime -> Word64
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (TurnUsername -> POSIXTime
_tuExpiresAt TurnUsername
tu))
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
shortByteString ShortByteString
".v="
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word -> Builder
wordDec (TurnUsername -> Word
_tuVersion TurnUsername
tu)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
shortByteString ShortByteString
".k="
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
word32Dec (TurnUsername -> Word32
_tuKeyindex TurnUsername
tu)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
shortByteString ShortByteString
".t="
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
charUtf8 (TurnUsername -> Char
_tuT TurnUsername
tu)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
shortByteString ShortByteString
".r="
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString (Getting ByteString Text ByteString -> Text -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (AReview ByteString Text -> Getter Text ByteString
forall t b. AReview t b -> Getter b t
re AReview ByteString Text
Prism' ByteString Text
utf8) (TurnUsername -> Text
_tuRandom TurnUsername
tu))

parseTurnUsername :: Text.Parser TurnUsername
parseTurnUsername :: Parser TurnUsername
parseTurnUsername =
  POSIXTime -> Word -> Word32 -> Char -> Text -> TurnUsername
TurnUsername
    (POSIXTime -> Word -> Word32 -> Char -> Text -> TurnUsername)
-> Parser Text POSIXTime
-> Parser Text (Word -> Word32 -> Char -> Text -> TurnUsername)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
string Text
"d=" Parser Text -> Parser Text POSIXTime -> Parser Text POSIXTime
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word64 -> POSIXTime)
-> Parser Text Word64 -> Parser Text POSIXTime
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> POSIXTime) Parser Text Word64
forall a. Integral a => Parser a
decimal)
    Parser Text (Word -> Word32 -> Char -> Text -> TurnUsername)
-> Parser Text Word
-> Parser Text (Word32 -> Char -> Text -> TurnUsername)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
string Text
".v=" Parser Text -> Parser Text Word -> Parser Text Word
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Word
forall a. Integral a => Parser a
decimal)
    Parser Text (Word32 -> Char -> Text -> TurnUsername)
-> Parser Text Word32 -> Parser Text (Char -> Text -> TurnUsername)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
string Text
".k=" Parser Text -> Parser Text Word32 -> Parser Text Word32
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Word32
forall a. Integral a => Parser a
decimal)
    Parser Text (Char -> Text -> TurnUsername)
-> Parser Text Char -> Parser Text (Text -> TurnUsername)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
string Text
".t=" Parser Text -> Parser Text Char -> Parser Text Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char
anyChar)
    Parser Text (Text -> TurnUsername)
-> Parser Text -> Parser TurnUsername
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
string Text
".r=" Parser Text -> Parser Text -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text
takeWhile1 (String -> Char -> Bool
inClass String
"a-z0-9"))

instance Arbitrary TurnUsername where
  arbitrary :: Gen TurnUsername
arbitrary =
    POSIXTime -> Word -> Word32 -> Char -> Text -> TurnUsername
TurnUsername
      (POSIXTime -> Word -> Word32 -> Char -> Text -> TurnUsername)
-> Gen POSIXTime
-> Gen (Word -> Word32 -> Char -> Text -> TurnUsername)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> POSIXTime) -> Gen Word64 -> Gen POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @Word64)
      Gen (Word -> Word32 -> Char -> Text -> TurnUsername)
-> Gen Word -> Gen (Word32 -> Char -> Text -> TurnUsername)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Word32 -> Char -> Text -> TurnUsername)
-> Gen Word32 -> Gen (Char -> Text -> TurnUsername)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Char -> Text -> TurnUsername)
-> Gen Char -> Gen (Text -> TurnUsername)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Char
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Text -> TurnUsername) -> Gen Text -> Gen TurnUsername
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Text
Text.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
QC.listOf1 Gen Char
genAlphaNum)
    where
      genAlphaNum :: Gen Char
genAlphaNum = String -> Gen Char
forall a. [a] -> Gen a
QC.elements (String -> Gen Char) -> String -> Gen Char
forall a b. (a -> b) -> a -> b
$ [Char
'a' .. Char
'z'] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'0' .. Char
'9']

--------------------------------------------------------------------------------
-- convenience

-- | given a list of URIs and a size, limit URIs
-- with order priority from highest to lowest: UDP -> TLS -> TCP
-- i.e. (if enough servers of each type are available)
--   1 -> 1x UDP
--   2 -> 1x UDP, 1x TLS
--   3 -> 1x UDP, 1x TLS, 1x TCP
--   4 -> 2x UDP, 1x TLS, 1x TCP
--   5 -> 2x UDP, 2x TLS, 1x TCP
--    ... etc
-- if not enough servers are available, prefer udp, then tls
limitServers :: [TurnURI] -> Int -> [TurnURI]
limitServers :: [TurnURI] -> Int -> [TurnURI]
limitServers [TurnURI]
uris Int
limit = [TurnURI] -> Int -> [TurnURI] -> [TurnURI]
limitServers' [] Int
limit [TurnURI]
uris
  where
    limitServers' :: [TurnURI] -> Int -> [TurnURI] -> [TurnURI]
limitServers' [TurnURI]
acc Int
x [TurnURI]
_ | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [TurnURI]
acc -- Already have accumulated enough
    limitServers' [TurnURI]
acc Int
_ [] = [TurnURI]
acc -- No more input
    limitServers' [TurnURI]
acc Int
_ [TurnURI]
input = do
      let ([TurnURI]
udps, [TurnURI]
noUdps) = (TurnURI -> Bool) -> [TurnURI] -> ([TurnURI], [TurnURI])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition TurnURI -> Bool
isUdp [TurnURI]
input
          ([TurnURI]
udp, [TurnURI]
forTls) = (Int -> [TurnURI] -> [TurnURI]
forall a. Int -> [a] -> [a]
Imports.take Int
1 [TurnURI]
udps, [TurnURI]
noUdps [TurnURI] -> [TurnURI] -> [TurnURI]
forall a. [a] -> [a] -> [a]
++ Int -> [TurnURI] -> [TurnURI]
forall a. Int -> [a] -> [a]
drop Int
1 [TurnURI]
udps)
          ([TurnURI]
tlss, [TurnURI]
noTlss) = (TurnURI -> Bool) -> [TurnURI] -> ([TurnURI], [TurnURI])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition TurnURI -> Bool
isTls [TurnURI]
forTls
          ([TurnURI]
tls, [TurnURI]
forTcp) = (Int -> [TurnURI] -> [TurnURI]
forall a. Int -> [a] -> [a]
Imports.take Int
1 [TurnURI]
tlss, [TurnURI]
noTlss [TurnURI] -> [TurnURI] -> [TurnURI]
forall a. [a] -> [a] -> [a]
++ Int -> [TurnURI] -> [TurnURI]
forall a. Int -> [a] -> [a]
drop Int
1 [TurnURI]
tlss)
          ([TurnURI]
tcps, [TurnURI]
noTcps) = (TurnURI -> Bool) -> [TurnURI] -> ([TurnURI], [TurnURI])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition TurnURI -> Bool
isTcp [TurnURI]
forTcp
          ([TurnURI]
tcp, [TurnURI]
rest) = (Int -> [TurnURI] -> [TurnURI]
forall a. Int -> [a] -> [a]
Imports.take Int
1 [TurnURI]
tcps, [TurnURI]
noTcps [TurnURI] -> [TurnURI] -> [TurnURI]
forall a. [a] -> [a] -> [a]
++ Int -> [TurnURI] -> [TurnURI]
forall a. Int -> [a] -> [a]
drop Int
1 [TurnURI]
tcps)
          new :: [TurnURI]
new = [TurnURI]
udp [TurnURI] -> [TurnURI] -> [TurnURI]
forall a. [a] -> [a] -> [a]
++ [TurnURI]
tls [TurnURI] -> [TurnURI] -> [TurnURI]
forall a. [a] -> [a] -> [a]
++ [TurnURI]
tcp
          newAcc :: [TurnURI]
newAcc = Int -> [TurnURI] -> [TurnURI]
forall a. Int -> [a] -> [a]
Imports.take Int
limit ([TurnURI] -> [TurnURI]) -> [TurnURI] -> [TurnURI]
forall a b. (a -> b) -> a -> b
$ [TurnURI]
acc [TurnURI] -> [TurnURI] -> [TurnURI]
forall a. [a] -> [a] -> [a]
++ [TurnURI]
new
      if [TurnURI] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TurnURI]
new -- Did we find anything interesting? If not, time to go
        then Int -> [TurnURI] -> [TurnURI]
forall a. Int -> [a] -> [a]
Imports.take Int
limit ([TurnURI] -> [TurnURI]) -> [TurnURI] -> [TurnURI]
forall a b. (a -> b) -> a -> b
$ [TurnURI]
acc [TurnURI] -> [TurnURI] -> [TurnURI]
forall a. [a] -> [a] -> [a]
++ [TurnURI]
rest
        else [TurnURI] -> Int -> [TurnURI] -> [TurnURI]
limitServers' [TurnURI]
newAcc (Int
limit Int -> Int -> Int
forall a. Num a => a -> a -> a
- [TurnURI] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TurnURI]
newAcc) [TurnURI]
rest

isUdp :: TurnURI -> Bool
isUdp :: TurnURI -> Bool
isUdp TurnURI
uri =
  TurnURI -> Scheme
_turiScheme TurnURI
uri Scheme -> Scheme -> Bool
forall a. Eq a => a -> a -> Bool
== Scheme
SchemeTurn
    Bool -> Bool -> Bool
&& ( TurnURI -> Maybe Transport
_turiTransport TurnURI
uri Maybe Transport -> Maybe Transport -> Bool
forall a. Eq a => a -> a -> Bool
== Transport -> Maybe Transport
forall a. a -> Maybe a
Just Transport
TransportUDP
           Bool -> Bool -> Bool
|| Maybe Transport -> Bool
forall a. Maybe a -> Bool
isNothing (TurnURI -> Maybe Transport
_turiTransport TurnURI
uri)
       )

isTcp :: TurnURI -> Bool
isTcp :: TurnURI -> Bool
isTcp TurnURI
uri =
  TurnURI -> Scheme
_turiScheme TurnURI
uri Scheme -> Scheme -> Bool
forall a. Eq a => a -> a -> Bool
== Scheme
SchemeTurn
    Bool -> Bool -> Bool
&& TurnURI -> Maybe Transport
_turiTransport TurnURI
uri Maybe Transport -> Maybe Transport -> Bool
forall a. Eq a => a -> a -> Bool
== Transport -> Maybe Transport
forall a. a -> Maybe a
Just Transport
TransportTCP

isTls :: TurnURI -> Bool
isTls :: TurnURI -> Bool
isTls TurnURI
uri =
  TurnURI -> Scheme
_turiScheme TurnURI
uri Scheme -> Scheme -> Bool
forall a. Eq a => a -> a -> Bool
== Scheme
SchemeTurns
    Bool -> Bool -> Bool
&& TurnURI -> Maybe Transport
_turiTransport TurnURI
uri Maybe Transport -> Maybe Transport -> Bool
forall a. Eq a => a -> a -> Bool
== Transport -> Maybe Transport
forall a. a -> Maybe a
Just Transport
TransportTCP

makeLenses ''RTCConfiguration
makeLenses ''RTCIceServer
makeLenses ''TurnURI
makeLenses ''TurnUsername
makeLenses ''SFTServer
makeLenses ''AuthSFTServer