packages feed

buster-network (empty) → 1.0

raw patch · 4 files changed

+223/−0 lines, 4 filesdep +HTTPdep +basedep +binarysetup-changed

Dependencies added: HTTP, base, binary, buster, bytestring, containers, dataenc, haxr, mtl, network, old-locale, pretty, time

Files

+ App/Behaviours/HTTP.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE ScopedTypeVariables #-}+-----------------------------------------------------------------------------+--+-- Module      :  App.Behaviours.HTTP+-- Copyright   :  2009 Renaissance Computing Institute+-- License     :  BSD3+--+-- Maintainer  :  Jeff Heard <jeff@renci.org>+-- Stability   :  Experimental+-- Portability :+--+-- | Behaviours for HTTP requests.  Looks for Events named+--   HTTP\//MethodName/ with event data of [EString uri, EByteString senddata, EStringL headers] and consumes them.  Produces+--   Events named HTTPResponse with source httpBehaviour\//MethodName/ and the contents of the response as the event data in a ByteString.+--   They also produce Exceptions with the same source and name ConnectionError if there is no network connection or HTTP Service+--   or HTTPErrorResponseCode if the Server sent back an error code or ParseFailure if the URI didn't parse.+--+-----------------------------------------------------------------------------++module App.Behaviours.HTTP (+++) where++import Control.Applicative ((<$>))+import App.EventBus+import Network.HTTP.HandleStream+import Network.HTTP+import Network.URI+import Network.Stream+import qualified Data.ByteString as BS++maybeHead (x:xs) = Just x+maybeHead [] = Nothing++httpBehaviour :: RequestMethod -> Behaviour [EData a]+httpBehaviour method b = consumeNamedEventsWith b ("HTTP/" ++ show method) $ \evt ->+    let EString uriS = head . eventdata $ evt+        postdata = maybe BS.empty (\(EByteString getdata) -> getdata) . maybeHead . tail . eventdata $ evt+        postheaders = headers . tail . tail . eventdata $ evt++        headers (EString nm:EString val:hs) = Header (HdrCustom nm) val : headers hs+        headers [] = []++        httpGet uri = (Network.HTTP.HandleStream.simpleHTTP $ Request uri method postheaders postdata) >>=+            either (\_ -> produce "Exception" ("httpBehaviour" ++ show method) "ConnectionError" once [])+                   (\(Response code reason rspheaders contents) ->+                                    case code of+                                        (1,_,_) -> produce "HTTPResponse" ("httpBehaviour/" ++ show method) (takeWhile (/='?') . show $ uri) Persistent [ EByteString contents]+                                        (2,_,_) -> produce "HTTPResponse" ("httpBehaviour/" ++ show method) (takeWhile (/='?') . show $ uri) Persistent [ EByteString contents]+                                        _       -> produce "Exception" ("httpBehaviour/" ++ show method) "HTTPErrorResponseCode" once [EString (show code), EStringL . map show $ rspheaders, EByteString contents])+       in case parseURI uriS of+            Just uri -> listM $ httpGet uri+            Nothing -> listM $ produce "Exception" ("httpBehaviour" ++ show method) "ParseFailure" once [EString uriS]++++++
+ App/Behaviours/XmlRpc.hs view
@@ -0,0 +1,100 @@+module App.Behaviours.XmlRpc where++import Control.Monad.Error+import Network.XmlRpc.Client+import Network.XmlRpc.Internals+import Control.Applicative+import App.EventBus+import qualified Codec.Binary.Base64+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB+import Data.Maybe++edata2value :: XmlRpcType a => EData a -> Value+edata2value (EString x) = ValueString x+edata2value (EStringL x) = ValueArray $ ValueString <$> x+edata2value (EByteString x) = ValueBase64 . Codec.Binary.Base64.encode . SB.unpack $ x+edata2value (EByteStringL x) = ValueArray $ ValueBase64 . Codec.Binary.Base64.encode . SB.unpack <$> x+edata2value (ELByteString x) = ValueBase64 . Codec.Binary.Base64.encode . LB.unpack $ x+edata2value (ELByteStringL x) = ValueArray $ ValueBase64 . Codec.Binary.Base64.encode . LB.unpack <$> x+edata2value (EChar x) = ValueString [x]+edata2value (EDouble x) = ValueDouble x+edata2value (EDoubleL x) = ValueArray $ ValueDouble <$> x+edata2value (EInt x) = ValueInt x+edata2value (EIntL x) = ValueArray $ ValueInt <$> x+edata2value (EBool x) = ValueBool x+edata2value (EBoolL x) = ValueArray $ ValueBool <$> x+edata2value (EOther x) = toValue x+edata2value (EOtherL x) = ValueArray $ toValue <$> x+edata2value (EAssoc (k,v)) = ValueStruct [(k, edata2value v)]+edata2value (EAssocL xs) = ValueStruct $ (\(k,v) -> (k, edata2value v)) <$> xs++edata2valueNX :: EData a -> Value+edata2valueNX (EString x) = ValueString x+edata2valueNX (EStringL x) = ValueArray $ ValueString <$> x+edata2valueNX (EByteString x) = ValueBase64 . Codec.Binary.Base64.encode . SB.unpack $ x+edata2valueNX (EByteStringL x) = ValueArray $ ValueBase64 . Codec.Binary.Base64.encode . SB.unpack <$> x+edata2valueNX (ELByteString x) = ValueBase64 . Codec.Binary.Base64.encode . LB.unpack $ x+edata2valueNX (ELByteStringL x) = ValueArray $ ValueBase64 . Codec.Binary.Base64.encode . LB.unpack <$> x+edata2valueNX (EChar x) = ValueString [x]+edata2valueNX (EDouble x) = ValueDouble x+edata2valueNX (EDoubleL x) = ValueArray $ ValueDouble <$> x+edata2valueNX (EInt x) = ValueInt x+edata2valueNX (EIntL x) = ValueArray $ ValueInt <$> x+edata2valueNX (EBool x) = ValueBool x+edata2valueNX (EBoolL x) = ValueArray $ ValueBool <$> x+edata2valueNX (EAssoc (k,v)) = ValueStruct [(k, edata2valueNX v)]+edata2valueNX (EAssocL xs) = ValueStruct $ (\(k,v) -> (k, edata2valueNX v)) <$> xs++value2edata :: Value -> EData a+value2edata (ValueInt x) = EInt x+value2edata (ValueBool x) = EBool x+value2edata (ValueString x) = EString x+value2edata (ValueDateTime x) = EString (show x)+value2edata (ValueBase64 x) = EByteString . SB.pack . fromJust . Codec.Binary.Base64.decode $ x+value2edata (ValueStruct xs) = EAssocL $ (\(x,y) -> (x, value2edata y)) <$> xs+value2edata (ValueArray xs) = EAssocL . zip (show<$>[0..]) $ value2edata <$> xs++++xmlrpcMethodBehaviour :: XmlRpcType a => String -> String -> Behaviour [EData a]+xmlrpcMethodBehaviour service method b = consumeEventGroupWith b (service ++ "/" ++ method) $ \evt -> do+    let parms = map edata2value . eventdata $ evt+        exceptionEvent errmsg = produce "Exception" (service ++ "/" ++ method) "XmlRpcException" once [EString errmsg]+        responseEvent val = produce "XmlRpcResponse" (service ++ "/" ++ method) (concat . map (safeShow Nothing) $ eventdata evt) once [value2edata val]+    r <- runErrorT $ call service method parms+    case r of+        Left err -> listM $ exceptionEvent err+        Right res -> listM $ responseEvent res++xmlrpcServiceBehaviour :: XmlRpcType a => String -> Behaviour [EData a]+xmlrpcServiceBehaviour service b = consumeEventGroupWith b service $ \evt -> do+    let parms = map edata2value . tail . eventdata $ evt+        EString method = head . eventdata $ evt+        exceptionEvent errmsg = produce "Exception" (service ++ "/" ++ method) "XmlRpcException" once [EString errmsg]+        responseEvent val = produce "XmlRpcResponse" (service ++ "/" ++ method) (concat . map (safeShow Nothing) $ eventdata evt) once [value2edata val]+    r <- runErrorT $ call service method parms+    case r of+        Left err -> listM $ exceptionEvent err+        Right res -> listM $ responseEvent res++xmlrpcMethodBehaviourNX :: String -> String -> Behaviour [EData a]+xmlrpcMethodBehaviourNX service method b = consumeEventGroupWith b (service ++ "/" ++ method) $ \evt -> do+    let parms = map edata2valueNX . eventdata $ evt+        exceptionEvent errmsg = produce "Exception" (service ++ "/" ++ method) "XmlRpcException" once [EString errmsg]+        responseEvent val = produce "XmlRpcResponse" (service ++ "/" ++ method) (concat . map (safeShow Nothing) $ eventdata evt) once [value2edata val]+    r <- runErrorT $ call service method parms+    case r of+        Left err -> listM $ exceptionEvent err+        Right res -> listM $ responseEvent res++xmlrpcServiceBehaviourNX :: String -> Behaviour [EData a]+xmlrpcServiceBehaviourNX service b = consumeEventGroupWith b service $ \evt -> do+    let parms = map edata2valueNX . tail . eventdata $ evt+        EString method = head . eventdata $ evt+        exceptionEvent errmsg = produce "Exception" (service ++ "/" ++ method) "XmlRpcException" once [EString errmsg]+        responseEvent val = produce "XmlRpcResponse" (service ++ "/" ++ method) (concat . map (safeShow Nothing) $ eventdata evt) once [value2edata val]+    r <- runErrorT $ call service method parms+    case r of+        Left err -> listM $ exceptionEvent err+        Right res -> listM $ responseEvent res
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+
+ buster-network.cabal view
@@ -0,0 +1,57 @@+name: buster-network+version: 1.0+cabal-version: -any+build-type: Simple+license: BSD3+license-file: ""+copyright: 2009 Renaissance Computing Institute+maintainer: Jeff Heard <jeff@renci.org>+build-depends: network -any, HTTP >= 4000.0.0, buster >= 1.0, haxr -any, binary -any, pretty -any, mtl -any, bytestring -any, base -any, containers -any, time -any, old-locale -any, dataenc -any+stability: Experimental+homepage: http://vis.renci.org/jeff/buster+package-url:+bug-reports:+synopsis: Almost but not quite entirely unlike FRP+description: Buster is best described by the following blog post: http:\/\/vis.renci.org\/jeff\/2009\/03\/31\/almost-but-not-quite-entirely-like-frp\/+             .+             It is an engine for orchestrating large, complex, and multifaceted applications by couching them in terms of time, events, a bus,+             behaviours, and widgets.  Time is continuous and infininte.  Events are discrete and exist for a particular time.  The bus is a+             discrete sample of time made available to behaviours. Behaviours are continuous and exist for all time, but sample time via+             the bus.  They filter Events to determine what is on the bus at future times.  Widgets are input-only objects that sample the+             outside world and assign events to discrete portions of time.+             .+             Buster is designed to be flexible, with a flexible event model and the ability to add custom data to events, and designed to be+             high performance.  It is simple to integrate with Gtk while at the same time able to handle other kinds of resources, like files+             and sockets.+category: FRP+author: Jeff Heard+tested-with:+data-files:+data-dir: ""+extra-source-files:+extra-tmp-files:+exposed-modules: App.Behaviours.HTTP App.Behaviours.XmlRpc+                 +exposed: True+buildable: True+build-tools:+cpp-options:+cc-options:+ld-options:+pkgconfig-depends:+frameworks:+c-sources:+extensions:+extra-libraries:+extra-lib-dirs:+includes:+install-includes:+include-dirs:+hs-source-dirs: .+other-modules:+ghc-prof-options:+ghc-shared-options:+ghc-options:+hugs-options:+nhc98-options:+jhc-options: