mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-09-07 03:34:15 +00:00
74a86043cc
* Parse bracketed IPv6 server hosts * lib: parse service-scheme and invitation hosts via TransportHost * correct encoding * encoding --------- Co-authored-by: Paul Bottinelli <paul.bottinelli@trailofbits.com> Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
46 lines
1.3 KiB
Haskell
46 lines
1.3 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Simplex.Messaging.ServiceScheme
|
|
( ServiceScheme (..),
|
|
SrvLoc (..),
|
|
simplexChat,
|
|
) where
|
|
|
|
import Control.Applicative ((<|>))
|
|
import qualified Data.Attoparsec.ByteString.Char8 as A
|
|
import qualified Data.ByteString.Char8 as B
|
|
import Data.Functor (($>))
|
|
import Network.Socket (ServiceName)
|
|
import Simplex.Messaging.Encoding.String (StrEncoding (..))
|
|
import Simplex.Messaging.Transport.Client (TransportHost (..))
|
|
|
|
data ServiceScheme = SSSimplex | SSAppServer SrvLoc
|
|
deriving (Eq, Show)
|
|
|
|
instance StrEncoding ServiceScheme where
|
|
strEncode = \case
|
|
SSSimplex -> "simplex:"
|
|
SSAppServer srv -> "https://" <> strEncode srv
|
|
strP =
|
|
"simplex:" $> SSSimplex
|
|
<|> "https://" *> (SSAppServer <$> strP)
|
|
|
|
data SrvLoc = SrvLoc TransportHost ServiceName
|
|
deriving (Eq, Ord, Show)
|
|
|
|
instance StrEncoding SrvLoc where
|
|
strEncode (SrvLoc host port)
|
|
| null port = strEncode host
|
|
| otherwise = h <> B.pack (':' : port)
|
|
where
|
|
h = case host of
|
|
THIPv6 _ -> ('[' `B.cons` strEncode host) `B.snoc` ']'
|
|
_ -> strEncode host
|
|
strP = SrvLoc <$> strP <*> (port <|> pure "")
|
|
where
|
|
port = show <$> (A.char ':' *> (A.decimal :: A.Parser Int))
|
|
|
|
simplexChat :: ServiceScheme
|
|
simplexChat = SSAppServer $ SrvLoc "simplex.chat" ""
|