packages feed

help-esb (empty) → 0.1.1

raw patch · 10 files changed

+491/−0 lines, 10 filesdep +MissingHdep +aesondep +basesetup-changed

Dependencies added: MissingH, aeson, base, bytestring, network, text, uuid

Files

+ HelpEsbClient.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}++{-|+Module : HelpEsbClient+Description: Haskell version of the Help.com ESB Client+Copyright: (c) Help.com, LLC, 2014+License: MIT+Maintainer: alex.martin@help.com+Stability: Stable+Portability: UNIX+-}+module HelpEsbClient (+-- * Classes+  EsbSend+, EsbRecieve+-- * Raw Exported Functions+, getSocket+, sendSocketData+, readSocketDataRaw+, readSocketData+-- * ESB Functions+, esbSend+, esbRecieve+, esbInit+, esbListen+-- * Utility Functions+, encode+, decode+, eitherDecode+, logger+-- * Utility Types+, Socket+, module Data.UUID+, module Data.UUID.V4+, module System.Environment+) where++-- Base Modules+import System.IO+import System.Environment+import Network.Socket+import Control.Exception+import GHC.Generics+import Data.Text hiding (replace)+import Data.List.Utils+import Data.UUID+import Data.UUID.V4+import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as C++-- JSON Modules+import qualified JSON.Basic.Response as Basic.Response+import qualified JSON.Login.Request as Login.Request+import qualified JSON.Login.Response as Login.Response+import qualified JSON.API.EventGroup.Post.Request as EventGroup.Post.Request+import qualified JSON.API.Event.Post.Request as Event.Post.Request++-- Classes+-- | The 'EsbSend' class determines how a message should be sent to the ESB.+class EsbSend a where+  -- | The 'esbSend' method takes a socket and writes somekind of payload.+  esbSend :: Socket -- ^ The socket connection.+    -> a -- ^ The payload.+    -> IO () -- ^ Any IO output.++-- | The 'EsbRecieve' class determines how a message from the ESB should be+-- recieved.+class EsbRecieve a where+  -- | The 'esbRecieve' method takes a socket and reads somekind of payload.+  esbRecieve :: Socket -- ^ The socket connection.+    -> a -- ^ The payload.+    -> IO () -- ^ Any IO output.++-- | The 'logger' function simply logs out in a consistent way. Will be+-- updated to be more robust.+logger :: String -- ^ Messaged to be logged.+  -> IO () -- ^ IO output.+logger out = do+  let logPrefix = "# "+  putStrLn $ logPrefix ++ out++-- Socket Specific Functions+-- | The 'getSocket' function takes a host and port and connects to and+-- returns the socket.+getSocket :: String -- ^ Host address.+  -> Int -- ^ Host port.+  -> IO Socket -- ^ The socket connection.+getSocket host port = withSocketsDo $ do+  (serveraddr:_) <- getAddrInfo Nothing (Just host) (Just (show port))+  sock <- socket (addrFamily serveraddr) Stream defaultProtocol+  connect sock (addrAddress serveraddr) >> return sock++-- | The 'sendSocketData' function accepts a socket and bytes, converts the+-- bytes to cleaned up JSON, and writes the JSON to the socket.+sendSocketData :: Socket -- ^ The socket connection.+  -> C.ByteString -- ^ The JSON bytestring payload.+  -> IO () -- ^ Any IO output.+sendSocketData sock bytes = do+  let json = replace "h_" "" (C.unpack bytes)+  send sock (json ++ "\n")+  logger ("+ Raw Send: " ++ json)++-- | The 'readSocketDataRaw' function accepts a socket and grabs whatever+-- data might be in the latest message.+readSocketDataRaw :: Socket -- ^ The socket connection.+  -> IO [Char] -- ^ Any IO output.+readSocketDataRaw sock = do+  message <- recv sock 1024+  logger ("+ Raw Read: " ++ message)+  return message++-- | The 'readSocketData' function accepts a socket, reads and cleans up+-- any JSON for parsing, and returns the bytes of JSON.+readSocketData :: Socket -- ^ The socket connection.+  -> IO (C.ByteString) -- ^ The JSON bytestring payload.+readSocketData sock = do+  raw <- readSocketDataRaw sock+  let fixed = replace ",\"" ",\"h_" (replace "{\"" "{\"h_" raw)+  return $ C.pack fixed++-- Send Socket Instances+-- | The 'EsbSend' instance for a login request.+instance EsbSend Login.Request.Data where+  esbSend sock payload = do+    uuid <- nextRandom+    let meta = Login.Request.Meta {+        Login.Request.h_type = "login"+      , Login.Request.h_id = toString uuid+      }+    let message = Login.Request.Message {+        Login.Request.h_meta = meta+      , Login.Request.h_data = payload+      }+    sendSocketData sock (encode message)+    logger ("Login Request: " ++ show message)++-- | The 'EsbSend' instance for an Event Group post request.+instance EsbSend EventGroup.Post.Request.Data where+  esbSend sock payload = do+    uuid <- nextRandom+    let meta = EventGroup.Post.Request.Meta {+        EventGroup.Post.Request.h_type = "sendMessage"+      , EventGroup.Post.Request.h_id = toString uuid+      , EventGroup.Post.Request.h_group = "api-messages"+      }+    let message = EventGroup.Post.Request.Message {+        EventGroup.Post.Request.h_meta = meta+      , EventGroup.Post.Request.h_data = payload+      }+    sendSocketData sock (encode message)+    logger ("EventGroup API Request: " ++ show message)++-- | The 'EsbSend' instance for an Event post request.+instance EsbSend Event.Post.Request.Data where+  esbSend sock payload = do+    uuid <- nextRandom+    let meta = Event.Post.Request.Meta {+        Event.Post.Request.h_type = "sendMessage"+      , Event.Post.Request.h_id = toString uuid+      , Event.Post.Request.h_group = "api-messages"+      }+    let message = Event.Post.Request.Message {+        Event.Post.Request.h_meta = meta+      , Event.Post.Request.h_data = payload+      }+    sendSocketData sock (encode message)+    logger ("Event API Request: " ++ show message)++-- Recieve Socket Instances+-- | The 'EsbRecieve' instance for a Login response.+instance EsbRecieve Login.Response.Message where+  esbRecieve sock message = do+    let payload = Login.Response.h_meta message+    case Login.Response.h_result payload of+      "SUCCESS" -> logger ("Successfully logged in.")+      _ -> error "! Failed to login!"++-- Initialization Instances+-- | The 'esbInit' function initializes the socket connection and logs+-- into the ESB.+esbInit :: Text -- ^ Group name.+  -> [Text] -- ^ Subscriptions.+  -> String -- ^ Host address.+  -> Int -- ^ Host port.+  -> IO Socket -- ^ The socket connection.+esbInit name subscriptions host port = do+  sock <- getSocket host port+  let loginData = Login.Request.Data { Login.Request.h_name = name, Login.Request.h_subscriptions = subscriptions }+  esbSend sock loginData+  return sock++-- Essential Listening Logic+-- | The 'esbListen' function performs all essential listening logic+-- for any ESB client.+esbListen :: Socket -- ^ The socket connection.+  -> IO (C.ByteString) -- ^ The JSON bytestring payload.+esbListen sock = do+  bytes <- readSocketData sock++  case eitherDecode bytes :: (Either String Login.Response.Message) of+    Left error -> return ()+    Right response -> do+      logger ("Response: " ++ show response)+      esbRecieve sock response++  return bytes
+ JSON/API/Event/Post/Request.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}++module JSON.API.Event.Post.Request+( Meta(..)+, Data(..)+, Message(..)+, encode+, decode+, eitherDecode+) where++import GHC.Generics+import Data.Text+import Data.Aeson++data Meta = Meta+  { h_type :: Text+  , h_id :: [Char]+  , h_group :: Text+  } deriving (Show, Generic)++data Data = Data+  { h_createdAt :: Int+  , h_content :: Text+  , h_eventType :: Text+  , h_senderType :: Text+  , h_senderId :: [Char]+  , h_customerId :: [Char]+  } deriving (Show, Generic)++data Message = Message+  { h_meta :: Meta+  , h_data :: Data+  } deriving (Show, Generic)++instance FromJSON Meta+instance FromJSON Data+instance FromJSON Message++instance ToJSON Meta+instance ToJSON Data where+  toJSON (Data h_createdAt h_content h_eventType h_senderType h_senderId h_customerId) =+    object [ "h_createdAt" .= h_createdAt+           , "h_content" .= h_content+           , "h_type" .= h_eventType+           , "h_senderType" .= h_senderType+           , "h_senderId" .= h_senderId+           , "h_customerId" .= h_customerId+           ]+instance ToJSON Message
+ JSON/API/EventGroup/Post/Request.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}++module JSON.API.EventGroup.Post.Request+( Meta(..)+, Data(..)+, Message(..)+, encode+, decode+, eitherDecode+) where++import GHC.Generics+import Data.Text+import Data.Aeson++data Meta = Meta+  { h_type :: Text+  , h_id :: [Char]+  , h_group :: Text+  } deriving (Show, Generic)++data Data = Data+  { h_eventGroupType :: [Char]+  , h_eventGroupId :: Text+  , h_ownerType :: Text+  , h_ownerId :: [Char]+  } deriving (Show, Generic)++data Message = Message+  { h_meta :: Meta+  , h_data :: Data+  } deriving (Show, Generic)++instance FromJSON Meta+instance FromJSON Data+instance FromJSON Message++instance ToJSON Meta+instance ToJSON Data where+  toJSON (Data h_eventGroupType h_eventGroupId h_ownerType h_ownerId) =+    object [ "h_type" .= h_eventGroupType+           , "h_id" .= h_eventGroupId+           , "h_ownerType" .= h_ownerType+           , "h_ownerId" .= h_ownerId+           ]+instance ToJSON Message
+ JSON/Basic/Request.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}++module JSON.Basic.Request+( Meta(..)+, Data(..)+, Message(..)+, encode+, decode+, eitherDecode+) where++import GHC.Generics+import Data.Text+import Data.Aeson++data Meta = Meta+  { h_type :: Text+  , h_id :: [Char]+  } deriving (Show, Generic)++data Data = Data+  { h_name :: Text+  , h_subscriptions :: [Text]+  } deriving (Show, Generic)++data Message = Message+  { h_meta :: Meta+  , h_data :: Data+  } deriving (Show, Generic)++instance FromJSON Meta+instance FromJSON Data+instance FromJSON Message++instance ToJSON Meta+instance ToJSON Data+instance ToJSON Message
+ JSON/Basic/Response.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}++module JSON.Basic.Response+( Meta(..)+, Message(..)+, encode+, decode+, eitherDecode+) where++import GHC.Generics+import Data.Text+import Data.Aeson++data Meta = Meta+  { h_type :: Text+  , h_id :: [Char]+  } deriving (Show, Generic)++data Message = Message+  { h_meta :: Meta+  } deriving (Show, Generic)++instance FromJSON Meta+instance FromJSON Message++instance ToJSON Meta+instance ToJSON Message
+ JSON/Login/Request.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}++module JSON.Login.Request+( Meta(..)+, Data(..)+, Message(..)+, encode+, decode+, eitherDecode+) where++import GHC.Generics+import Data.Text+import Data.Aeson++data Meta = Meta+  { h_type :: Text+  , h_id :: [Char]+  } deriving (Show, Generic)++data Data = Data+  { h_name :: Text+  , h_subscriptions :: [Text]+  } deriving (Show, Generic)++data Message = Message+  { h_meta :: Meta+  , h_data :: Data+  } deriving (Show, Generic)++instance FromJSON Meta+instance FromJSON Data+instance FromJSON Message++instance ToJSON Meta+instance ToJSON Data+instance ToJSON Message
+ JSON/Login/Response.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}++module JSON.Login.Response+( Meta(..)+, Data(..)+, Message(..)+, encode+, decode+, eitherDecode+) where++import GHC.Generics+import Data.Text+import Data.Aeson++data Meta = Meta+  { h_type :: Text+  , h_id :: [Char]+  , h_source :: Text+  , h_replyTo :: Text+  , h_result :: Text+  } deriving (Show, Generic)++data Data = Data+  { h_heartbeatInterval :: Int+  , h_channelId :: Text+  } deriving (Show, Generic)++data Message = Message+  { h_meta :: Meta+  , h_data :: Data+  } deriving (Show, Generic)++instance FromJSON Meta+instance FromJSON Data+instance FromJSON Message++instance ToJSON Meta+instance ToJSON Data+instance ToJSON Message
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Help.com, LLC++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
+ help-esb.cabal view
@@ -0,0 +1,25 @@+-- Initial help-esb.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                help-esb+version:             0.1.1+synopsis:            A Haskell client for the Help.com team's ESB.+description:         A Haskell clinet for the Help.com team's ESB.+homepage:            https://github.com/helpdotcom/help-esb.hs+license:             MIT+license-file:        LICENSE+author:              Alexander Martin+maintainer:          alex.martin@help.com+-- copyright:           +category:            Development+build-type:          Simple+cabal-version:       >=1.8++source-repository head+  type: git+  location: git://github.com/helpdotcom/help-esb.hs++library+  exposed-modules:     HelpEsbClient, JSON.API.EventGroup.Post.Request, JSON.API.Event.Post.Request, JSON.Login.Request, JSON.Login.Response, JSON.Basic.Request, JSON.Basic.Response+  -- other-modules:       +  build-depends:       base ==4.6.*, network ==2.6.*, text ==1.2.*, MissingH ==1.3.*, uuid ==1.3.*, aeson ==0.8.*, bytestring ==0.10.*