{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}

-- | Simple tools for establishing and using Secure WebSockets connections on
-- top of TLS (i.e, @wss:\/\/@).
--
-- See the
-- [network-simple-ws](https://hackage.haskell.org/package/network-simple-ws)
-- package for insecure WebSockets (i.e, @ws:\/\/@) support.
--
-- Notice that, currently, this is package offers tools that are mostly
-- intreresting from a client's point of view. Server side support will come
-- later.
module Network.Simple.WSS
 ( W.Connection
 , WS.send
 , WS.recv
   -- * Client side
 , connect
 , connectOverSOCKS5
   -- * Low level
 , streamFromContext
 ) where


import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Control.Exception.Safe as Ex
import qualified Data.ByteString as B
import Data.Foldable (traverse_)

import qualified Network.Simple.TCP.TLS as T
import qualified Network.Simple.WS as WS
import qualified Network.WebSockets as W
import qualified Network.WebSockets.Stream as W (Stream, makeStream, close)

--------------------------------------------------------------------------------

-- | Connect to the specified Secure WebSockets server.
connect
  :: (MonadIO m, Ex.MonadMask m)
  => T.ClientSettings  -- ^ TLS settings.
  -> T.HostName
  -- ^ Secure WebSockets server host name (e.g., @\"www.example.com\"@ or IP
  -- address).
  -> T.ServiceName
  -- ^ Secure WebSockets server port (e.g., @\"443\"@ or @\"www\"@).
  -> B.ByteString
  -- ^ Secure WebSockets resource (e.g., @\"/foo\/qux?bar=wat&baz\"@).
  --
  -- Leading @\'\/\'@ is optional.
  -> [(B.ByteString, B.ByteString)]
  -- ^ Extra HTTP Headers
  -- (e.g., @[(\"Authorization\", \"Basic dXNlcjpwYXNzd29yZA==\")]@).
  -> ((W.Connection, T.SockAddr) -> m r)
  -- ^ Computation to run after establishing a Secure WebSockets to the remote
  -- server. Takes the WebSockets connection and remote end address.
  -> m r
connect cs hn sn res hds act = do
  T.connect cs hn sn $ \(ctx, saddr) -> do
     Ex.bracket (streamFromContext ctx) (liftIO . W.close) $ \stream -> do
        conn <- WS.clientConnectionFromStream stream hn sn res hds
        liftIO (W.forkPingThread conn 30)
        act (conn, saddr)

-- | Like 'connect', but connects to the destination server through a SOCKS5
-- proxy.
connectOverSOCKS5
  :: (MonadIO m, Ex.MonadMask m)
  => T.HostName -- ^ SOCKS5 proxy server hostname or IP address.
  -> T.ServiceName -- ^ SOCKS5 proxy server service port name or number.
  -> T.ClientSettings -- ^ TLS settings.
  -> T.HostName
  -- ^ Destination Secure WebSockets server hostname or IP address. We connect
  -- to this host /through/ the SOCKS5 proxy specified in the previous
  -- arguments.
  --
  -- Note that if hostname resolution on this 'T.HostName' is necessary, it
  -- will happen on the proxy side for security reasons, not locally.
  -> T.ServiceName
  -- ^ Destination Secure WebSockets server port (e.g., @\"443\"@ or @\"www\"@).
  -> B.ByteString
  -- ^ WebSockets resource (e.g., @\"/foo\/qux?bar=wat&baz\"@).
  --
  -- Leading @\'\/\'@ is optional.
  -> [(B.ByteString, B.ByteString)]
  -- ^ Extra HTTP Headers
  -- (e.g., @[(\"Authorization\", \"Basic dXNlcjpwYXNzd29yZA==\")]@).
  -> ((W.Connection, T.SockAddr, T.SockAddr) -> m r)
  -- ^ Computation taking a 'W.Connection' for communicating with the
  -- destination Secure WebSockets server through the SOCKS5 server, the address
  -- of that SOCKS5 server, and the address of the destination WebSockets
  -- server, in that order.
 -> m r
connectOverSOCKS5 phn psn tcs dhn dsn res hds act = do
  T.connectOverSOCKS5 phn psn tcs dhn dsn $ \(ctx, pa, da) -> do
    Ex.bracket (streamFromContext ctx) (liftIO . W.close) $ \stream -> do
      conn <- WS.clientConnectionFromStream stream dhn dsn res hds
      liftIO (W.forkPingThread conn 30)
      act (conn, pa, da)

-- | Obtain a 'W.Stream' implemented using the given TLS 'T.Context'. You can
-- use the
-- [network-simple-tls](https://hackage.haskell.org/package/network-simple-tls)
-- library to get one of those.
streamFromContext :: MonadIO m => T.Context -> m W.Stream
streamFromContext ctx = liftIO $ do
  W.makeStream (T.recv ctx) (traverse_ (T.sendLazy ctx))