packages feed

amqp-streamly (empty) → 0.1.0

raw patch · 8 files changed

+288/−0 lines, 8 filesdep +amqpdep +amqp-streamlydep +basesetup-changed

Dependencies added: amqp, amqp-streamly, base, bytestring, hspec, process, streamly, testcontainers, text

Files

+ ChangeLog.md view
@@ -0,0 +1,4 @@+# Changelog for amqp-streamly++## 0.1.0+ * Creation with `produce` and `consume`
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Gautier DI FOLCO (c) 2020++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 Gautier DI FOLCO 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.
+ README.md view
@@ -0,0 +1,18 @@+# amqp-streamly++A simple wrapper around [amqp](https://hackage.haskell.org/package/amqp/).++## Usage+You can either build a producer, which will publish all the messages of+a stream:++```+Streamly.drain $ produce channel sendInstructionsStream+```++Or a consumer, which will contain the `Message`s and `Envelope`s of+a queue:++```+Streamly.drain $ consume channel aQueue NoAck+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import           Distribution.Simple+main = defaultMain
+ amqp-streamly.cabal view
@@ -0,0 +1,63 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 12d7b6fb1d3da6a6da9f0769f11d261769c8ee0f8ec6e302b18d756e3ac46127++name:           amqp-streamly+version:        0.1.0+synopsis:       A simple streamly wrapper for amqp+description:    A simple streamly wrapper for amqp. Provides two functions `produce` and `consume`.+category:       streamly, conduit, amqp, rabbitmq+homepage:       https://github.com/blackheaven/amqp-streamly#readme+bug-reports:    https://github.com/blackheaven/amqp-streamly/issues+author:         Gautier DI FOLCO+maintainer:     gautier.difolco@gmail.com+copyright:      Gautier DI FOLCO+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/blackheaven/amqp-streamly++library+  exposed-modules:+      Network.AMQP.Streamly+  other-modules:+      Paths_amqp_streamly+  hs-source-dirs:+      src+  build-depends:+      amqp >=0.19.1 && <0.20+    , base >=4.7 && <5+    , streamly >=0.7.2 && <0.8+    , text >=1.2.4.0 && <1.3+  default-language: Haskell2010++test-suite amqp-streamly-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Network.AMQP.StreamlySpec+      Paths_amqp_streamly+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      amqp >=0.19.1 && <0.20+    , amqp-streamly+    , base >=4.7 && <5+    , bytestring >=0.10.10.0 && <0.11+    , hspec >=2.7.1 && <2.8+    , process >=1.6.8.0 && <1.7+    , streamly >=0.7.2 && <0.8+    , testcontainers ==0.1.*+    , text >=1.2.4.0 && <1.3+  default-language: Haskell2010
+ src/Network/AMQP/Streamly.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE FlexibleContexts #-}++module Network.AMQP.Streamly+  (+    -- * How to use this library+    -- $use+    SendInstructions(..)+  , produce+  , consume+  )+where++import           Control.Concurrent.MVar+import           Control.Monad.IO.Class         ( MonadIO+                                                , liftIO+                                                )++import           Data.Text                      ( Text )+import           Network.AMQP+import           Streamly+import qualified Streamly.Internal.Prelude     as S+import qualified Streamly.Prelude              as S++-- | Informations to be sent+--+-- See @Network.AMQP.publishMsg'@ for options+data SendInstructions = SendInstructions { exchange :: Text, routingKey :: Text, mandatory :: Bool, message :: Message } deriving (Show)++-- | The Queue name+type Queue = Text++-- | Publish the produced messages+produce+  :: (IsStream t, MonadAsync m) => Channel -> t m SendInstructions -> t m ()+produce channel = S.mapM send+ where+  send i = liftIO $ do+    publishMsg' channel (exchange i) (routingKey i) (mandatory i) (message i)+    return ()++-- | Stream messages from a queue+--+-- See @Network.AMQP.consumeMsgs@ for options+consume+  :: (IsStream t, MonadAsync m)+  => Channel+  -> Queue+  -> Ack+  -> t m (Message, Envelope)+consume channel queue ack = S.concatM $ liftIO $ do+  mvar <- newEmptyMVar+  consumeMsgs channel queue Ack $ putMVar mvar+  return $ S.repeatM $ taking mvar+ where+  taking :: MonadIO m => MVar (Message, Envelope) -> m (Message, Envelope)+  taking mvar = liftIO $ if ack == NoAck+    then do+      retrieved <- takeMVar mvar+      ackEnv $ snd retrieved+      return retrieved+    else takeMVar mvar+++-- $use+--+-- This section contains basic step-by-step usage of the library.+--+-- You can either build a producer, which will publish all the messages of+-- a stream:+--+-- > Streamly.drain $ produce channel sendInstructionsStream+--+-- Or a consumer, which will contain the @Message@s and @Envelope@s of+-- a queue:+--+-- > Streamly.drain $ consume channel aQueue NoAck
+ test/Network/AMQP/StreamlySpec.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.AMQP.StreamlySpec+  ( main+  , spec+  )+where++import           Network.AMQP.Streamly++import           Control.Concurrent             ( threadDelay )+import           Control.Monad.IO.Class         ( liftIO )++import           Network.AMQP+import           Test.Hspec+import           TestContainers.Hspec+import qualified Data.ByteString.Lazy.Char8    as B+import           Data.Maybe                     ( fromJust )+import qualified Data.Text                     as T+import           System.Process                 ( readProcess )+import qualified Streamly.Prelude              as S++main :: IO ()+main = hspec spec++spec :: Spec+spec =+  around (withContainers containers)+    $ it "producing 5 messages should be consumed in the right order"+    $ \channel -> flip shouldReturn messages $ do+        let arbitraryExchange   = "arbitraryExchange"+        let arbitraryRoutingKey = "arbitraryRoutingKey"+        let arbitraryQueue      = "arbitraryQueue"+        let fixedInstructions =+              SendInstructions arbitraryExchange arbitraryRoutingKey True+        liftIO $ declareExchange+          channel+          newExchange { exchangeName = arbitraryExchange+                      , exchangeType = "fanout"+                      }+        liftIO $ declareQueue channel newQueue { queueName = arbitraryQueue }+        liftIO $ bindQueue channel+                           arbitraryQueue+                           arbitraryExchange+                           arbitraryRoutingKey+        S.drain $ produce channel $ S.fromList $ map fixedInstructions messages+        S.toList+          (   S.take (length messages)+          $   fst+          <$> consume channel arbitraryQueue NoAck+          )++messages :: [Message]+messages = map toMessage ["Lorem", "ipsum", "dolor", "sit", "amet"]+ where+  toMessage x = Message (B.pack x)+                        Nothing+                        Nothing+                        Nothing+                        Nothing+                        Nothing+                        Nothing+                        Nothing+                        Nothing+                        Nothing+                        Nothing+                        Nothing+                        Nothing+                        Nothing+                        Nothing++mkChannel :: T.Text -> T.Text -> String -> IO Channel+mkChannel login password ip = do+  connection <- openConnection ip "/" login password+  openChannel connection++getIp :: Container -> IO String+getIp (Container id _ _) = format <$> readProcess+  "docker"+  [ "inspect"+  , "-f"+  , "'{{range .NetworkSettings.Networks}}{{.IPAddress}}{{end}}'"+  , T.unpack id+  ]+  ""+  where format = init . init . tail++containers :: MonadDocker m => m Channel+containers = do+  let (login, password) = ("guest", "guest")+  container <- run (fromTag "rabbitmq:3.8.4") defaultContainerRequest+  liftIO $ threadDelay $ 15 * 1000 * 1000+  ip <- liftIO $ getIp container+  liftIO $ mkChannel login password ip
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}