Skip to content
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
39 commits
Select commit Hold shift + click to select a range
08ee7c4
typed-protocols: new API
coot Jul 25, 2024
81f2fbe
typed-protocols: Peer pattern synonyms
coot Jul 25, 2024
fe36759
typed-protocols-examples: updated
coot Jul 25, 2024
88d246f
typed-protocols: ActiveAgency
coot Sep 6, 2021
b121a80
typed-protocols: simplify runPeerWithDriver
coot Mar 27, 2022
bdf8100
typed-protocols: internal lemmas module
coot May 23, 2022
564da48
typed-protocols: provide ReflRelativeAgency type aliases
coot Jul 13, 2022
6f5ce41
typed-protocols-examples: socketAsChannel
coot Sep 4, 2021
c69993a
typed-protocols-examples: ReqResp2 example
coot Sep 17, 2021
e4bcf98
typed-protocols-examples: Wedge
coot Sep 18, 2021
86d007a
typed-protocols-examples: requestOnce
coot Sep 28, 2021
b4070d4
typed-protocols-examples: fixed cborg tests
coot Oct 2, 2021
74a64f2
typed-protocols-examples: pipelined tests
coot Oct 2, 2021
5ef5f2d
typed-protocols-examples: unbounded buffered channel
coot Mar 27, 2022
ce833a9
typed-protocols-examples: added runConnectedPeersAsymetric
coot Mar 27, 2022
1ca4aa7
typed-protocols: simplify evidence of termination in a terminal state
coot May 13, 2022
558a9fc
typed-protocols: added StateToken type family to Protocol type class
coot Jun 23, 2022
03270e4
typed-protocols: renamed Pipelined kind to IsPipelined
coot Jul 13, 2022
6b6118d
typed-protocols: added AnyMessageAndAgency pattern synonym
coot Sep 8, 2023
abecdaf
typed-protocols: added application specific singletons for protocol s…
coot Sep 26, 2023
a81caa1
typed-protocols-examples: relaxed constraint in PingPong client
coot Jul 1, 2022
166f5af
typed-protocols-examples: fixed a socket test on macos
coot Aug 17, 2022
f5ccedd
typed-protocols: bump version to `0.2.0.0`
coot Aug 25, 2023
148a91b
Added CHANGELOG and bumped versions of the packages
coot May 17, 2022
6c6a8ce
typed-protocols: moved outstanding counter into IsPipelined kind
coot Jul 23, 2024
d2f1e74
typed-protocols-stateful: non-pipelined stateful Peer
coot Jul 24, 2024
0d9cb77
typed-protocols: moved types to `Core` module
coot Jul 24, 2024
5ec9a8c
typed-protocols: connectPipelined type signature
coot Jul 24, 2024
8d31814
typed-protocols: added PeerPipelined newtype wrapper
coot Jul 24, 2024
b3ba779
Support io-classes-1.7
coot Jul 26, 2024
b23f327
typed-protocols: added haddocks
coot Aug 19, 2024
72a799c
disabled `typed-protocols-doc` in GHA
coot Aug 22, 2024
5cf79f3
stylish-haskell: fixes
coot Aug 22, 2024
b9e71bb
typed-protocols: removed unused extensions
coot Aug 23, 2024
20aa2fe
Improved haddocks, removed unused pragmas (extensions)
coot Aug 23, 2024
bdcf30a
Core module cannot be checked with stylish-haskell
coot Aug 23, 2024
0042b72
Removed Stateful PingPong example
coot Sep 4, 2024
b195c92
Stateful RPC example
coot Sep 5, 2024
f451040
typed-protocols: fixed typos
coot Sep 14, 2024
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
Improved haddocks, removed unused pragmas (extensions)
  • Loading branch information
coot committed Sep 16, 2024
commit 20aa2fe25efcaaebb6a14e8e91baadf73ff07259
28 changes: 18 additions & 10 deletions typed-protocols-cborg/src/Network/TypedProtocol/Codec/CBOR.hs
Original file line number Diff line number Diff line change
@@ -1,17 +1,19 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Network.TypedProtocol.Codec.CBOR
( module Network.TypedProtocol.Codec
, DeserialiseFailure
, mkCodecCborLazyBS
, mkCodecCborStrictBS
, convertCborDecoderBS
, convertCborDecoderLBS
-- * Re-exports
, CBOR.DeserialiseFailure (..)
) where

import Control.Monad.Class.MonadST (MonadST (..))
Expand All @@ -31,8 +33,6 @@ import Network.TypedProtocol.Codec
import Network.TypedProtocol.Core


type DeserialiseFailure = CBOR.DeserialiseFailure

