master..a7664a3 · curryer

git.iko.soy/curryer

on a7664a3 help sign in

cabal.project+1−1

since splitsnapshots

unifiedsplit

@@ -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+1−2

@@ -65,8 +65,7 @@ Benchmark perf

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

src/Network/RPC/Curryer/Server.hs+9−15

@@ -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

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

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

160envelopeP :: Parser IO Word8 Envelope

161envelopeP = do

162+ let s = FL.toList

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

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

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

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

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

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

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

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

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

170 if c == 0 then

171 if c == 0 then

171 pure BS.empty

172 pure BS.empty

172 else

173 else

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

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

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

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

175

176

176encodeEnvelope :: Envelope -> BS.ByteString

177encodeEnvelope :: Envelope -> BS.ByteString

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

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

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

334fingerprint = typeRepFingerprint . typeOf

335fingerprint = typeRepFingerprint . typeOf

335

336

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