mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-03-31 03:16:07 +00:00
f3408d9bb6
* explicit exports * more empty exports * add exports * reorder * use correct ControlProtocol type for xftp router --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
40 lines
1.2 KiB
Haskell
40 lines
1.2 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 (HostName, ServiceName)
|
|
import Simplex.Messaging.Encoding.String (StrEncoding (..))
|
|
|
|
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 HostName ServiceName
|
|
deriving (Eq, Ord, Show)
|
|
|
|
instance StrEncoding SrvLoc where
|
|
strEncode (SrvLoc host port) = B.pack $ host <> if null port then "" else ':' : port
|
|
strP = SrvLoc <$> host <*> (port <|> pure "")
|
|
where
|
|
host = B.unpack <$> A.takeWhile1 (A.notInClass ":#,;/ ")
|
|
port = show <$> (A.char ':' *> (A.decimal :: A.Parser Int))
|
|
|
|
simplexChat :: ServiceScheme
|
|
simplexChat = SSAppServer $ SrvLoc "simplex.chat" ""
|