-- | Construct a 'Codec' for a CBOR based serialisation format, using strict
-- 'BS.ByteString's.
--
Expand All @@ -52,13 +52,15 @@ mkCodecCborStrictBS
StateTokenI st
=> ActiveState st
=> Message ps st st' -> CBOR.Encoding)
-- ^ cbor encoder

-> (forall (st :: ps) s.
ActiveState st
=> StateToken st
-> CBOR.Decoder s (SomeMessage st))
-- ^ cbor decoder

-> Codec ps DeserialiseFailure m BS.ByteString
-> Codec ps CBOR.DeserialiseFailure m BS.ByteString
mkCodecCborStrictBS cborMsgEncode cborMsgDecode =
Codec {
encode = \msg -> convertCborEncoder cborMsgEncode msg,
Expand All @@ -72,20 +74,22 @@ mkCodecCborStrictBS cborMsgEncode cborMsgDecode =

convertCborDecoder
:: (forall s. CBOR.Decoder s a)
-> m (DecodeStep BS.ByteString DeserialiseFailure m a)
-> m (DecodeStep BS.ByteString CBOR.DeserialiseFailure m a)
convertCborDecoder cborDecode =
convertCborDecoderBS cborDecode stToIO

convertCborDecoderBS
:: forall s m a. Functor m
=> (CBOR.Decoder s a)
=> CBOR.Decoder s a
-- ^ cbor decoder
-> (forall b. ST s b -> m b)
-> m (DecodeStep BS.ByteString DeserialiseFailure m a)
-- ^ lift ST computation (e.g. 'Control.Monad.ST.stToIO', 'stToPrim', etc)
-> m (DecodeStep BS.ByteString CBOR.DeserialiseFailure m a)
convertCborDecoderBS cborDecode liftST =
go <$> liftST (CBOR.deserialiseIncremental cborDecode)
where
go :: CBOR.IDecode s a
-> DecodeStep BS.ByteString DeserialiseFailure m a
-> DecodeStep BS.ByteString CBOR.DeserialiseFailure m a
go (CBOR.Done trailing _ x)
| BS.null trailing = DecodeDone x Nothing
| otherwise = DecodeDone x (Just trailing)
Expand All @@ -108,11 +112,13 @@ mkCodecCborLazyBS
StateTokenI st
=> ActiveState st
=> Message ps st st' -> CBOR.Encoding)
-- ^ cbor encoder

-> (forall (st :: ps) s.
ActiveState st
=> StateToken st
-> CBOR.Decoder s (SomeMessage st))
-- ^ cbor decoder

-> Codec ps CBOR.DeserialiseFailure m LBS.ByteString
mkCodecCborLazyBS cborMsgEncode cborMsgDecode =
Expand All @@ -135,8 +141,10 @@ mkCodecCborLazyBS cborMsgEncode cborMsgDecode =

convertCborDecoderLBS
:: forall s m a. Monad m
=> (CBOR.Decoder s a)
=> CBOR.Decoder s a
-- ^ cbor decoder
-> (forall b. ST s b -> m b)
-- ^ lift ST computation (e.g. 'Control.Monad.ST.stToIO', 'stToPrim', etc)
-> m (DecodeStep LBS.ByteString CBOR.DeserialiseFailure m a)
convertCborDecoderLBS cborDecode liftST =
go [] =<< liftST (CBOR.deserialiseIncremental cborDecode)
Expand All @@ -156,7 +164,7 @@ convertCborDecoderLBS cborDecode liftST =
-- We keep a bunch of chunks and supply the CBOR decoder with them
-- until we run out, when we go get another bunch.
go (c:cs) (CBOR.Partial k) = go cs =<< liftST (k (Just c))
go [] (CBOR.Partial k) = return $ DecodePartial $ \mbs -> case mbs of
go [] (CBOR.Partial k) = return $ DecodePartial $ \case
Nothing -> go [] =<< liftST (k Nothing)
Just bs -> go cs (CBOR.Partial k)
where cs = LBS.toChunks bs
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -42,12 +42,9 @@ data SPingPong (st :: PingPong) where

deriving instance Show (SPingPong st)

instance StateTokenI StIdle where
stateToken = SingIdle
instance StateTokenI StBusy where
stateToken = SingBusy
instance StateTokenI StDone where
stateToken = SingDone
instance StateTokenI StIdle where stateToken = SingIdle
instance StateTokenI StBusy where stateToken = SingBusy
instance StateTokenI StDone where stateToken = SingDone

instance Protocol PingPong where

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -49,12 +49,14 @@ mkCodecCborStrictBS
StateTokenI st
=>ActiveState st
=> f st' -> Message ps st st' -> CBOR.Encoding)
-- ^ cbor encoder

