Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Experiment with a bearer which allows to avoid extra threads in a Driver #7

Open
coot opened this issue Jun 24, 2022 · 0 comments
Open
Assignees

Comments

@coot
Copy link
Collaborator

coot commented Jun 24, 2022

We need a new Channel type:

data Channel m = Channel {

    send :: LBS.ByteString -> m (),

    recv :: STM m (Maybe LBS.ByteString)
  }

The Driver type can stay as is. However codec type is not general enough:

data Codec ps failure m bytes = Codec {
       encode :: forall (st :: ps) (st' :: ps).
                 SingI st
              => ActiveState st
              => Message ps st st'
              -> bytes,

       decode :: forall (st :: ps).
                 ActiveState st
              => Sing st
              -> m (DecodeStep bytes failure m (SomeMessage st))
     }

We will need a codec which works in both m and STM m. cborg requires access to the ST operations, e.g. mkCodecCborStrictST but STM monad has no MonadST instance.

In coot/typed-protocols-rewrite branch we have:

runDecoderWithChannel :: MonadSTM m
                      => Channel m bytes
                      -> Maybe bytes
                      -> DecodeStep bytes failure m a
                      -> m (Either failure (a, Maybe bytes))


tryRunDecoderWithChannel :: Monad m
                         => Channel m bytes
                         -> Maybe bytes
                         -> DecodeStep bytes failure m (SomeMessage st)
                         -> m (Either failure
                                (Either (DriverState ps pr st bytes failure (Maybe bytes) m)
                                        (SomeMessage st, Maybe bytes)))

because of the above constraint we cannot change its signature to STM m, but we can guarantee that all recvs are non blocking (e.g. atomically $ Just <$> recv `orElse` pure Nothing).

The tryRunDecoderWithChannel one is used to implement the tryRecvMessage record field of Driver. And it is plausible to implement it with recv :: STM m (Maybe ByteString))

data Driver ps (pr :: PeerRole) bytes failure dstate m =
        Driver {
          ...
          tryRecvMessage :: forall (st :: ps).
                            SingI st
                         => ActiveState st
                         => ReflRelativeAgency (StateAgency st)
                                                TheyHaveAgency
                                               (Relative pr (StateAgency st))
                         -> DriverState ps pr st bytes failure dstate m
                         -> m (Either (DriverState ps pr st bytes failure dstate m)
                                      ( SomeMessage st
                                      , dstate
                                      ))
        , -- | Construct a non-blocking stm action which awaits for the
          -- message.
          --
          recvMessageSTM :: forall (st :: ps).
                            SingI st
                         => ActiveState st
                         => ReflRelativeAgency (StateAgency st)
                                                TheyHaveAgency
                                               (Relative pr (StateAgency st))
                         -> DriverState ps pr st bytes failure dstate m
                         -> m (STM m (SomeMessage st, dstate))

        , startDState    :: dstate
        }

The question is how we can implement recvMessageSTM. For that it seems that being able to run a decoder in the STM monad (without forking a thread) is indispensable.

GHC exposes unsafeIOToSTM which could be used to lift ST to STM (via IO), but this is rather dodgy way, so a different solution is needed. On the other hand, a rudimentary inspection of cborg library shows that ST is deeply grained, e.g.

@coot coot self-assigned this Jun 24, 2022
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
No open projects
Status: No status
Development

No branches or pull requests

1 participant