snocket: Accept in arbitrary monad

Forcing IO excplicitly in Accept renders 'Snocket' unusabel in non IO
monads.

ouroboros-network-framework/src/Ouroboros/Network/Snocket.hs

@@ -91,11 +91,11 @@ import Ouroboros.Network.IOManager
 -- created by 'open' and only subsequent calls will create a new file
 -- descriptor by `createNamedPipe`, see 'namedPipeSnocket'.
 --
-newtype Accept addr fd = Accept
- { runAccept :: IO (fd, addr, Accept addr fd)
+newtype Accept m addr fd = Accept
+ { runAccept :: m (fd, addr, Accept m addr fd)
  }
 
-instance Bifunctor Accept where
+instance Functor m => Bifunctor (Accept m) where
  bimap f g ac = Accept $ h <$> runAccept ac
  where
  h (fd, addr, next) = (g fd, f addr, bimap f g next)
@@ -105,7 +105,7 @@ instance Bifunctor Accept where
 --
 berkeleyAccept :: IOManager
  -> Socket
- -> Accept SockAddr Socket
+ -> Accept IO SockAddr Socket
 berkeleyAccept ioManager sock = go
  where
  go = Accept $ do
@@ -181,7 +181,7 @@ data Snocket m fd addr = Snocket {
  , bind :: fd -> addr -> m ()
  , listen :: fd -> m ()
 
- , accept :: fd -> Accept addr fd
+ , accept :: fd -> Accept m addr fd
 
  , close :: fd -> m ()
 
@@ -346,7 +346,7 @@ localSnocket ioManager path = Snocket {
  localAddress :: LocalAddress
  localAddress = LocalAddress path
 
- acceptNext :: Accept LocalAddress LocalSocket
+ acceptNext :: Accept IO LocalAddress LocalSocket
  acceptNext = Accept $ do
  hpipe <- Win32.createNamedPipe
  path

ouroboros-network-framework/src/Ouroboros/Network/Socket.hs

@@ -420,7 +420,7 @@ fromSnocket
  -> Server.Socket addr fd
 fromSnocket tblVar sn sd = go (Snocket.accept sn sd)
  where
- go :: Snocket.Accept addr fd -> Server.Socket addr fd
+ go :: Snocket.Accept IO addr fd -> Server.Socket addr fd
  go (Snocket.Accept accept) = Server.Socket $ do
  (sd', remoteAddr, next) <- accept
  -- TOOD: we don't need to that on each accept