packages feed

eventsourced (empty) → 1.0.0.0

raw patch · 7 files changed

+231/−0 lines, 7 filesdep +HUnitdep +basedep +blaze-buildersetup-changed

Dependencies added: HUnit, base, blaze-builder, bytestring, eventsourced, wai, wai-extra, warp

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016 Richard Towers++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,18 @@+module Main where++import Network.Eventsourced.Lib (application)+import Network.Eventsourced.Args (Options(..), getCommandLineOptions)++import System.Environment (getArgs)+import Network.Wai.Handler.Warp (run)++main :: IO ()+main = do+    args <- getArgs+    let opts = getCommandLineOptions args+    case opts of+        Options _    _          (Just help)  -> putStrLn help+        Options port allowOrigin Nothing     -> do+            putStrLn $ "Streaming standard input to port " ++ (show port)+            putStrLn $ "Allowed orgins: " ++ allowOrigin+            run port $ application allowOrigin
+ eventsourced.cabal view
@@ -0,0 +1,73 @@+name:                eventsourced+version:             1.0.0.0+synopsis:            Server-Sent Events the UNIX way+description:+  @eventsourced@ streams stdin to a TCP\/IP port as @text\/event-source@.+  .+  On the server:+  .+  .+  > $ ping example.com | eventsourced --port=1337 --allow-origin=localhost+  .+  .+  In the browser:+  .+  .+  >  new EventSource('http://0.0.0.0:1337').onmessage = e => console.log(e.data)+  >  PING example.com (93.184.216.34): 56 data bytes+  >  64 bytes from 93.184.216.34: icmp_seq=0 ttl=50 time=86.586 ms+  >  64 bytes from 93.184.216.34: icmp_seq=1 ttl=50 time=89.107 ms+  >  64 bytes from 93.184.216.34: icmp_seq=2 ttl=50 time=88.805 ms+  >  64 bytes from 93.184.216.34: icmp_seq=3 ttl=50 time=88.843 ms+  >  64 bytes from 93.184.216.34: icmp_seq=4 ttl=50 time=89.181 ms+  >  64 bytes from 93.184.216.34: icmp_seq=5 ttl=50 time=89.159 ms+  >  64 bytes from 93.184.216.34: icmp_seq=6 ttl=50 time=87.214 ms+  >  ...+  .+homepage:            https://github.com/githubuser/eventsourced#readme+license:             MIT+license-file:        LICENSE+author:              Richard Towers+maintainer:          richard@richard-towers.com+copyright:           2016 Richard Towers+category:            Network+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Network.Eventsourced.Lib+                     , Network.Eventsourced.Args+  build-depends:       base >= 4.7 && < 5+                     , bytestring+                     , blaze-builder+                     , wai+                     , wai-extra+  default-language:    Haskell2010++executable eventsourced+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , warp+                     , eventsourced+  default-language:    Haskell2010++test-suite eventsourced-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , HUnit+                     , bytestring+                     , blaze-builder+                     , wai-extra+                     , eventsourced+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/githubuser/eventsourced
+ src/Network/Eventsourced/Args.hs view
@@ -0,0 +1,35 @@+module Network.Eventsourced.Args (Options(..), getCommandLineOptions, defaultOptions) where++import System.Console.GetOpt++type OptionsTransformer = (Options -> Options)++data Options = Options {+    optPort :: Int,+    optAllowOrigin :: String,+    optHelp :: (Maybe String)+} deriving (Eq, Show)++defaultOptions :: Options+defaultOptions = Options 1337 "null" Nothing++getCommandLineOptions :: [String] -> Options+getCommandLineOptions args = do+    let (transformers, _, _) = getOpt RequireOrder options args+    foldl (flip ($)) defaultOptions transformers++options :: [OptDescr (OptionsTransformer)]+options = [+    Option ['h'] ["help"] (NoArg makeHelp) "show this help message",+    Option ['p'] ["port"] (ReqArg makePort "PORT") "send events to port (default 1337)",+    Option ['a'] ["allow-origin"] (ReqArg makeAllowOrigin "ORIGIN") "value for the Access-Control-Allow-Origin header (default null)"+  ]++makeHelp :: OptionsTransformer+makeHelp opt = opt { optHelp = Just (usageInfo  "Usage: eventsourced [OPTIONS...]" options) }++makePort :: String -> OptionsTransformer+makePort s opt = opt { optPort = (read s) }++makeAllowOrigin :: String -> OptionsTransformer+makeAllowOrigin s opt = opt { optAllowOrigin = s }
+ src/Network/Eventsourced/Lib.hs view
@@ -0,0 +1,27 @@+module Network.Eventsourced.Lib (application, serverEvent, createCorsHeaders) where++import System.IO.Error (tryIOError)+import Network.Wai (Middleware, Application)+import Network.Wai.EventSource (ServerEvent(..), eventSourceAppIO)+import Network.Wai.Middleware.AddHeaders (addHeaders)+import Blaze.ByteString.Builder.Char8 (fromString)+import Data.ByteString.Char8 (pack)+import Data.ByteString (ByteString)++serverEvent :: Either IOError String -> ServerEvent+serverEvent (Left _) = CloseEvent+serverEvent (Right s) = ServerEvent Nothing Nothing [ fromString s ]++eventFromLine :: IO ServerEvent+eventFromLine = do+    input <- tryIOError getLine+    return $ serverEvent input++createCorsHeaders :: String -> [(ByteString, ByteString)]+createCorsHeaders s = [(pack "Access-Control-Allow-Origin", pack s)]++addCorsHeaders :: String -> Middleware+addCorsHeaders s = addHeaders $ createCorsHeaders s++application :: String -> Application+application allowOrigin = addCorsHeaders allowOrigin $ eventSourceAppIO eventFromLine
+ test/Spec.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++import Test.HUnit+import System.IO.Error+import Control.Monad+import Network.Wai.EventSource (ServerEvent(..))+import Blaze.ByteString.Builder.Char8 (fromString)+import Blaze.ByteString.Builder (toByteString)+import Data.ByteString.Char8 (unpack)+import Data.ByteString.Builder (Builder)++import Network.Eventsourced.Lib (serverEvent, createCorsHeaders)+import Network.Eventsourced.Args (Options(..), getCommandLineOptions, defaultOptions)++-- ServerEvent and Builder don't derive Eq or Show, which makes them hard to test.+-- We can tell Haskell how to compare / show them by creating type instances:+deriving instance Show ServerEvent+instance Show (Builder) where show = unpack . toByteString+deriving instance Eq ServerEvent+instance Eq Builder where+    (==) x y = (show x) == (show y)+    (/=) x y = (show x) /= (show y)++testServerEvent :: Test+testServerEvent = do+    let expected = ServerEvent Nothing Nothing [ fromString "Hello World!" ]+    let actual = serverEvent $ Right "Hello World!"+    TestCase $ assertEqual "for severEvent (Right \"Hello World!\")" actual expected++testServerEventClosesWhenEndOfFileReached :: Test+testServerEventClosesWhenEndOfFileReached = do+    let endOfFileError = Left $ mkIOError eofErrorType "" Nothing Nothing+    TestCase $ assertEqual "for serverEvent (Left IOError)" (serverEvent endOfFileError) CloseEvent++testCreateCorsHeaders :: Test+testCreateCorsHeaders = do+    TestCase $ assertEqual "for createCorsHeaders BANANA" (createCorsHeaders "BANANA") [("Access-Control-Allow-Origin", "BANANA")]++testGetCommandLineOptions :: Test+testGetCommandLineOptions = do+    TestCase $ do+        assertEqual "getCommandLineOptions []" (getCommandLineOptions []) defaultOptions+        assertEqual "getCommandLineOptions [--port=12345]" (getCommandLineOptions ["--port=12345"]) (defaultOptions { optPort = 12345 })+        assertEqual "getCommandLineOptions [--allow-origin=*]" (getCommandLineOptions ["--allow-origin=*"]) (defaultOptions { optAllowOrigin = "*" })+        assertEqual "getCommandLineOptions [--port=12345 --allow-origin=*]" (getCommandLineOptions ["--port=12345", "--allow-origin=*"]) (defaultOptions {  optPort = 12345, optAllowOrigin = "*" })++main :: IO ()+main = void $ runTestTT $ test [+    testServerEvent,+    testServerEventClosesWhenEndOfFileReached,+    testCreateCorsHeaders,+    testGetCommandLineOptions+  ]