master..f67c45d · curryer

git.iko.soy/curryer

on f67c45d help sign in

Changelog.markdowndeleted−4

since splitsnapshots

unifiedsplit

@@ -1,4 +0,0 @@

1−# v0.1 (2020-12-27)

2−

3−* initial release to support [Project:M36](https://github.com/agentm/project-m36)

4−

README.markdown−4

@@ -11,10 +11,6 @@ Curryer is inspired by the now unmaintained [distributed-process](https://hackag

11* timeouts

12* leverages [winery](https://hackage.haskell.org/package/winery) for high-performance serialization

14−## Requirements

15−

16−* GHC 8.6+

17−

18## Code Example

14## Code Example

20[Server](https://github.com/agentm/curryer/examples/SimpleKeyValueServer.hs):

16[Server](https://github.com/agentm/curryer/examples/SimpleKeyValueServer.hs):

cabal.project+1−1

@@ -3,4 +3,4 @@ packages: .

3source-repository-package

4 type: git

5 location: https://github.com/composewell/streamly.git

6− tag: 4e48b52e8709390a47e99c107ebed2d1c9420076

6+ tag: ac3af8749194f1788704dda8667d0b3807075cc2

curryer-rpc.cabal → curryer.cabalrenamed+8−9

@@ -1,4 +1,4 @@

1−Name: curryer-rpc

1+Name: curryer

2Version: 0.1

3License: PublicDomain

4Build-Type: Simple

@@ -11,14 +11,14 @@ Maintainer: agentm@themactionfaction.com

11Cabal-Version: >= 1.10

12Synopsis: Fast, Haskell RPC

13Description: Haskell-to-Haskell RPC using Winery serialization.

14−Extra-Source-Files: Changelog.markdown README.markdown cabal.project

14+Extra-Source-Files: Changelog.markdown README.markdown

16Source-Repository head

17 Type: git

18 location: https://github.com/agentm/curryer

20Library

21− Build-Depends: base >= 4.12 && < 4.15

21+ Build-Depends: base >= 4.8

22 , winery

23 , bytestring

24 , streamly >= 0.7.2

@@ -51,7 +51,7 @@ Test-Suite test

51 build-depends: tasty

52 , tasty-hunit

53 , base

54− , curryer-rpc

54+ , curryer

55 , winery

56 , network

57 , async

@@ -61,22 +61,21 @@ Test-Suite test

61Benchmark perf

62 Default-Language: Haskell2010

63 Default-Extensions: OverloadedStrings

64− Build-Depends: base, criterion, curryer-rpc, network, winery, async, bytestring

64+ Build-Depends: base, criterion, curryer, network, winery, async, bytestring

66 Main-Is: Basic.hs

67 Type: exitcode-stdio-1.0

68− GHC-Options: -Wall -threaded -rtsopts

68+ GHC-Options: -Wall -threaded -rtsopts -fprof-auto

69− -- -fprof-auto

70 HS-Source-Dirs: ./bench

69 HS-Source-Dirs: ./bench

72Executable SimpleKeyValueServer

71Executable SimpleKeyValueServer

73− Build-Depends: stm-containers, stm, base, curryer-rpc, winery

72+ Build-Depends: stm-containers, stm, base, curryer, winery

74 Main-Is: examples/SimpleKeyValueServer.hs

73 Main-Is: examples/SimpleKeyValueServer.hs

75 GHC-Options: -Wall -threaded

74 GHC-Options: -Wall -threaded

76 Default-Language: Haskell2010

75 Default-Language: Haskell2010

78Executable SimpleKeyValueClient

77Executable SimpleKeyValueClient

79− Build-Depends: stm, base, curryer-rpc, winery, optparse-generic

78+ Build-Depends: stm, base, curryer, winery, optparse-generic

80 Main-Is: examples/SimpleKeyValueClient.hs

79 Main-Is: examples/SimpleKeyValueClient.hs

81 GHC-Options: -Wall -threaded

80 GHC-Options: -Wall -threaded

82 Default-Language: Haskell2010

81 Default-Language: Haskell2010

src/Network/RPC/Curryer/Server.hs+14−21

@@ -1,4 +1,4 @@

1−{-# LANGUAGE DerivingVia, DeriveGeneric, RankNTypes, ScopedTypeVariables, MultiParamTypeClasses, OverloadedStrings, GeneralizedNewtypeDeriving, CPP, ExistentialQuantification, StandaloneDeriving, GADTs, RecordWildCards #-}

1+{-# LANGUAGE DerivingVia, DeriveGeneric, RankNTypes, ScopedTypeVariables, MultiParamTypeClasses, OverloadedStrings, GeneralizedNewtypeDeriving, CPP, ExistentialQuantification, StandaloneDeriving, GADTs #-}

2{-# OPTIONS_GHC -fno-warn-orphans #-}

3{- HLINT ignore "Use lambda-case" -}

4module Network.RPC.Curryer.Server where

@@ -35,13 +35,13 @@ import Data.Hashable

35import System.Timeout

36import qualified Network.ByteOrder as BO

38−

39-- for toArrayS conversion

38-- for toArrayS conversion

40−import qualified Data.ByteString.Internal as BSI

39+{-import qualified Data.ByteString.Internal as BSI

41−import qualified Streamly.Internal.Data.Array.Storable.Foreign.Types as Arr

40+import qualified Streamly.Internal.Data.Array.Storable.Foreign.Types as SA

41+import Foreign.ForeignPtr (plusForeignPtr)

42import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

43−import GHC.Ptr (minusPtr)

43+import GHC.Ptr (plusPtr)

44−

44+-}

45-- define CURRYER_SHOW_BYTES 1

46#if CURRYER_SHOW_BYTES == 1

47import Debug.Trace

@@ -111,14 +111,13 @@ data ConnectionState a = ConnectionState {

111 connectionSocket :: Locking Socket

112 }

113

114−-- | Used by server-side request handlers to send additional messages to the client. This is useful for sending asynchronous responses to the client outside of the normal request-response flow. The locking socket can be found in the ConnectionState when a request handler is called.

114+-- | Used by server-side request handlers to send additional messages to the client. This is useful for sending asynchronous responses to the client outside of the normal request-response flow.

115−sendMessage :: Serialise a => Locking Socket -> a -> IO ()

115+sendMessage :: Serialise a => ConnectionState s -> a -> IO ()

116−sendMessage lockSock msg = do

116+sendMessage sState msg = do

117 requestID <- UUID <$> UUIDBase.nextRandom

118 let env =

119− Envelope (fingerprint msg) (RequestMessage timeout') requestID (serialise msg)

119+ Envelope (fingerprint msg) (RequestMessage 0) requestID (serialise msg)

120− timeout' = 0

121− sendEnvelope env lockSock

120+ sendEnvelope env (connectionSocket sState)

122

121

123--avoid orphan instance

122--avoid orphan instance

124newtype UUID = UUID { _unUUID :: UUIDBase.UUID }

123newtype UUID = UUID { _unUUID :: UUIDBase.UUID }

@@ -159,7 +158,8 @@ localHostAddr = (127,0,0,1)

159-- Each message is length-prefixed by a 32-bit unsigned length.

158-- Each message is length-prefixed by a 32-bit unsigned length.

160envelopeP :: Parser IO Word8 Envelope

159envelopeP :: Parser IO Word8 Envelope

161envelopeP = do

160envelopeP = do

161+ let s = FL.toList

162− let msgTypeP = (P.satisfy (== 0) *>

162+ msgTypeP = (P.satisfy (== 0) *>

163 (RequestMessage . fromIntegral <$> word32P)) `P.alt`

164 (P.satisfy (== 1) $> ResponseMessage) `P.alt`

165 (P.satisfy (== 2) $> TimeoutResponseMessage) `P.alt`

@@ -170,7 +170,7 @@ envelopeP = do

170 if c == 0 then

171 pure BS.empty

172 else

173− fromArray <$> P.takeEQ c (Arr.writeN c)

173+ BS.pack <$> P.takeEQ c s

174 Envelope <$> fingerprintP <*> msgTypeP <*> uuidP <*> lenPrefixedByteStringP

175

176encodeEnvelope :: Envelope -> BS.ByteString

@@ -333,10 +333,3 @@ sendEnvelope envelope sockLock = do

333fingerprint :: Typeable a => a -> Fingerprint

334fingerprint = typeRepFingerprint . typeOf

335

336−fromArray :: Arr.Array Word8 -> BSI.ByteString

337−fromArray Arr.Array {..}

338− | aLen == 0 = mempty

339− | otherwise = BSI.PS aStart 0 aLen

340− where

341− aStartPtr = unsafeForeignPtrToPtr aStart

342− aLen = aEnd `minusPtr` aStartPtr

test/Curryer/Test/Basic.hs+1−1

@@ -78,7 +78,7 @@ testServerRequestHandlers mAsyncMVar =

78 maybe (pure ()) (\mvar -> putMVar mvar v) mAsyncMVar

79 -- an async hello to the server generates an async hello to the client

80 , AsyncRequestHandler $ \sState (AsyncHelloReq s) -> do

81− sendMessage (connectionSocket sState) (AsyncHelloReq s)

81+ sendMessage sState (AsyncHelloReq s)

83 , RequestHandler $ \_ (RoundtripStringReq s) -> pure s

84 , RequestHandler $ \_ (DelayMicrosecondsReq ms) -> do