module Wire.API.Presence (Presence (..), URI (..), parse) where

import Control.Lens ((?~))
import Data.Aeson qualified as A
import Data.Aeson.Types qualified as A
import Data.Attoparsec.ByteString (takeByteString)
import Data.ByteString.Char8 qualified as Bytes
import Data.ByteString.Conversion
import Data.ByteString.Lazy qualified as Lazy
import Data.Id
import Data.Misc (Milliseconds)
import Data.OpenApi qualified as S
import Data.Proxy
import Data.Schema
import Data.Text qualified as Text
import Data.Text.Encoding (decodeUtf8)
import Imports
import Network.URI qualified as Net
import Servant.API (ToHttpApiData (toUrlPiece))

-- FUTUREWORK: use Network.URI and toss this newtype.  servant should have all these instances for us these days.
newtype URI = URI
  { URI -> URI
fromURI :: Net.URI
  }
  deriving (URI -> URI -> Bool
(URI -> URI -> Bool) -> (URI -> URI -> Bool) -> Eq URI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: URI -> URI -> Bool
== :: URI -> URI -> Bool
$c/= :: URI -> URI -> Bool
/= :: URI -> URI -> Bool
Eq, Eq URI
Eq URI =>
(URI -> URI -> Ordering)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> URI)
-> (URI -> URI -> URI)
-> Ord URI
URI -> URI -> Bool
URI -> URI -> Ordering
URI -> URI -> URI
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 :: URI -> URI -> Ordering
compare :: URI -> URI -> Ordering
$c< :: URI -> URI -> Bool
< :: URI -> URI -> Bool
$c<= :: URI -> URI -> Bool
<= :: URI -> URI -> Bool
$c> :: URI -> URI -> Bool
> :: URI -> URI -> Bool
$c>= :: URI -> URI -> Bool
>= :: URI -> URI -> Bool
$cmax :: URI -> URI -> URI
max :: URI -> URI -> URI
$cmin :: URI -> URI -> URI
min :: URI -> URI -> URI
Ord, Int -> URI -> ShowS
[URI] -> ShowS
URI -> String
(Int -> URI -> ShowS)
-> (URI -> String) -> ([URI] -> ShowS) -> Show URI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> URI -> ShowS
showsPrec :: Int -> URI -> ShowS
$cshow :: URI -> String
show :: URI -> String
$cshowList :: [URI] -> ShowS
showList :: [URI] -> ShowS
Show)

instance A.FromJSON URI where
  parseJSON :: Value -> Parser URI
parseJSON = String -> (Text -> Parser URI) -> Value -> Parser URI
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"URI" (String -> Parser URI
forall (m :: * -> *). MonadFail m => String -> m URI
parse (String -> Parser URI) -> (Text -> String) -> Text -> Parser URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack)

instance A.ToJSON URI where
  toJSON :: URI -> Value
toJSON URI
uri = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (URI -> String
forall a. Show a => a -> String
show (URI -> URI
fromURI URI
uri))

instance ToByteString URI where
  builder :: URI -> Builder
builder = String -> Builder
forall a. ToByteString a => a -> Builder
builder (String -> Builder) -> (URI -> String) -> URI -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show (URI -> String) -> (URI -> URI) -> URI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> URI
fromURI

instance FromByteString URI where
  parser :: Parser URI
parser = Parser ByteString
takeByteString Parser ByteString -> (ByteString -> Parser URI) -> Parser URI
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 URI
forall (m :: * -> *). MonadFail m => String -> m URI
parse (String -> Parser URI)
-> (ByteString -> String) -> ByteString -> Parser URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Bytes.unpack

instance ToHttpApiData URI where
  toUrlPiece :: URI -> Text
toUrlPiece = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString'

instance S.ToParamSchema URI where
  toParamSchema :: Proxy URI -> Schema
toParamSchema Proxy URI
_ =
    Proxy Text -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
S.toParamSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Valid URI"