-> (forall (st :: ps) s.
ActiveState st
=> StateToken st
-> f st
-> CBOR.Decoder s (SomeMessage st))
-- ^ cbor decoder

-> Codec ps DeserialiseFailure f m BS.ByteString
mkCodecCborStrictBS cborMsgEncode cborMsgDecode =
Expand Down Expand Up @@ -90,12 +92,14 @@ mkCodecCborLazyBS
=> ActiveState st
=> f st'
-> Message ps st st' -> CBOR.Encoding)
-- ^ cbor encoder

-> (forall (st :: ps) s.
ActiveState st
=> StateToken st
-> f st
-> CBOR.Decoder s (SomeMessage st))
-- ^ cbor decoder

-> Codec ps CBOR.DeserialiseFailure f m LBS.ByteString
mkCodecCborLazyBS cborMsgEncode cborMsgDecode =
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -24,16 +24,23 @@ module Network.TypedProtocol.Stateful.Codec
, isoCodec
, mapFailureCodec
, liftCodec
-- ** Related types
, ActiveState
, PeerRole (..)
, SomeMessage (..)
, CodecFailure (..)
-- ** Incremental decoding
, DecodeStep (..)
, runDecoder
, runDecoderPure
-- ** Codec properties
-- ** Related types
-- *** SomeMessage
, SomeMessage (..)
-- *** StateToken
, StateToken
, StateTokenI (..)
-- *** ActiveState
, ActiveState
-- *** PeerRole
, PeerRole (..)
-- * CodecFailure
, CodecFailure (..)
-- * Testing codec properties
, AnyMessage (..)
, pattern AnyMessageAndAgency
, prop_codecM
Expand All @@ -42,9 +49,6 @@ module Network.TypedProtocol.Stateful.Codec
, prop_codec_splits
, prop_codecs_compatM
, prop_codecs_compat
-- ** StateToken
, StateToken
, StateTokenI (..)
) where

import Data.Kind (Type)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -13,12 +13,13 @@
-- imported qualified.
--
module Network.TypedProtocol.Stateful.Driver
( -- * Running a peer
runPeerWithDriver
( -- * DriverIngerface
Driver (..)
-- * Running a peer
, runPeerWithDriver
-- * Re-exports
, DecodeStep (..)
, Driver (..)
, SomeMessage (..)
, DecodeStep (..)
) where

import Control.Monad.Class.MonadSTM
Expand Down Expand Up @@ -46,12 +47,6 @@ data Driver ps (pr :: PeerRole) bytes failure dstate f m =

, -- | Receive a message, a blocking action which reads from the network
-- and runs the incremental decoder until a full message is decoded.
-- As an input it might receive a 'DecodeStep' previously started with
-- 'tryRecvMessage'.
--
-- It could be implemented in terms of 'recvMessageSTM', but in some
-- cases it can be easier (or more performant) to have a different
-- implementation.
--
recvMessage :: forall (st :: ps).
StateTokenI st
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -46,8 +46,8 @@ import Network.TypedProtocol.Core as Core
--
-- For example:
--
-- > pingPongClientExample :: Int -> Peer PingPong AsClient StIdle m ()
-- > pingPongServerExample :: Peer PingPong AsServer StIdle m Int
-- > pingPongClientExample :: Peer PingPong AsClient StIdle m ()
-- > pingPongServerExample :: Peer PingPong AsServer StIdle m Int
--
-- The actions that a peer can take are:
--
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,8 @@
-- singleton.
--
module Network.TypedProtocol.Stateful.Peer.Client
( Client
( -- * Client type alias and its pattern synonyms
Client
, pattern Effect
, pattern Yield
, pattern Await
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,8 @@
-- singleton.
--
module Network.TypedProtocol.Stateful.Peer.Server
( Server
( -- * Server type alias and its pattern synonyms
Server
, pattern Effect
, pattern Yield
, pattern Await
Expand Down
2 changes: 0 additions & 2 deletions typed-protocols/src/Network/TypedProtocol.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@ module Network.TypedProtocol
-- * Defining and implementing protocols
-- $defining
module Network.TypedProtocol.Core
, module Network.TypedProtocol.Peer
-- ** Protocol proofs and tests
-- $tests
, module Network.TypedProtocol.Proofs
Expand All @@ -19,7 +18,6 @@ module Network.TypedProtocol

import Network.TypedProtocol.Core
import Network.TypedProtocol.Driver
import Network.TypedProtocol.Peer
import Network.TypedProtocol.Proofs


Expand Down
Loading