diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -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 diff --git a/eventsourced.cabal b/eventsourced.cabal new file mode 100644 --- /dev/null +++ b/eventsourced.cabal @@ -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 diff --git a/src/Network/Eventsourced/Args.hs b/src/Network/Eventsourced/Args.hs new file mode 100644 --- /dev/null +++ b/src/Network/Eventsourced/Args.hs @@ -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 } diff --git a/src/Network/Eventsourced/Lib.hs b/src/Network/Eventsourced/Lib.hs new file mode 100644 --- /dev/null +++ b/src/Network/Eventsourced/Lib.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -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 + ]