diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Hemanth Kapila + +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 Hemanth Kapila 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. 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/Web/WindowsAzure/ServiceBus/Queue.hs b/Web/WindowsAzure/ServiceBus/Queue.hs new file mode 100644 --- /dev/null +++ b/Web/WindowsAzure/ServiceBus/Queue.hs @@ -0,0 +1,88 @@ +-- | +-- Module : Web.WindowsAzure.ServiceBus.Queue +-- Description : API for reading from and writing to ServiceBus Queue +-- Copyright : (c) Hemanth Kapila, 2014 +-- License : BSD3 +-- Maintainer : saihemanth@gmail.com +-- Stability : Experimental +-- +-- Provides API to pull from and push to ServiceBus queue +-- Please refer to for Service bus API +-- +-- Following piece of code illustrates the use of API +-- +-- @ +-- module Main where +-- +-- import Web.WindowsAzure.ServiceBus.SBTypes +-- import Web.WindowsAzure.ServiceBus.Queue +-- import qualified Data.ByteString.Char8 as C +-- +-- main = do +-- sbContext <- sbContext (simpleSBInfo "sb-namespace" "insert-your-issuer-key") +-- enQueueBS sbContext "queue-name" (C.pack "hello Haskell world") +-- res <- deQueue sbContext "kqueue" 30 +-- print res +-- @ +-- + +module Web.WindowsAzure.ServiceBus.Queue( + -- * Pushing data to Queue + enQueueBS, + enQueueLBS, + enQueueBodySrc, + -- * Reading data from Queue + deQueue + )where + +import Web.WindowsAzure.ServiceBus.SBTypes +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as L +import Network.HTTP.Conduit hiding (requestBodySource) +import Network.HTTP.Client.Conduit +import Data.Conduit +import Data.Int + +-- | publish a message containing 'C.ByteString' to queue. +-- +-- The following publishes a strict bytestring \bs\ to queue \q\ +-- +-- @ +-- enQueueBS q bs ctx +-- @ +enQueueBS :: String -> C.ByteString -> SBContext -> IO () +enQueueBS queueName content context = + enQueueRequest queueName (RequestBodyBS content) context + + +-- | publish a message containing 'L.ByteString' to queue +-- +-- The following publishes a lazy bytestring ,\lbs\, to queue \q\, +-- +-- @ +-- enQueueLBS q lbs ctx +-- @ +-- +enQueueLBS :: String -> L.ByteString -> SBContext -> IO () +enQueueLBS queueName content context = + enQueueRequest queueName (RequestBodyLBS content) context + + +-- | publish from a 'Source' (refer to 'requestBodySource') +enQueueBodySrc :: String -> Int64 -> Source IO C.ByteString -> SBContext -> IO () +enQueueBodySrc queueName len bodysrc context = enQueueRequest queueName (requestBodySource len bodysrc) context + + +-- | Reads and deletes the message from a queue. +-- +-- +-- In order to destructively read the latest message from the queue (with a time out of n seconds), +-- +-- +-- @ +-- deQueue queueName n context +-- @ +-- Note that the timeout can be at the most 55 seconds. This silently \ignores\ the timeouts greater than 55 +deQueue :: String -> Int -> SBContext -> IO (L.ByteString) +deQueue queueName timeout context = deQueueRequest queueName (timeout `mod` 55) context + diff --git a/Web/WindowsAzure/ServiceBus/SBTypes.hs b/Web/WindowsAzure/ServiceBus/SBTypes.hs new file mode 100644 --- /dev/null +++ b/Web/WindowsAzure/ServiceBus/SBTypes.hs @@ -0,0 +1,83 @@ +-- | +-- Module : Web.WindowsAzure.ServiceBus.SBTypes +-- Description : Defines Types for dealing with Windows Azure Service Bus +-- Copyright : (c) Hemanth Kapila, 2014 +-- License : BSD3 +-- Maintainer : saihemanth@gmail.com +-- Stability : Experimental +-- +-- + +module Web.WindowsAzure.ServiceBus.SBTypes( + -- * Types + SBInfo(..), + SBContext, + -- * initialization + sbContext, + simpleSBInfo, + -- * low-level functions for creating 'Request' + enQueueRequest, + deQueueRequest + )where + +import Web.WindowsAzure.ACS +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as L +import Network.HTTP.Conduit hiding (requestBodySource) +import Network.HTTP.Client.Conduit +import Network.HTTP.Types.Method(methodPost,methodDelete) + +import Network.Connection (TLSSettings (..)) + + + +-- | 'SBInfo' is encapsulation of Connection Information needed to connect to a Service Bus Namespace. +-- +-- This information is typically found when you click on the /Connection Information/ link on the azure portal and comprises of +-- +-- * ServiceBus namespace +-- * Issuer Name +-- * Issuer Key +-- +data SBInfo = SBInfo String C.ByteString C.ByteString + deriving (Show) + +-- | Abstract type representing the service bus context. +data SBContext = SBContext String Manager AcsContext + +-- | a convenience function, where issuer name is owner +simpleSBInfo :: String -> String -> SBInfo +simpleSBInfo ns key = SBInfo ns (C.pack "owner") (C.pack key) + +-- | Create SB Context from 'SBInfo' +sbContext :: SBInfo -> IO SBContext +sbContext (SBInfo ns name key) = do + aContext <- acsContext $ AcsInfo (ns ++ "-sb") (C.pack $ "http://" ++ ns ++ ".servicebus.windows.net") name key + manager <- newManagerSettings (mkManagerSettings (TLSSettingsSimple True False False) Nothing) + return $ SBContext ("https://" ++ ns ++ ".servicebus.windows.net") manager aContext + + +-- | Internal low-level method for performing HTTP calls. +-- +-- should be avoided by most users. +enQueueRequest :: String -> RequestBody -> SBContext -> IO () +enQueueRequest queueName body (SBContext baseUrl manager aContext) = do + token <- acsToken manager aContext + reqInit <- parseUrl (baseUrl ++ "/" ++ queueName ++ "/messages") + httpLbs (reqInit { method = methodPost, + requestHeaders = [token], + requestBody = body + }) manager + return () + +-- | Internal low-level method for creating the HTTP calls. For internal use. +-- +-- should be avoided by most users +deQueueRequest :: String -> Int -> SBContext -> IO L.ByteString +deQueueRequest queueName timeout (SBContext baseUrl manager aContext) = do + token <- acsToken manager aContext + reqInit <- parseUrl (baseUrl ++ "/" ++ queueName ++ "/messages/head?timeout=" ++ (show timeout)) + res <- httpLbs ( reqInit { method = methodDelete, + requestHeaders = [token] + }) manager + return $ responseBody res diff --git a/azure-servicebus.cabal b/azure-servicebus.cabal new file mode 100644 --- /dev/null +++ b/azure-servicebus.cabal @@ -0,0 +1,41 @@ +-- Initial azure-servicebus.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: azure-servicebus +version: 0.1.0.0 +synopsis: Windows Azure ServiceBus API +description: Haskell wrappers over Windows Azure ServiceBus API. +homepage: https://github.com/kapilash/hs-azure +license: BSD3 +license-file: LICENSE +author: Hemanth Kapila +maintainer: saihemanth@gmail.com +copyright: Hemanth Kapila (c) 2014-2015 +category: Web +build-type: Simple +extra-source-files: examples/*.hs +cabal-version: >=1.10 + +library + exposed-modules: Web.WindowsAzure.ServiceBus.Queue, + Web.WindowsAzure.ServiceBus.SBTypes + -- other-modules: + -- other-extensions: + build-depends: base >=4.7 && <4.8, + azure-acs >=0.0 && <0.1, + bytestring >=0.10 && <0.11, + http-conduit >=2.1 && <2.2, + conduit >=1.1 && <1.2, + http-types >=0.8 && <0.9, + attoparsec >=0.11 && <0.12, + async >=2.0 && <2.1, + http-client, + connection + -- hs-source-dirs: + default-language: Haskell2010 + ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-unused-do-bind + ghc-prof-options: -prof -auto-all + +source-repository head + type: git + location: https://github.com/kapilash/hs-azure.git diff --git a/examples/Example.hs b/examples/Example.hs new file mode 100644 --- /dev/null +++ b/examples/Example.hs @@ -0,0 +1,11 @@ +module Main where + +import Web.WindowsAzure.ServiceBus.Queue +import Web.WindowsAzure.ServiceBus.SBTypes +import qualified Data.ByteString.Char8 as C + +main = do + sbContext <- sbContext (simpleSBInfo "sb-namespace" "issuer-key") + enQueueBS "queue-name" (C.pack "hello Haskell world") sbContext + res <- deQueue "queue-name" 30 sbContext + print res