Simple.hs

{-# LANGUAGE CPP #-}

module Network.QUIC.Simple
  ( -- $intro

    -- * Basic wrappers
    runServer
  , runClient
    -- * CBOR/Serialise wrappers
  , runServerSimple
  , startClientSimple
    -- ** More flexible variants
  , runServerStateful
  , startClientAsync
  , Serialise
    -- * The rest of the QUIC API
  , module Network.QUIC
  ) where

import Control.Concurrent.STM
import Network.QUIC
import Network.QUIC.Simple.Stream

import Codec.Serialise (Serialise)
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (Async, async, cancel, link, link2)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
import Control.Exception (SomeException, handle, onException)
import Control.Monad (forever)
import Data.IP (IP(..))
import Network.QUIC.Client (ClientConfig(..), defaultClientConfig)
import Network.QUIC.Client qualified as Client
import Network.QUIC.Server (ServerConfig(..), defaultServerConfig)
import Network.QUIC.Server qualified as Server
import Network.QUIC.Simple.Credentials (genCredentials)
import Network.Socket (HostName, PortNumber, ServiceName)

{- $intro
Check out the tests in the package git for a cookbook.

If you're unsure, start with the simplest wrapper.
If the wrapper's limitations bother you, replace it with the source code and customize it to suit your needs.
Alternatively, switch to a lower-level implementation to gain more features.

Don't let wrappers dictate your code structure and protocols — they're just there to get you a QUIC-start!
-}

{- | Start a server on all of the address-port pairs.

The server will have an autogenerated set of credentials on each start, just to get the TLS running.
You can use "Network.QUIC.Simple.Credentials.genCredentials" to generate and keep them,
so the clients can pin them after first connection.

The server will automatically accept the incoming stream before passing it to a (stateless) connection handler.
-}
runServer :: [(IP, PortNumber)] -> (Connection -> Stream -> IO ()) -> IO ()
runServer scAddresses action = do
  scCredentials <- genCredentials
  let
    sc = defaultServerConfig
      { scCredentials
      , scAddresses
      }
  Server.run sc \conn -> do
    defaultStream <- acceptStream conn
    action conn defaultStream

{- | Start a server on the provided host and port and run a stateless CBOR-encoded request-response protocol.

While it is possible to use `myThreadId` to get some connection identifier and attach connection data on it,
you'd better use `runServerStateful` instead.
-}
runServerSimple
  :: (Serialise q, Serialise r)
  => IP
  -> PortNumber
  -> (q -> IO r)
  -> IO ()
runServerSimple host port action =
  runServerStateful host port setup teardown handler
  where
    setup _conn _wq = pure ()
    teardown _conn _s = pure ()
    handler s q = do
      r <- action q
      pure (s, Just r)

{- | Start a server on the provided host and port and run a stateless CBOR-encoded request-response protocol.

The connection handler is stateful, with the initial state provided by a setup function.
The handler function must provide next connection state, but may opt out of replying.
Throw an exception to terminate the curent connection - the teardown function then can do the clean up.
-}
runServerStateful
  :: (Serialise q, Serialise r)
  => IP
  -> PortNumber
  -> (Connection -> TBQueue r -> IO s)
  -> (Connection -> s -> IO ())
  -> (s -> q -> IO (s, Maybe r))
  -> IO ()
runServerStateful host port setup teardown action =
  runServer [(host, port)] \conn stream0 -> do
    (codec, (writeQ, readQ)) <- streamSerialise stream0
    link codec
    let
      loop !s = handle (\(_ :: SomeException) -> teardown conn s) do
        query <- atomically (readTBQueue readQ)
        (s', reply_) <- action s query
        mapM_ (atomically . writeTBQueue writeQ) reply_
        loop s'
    setup conn writeQ >>= loop

{- | Run a client connecting to the provided host/port and auto-request a stream.

Server validation is disabled.
If you want server authentication, you'd have to do that in your protocol handshake.

With the @quic@ library >0.2.10 the connection migration will be enabled by default.
-}
runClient :: HostName -> ServiceName -> (Connection -> Stream -> IO ()) -> IO ()
runClient ccServerName ccPortName action = do
  Client.run cc \conn -> do
    defaultStream <- stream conn
    action conn defaultStream
  where
    cc = defaultClientConfig
      { ccServerName
      , ccPortName
      , ccValidate = False
#if MIN_VERSION_quic(0,2,10)
      , ccSockConnected = True
      , ccWatchDog = True
#endif
      }

{- | Start a client wrapper that will wait for a connection.

When connected, it will provide a way to stop it, and to do a simple blocking call.
There is no call tracking, so the client is not thread-safe.
Which is fine, when used with the 'runServerSimple'.

Use 'startClientAsync' to expose more functionality.
-}
startClientSimple
  :: (Serialise q, Serialise r)
  => HostName
  -> ServiceName
  -> IO (IO (), q -> IO r)
startClientSimple host port = do
  (client, _conn, (writeQ, readQ)) <- startClientAsync host port
  pure
    ( cancel client
    , \query -> do
        atomically $ writeTBQueue writeQ query
        atomically $ readTBQueue readQ
    )

{- | Start a client wrapper that will wait for a connection.

Canceling the exposed worker thread will terminate connection.
The exposed connection can be used to request more streams.
The message queues are running CBOR codec to shuttle the data.
-}
startClientAsync
  :: (Serialise q, Serialise r)
  => HostName
  -> ServiceName
  -> IO (Async (), Connection, MessageQueues q r)
startClientAsync host port = do
  client <- newEmptyMVar
  tid <- async $ runClient host port \conn stream0 -> do
    queues <- streamSerialise stream0
    putMVar client (conn, queues)
    forever (threadDelay maxBound)
  (conn, (codec, queues)) <- takeMVar client `onException` cancel tid
  link2 codec tid
  pure
    ( tid
    , conn
    , queues
    )