mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-03-30 20:45:52 +00:00
2f7a288280
* xftp: add URI encoding for FileDescription * tweak URI * allow smaller blocks * draft xftpReceiveFileFollow' and xftpSendFilePublic' * add sending with redirect * allow 64k chunks * add migrations with redirect fields * add test case * fix deadlock * revert CLI code * WIP: working send/receive via URI * fix field ambiguity * cleanup * update agent db schema * update minimal chunk size * add rfc * apply suggestions from code review Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com> * add createRcvFileRedirect * extract Simplex.Messaging.ServiceScheme and reuse for files * update db schema * check size/digest on receive complete * cleanup * use SIZE/DIGEST errors for redirects too * split digest/size errors from redirect checks * fix redirect error encoding * rename RedirectMeta to RedirectFileInfo * use query encoding for file URI * group maybe fields under RcvFileRedirect * add extras field * update rfc * add extras encoding and no-redirect tests * fix toStrict for old ghc * extra client data in file descr URI * remove decoded yaml file --------- Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
36 lines
1.1 KiB
Haskell
36 lines
1.1 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Simplex.Messaging.ServiceScheme 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" ""
|