1e60c05...master · curryer

git.iko.soy/curryer

5 files changed+35−20

since splitsnapshots

unifiedsplit

Changelog.markdown+4 README.markdown+4 cabal.project+1−1 curryer.cabal → curryer-rpc.cabal+9−8 src/Network/RPC/Curryer/Server.hs+17−11

Changelog.markdownnew file+4

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

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

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

README.markdown+4

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

1111* timeouts

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

1313

14+## Requirements

15+

16+* GHC 8.6+

17+

1418## Code Example

1519

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

cabal.project+1−1

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

33source-repository-package

44 type: git

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

6− tag: ac3af8749194f1788704dda8667d0b3807075cc2

6+ tag: 4e48b52e8709390a47e99c107ebed2d1c9420076

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

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

1−Name: curryer

1+Name: curryer-rpc

22Version: 0.1

33License: PublicDomain

44Build-Type: Simple

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

1111Cabal-Version: >= 1.10

1212Synopsis: Fast, Haskell RPC

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

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

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

1515

1616Source-Repository head

1717 Type: git

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

1919

2020Library

21− Build-Depends: base >= 4.8

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

2222 , winery

2323 , bytestring

2424 , streamly >= 0.7.2

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

5151 build-depends: tasty

5252 , tasty-hunit

5353 , base

54− , curryer

54+ , curryer-rpc

5555 , winery

5656 , network

5757 , async

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

6161Benchmark perf

6262 Default-Language: Haskell2010

6363 Default-Extensions: OverloadedStrings

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

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

6565

6666 Main-Is: Basic.hs

6767 Type: exitcode-stdio-1.0

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

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

69+ -- -fprof-auto

6970 HS-Source-Dirs: ./bench

7071

7172Executable SimpleKeyValueServer

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

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

7374 Main-Is: examples/SimpleKeyValueServer.hs

7475 GHC-Options: -Wall -threaded

7576 Default-Language: Haskell2010

7677

7778Executable SimpleKeyValueClient

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

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

7980 Main-Is: examples/SimpleKeyValueClient.hs

8081 GHC-Options: -Wall -threaded

8182 Default-Language: Haskell2010

src/Network/RPC/Curryer/Server.hs+17−11

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

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

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

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

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

44module Network.RPC.Curryer.Server where

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

3535import System.Timeout

3636import qualified Network.ByteOrder as BO

3737

38+

3839-- for toArrayS conversion

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

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

41−import Foreign.ForeignPtr (plusForeignPtr)

40+import qualified Data.ByteString.Internal as BSI

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

4242import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

43−import GHC.Ptr (plusPtr)

44−-}

43+import GHC.Ptr (minusPtr)

44+

4545-- define CURRYER_SHOW_BYTES 1

4646#if CURRYER_SHOW_BYTES == 1

4747import Debug.Trace

@@ -116,8 +116,8 @@ sendMessage :: Serialise a => Locking Socket -> a -> IO ()

116116sendMessage lockSock msg = do

117117 requestID <- UUID <$> UUIDBase.nextRandom

118118 let env =

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

120− timeout = 0

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

120+ timeout' = 0

121121 sendEnvelope env lockSock

122122

123123--avoid orphan instance

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

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

160160envelopeP :: Parser IO Word8 Envelope

161161envelopeP = do

162− let s = FL.toList

163− msgTypeP = (P.satisfy (== 0) *>

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

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

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

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

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

171170 if c == 0 then

172171 pure BS.empty

173172 else

174− BS.pack <$> P.takeEQ c s

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

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

176175

177176encodeEnvelope :: Envelope -> BS.ByteString

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

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

335334fingerprint = typeRepFingerprint . typeOf

336335

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