Copyright | (c) simplex.chat |
---|---|
License | AGPL-3 |
Maintainer | chat@simplex.chat |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
This module defines basic TCP server and client and SMP protocol encrypted transport over TCP.
See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
Synopsis
- class Transport c where
- transport :: ATransport
- transportName :: TProxy c -> String
- getServerConnection :: Socket -> IO c
- getClientConnection :: Socket -> IO c
- closeConnection :: c -> IO ()
- cGet :: c -> Int -> IO ByteString
- cPut :: c -> ByteString -> IO ()
- getLn :: c -> IO ByteString
- putLn :: c -> ByteString -> IO ()
- data TProxy c = TProxy
- data ATransport = forall c.Transport c => ATransport (TProxy c)
- runTransportServer :: (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> (c -> m ()) -> m ()
- runTransportClient :: Transport c => MonadUnliftIO m => HostName -> ServiceName -> (c -> m a) -> m a
- newtype TCP = TCP {}
- data THandle c = THandle {
- connection :: c
- sndKey :: SessionKey
- rcvKey :: SessionKey
- blockSize :: Int
- data TransportError
- = TEBadBlock
- | TEEncrypt
- | TEDecrypt
- | TEHandshake HandshakeError
- serverHandshake :: forall c. Transport c => c -> Int -> FullKeyPair -> ExceptT TransportError IO (THandle c)
- clientHandshake :: forall c. Transport c => c -> Maybe Int -> Maybe KeyHash -> ExceptT TransportError IO (THandle c)
- tPutEncrypted :: Transport c => THandle c -> ByteString -> IO (Either TransportError ())
- tGetEncrypted :: Transport c => THandle c -> IO (Either TransportError ByteString)
- serializeTransportError :: TransportError -> ByteString
- transportErrorP :: Parser TransportError
- currentSMPVersionStr :: ByteString
- trimCR :: ByteString -> ByteString
Transport connection class
class Transport c where Source #
transport :: ATransport Source #
transportName :: TProxy c -> String Source #
getServerConnection :: Socket -> IO c Source #
Upgrade client socket to connection (used in the server)
getClientConnection :: Socket -> IO c Source #
Upgrade server socket to connection (used in the client)
closeConnection :: c -> IO () Source #
Close connection
cGet :: c -> Int -> IO ByteString Source #
Read fixed number of bytes from connection
cPut :: c -> ByteString -> IO () Source #
Write bytes to connection
getLn :: c -> IO ByteString Source #
Receive ByteString from connection, allowing LF or CRLF termination.
putLn :: c -> ByteString -> IO () Source #
Send ByteString to connection terminating it with CRLF.
Instances
Transport TCP Source # | |
Defined in Simplex.Messaging.Transport transport :: ATransport Source # transportName :: TProxy TCP -> String Source # getServerConnection :: Socket -> IO TCP Source # getClientConnection :: Socket -> IO TCP Source # closeConnection :: TCP -> IO () Source # cGet :: TCP -> Int -> IO ByteString Source # cPut :: TCP -> ByteString -> IO () Source # | |
Transport WS Source # | |
Defined in Simplex.Messaging.Transport.WebSockets transport :: ATransport Source # transportName :: TProxy WS -> String Source # getServerConnection :: Socket -> IO WS Source # getClientConnection :: Socket -> IO WS Source # closeConnection :: WS -> IO () Source # cGet :: WS -> Int -> IO ByteString Source # cPut :: WS -> ByteString -> IO () Source # |
data ATransport Source #
forall c.Transport c => ATransport (TProxy c) |
Transport over TCP
runTransportServer :: (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> (c -> m ()) -> m () Source #
Run transport server (plain TCP or WebSockets) on passed TCP port and signal when server started and stopped via passed TMVar.
All accepted connections are passed to the passed function.
runTransportClient :: Transport c => MonadUnliftIO m => HostName -> ServiceName -> (c -> m a) -> m a Source #
Connect to passed TCP host:port and pass handle to the client.
TCP transport
Instances
Transport TCP Source # | |
Defined in Simplex.Messaging.Transport transport :: ATransport Source # transportName :: TProxy TCP -> String Source # getServerConnection :: Socket -> IO TCP Source # getClientConnection :: Socket -> IO TCP Source # closeConnection :: TCP -> IO () Source # cGet :: TCP -> Int -> IO ByteString Source # cPut :: TCP -> ByteString -> IO () Source # |
SMP encrypted transport
The handle for SMP encrypted transport connection over Transport .
data TransportError Source #
Error of SMP encrypted transport over TCP.
TEBadBlock | error parsing transport block |
TEEncrypt | block encryption error |
TEDecrypt | block decryption error |
TEHandshake HandshakeError | transport handshake error |
Instances
serverHandshake :: forall c. Transport c => c -> Int -> FullKeyPair -> ExceptT TransportError IO (THandle c) Source #
Server SMP encrypted transport handshake.
See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
The numbers in function names refer to the steps in the document.
clientHandshake :: forall c. Transport c => c -> Maybe Int -> Maybe KeyHash -> ExceptT TransportError IO (THandle c) Source #
Client SMP encrypted transport handshake.
See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
The numbers in function names refer to the steps in the document.
tPutEncrypted :: Transport c => THandle c -> ByteString -> IO (Either TransportError ()) Source #
Encrypt and send block to SMP encrypted transport.
tGetEncrypted :: Transport c => THandle c -> IO (Either TransportError ByteString) Source #
Receive and decrypt block from SMP encrypted transport.
serializeTransportError :: TransportError -> ByteString Source #
Serialize SMP encrypted transport error.
transportErrorP :: Parser TransportError Source #
SMP encrypted transport error parser.
Trim trailing CR
trimCR :: ByteString -> ByteString Source #
Trim trailing CR from ByteString.