Skip to content

Commit

Permalink
Trailers-only tutorial
Browse files Browse the repository at this point in the history
  • Loading branch information
edsko committed Oct 25, 2024
1 parent 94dead4 commit 20c5f62
Show file tree
Hide file tree
Showing 7 changed files with 196 additions and 1 deletion.
13 changes: 12 additions & 1 deletion .github/workflows/haskell-ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -163,6 +163,7 @@ jobs:
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/./tutorials/metadata" >> cabal.project ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/./tutorials/monadstack" >> cabal.project ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/./tutorials/conduit" >> cabal.project ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/./tutorials/trailers-only" >> cabal.project ; fi
cat cabal.project
- name: sdist
run: |
Expand Down Expand Up @@ -190,6 +191,8 @@ jobs:
echo "PKGDIR_monadstack_tutorial=${PKGDIR_monadstack_tutorial}" >> "$GITHUB_ENV"
PKGDIR_conduit_tutorial="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/conduit-tutorial-[0-9.]*')"
echo "PKGDIR_conduit_tutorial=${PKGDIR_conduit_tutorial}" >> "$GITHUB_ENV"
PKGDIR_trailers_only_tutorial="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/trailers-only-tutorial-[0-9.]*')"
echo "PKGDIR_trailers_only_tutorial=${PKGDIR_trailers_only_tutorial}" >> "$GITHUB_ENV"
rm -f cabal.project cabal.project.local
touch cabal.project
touch cabal.project.local
Expand All @@ -201,6 +204,7 @@ jobs:
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: ${PKGDIR_metadata_tutorial}" >> cabal.project ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: ${PKGDIR_monadstack_tutorial}" >> cabal.project ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: ${PKGDIR_conduit_tutorial}" >> cabal.project ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: ${PKGDIR_trailers_only_tutorial}" >> cabal.project ; fi
echo "package grpc-spec" >> cabal.project
echo " ghc-options: -Werror=missing-methods" >> cabal.project
echo "package grapesy" >> cabal.project
Expand All @@ -217,6 +221,8 @@ jobs:
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "package conduit-tutorial" >> cabal.project ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "package trailers-only-tutorial" >> cabal.project ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi
cat >> cabal.project <<EOF
allow-newer: proto-lens:base
allow-newer: proto-lens-runtime:base
Expand Down Expand Up @@ -249,8 +255,11 @@ jobs:
package conduit-tutorial
ghc-options: -Werror
package trailers-only-tutorial
ghc-options: -Werror
EOF
$HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(basics-tutorial|conduit-tutorial|grapesy|grpc-spec|lowlevel-tutorial|metadata-tutorial|monadstack-tutorial|quickstart-tutorial)$/; }' >> cabal.project.local
$HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(basics-tutorial|conduit-tutorial|grapesy|grpc-spec|lowlevel-tutorial|metadata-tutorial|monadstack-tutorial|quickstart-tutorial|trailers-only-tutorial)$/; }' >> cabal.project.local
cat cabal.project
cat cabal.project.local
- name: dump install plan
Expand Down Expand Up @@ -294,6 +303,8 @@ jobs:
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then cd ${PKGDIR_conduit_tutorial} || false ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then cd ${PKGDIR_trailers_only_tutorial} || false ; fi
if [ $((HCNUMVER < 91000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi
- name: haddock
run: |
$CABAL v2-haddock --disable-documentation $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
Expand Down
1 change: 1 addition & 0 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ packages:
, ./tutorials/metadata
, ./tutorials/monadstack
, ./tutorials/conduit
, ./tutorials/trailers-only

package grpc-spec
tests: True
Expand Down
4 changes: 4 additions & 0 deletions cabal.project.ci
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ packages:
, ./tutorials/metadata
, ./tutorials/monadstack
, ./tutorials/conduit
, ./tutorials/trailers-only

package grpc-spec
tests: True
Expand Down Expand Up @@ -37,6 +38,9 @@ package monadstack-tutorial
package conduit-tutorial
ghc-options: -Werror

package trailers-only-tutorial
ghc-options: -Werror

--
-- ghc 9.10
--
Expand Down
31 changes: 31 additions & 0 deletions tutorials/trailers-only/LICENSE
Original file line number Diff line number Diff line change
@@ -0,0 +1,31 @@
Copyright (c) 2023-2024, Well-Typed LLP and Anduril Industries Inc.

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.

* Neither the name of Well-Typed LLP, the name of Anduril
Industries Inc., nor the names of other contributors may be
used to endorse or promote products derived from this software
without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
12 changes: 12 additions & 0 deletions tutorials/trailers-only/README.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
# Basics tutorial, taking advantage of the gRPC Trailers-Only case

See `/tutorials/basics` for the more direct `grapesy` translation of the
[official Basics tutorial](https://grpc.io/docs/languages/python/basics/).

In this tutorial we re-implement the server using the low-level API (similar to
what we did in `/tutorials/lowlevel`), but taking advantage of the Trailers-Only
case in `listFeatures`.

We don't re-implement the client (you can run the client from
`tutorials/basics`).

92 changes: 92 additions & 0 deletions tutorials/trailers-only/app/Server.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,92 @@
module Server (main) where

import Control.Monad
import Data.IORef
import Data.Maybe (fromMaybe)
import Data.Time

import Network.GRPC.Common
import Network.GRPC.Common.Protobuf
import Network.GRPC.Common.StreamElem qualified as StreamElem
import Network.GRPC.Server
import Network.GRPC.Server.Protobuf
import Network.GRPC.Server.Run
import Network.GRPC.Server.StreamType (Methods(..), fromMethods)

import Proto.API.RouteGuide

import RouteGuide

{-------------------------------------------------------------------------------
Individual handlers
-------------------------------------------------------------------------------}

getFeature :: DB -> Call (Protobuf RouteGuide "getFeature") -> IO ()
getFeature db call = do
p <- recvFinalInput call
sendFinalOutput call (
fromMaybe (defMessage & #location .~ p) (featureAt db p)
, NoMetadata
)

listFeatures :: DB -> Call (Protobuf RouteGuide "listFeatures") -> IO ()
listFeatures db call = do
r <- recvFinalInput call
case featuresIn db r of
[] -> sendTrailersOnly call NoMetadata
ps -> StreamElem.forM_ ps NoMetadata (sendOutput call)

recordRoute :: DB -> Call (Protobuf RouteGuide "recordRoute") -> IO ()
recordRoute db call = do
start <- getCurrentTime
(ps, NoMetadata) <- StreamElem.collect (recvInput call)
stop <- getCurrentTime
sendFinalOutput call (
summary db (stop `diffUTCTime` start) ps
, NoMetadata
)

routeChat :: Call (Protobuf RouteGuide "routeChat") -> IO ()
routeChat call = do
st :: IORef Chat <- newIORef emptyChat
NoMetadata <- StreamElem.whileNext_ (recvInput call) $ \note -> do
prev <- atomicModifyIORef st $ \chat -> (
recordNote note chat
, getNotes chat (note ^. #location)
)
-- Can't use StreamElem.forM_ here: we don't want to send 'FinalElem' yet
forM_ prev $ sendNextOutput call
sendTrailers call NoMetadata

{-------------------------------------------------------------------------------
Server top-level
-------------------------------------------------------------------------------}

methods :: DB -> Methods IO (ProtobufMethodsOf RouteGuide)
methods db =
RawMethod (mkRpcHandler $ getFeature db)
$ RawMethod (mkRpcHandler $ listFeatures db)
$ RawMethod (mkRpcHandler $ recordRoute db)
$ RawMethod (mkRpcHandler $ routeChat )
$ NoMoreMethods


-- Alternative way to define the handlers, avoiding 'fromMethods'
_handlers :: DB -> [SomeRpcHandler IO]
_handlers db = [
someRpcHandler . mkRpcHandler $ getFeature db
, someRpcHandler . mkRpcHandler $ listFeatures db
, someRpcHandler . mkRpcHandler $ recordRoute db
, someRpcHandler . mkRpcHandler $ routeChat
]

main :: IO ()
main = do
db <- getDB
runServerWithHandlers def config $ fromMethods (methods db)
where
config :: ServerConfig
config = ServerConfig {
serverInsecure = Just (InsecureConfig Nothing defaultInsecurePort)
, serverSecure = Nothing
}
44 changes: 44 additions & 0 deletions tutorials/trailers-only/trailers-only-tutorial.cabal
Original file line number Diff line number Diff line change
@@ -0,0 +1,44 @@
cabal-version: 3.0
name: trailers-only-tutorial
synopsis: gRPC basics tutorial for grapesy, taking advantage of
the gRPC Trailers-Only case.
version: 0.1.0
license: BSD-3-Clause
license-file: LICENSE
author: Edsko de Vries
maintainer: [email protected]
build-type: Simple
tested-with: GHC==8.10.7
, GHC==9.2.8
, GHC==9.4.8
, GHC==9.6.6
, GHC==9.8.2

common lang
build-depends: base >= 4.14 && < 5
default-language: Haskell2010
ghc-options: -Wall

if impl(ghc >= 9.0)
ghc-options:
-Wunused-packages

default-extensions:
DataKinds
ImportQualifiedPost
NumericUnderscores
OverloadedLabels
OverloadedStrings
ScopedTypeVariables
TypeApplications

executable route_guide_server
import: lang
main-is: Server.hs
hs-source-dirs: app
ghc-options: -main-is Server
build-depends: basics-tutorial

build-depends:
, grapesy >= 0.1 && < 0.2
, time >= 1.9 && < 1.13

0 comments on commit 20c5f62

Please sign in to comment.