parse :: (MonadFail m) => String -> m URI
parse :: forall (m :: * -> *). MonadFail m => String -> m URI
parse = m URI -> (URI -> m URI) -> Maybe URI -> m URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m URI
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid URI") (URI -> m URI
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URI -> m URI) -> (URI -> URI) -> URI -> m URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> URI
URI) (Maybe URI -> m URI) -> (String -> Maybe URI) -> String -> m URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe URI
Net.parseURI

-- | This is created in gundeck by cannon every time the client opens a new websocket connection.
-- (That's why we always have a 'ConnId' from the most recent connection by that client.)
data Presence = Presence
  { Presence -> UserId
userId :: !UserId,
    Presence -> ConnId
connId :: !ConnId,
    -- | cannon instance hosting the presence
    Presence -> URI
resource :: !URI,
    -- | This is 'Nothing' if either (a) the presence is older
    -- than mandatory end-to-end encryption, or (b) the client is
    -- operating the team settings pages without the need for
    -- end-to-end crypto.
    Presence -> Maybe ClientId
clientId :: !(Maybe ClientId),
    Presence -> Milliseconds
createdAt :: !Milliseconds,
    -- | REFACTOR: temp. addition to ease migration
    Presence -> ByteString
__field :: !Lazy.ByteString
  }
  deriving (Presence -> Presence -> Bool
(Presence -> Presence -> Bool)
-> (Presence -> Presence -> Bool) -> Eq Presence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Presence -> Presence -> Bool
== :: Presence -> Presence -> Bool
$c/= :: Presence -> Presence -> Bool
/= :: Presence -> Presence -> Bool
Eq, Eq Presence
Eq Presence =>
(Presence -> Presence -> Ordering)
-> (Presence -> Presence -> Bool)
-> (Presence -> Presence -> Bool)
-> (Presence -> Presence -> Bool)
-> (Presence -> Presence -> Bool)
-> (Presence -> Presence -> Presence)
-> (Presence -> Presence -> Presence)
-> Ord Presence
Presence -> Presence -> Bool
Presence -> Presence -> Ordering
Presence -> Presence -> Presence
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 :: Presence -> Presence -> Ordering
compare :: Presence -> Presence -> Ordering
$c< :: Presence -> Presence -> Bool
< :: Presence -> Presence -> Bool
$c<= :: Presence -> Presence -> Bool
<= :: Presence -> Presence -> Bool
$c> :: Presence -> Presence -> Bool
> :: Presence -> Presence -> Bool
$c>= :: Presence -> Presence -> Bool
>= :: Presence -> Presence -> Bool
$cmax :: Presence -> Presence -> Presence
max :: Presence -> Presence -> Presence
$cmin :: Presence -> Presence -> Presence
min :: Presence -> Presence -> Presence
Ord, Int -> Presence -> ShowS
[Presence] -> ShowS
Presence -> String
(Int -> Presence -> ShowS)
-> (Presence -> String) -> ([Presence] -> ShowS) -> Show Presence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Presence -> ShowS
showsPrec :: Int -> Presence -> ShowS
$cshow :: Presence -> String
show :: Presence -> String
$cshowList :: [Presence] -> ShowS
showList :: [Presence] -> ShowS
Show)
  deriving (Value -> Parser [Presence]
Value -> Parser Presence
(Value -> Parser Presence)
-> (Value -> Parser [Presence]) -> FromJSON Presence
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Presence
parseJSON :: Value -> Parser Presence
$cparseJSONList :: Value -> Parser [Presence]
parseJSONList :: Value -> Parser [Presence]
A.FromJSON, [Presence] -> Value
[Presence] -> Encoding
Presence -> Value
Presence -> Encoding
(Presence -> Value)
-> (Presence -> Encoding)
-> ([Presence] -> Value)
-> ([Presence] -> Encoding)
-> ToJSON Presence
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Presence -> Value
toJSON :: Presence -> Value
$ctoEncoding :: Presence -> Encoding
toEncoding :: Presence -> Encoding
$ctoJSONList :: [Presence] -> Value
toJSONList :: [Presence] -> Value
$ctoEncodingList :: [Presence] -> Encoding
toEncodingList :: [Presence] -> Encoding
A.ToJSON, Typeable Presence
Typeable Presence =>
(Proxy Presence -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Presence
Proxy Presence -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Presence -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Presence -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema Presence)

instance ToSchema Presence where
  schema :: ValueSchema NamedSwaggerDoc Presence
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] Presence Presence
-> ValueSchema NamedSwaggerDoc Presence
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"Presence" (SchemaP SwaggerDoc Object [Pair] Presence Presence
 -> ValueSchema NamedSwaggerDoc Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence Presence
-> ValueSchema NamedSwaggerDoc Presence
forall a b. (a -> b) -> a -> b
$
      ( UserId
-> ConnId
-> URI
-> Maybe ClientId
-> Milliseconds
-> ByteString
-> Presence
Presence
          (UserId
 -> ConnId
 -> URI
 -> Maybe ClientId
 -> Milliseconds
 -> ByteString
 -> Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence UserId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Presence
     (ConnId
      -> URI -> Maybe ClientId -> Milliseconds -> ByteString -> Presence)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Presence -> UserId
userId (Presence -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP SwaggerDoc Object [Pair] Presence UserId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"user_id" SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
          SchemaP
  SwaggerDoc
  Object
  [Pair]
  Presence
  (ConnId
   -> URI -> Maybe ClientId -> Milliseconds -> ByteString -> Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence ConnId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Presence
     (URI -> Maybe ClientId -> Milliseconds -> ByteString -> Presence)
forall a b.
SchemaP SwaggerDoc Object [Pair] Presence (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Presence a
-> SchemaP SwaggerDoc Object [Pair] Presence b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Presence -> ConnId
connId (Presence -> ConnId)
-> SchemaP SwaggerDoc Object [Pair] ConnId ConnId
-> SchemaP SwaggerDoc Object [Pair] Presence ConnId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ConnId ConnId
-> SchemaP SwaggerDoc Object [Pair] ConnId ConnId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"device_id" SchemaP NamedSwaggerDoc Value Value ConnId ConnId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
          SchemaP
  SwaggerDoc
  Object
  [Pair]
  Presence
  (URI -> Maybe ClientId -> Milliseconds -> ByteString -> Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence URI
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Presence
     (Maybe ClientId -> Milliseconds -> ByteString -> Presence)
forall a b.
SchemaP SwaggerDoc Object [Pair] Presence (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Presence a
-> SchemaP SwaggerDoc Object [Pair] Presence b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Presence -> URI
resource (Presence -> URI)
-> SchemaP SwaggerDoc Object [Pair] URI URI
-> SchemaP SwaggerDoc Object [Pair] Presence URI
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value URI URI
-> SchemaP SwaggerDoc Object [Pair] URI URI
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"resource" SchemaP NamedSwaggerDoc Value Value URI URI
uriSchema
          SchemaP
  SwaggerDoc
  Object
  [Pair]
  Presence
  (Maybe ClientId -> Milliseconds -> ByteString -> Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence (Maybe ClientId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Presence
     (Milliseconds -> ByteString -> Presence)
forall a b.
SchemaP SwaggerDoc Object [Pair] Presence (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Presence a
-> SchemaP SwaggerDoc Object [Pair] Presence b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Presence -> Maybe ClientId
clientId (Presence -> Maybe ClientId)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ClientId) (Maybe ClientId)
-> SchemaP SwaggerDoc Object [Pair] Presence (Maybe ClientId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value (Maybe ClientId) ClientId
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ClientId) (Maybe ClientId)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"client_id" (Value
-> SchemaP NamedSwaggerDoc Value Value ClientId ClientId
-> SchemaP NamedSwaggerDoc Value Value (Maybe ClientId) ClientId
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP NamedSwaggerDoc Value Value ClientId ClientId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema) -- keep null for backwards compat
          SchemaP
  SwaggerDoc
  Object
  [Pair]
  Presence
  (Milliseconds -> ByteString -> Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence Milliseconds
-> SchemaP
     SwaggerDoc Object [Pair] Presence (ByteString -> Presence)
forall a b.
SchemaP SwaggerDoc Object [Pair] Presence (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Presence a
-> SchemaP SwaggerDoc Object [Pair] Presence b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Presence -> Milliseconds
createdAt (Presence -> Milliseconds)
-> SchemaP SwaggerDoc Object [Pair] Milliseconds Milliseconds
-> SchemaP SwaggerDoc Object [Pair] Presence Milliseconds
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Milliseconds -> Maybe Milliseconds -> Milliseconds
forall a. a -> Maybe a -> a
fromMaybe Milliseconds
0 (Maybe Milliseconds -> Milliseconds)
-> SchemaP
     SwaggerDoc Object [Pair] Milliseconds (Maybe Milliseconds)
-> SchemaP SwaggerDoc Object [Pair] Milliseconds Milliseconds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text
-> SchemaP NamedSwaggerDoc Value Value Milliseconds Milliseconds
-> SchemaP
     SwaggerDoc Object [Pair] Milliseconds (Maybe Milliseconds)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"created_at" SchemaP NamedSwaggerDoc Value Value Milliseconds Milliseconds
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
      )
        SchemaP SwaggerDoc Object [Pair] Presence (ByteString -> Presence)
-> ((ByteString -> Presence) -> Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence Presence
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((ByteString -> Presence) -> ByteString -> Presence
forall a b. (a -> b) -> a -> b
$ (ByteString
"" :: Lazy.ByteString))

uriSchema :: ValueSchema NamedSwaggerDoc URI
uriSchema :: SchemaP NamedSwaggerDoc Value Value URI URI
uriSchema = NamedSwaggerDoc
-> (Value -> Parser URI)
-> (URI -> Maybe Value)
-> SchemaP NamedSwaggerDoc Value Value URI URI
forall doc v b a w.
doc -> (v -> Parser b) -> (a -> Maybe w) -> SchemaP doc v w a b
mkSchema NamedSwaggerDoc
desc Value -> Parser URI
uriFromJSON (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> (URI -> Value) -> URI -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Value
uriToJSON)
  where
    desc :: NamedSwaggerDoc
    desc :: NamedSwaggerDoc
desc =
      forall a. ToSchema a => NamedSwaggerDoc
swaggerDoc @Text
        NamedSwaggerDoc
-> (NamedSwaggerDoc -> NamedSwaggerDoc) -> NamedSwaggerDoc
forall a b. a -> (a -> b) -> b
& ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
    -> Schema -> Identity Schema)
-> (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> OpenApiType -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString)
        NamedSwaggerDoc
-> (NamedSwaggerDoc -> NamedSwaggerDoc) -> NamedSwaggerDoc
forall a b. a -> (a -> b) -> b
& ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe Text -> Identity (Maybe Text))
    -> Schema -> Identity Schema)
-> (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
S.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
"Valid URI.")

uriFromJSON :: A.Value -> A.Parser URI
uriFromJSON :: Value -> Parser URI
uriFromJSON = String -> (Text -> Parser URI) -> Value -> Parser URI
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"URI" (String -> Parser URI
forall (m :: * -> *). MonadFail m => String -> m URI
p (String -> Parser URI) -> (Text -> String) -> Text -> Parser URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack)
  where
    p :: (MonadFail m) => String -> m URI
    p :: forall (m :: * -> *). MonadFail m => String -> m URI
p = m URI -> (URI -> m URI) -> Maybe URI -> m URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m URI
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid URI") URI -> m URI
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe URI -> m URI) -> (String -> Maybe URI) -> String -> m URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe URI
forall (m :: * -> *). MonadFail m => String -> m URI
parse

uriToJSON :: URI -> A.Value
uriToJSON :: URI -> Value
uriToJSON (URI URI
uri) = Text -> Value
A.String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ ShowS -> URI -> ShowS
Net.uriToString ShowS
forall a. a -> a
id URI
uri String
forall a. Monoid a => a
mempty