reflex-backend-socket-0.2.0.0: example/Others.hs

{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecursiveDo         #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}

{-|
Copyright   : (c) 2018-2019, Commonwealth Scientific and Industrial Research Organisation
License     : BSD3
Maintainer  : dave.laing.80@gmail.com, jack.kelly@data61.csiro.au
Stability   : experimental
Portability : non-portable
-}

module Main (main) where

import           Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString.Char8 as BC
import           Data.Functor ((<&>), void)
import           Data.Maybe (isNothing)
import           Data.Witherable (catMaybes)
import qualified Network.Socket as NS
import           Reflex
import           Reflex.Backend.Socket
import           Reflex.Host.Basic (basicHostForever, basicHostWithQuit)
import           Reflex.Network (networkHold)
import           System.Environment (getArgs)

-- | Connect to a remote host, and quit as soon as something happens.
connect1 :: IO ()
connect1 = basicHostWithQuit $ do
  eQuit <- connect (Just "127.0.0.1") "9000"
  let (eError, eConnect) = fanEither eQuit

  performEvent_ $ (liftIO . putStrLn $ "Connected") <$ eConnect
  performEvent_ $ liftIO . print <$> eError

  pure (void eQuit)

-- | Listen for connections, and log them as they come in. Does
-- nothing with arriving connections, so will leak FDs.
accept1 :: IO ()
accept1 = basicHostForever $ do
  (eListenError, eAccept) <- fanEither <$> accept
    (AcceptConfig (Just "127.0.0.1") (Just "9000") 1 [(NS.ReuseAddr, 1)] never)

  eNewClient <- switchHold never $ _aAcceptSocket <$> eAccept
  eListenClosed <- switchHold never $ _aClose <$> eAccept
  eAcceptError <- switchHold never $ _aError <$> eAccept

  performEvent_ $
    (liftIO . putStrLn $ "Error starting listen socket") <$ eListenError
  performEvent_ $ (liftIO . putStrLn $ "Listen closed") <$ eListenClosed
  performEvent_ $ (liftIO . putStrLn $ "Connected") <$ eNewClient
  performEvent_ $ liftIO . print <$> eAcceptError

  pure ()

-- | Connect to a remote host. When the connection succeeds, put the
-- @'Socket' t@ into @dSocket@, send a message, then close.
connect2 :: IO ()
connect2 = basicHostWithQuit $ mdo
  (eConnError, eConnect) <- fanEither <$> connect (Just "127.0.0.1") "9000"

  performEvent_ $ (liftIO . putStrLn $ "Connected") <$ eConnect
  performEvent_ $ liftIO . print <$> eConnError

  dSocket :: Dynamic t (Maybe (Socket t)) <- networkHold (pure Nothing) $ leftmost
    [ eConnect <&> \s -> Just <$> socket (SocketConfig s 2048 eTx eOpen)
    , pure Nothing <$ eClosed
    ]

  eOpen <- switchHold never . fmap _sOpen . catMaybes $ updated dSocket
  let eTx = "Hi" <$ eOpen

  eClosed <- switchHold never . fmap _sClose . catMaybes $ updated dSocket
  eRx <- switchHold never . fmap _sReceive . catMaybes $ updated dSocket
  eSockError <- switchHold never . fmap _sError . catMaybes $ updated dSocket

  performEvent_ $ liftIO . BC.putStrLn <$> eRx
  performEvent_ $ liftIO . print <$> eSockError
  performEvent_ $ liftIO (putStrLn "Closed") <$ eClosed

  let eQuit = leftmost
        [ void eConnError
        , void . ffilter isNothing $ updated dSocket
        ]

  pure eQuit

main :: IO ()
main = getArgs >>= \case
  ["accept1"] -> accept1
  ["connect1"] -> connect1
  ["connect2"] -> connect2
  _ -> pure ()