network-rpca-0.0.1: examples/service.hs

module Main where

import qualified Data.ByteString as BS
import qualified Data.Map as Map
import Control.Concurrent
import Control.Concurrent.STM
import Control.Timeout

import Network.RPCA.Structs
import Network.RPCA.ExportedService
import Network.RPCA.Util
import qualified Network.RPCA.Port as Port

import Codec.Libevent.Class as Tagged
import qualified TestRPC

-- These two callbacks demo the use of raw callback (where the payload doesn't
-- have to be a Libevent structure)
quickRPC :: Callback
quickRPC rpcreq payload cb = do
  print "Got quick request"
  atomically $ cb rpcreplyEmpty BS.empty

halfsecRPC :: Callback
halfsecRPC rpcreq payload cb = do
  print "Got 1/2 second request"
  addTimeout 0.5 $ atomically $ cb rpcreplyEmpty BS.empty
  return ()

-- This one uses rpcFunction to wrap Libevent parsing of the payload
addNumbers :: TestRPC.Addnumbersrequest -> ((Maybe TestRPC.Addnumbersreply) -> STM ()) -> IO ()
addNumbers (TestRPC.Addnumbersrequest { TestRPC.addnumbersrequest_a = a
                                      , TestRPC.addnumbersrequest_b = b }) cb = do
  atomically $ cb $ Just $ TestRPC.addnumbersreplyEmpty { TestRPC.addnumbersreply_c = a + b }

methods = Map.fromList
  [  ("quick", MethodInfo quickRPC () ())
   , ("halfsec", MethodInfo halfsecRPC () ())
   , ("add", MethodInfo (rpcFunction addNumbers TestRPC.addnumbersrequestEmpty TestRPC.addnumbersreplyEmpty) () ())
  ]

main = do
  port <- Port.new 4545
  serv <- newService port "test" Up methods
  threadDelay 100000000