diff --git a/app/box-socket.hs b/app/box-socket.hs
new file mode 100644
--- /dev/null
+++ b/app/box-socket.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -Wall #-}
+{-# OPTIONS_GHC -Wno-unused-do-bind #-}
+
+{-
+
+It's a box. It's a socket.
+
+-}
+
+module Main where
+
+import Box
+import Box.Socket
+import Control.Lens hiding (Wrapped, Unwrapped)
+import Data.Generics.Labels ()
+import NumHask.Prelude hiding (STM, bracket)
+import Options.Generic
+import Control.Concurrent.Classy.Async as C
+
+data SocketType = Client | Responder | TestRun deriving (Eq, Read, Show, Generic)
+
+instance ParseField SocketType
+
+instance ParseRecord SocketType
+
+instance ParseFields SocketType
+
+data Opts w
+  = Opts
+      { apptype :: w ::: SocketType <?> "type of websocket app"
+      }
+  deriving (Generic)
+
+instance ParseRecord (Opts Wrapped)
+
+main :: IO ()
+main = do
+  o :: Opts Unwrapped <- unwrapRecord "example websocket apps"
+  r :: Text <- case apptype o of
+    Client -> show <$> clientIO
+    Responder -> show <$> q' serverIO
+    TestRun -> show <$> testRun
+  putStrLn r
+
+-- * older stuff
+serverIO :: IO ()
+serverIO = runServer defaultSocketConfig
+  (responderApp (\x -> bool (Right $ "echo:" <> x) (Left "quit") (x=="q")))
+
+clientIO :: IO ()
+clientIO =
+  (runClient defaultSocketConfig . clientApp)
+  (Box (contramap show toStdout) fromStdin)
+
+q' :: IO a -> IO (Either () a)
+q' f = C.race (cancelQ fromStdin) f
+
+cancelQ :: Emitter IO Text -> IO ()
+cancelQ e = do
+  e' <- emit e
+  case e' of
+    Just "q" -> pure ()
+    _ -> do
+      putStrLn ("nothing happens" :: Text)
+      cancelQ e
+
+-- | test of clientApp via a cRef committer and a canned list of Text
+tClient :: [Text] -> IO [Either Text Text]
+tClient xs = do
+  (c,r) <- cRef
+  runClient defaultSocketConfig
+    (\conn ->
+       (\b -> clientApp b conn) <$.>
+       (Box <$>
+        pure c <*>
+        fromListE (xs <> ["q"])))
+  r
+
+tClientIO :: [Text] -> IO ()
+tClientIO xs =
+  (runClient defaultSocketConfig . clientApp) <$.>
+  (Box (contramap show toStdout) <$> (fromListE (xs <> ["q"])))
+
+-- | main test run of client-server functionality
+-- the code starts a server in a thread, starts the client in the main thread, and cancels the server on completion.
+-- >>> testRun
+-- [Left "receiver: received: echo:1",Right "echo:1",Left "receiver: received: echo:2",Right "echo:2",Left "receiver: received: echo:3",Right "echo:3",Left "receiver: received: close: 1000 \"received close signal: responder closed.\""]
+testRun :: IO [Either Text Text]
+testRun = do
+  a <- C.async (runServer defaultSocketConfig (responderApp (\x -> bool (Right $ "echo:" <> x) (Left "quit") (x=="q"))))
+  sleep 0.1
+  r <- tClient (show <$> [1..3::Int])
+  C.cancel a
+  pure r
+
diff --git a/box-socket.cabal b/box-socket.cabal
new file mode 100644
--- /dev/null
+++ b/box-socket.cabal
@@ -0,0 +1,92 @@
+cabal-version: 2.4
+name:          box-socket
+version:       0.0.1
+synopsis: See readme.md
+description: See readme.md for description.
+category: project
+author: Tony Day
+maintainer: tonyday567@gmail.com
+copyright: Tony Day (c) AfterTimes
+license: BSD-3-Clause
+homepage: https://github.com/tonyday567/box-socket#readme
+bug-reports: https://github.com/tonyday567/box-socket/issues
+build-type: Simple
+source-repository head
+  type: git
+  location: https://github.com/tonyday567/box-socket
+
+library
+  exposed-modules:
+    Box.Socket
+  hs-source-dirs:
+    src
+  build-depends:
+    base >= 4.12 && <5,
+    box >= 0.5,
+    concurrency >= 1.11,
+    exceptions >= 0.10,
+    generic-lens >= 1.1.0 && < 3.0,
+    lens >= 4.17.1 && < 4.20,
+    numhask >= 0.6,
+    websockets >= 0.12,
+  default-language: Haskell2010
+  default-extensions:
+    NegativeLiterals
+    NoImplicitPrelude
+    OverloadedStrings
+    UnicodeSyntax
+  ghc-options:
+    -Wall
+    -Wcompat
+    -Wincomplete-record-updates
+    -Wincomplete-uni-patterns
+    -Wredundant-constraints
+
+executable box-socket
+  main-is: box-socket.hs
+  hs-source-dirs: app
+  build-depends:
+    base >= 4.7 && < 5,
+    box,
+    box-socket,
+    concurrency >= 1.11,
+    generic-lens >= 2.0,
+    lens >= 4.19,
+    numhask >= 0.6,
+    optparse-generic >= 1.3,
+  default-language: Haskell2010
+  default-extensions:
+    NegativeLiterals
+    NoImplicitPrelude
+    OverloadedStrings
+    UnicodeSyntax
+  ghc-options:
+    -funbox-strict-fields
+    -fforce-recomp
+    -threaded
+    -rtsopts
+    -with-rtsopts=-N
+
+test-suite test
+  type: exitcode-stdio-1.0
+  main-is: test.hs
+  hs-source-dirs:
+    test
+  build-depends:
+    base >=4.7 && <5,
+    box-socket,
+    doctest >= 0.16,
+    numhask >= 0.6,
+  default-language: Haskell2010
+  default-extensions:
+    NegativeLiterals
+    NoImplicitPrelude
+    OverloadedStrings
+    UnicodeSyntax
+  ghc-options:
+    -Wall
+    -Wcompat
+    -Wincomplete-record-updates
+    -Wincomplete-uni-patterns
+    -Wredundant-constraints
+    -funbox-strict-fields
diff --git a/src/Box/Socket.hs b/src/Box/Socket.hs
new file mode 100644
--- /dev/null
+++ b/src/Box/Socket.hs
@@ -0,0 +1,163 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -Wall #-}
+{-# OPTIONS_GHC -Wno-unused-do-bind #-}
+
+module Box.Socket
+  ( SocketConfig(..),
+    defaultSocketConfig,
+    runClient,
+    runServer,
+    connect,
+    clientApp,
+    responderApp,
+    serverApp,
+    receiver',
+    receiver,
+    sender,
+    responder,
+  )
+where
+
+import qualified Network.WebSockets as WS
+import Box
+import Control.Lens
+import NumHask.Prelude hiding (bracket)
+import Data.Generics.Labels ()
+import Control.Monad.Conc.Class as C
+import Control.Monad.Catch
+import qualified Control.Concurrent.Classy.Async as C
+
+data SocketConfig
+  = SocketConfig
+      { host :: Text,
+        port :: Int,
+        path :: Text
+      }
+  deriving (Show, Eq, Generic)
+
+defaultSocketConfig :: SocketConfig
+defaultSocketConfig = SocketConfig "127.0.0.1" 9160 "/"
+
+runClient :: (MonadIO m) => SocketConfig -> WS.ClientApp () -> m ()
+runClient c app = liftIO $ WS.runClient (unpack $ c ^. #host) (c ^. #port) (unpack $ c ^. #path) app
+
+runServer :: (MonadIO m) => SocketConfig -> WS.ServerApp -> m ()
+runServer c app = liftIO $ WS.runServer (unpack $ c ^. #host) (c ^. #port) app
+
+connect :: (MonadIO m, MonadConc m) => WS.PendingConnection -> Cont m WS.Connection
+connect p = Cont $ \action ->
+    bracket
+      (liftIO $ WS.acceptRequest p)
+      (\conn -> liftIO $ WS.sendClose conn ("Bye from connect!" :: Text))
+      (\conn ->
+         C.withAsync
+         (liftIO $ forever $ WS.sendPing conn ("ping" :: ByteString) >> sleep 30)
+         (\_ -> action conn))
+
+clientApp :: (MonadIO m, MonadConc m) =>
+  Box m (Either Text Text) Text ->
+  WS.Connection ->
+  m ()
+clientApp (Box c e) conn =
+  void $
+    C.race
+      (receiver' c conn)
+      (sender (Box mempty e) conn)
+
+responderApp ::
+  (Text -> Either Text Text) ->
+  WS.PendingConnection ->
+  IO ()
+responderApp f p = with (connect p) (responder f mempty)
+
+serverApp ::
+  (MonadConc m, MonadIO m) =>
+  Box m Text Text ->
+  WS.PendingConnection ->
+  m ()
+serverApp (Box c e) p = void $ with (connect p)
+  (\conn -> C.race
+    (receiver c conn)
+    (sender (Box mempty e) conn))
+
+-- | default websocket receiver
+-- Lefts are info/debug
+receiver' :: (MonadIO m) =>
+  Committer m (Either Text Text) ->
+  WS.Connection ->
+  m Bool
+receiver' c conn = go
+  where
+    go = do
+      msg <- liftIO $ WS.receive conn
+      case msg of
+        WS.ControlMessage (WS.Close w b) ->
+          commit
+            c
+            ( Left
+                ( "receiver: received: close: " <> show w <> " " <> show b
+                )
+            )
+        WS.ControlMessage _ -> go
+        WS.DataMessage _ _ _ msg' -> do
+          commit c $ Left $ "receiver: received: " <> (WS.fromDataMessage msg' :: Text)
+          _ <- commit c (Right (WS.fromDataMessage msg'))
+          go
+
+-- | default websocket receiver
+-- Lefts are info/debug
+receiver :: (MonadIO m) =>
+  Committer m Text ->
+  WS.Connection ->
+  m ()
+receiver c conn = go
+  where
+    go = do
+      msg <- liftIO $ WS.receive conn
+      case msg of
+        WS.ControlMessage (WS.Close _ _) -> pure ()
+        WS.ControlMessage _ -> go
+        WS.DataMessage _ _ _ msg' -> commit c (WS.fromDataMessage msg') >> go
+
+-- | default websocket sender
+sender ::
+  (MonadIO m, WS.WebSocketsData a, Show a) =>
+  Box m Text a ->
+  WS.Connection ->
+  m ()
+sender (Box c e) conn = forever $ do
+  msg <- emit e
+  case msg of
+    Nothing -> pure ()
+    Just msg' -> do
+      commit c $ "sender: sending: " <> (show msg' :: Text)
+      liftIO $ WS.sendTextData conn msg'
+
+-- | a receiver that responds based on received Text.
+-- lefts are quit signals. Rights are response text.
+responder :: (MonadIO m) =>
+  (Text -> Either Text Text) ->
+  Committer m Text ->
+  WS.Connection ->
+  m ()
+responder f c conn = go
+  where
+    go = do
+      msg <- liftIO $ WS.receive conn
+      case msg of
+        WS.ControlMessage (WS.Close _ _) -> do
+          commit c "responder: normal close"
+          liftIO $ WS.sendClose conn ("received close signal: responder closed." :: Text)
+        WS.ControlMessage _ -> go
+        WS.DataMessage _ _ _ msg' -> do
+          case (f $ WS.fromDataMessage msg') of
+            Left _ -> do
+              commit c "responder: sender initiated close"
+              liftIO $ WS.sendClose conn ("received close signal: responder closed." :: Text)
+            Right r -> do
+              commit c ("responder: sending" <> r)
+              liftIO $ WS.sendTextData conn r
+              go
diff --git a/test/test.hs b/test/test.hs
new file mode 100644
--- /dev/null
+++ b/test/test.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_GHC -Wall #-}
+
+module Main where
+
+import NumHask.Prelude
+import Test.DocTest
+
+main :: IO ()
+main = doctest
+  [ "app/box-socket.hs"
+  ]