polysemy-socket (empty) → 0.0.1.0

raw patch · 5 files changed

+230/−0 lines, 5 filesdep +basedep +bytestringdep +polysemy

Dependencies added: base, bytestring, polysemy, polysemy-plugin, socket

Files

• ChangeLog.md +5/−0
• LICENSE +30/−0
• README.md +5/−0
• polysemy-socket.cabal +39/−0
• src/Polysemy/Socket.hs +151/−0

@@ -0,0 +1,5 @@+# Changelog for polysemy-socket++## v0.0.1.0++Added `Socket` effect with some interpreters.

@@ -0,0 +1,30 @@+Copyright Daniel Firth (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,5 @@+# polysemy-socket++Experimental Socket effect for polysemy. The interface is made to mirror the+TCP interface in [socket](https://hackage.haskell.org/package/socket), but+is subject to change.

@@ -0,0 +1,39 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           polysemy-socket+version:        0.0.1.0+synopsis:       Socket effect for polysemy.+category:       Polysemy+author:         Daniel Firth+maintainer:     dan.firth@homotopic.tech+copyright:      2020 Daniel Firth+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://gitlab.com/homotopic-tech/polysemy-socket++library+  exposed-modules:+      Polysemy.Socket+  other-modules:+      Paths_polysemy_socket+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , bytestring >=0.9 && <0.12+    , polysemy >=1.3.0.0 && <1.7+    , polysemy-plugin >=0.3.0.0 && <0.5+    , socket >=0.5.0.0 && <0.9+  default-language: Haskell2010

@@ -0,0 +1,151 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}++-- |+--   Module     : Polysemy.Socket+--   License    : MIT+--   Stability  : experimental+--+-- Socket effect for polysemy.+module Polysemy.Socket+  ( -- * Definition+    Socket (..),+    acquire,+    bind,+    listen,+    send,+    receive,+    release,+    accept,+    close,++    -- * Adapters+    adaptSocket,+    adaptSocketSem,++    -- * Eliminators+    runSocketTcp,+    runSocketVirtual,+    Virtual,++    -- * Tracing+    traceSocket,+  )+where++import Control.Monad+import Data.ByteString (ByteString)+import Polysemy+import Polysemy.Input+import Polysemy.Resource+import Polysemy.State+import Polysemy.Trace+import qualified System.Socket as S+import qualified System.Socket.Family.Inet6 as S+import qualified System.Socket.Protocol.TCP as S+import qualified System.Socket.Type.Stream as S++-- |+--+-- @since 0.0.1.0+data Socket s k b c m a where+  Acquire :: Socket s k b c m s+  Bind :: s -> Socket s k b c m ()+  Release :: s -> Socket s k b c m ()+  Listen :: s -> Int -> Socket s k b c m ()+  Accept :: s -> Socket s k b c m (s, k)+  Send :: s -> c -> Socket s k b c m ()+  Receive :: s -> Socket s k b c m b+  Close :: s -> Socket s k b c m ()++makeSem ''Socket++-- |+--+-- @since 0.0.1.0+traceSocket :: forall s k b c r a. Members '[Socket s k b c, Trace] r => Sem r a -> Sem r a+traceSocket = intercept $ \case+  Acquire -> trace "acquring" >> acquire+  Bind s -> trace "binding" >> bind s+  Listen s x -> trace "listening" >> listen s x+  Receive s -> trace "receiving" >> receive s+  Send s x -> trace "sending" >> send s x+  Release s -> trace "releasing" >> release s+  Accept s -> trace "accept" >> accept s+  Close s -> trace "closing" >> close s+{-# INLINE traceSocket #-}++-- |+--+-- @since 0.0.1.0+adaptSocket :: Members '[Socket s k b' c'] r => (b' -> b) -> (c -> c') -> Sem (Socket s k b c ': r) a -> Sem r a+adaptSocket f g = adaptSocketSem (pure . f) (pure . g)+{-# INLINE adaptSocket #-}++-- |+--+-- @since 0.0.1.0+adaptSocketSem :: Members '[Socket s k b' c'] r => (b' -> Sem r b) -> (c -> Sem r c') -> Sem (Socket s k b c ': r) a -> Sem r a+adaptSocketSem f g = interpret $ \case+  Acquire -> acquire+  Bind s -> bind s+  Release s -> release s+  Listen s x -> listen s x+  Accept s -> accept s+  Send s c -> g c >>= send s+  Receive s -> receive s >>= f+  Close s -> close s+{-# INLINE adaptSocketSem #-}++-- |+--+-- @since 0.0.1.0+runSocketTcp ::+  forall s r a.+  ( S.Socket S.Inet6 S.Stream S.TCP ~ s,+    Members '[Resource, Embed IO, Input S.Inet6Port] r+  ) =>+  Sem (Socket s (S.SocketAddress S.Inet6) ByteString ByteString ': r) a ->+  Sem r a+runSocketTcp = interpret $ \case+  Acquire -> embed $ S.socket+  Bind s -> do+    x <- input @S.Inet6Port+    Polysemy.embed $ do+      S.setSocketOption s (S.ReuseAddress True)+      S.setSocketOption s (S.V6Only False)+      S.bind s (S.SocketAddressInet6 S.inet6Any x 0 0)+  Listen s x -> embed $ S.listen s x+  Receive s -> embed $ S.receive s 1024 mempty+  Send s x -> void $ embed $ S.sendAll s x S.msgNoSignal+  Release s -> embed $ S.close s+  Accept s -> embed $ S.accept s+  Close s -> embed $ S.close s+{-# INLINE runSocketTcp #-}++data Virtual = Virtual++-- |+--+-- @since 0.0.1.0+runSocketVirtual :: Members '[State p] r => (c -> p) -> (p -> b) -> Sem (Socket Virtual Virtual b c ': r) a -> Sem r a+runSocketVirtual f g = interpret $ \case+  Acquire -> pure Virtual+  Bind _ -> pure ()+  Release _ -> pure ()+  Listen _ _ -> pure ()+  Accept _ -> pure (Virtual, Virtual)+  Send _ c -> put (f c)+  Receive _ -> g <$> get+  Close _ -> pure ()+{-# INLINE runSocketVirtual #-}