Add SSE example

This commit is contained in:
Rashad Gover 2023-11-17 02:42:49 -08:00
parent 775479eb9b
commit 87c65c7064
2 changed files with 61 additions and 0 deletions

44
lib/examples/tick/Main.hs Normal file
View File

@ -0,0 +1,44 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Main where
import qualified Control.Concurrent as Concurrent
import qualified Control.Concurrent.Chan as Chan
import Control.Monad
import qualified Data.Binary.Builder as Builder
import qualified Data.Text as Text
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
import qualified Network.Wai.EventSource as Wai
import qualified Network.Wai.Handler.Warp as Warp
import Okapi.App
import Okapi.Response
import qualified Web.HttpApiData as Web
ticker :: Chan.Chan Wai.ServerEvent -> Node '[]
ticker source =
choice
[ lit "connect" $ events source
]
tick source = do
let event =
Wai.ServerEvent
{ Wai.eventName = Nothing
, Wai.eventId = Nothing
, Wai.eventData = [Builder.putStringUtf8 "tick"]
}
forever do
Concurrent.threadDelay (1 * (10 ^ 6))
print "Sending"
Chan.writeChan source event
main = do
source <- Chan.newChan
Concurrent.forkIO $ tick source
Warp.run 8003
. withDefault (ticker source)
$ \_ resp -> resp $ Wai.responseLBS HTTP.status404 [] "Not Found..."

View File

@ -110,6 +110,23 @@ executable bookstore
ghc-options: -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010
executable tick
main-is: Main.hs
hs-source-dirs:
examples/tick
build-depends:
base
, okapi
, warp
, wai
, text
, http-api-data
, http-types
, wai-extra
, binary
ghc-options: -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010
test-suite okapi-test
type: exitcode-stdio-1.0
main-is: Spec.hs