servant-event-stream (empty) → 0.2.0.0

raw patch · 7 files changed

+258/−0 lines, 7 filesdep +basedep +binarydep +http-mediasetup-changed

Dependencies added: base, binary, http-media, lens, pipes, servant-foreign, servant-js, servant-pipes, servant-server, text, wai-extra

Files

• CHANGELOG.md +9/−0
• LICENSE +30/−0
• README.md +20/−0
• Setup.hs +2/−0
• servant-event-stream.cabal +61/−0
• src/Servant/API/EventStream.hs +134/−0
• tests/Spec.hs +2/−0

@@ -0,0 +1,9 @@+# Revision history for servant-event-stream++## 0.2.0.0 -- 2021-04-x++* `Servant.EventStream` was moved to `Servant.API.EventStream` to adhere existing [upstream layout](https://hackage.haskell.org/package/servant-0.18.2/docs/Servant-API-Stream.html).++## 0.1.0.0 -- 2018-04-30++* First version. Released on an unsuspecting world.

@@ -0,0 +1,30 @@+Copyright (c) 2021, Shaun Sharples++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 Shaun Sharples 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.

@@ -0,0 +1,20 @@+servant-event-stream+====================++This library adds necessary type combinators to support [Server Sent Events](https://developer.mozilla.org/en-US/docs/Web/API/Server-sent_events/Using_server-sent_events)+within [Servant ecosystem](https://github.com/haskell-servant/).++Dev Environment+---------------++Dev env is based on [Nix](https://nixos.org) and [Niv](https://github.com/nmattia/niv).++To enter the dev shell, run+```bash+nix-shell+```++You can build the project with+```bash+nix-build+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,61 @@+cabal-version:       >=1.10+name:                servant-event-stream+version:             0.2.0.0+stability:           alpha++synopsis:            Servant support for Server-Sent events+category:            Servant, Web+description:         This library adds necessary type combinators to support+                     Server Sent Events within Servant ecosystem.++homepage:            https://github.com/bflyblue/servant-event-stream+bug-reports:         https://github.com/bflyblue/servant-event-stream/issues+license:             BSD3+license-file:        LICENSE+author:              Shaun Sharples+maintainer:          shaun.sharples@gmail.com+copyright:           (c) 2021 Shaun Sharples+build-type:          Simple++extra-source-files:+  CHANGELOG.md+  README.md++source-repository head+  type: git+  location: https://github.com/bflyblue/servant-event-stream.git++library+  exposed-modules:+    Servant.API.EventStream++  default-extensions:+    MultiParamTypeClasses+    OverloadedStrings++  build-depends:+      base                  >= 4.9 && < 4.15+    , binary                >= 0.7 && < 0.11+    , http-media            >= 0.7.1.3 && < 0.9+    , lens                  >= 4.17 && < 4.20+    , pipes                 >= 4.3.9 && < 4.4+    , servant-foreign       >= 0.15 && < 0.16+    , servant-js            >= 0.9 && < 0.10+    , servant-pipes         >= 0.15 && < 0.16+    , servant-server        >= 0.15 && < 0.19+    , text                  >= 1.2.3 && < 1.3+    , wai-extra             >= 3.0 && < 3.2++  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall++test-suite tests-default+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+    tests+  default-language:+    Haskell2010+  build-depends:+    base

@@ -0,0 +1,134 @@+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PolyKinds                  #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE UndecidableInstances       #-}++module Servant.API.EventStream+  ( ServerSentEvents+  , EventStream+  , EventSource+  , EventSourceHdr+  , eventSource+  , jsForAPI+  )+where++import           Control.Lens+import           Data.Binary.Builder            ( toLazyByteString )+import           Data.Text                      ( Text )+import qualified Data.Text                     as T+import           GHC.Generics                   ( Generic )+import           Network.HTTP.Media             ( (//)+                                                , (/:)+                                                )+import           Network.Wai.EventSource        ( ServerEvent(..) )+import           Network.Wai.EventSource.EventStream+                                                ( eventToBuilder )+import qualified Pipes+import           Pipes                          ( X+                                                , (>->)+                                                , await+                                                , yield+                                                )+import           Servant+import           Servant.Foreign+import           Servant.Foreign.Internal       ( _FunctionName )+import           Servant.JS.Internal+import           Servant.Pipes                  ( pipesToSourceIO )++newtype ServerSentEvents+  = ServerSentEvents (StreamGet NoFraming EventStream EventSourceHdr)+  deriving (Generic, HasLink)++instance HasServer ServerSentEvents context where+  type ServerT ServerSentEvents m = ServerT (StreamGet NoFraming EventStream EventSourceHdr) m+  route Proxy = route+    (Proxy :: Proxy (StreamGet NoFraming EventStream EventSourceHdr))+  hoistServerWithContext Proxy = hoistServerWithContext+    (Proxy :: Proxy (StreamGet NoFraming EventStream EventSourceHdr))++-- | a helper instance for <https://hackage.haskell.org/package/servant-foreign-0.15.3/docs/Servant-Foreign.html servant-foreign>+instance  (HasForeignType lang ftype EventSourceHdr)+  => HasForeign lang ftype ServerSentEvents where+  type Foreign ftype ServerSentEvents = Req ftype++  foreignFor lang Proxy Proxy req =+    req+      &  reqFuncName .  _FunctionName %~ ("stream" :)+      &  reqMethod .~ method+      &  reqReturnType ?~ retType+   where+    retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy EventSourceHdr)+    method  = reflectMethod (Proxy :: Proxy 'GET)++-- | A type representation of an event stream. It's responsible for setting proper content-type+--   and buffering headers, as well as for providing parser implementations for the streams.+--   Read more on <https://docs.servant.dev/en/stable/tutorial/Server.html#streaming-endpoints Servant Streaming Docs>+data EventStream++instance Accept EventStream where+  contentType _ = "text" // "event-stream" /: ("charset", "utf-8")++type EventSource = SourceIO ServerEvent++-- | This is mostly to guide reverse-proxies like +--   <https://www.nginx.com/resources/wiki/start/topics/examples/x-accel/#x-accel-buffering nginx>+type EventSourceHdr = Headers '[Header "X-Accel-Buffering" Text] EventSource++-- | See details at+--   https://hackage.haskell.org/package/wai-extra-3.1.6/docs/Network-Wai-EventSource-EventStream.html#v:eventToBuilder+instance MimeRender EventStream ServerEvent where+  mimeRender _ = maybe "" toLazyByteString . eventToBuilder++eventSource :: Pipes.Proxy X () () ServerEvent IO () -> EventSourceHdr+eventSource prod = addHeader "no" $ pipesToSourceIO (prod >-> yieldUntilClose)+ where+  yieldUntilClose = do+    e <- await+    case e of+      CloseEvent -> return ()+      _          -> yield e >> yieldUntilClose++jsForAPI+  :: ( HasForeign NoTypes NoContent api+     , GenerateList NoContent (Foreign NoContent api)+     )+  => Proxy api+  -> Text+jsForAPI p = gen+  (listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) p)+ where+  gen :: [Req NoContent] -> Text+  gen = mconcat . map genEventSource++  genEventSource :: Req NoContent -> Text+  genEventSource req = T.unlines+    [ ""+    , fname <> " = function(" <> argsStr <> ")"+    , "{"+    , "  s = new EventSource(" <> url <> ", conf);"+    , "  Object.entries(eventListeners).forEach(([ev, cb]) => s.addEventListener(ev, cb));"+    , "  return s;"+    , "}"+    ]+   where+    argsStr = T.intercalate ", " args+    args = captures+        ++ map (view $ queryArgName . argPath) queryparams+        ++ ["eventListeners = {}", "conf"]++    captures = map (view argPath . captureArg)+              . filter isCapture+              $ req ^. reqUrl.path++    queryparams = req ^.. reqUrl.queryStr.traverse++    fname   = "var " <> toValidFunctionName (camelCase $ req ^. reqFuncName)+    url     = if url' == "'" then "'/'" else url'+    url'    = "'" <> urlArgs+    urlArgs = jsSegments $ req ^.. reqUrl . path . traverse

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"