packages feed

amqp 0.22.2 → 0.24.0

raw patch · 5 files changed

Files

Network/AMQP.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, OverloadedStrings, ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns, DeriveDataTypeable, OverloadedStrings, ScopedTypeVariables, TupleSections #-}
 -- |
 --
 -- A client library for AMQP servers implementing the 0-9-1 spec; currently only supports RabbitMQ (see <http://www.rabbitmq.com>)
@@ -174,6 +174,7 @@ import Network.AMQP.Generated
 import Network.AMQP.Internal
 import Network.AMQP.Helpers
+import Text.Read (readMaybe)
 
 ----- EXCHANGE -----
 
@@ -703,35 +704,51 @@         global
     return ()
 
--- | Parses amqp standard URI of the form @amqp://user:password@host:port/vhost@ and returns a @ConnectionOpts@ for use with @openConnection''@
--- | Any of these fields may be empty and will be replaced with defaults from @amqp://guest:guest@localhost:5672/@
-fromURI :: String -> ConnectionOpts
-fromURI uri = defaultConnectionOpts {
-    coServers     = hostPorts',
-    coVHost       = T.pack vhost,
-    coAuth        = [plain (T.pack uid) (T.pack pw)],
-    coTLSSettings = if tls then Just TLSTrusted else Nothing
-  }
-  where (hostPorts, uid, pw, vhost, tls) = fromURI' uri
-        hostPorts' = [(h, fromIntegral p) | (h, p) <- hostPorts]
+-- | Parses an AMQP standard URI of the form @amqp://user:password\@host:port\/vhost@ and returns a 'ConnectionOpts' for use with 'openConnection'''.
+--
+-- To pass multiple servers, separate them by comma, like: @amqp://user:password\@host:port,host2:port2\/vhost@
+--
+-- Any of these fields may be empty and will be replaced with defaults from @amqp://guest:guest\@localhost:5672\/@
+--
+-- When parsing fails, a @Left String@ will be returned with a human-readable error-message.
+fromURI :: String -> Either String ConnectionOpts
+fromURI uri =
+    case fromURI' uri of
+        Right (hostPorts, uid, pw, vhost, tls) ->
+            Right $ defaultConnectionOpts {
+                coServers     = hostPorts,
+                coVHost       = T.pack vhost,
+                coAuth        = [plain (T.pack uid) (T.pack pw)],
+                coTLSSettings = if tls then Just TLSTrusted else Nothing
+            }
+        Left err -> Left err
 
-fromURI' :: String -> ([(String, Int)], String, String, String, Bool)
-fromURI' uri = (fromHostPort dport <$> hstPorts,
-    unEscapeString (dropWhile (=='/') uid), unEscapeString pw,
-    unEscapeString vhost, tls)
+fromURI' :: String -> Either String ([(String, PortNumber)], String, String, String, Bool)
+fromURI' uri =
+    case sequence (map (fromHostPort dport) hostPorts) of
+        Right hostPorts' -> Right (
+            hostPorts',
+            unEscapeString (dropWhile (=='/') uid),
+            unEscapeString pw,
+            unEscapeString vhost,
+            tls
+         )
+        Left err -> Left err
   where (pre :suf  :    _) = splitOn "@" (uri ++ "@" ) -- look mom, no regexp dependencies
         (pro :uid' :pw':_) = splitOn ":" (pre ++ "::")
         (hnp :thost:    _) = splitOn "/" (suf ++ "/" )
-        hstPorts           = splitOn "," hnp
+        hostPorts          = splitOn "," hnp
         vhost = if null thost     then "/"     else thost
         dport = if pro == "amqps" then 5671    else 5672
         uid   = if null uid'      then "guest" else uid'
         pw    = if null pw'       then "guest" else pw'
         tls   = pro == "amqps"
 
-fromHostPort :: Int -> String -> (String, Int)
-fromHostPort dport hostPort = (unEscapeString host, nport)
+fromHostPort :: PortNumber -> String -> Either String (String, PortNumber)
+fromHostPort defPort hostPort = (unEscapeString host, ) <$> nport
     where
         (hst':port :    _) = splitOn ":" (hostPort ++ ":" )
         host  = if null hst' then "localhost" else hst'
-        nport = if null port then dport       else read port
+        nport = if null port
+                    then Right defPort
+                    else maybe (Left $ "invalid port number: "++port) Right $ readMaybe port
Network/AMQP/Internal.hs view
@@ -11,6 +11,7 @@ import Data.Binary
 import Data.Binary.Get
 import Data.Binary.Put as BPut
+import Data.Default.Class
 import Data.Int (Int64)
 import Data.Maybe
 import Data.Text (Text)
@@ -163,19 +164,19 @@     coMaxChannel :: !(Maybe Word16), -- ^ The maximum number of channels the client will use.
     coTLSSettings :: Maybe TLSSettings, -- ^ Whether or not to connect to servers using TLS. See http://www.rabbitmq.com/ssl.html for details.
     coName :: !(Maybe Text) -- ^ optional connection name (will be displayed in the RabbitMQ web interface)
-}
+} deriving Show
 
 -- | Represents the kind of TLS connection to establish.
 data TLSSettings =
     TLSTrusted   -- ^ Require trusted certificates (Recommended).
   | TLSUntrusted -- ^ Allow untrusted certificates (Discouraged. Vulnerable to man-in-the-middle attacks)
   | TLSCustom Conn.TLSSettings -- ^ Provide your own custom TLS settings
-
+  deriving Show
 connectionTLSSettings :: TLSSettings -> Maybe Conn.TLSSettings
 connectionTLSSettings tlsSettings =
     Just $ case tlsSettings of
-        TLSTrusted -> Conn.TLSSettingsSimple False False False
-        TLSUntrusted -> Conn.TLSSettingsSimple True False False
+        TLSTrusted -> Conn.TLSSettingsSimple False False False def
+        TLSUntrusted -> Conn.TLSSettingsSimple True False False def
         TLSCustom x -> x
 
 -- | A 'SASLMechanism' is described by its name ('saslName'), its initial response ('saslInitialResponse'), and an optional function ('saslChallengeFunc') that
@@ -185,6 +186,9 @@     saslInitialResponse :: !BS.ByteString, -- ^ initial response
     saslChallengeFunc :: !(Maybe (BS.ByteString -> IO BS.ByteString)) -- ^ challenge processing function
 }
+
+instance Show SASLMechanism where
+     show x = "SASL"
 
 -- | reads incoming frames from socket and forwards them to the opened channels
 connectionReceiver :: Connection -> IO ()
amqp.cabal view
@@ -1,5 +1,5 @@ Name:                amqp
-Version:             0.22.2
+Version:             0.24.0
 Synopsis:            Client library for AMQP servers (currently only RabbitMQ)
 Description:         Client library for AMQP servers (currently only RabbitMQ)
 License:             BSD3
@@ -24,11 +24,12 @@     containers>=0.2,
     bytestring>=0.9,
     data-binary-ieee754>=0.4.2.1,
+    data-default-class >= 0.1,
     text>=0.11.2,
     split>=0.2,
     clock >= 0.4.0.1,
     monad-control >= 0.3,
-    crypton-connection >= 0.3.1 && <= 0.4,
+    crypton-connection >= 0.4 && <= 0.5,
     vector,
     stm >= 2.4.0,
     network-uri >= 2.6,
@@ -67,6 +68,7 @@       ConnectionSpec
       ExchangeDeclareSpec
       ExchangeDeleteSpec
+      FromURISpec
       QueueDeclareSpec
       QueueDeleteSpec
       QueuePurgeSpec
@@ -76,12 +78,13 @@     , containers>=0.2
     , bytestring>=0.9
     , data-binary-ieee754>=0.4.2.1
+    , data-default-class >= 0.1
     , text>=0.11.2
     , split>=0.2
     , clock >= 0.4.0.1
     , hspec              >= 1.3
     , hspec-expectations >= 0.3.3
-    , crypton-connection >= 0.3.1 && <= 0.4
+    , crypton-connection >= 0.4 && <= 0.5
     , vector
     , stm >= 2.4.0
     , network-uri >= 2.6
changelog.md view
@@ -1,3 +1,11 @@+### Version 0.24.0
+
+* the `fromURI` method now returns `Either String ConnectionOpts` to better handle parsing-errors
+
+### Version 0.23.0
+
+* bump dependency bounds for `crypton-connection`
+
 ### Version 0.22.2
 
 * replace `connection` dependency with `crypton-connection`
+ test/FromURISpec.hs view
@@ -0,0 +1,190 @@+{-# OPTIONS -XOverloadedStrings #-}
+
+
+module FromURISpec (main, spec) where
+
+
+import              Network.AMQP
+import              Test.Hspec
+
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = do
+    describe "fromURI" $ do
+        it "empty" $ do
+            let Right o = fromURI ""
+            coServers o `shouldBe` [("localhost", 5672)]
+            coVHost o `shouldBe` "/"
+            -- avoid undefined SASLMechanism Show instance
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULguest\NULguest"]
+            -- avoid undefined TLSSettings Show instance
+            (isTrusted $ coTLSSettings o) `shouldBe` False
+
+        it "amqp auth host" $ do
+            let Right o = fromURI "amqp://u:p@127.0.0.1"
+            coServers o `shouldBe` [("127.0.0.1", 5672)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` False
+
+        it "amqp auth host-2" $ do
+            let Right o = fromURI "amqp://u:p@127.0.0.1,127.0.0.2"
+            coServers o `shouldBe` [("127.0.0.1", 5672),("127.0.0.2", 5672)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` False
+
+        it "amqp auth host port" $ do
+            let Right o = fromURI "amqp://u:p@127.0.0.1:5672"
+            coServers o `shouldBe` [("127.0.0.1", 5672)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` False
+
+        it "amqp auth host-2 port" $ do
+            let Right o = fromURI "amqp://u:p@127.0.0.1,127.0.0.2:5672"
+            coServers o `shouldBe` [("127.0.0.1", 5672),("127.0.0.2", 5672)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` False
+
+        it "amqp auth host-2 port-2" $ do
+            let Right o = fromURI "amqp://u:p@127.0.0.1:5672,127.0.0.2:5672"
+            coServers o `shouldBe` [("127.0.0.1", 5672),("127.0.0.2", 5672)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` False
+
+        it "amqp auth host port vhost" $ do
+            let Right o = fromURI "amqp://u:p@127.0.0.1:5672/v"
+            coServers o `shouldBe` [("127.0.0.1", 5672)]
+            coVHost o `shouldBe` "v"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` False
+
+        it "amqp auth host-2 port-2 vhost" $ do
+            let Right o = fromURI "amqp://u:p@127.0.0.1:5673,127.0.0.2:5674/v"
+            coServers o `shouldBe` [("127.0.0.1", 5673),("127.0.0.2", 5674)]
+            coVHost o `shouldBe` "v"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` False
+
+        it "amqp auth host-3 port-3 vhost" $ do
+            let Right o = fromURI "amqp://a:b@h1:8001,h2:8002,h3:8003/w"
+            coServers o `shouldBe` [("h1", 8001),("h2", 8002),("h3", 8003)]
+            coVHost o `shouldBe` "w"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULa\NULb"]
+            (isTrusted $ coTLSSettings o) `shouldBe` False
+
+        it "amqp host" $ do
+            let Right o = fromURI "amqp://127.0.0.1"
+            -- this appears to break: user host
+            coServers o `shouldBe` [("localhost", 5672)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe`
+                ["\NUL127.0.0.1\NULguest"]
+            (isTrusted $ coTLSSettings o) `shouldBe` False
+
+        it "amqp host-2" $ do
+            let Right o = fromURI "amqp://127.0.0.1,127.0.0.2"
+            -- this appears to break: user host
+            coServers o `shouldBe` [("localhost", 5672)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe`
+                ["\NUL127.0.0.1,127.0.0.2\NULguest"]
+            (isTrusted $ coTLSSettings o) `shouldBe` False
+
+        it "amqps auth host" $ do
+            let Right o = fromURI "amqps://u:p@127.0.0.1"
+            coServers o `shouldBe` [("127.0.0.1", 5671)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` True
+
+        it "amqps auth host-2" $ do
+            let Right o = fromURI "amqps://u:p@127.0.0.1,127.0.0.2"
+            coServers o `shouldBe` [("127.0.0.1", 5671),("127.0.0.2", 5671)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` True
+
+        it "amqps auth host port" $ do
+            let Right o = fromURI "amqps://u:p@127.0.0.1:5672"
+            coServers o `shouldBe` [("127.0.0.1", 5672)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` True
+
+        it "amqps auth host-2 port" $ do
+            let Right o = fromURI "amqps://u:p@127.0.0.1,127.0.0.1:5673"
+            coServers o `shouldBe` [("127.0.0.1", 5671),("127.0.0.1", 5673)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` True
+
+        it "amqps auth host-2 port-2" $ do
+            let Right o = fromURI "amqps://u:p@127.0.0.1:5672,127.0.0.1:5673"
+            coServers o `shouldBe` [("127.0.0.1", 5672),("127.0.0.1", 5673)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` True
+
+        it "amqps auth host port vhost" $ do
+            let Right o = fromURI "amqps://u:p@127.0.0.1:5672/v"
+            coServers o `shouldBe` [("127.0.0.1", 5672)]
+            coVHost o `shouldBe` "v"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` True
+
+        it "amqps auth host-2 port-2 vhost" $ do
+            let Right o = fromURI "amqps://u:p@127.0.0.1:5672,127.0.0.2:5673/v"
+            coServers o `shouldBe` [("127.0.0.1", 5672),("127.0.0.2", 5673)]
+            coVHost o `shouldBe` "v"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe` ["\NULu\NULp"]
+            (isTrusted $ coTLSSettings o) `shouldBe` True
+
+        it "amqps host" $ do
+            let Right o = fromURI "amqps://127.0.0.1"
+            -- this appears to break: user host
+            coServers o `shouldBe` [("localhost", 5671)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe`
+                ["\NUL127.0.0.1\NULguest"]
+            (isTrusted $ coTLSSettings o) `shouldBe` True
+
+        it "amqps host-2" $ do
+            let Right o = fromURI "amqps://127.0.0.1,127.0.0.2"
+            -- this appears to break: user host
+            coServers o `shouldBe` [("localhost", 5671)]
+            coVHost o `shouldBe` "/"
+            (saslName <$> coAuth o) `shouldBe` ["PLAIN"]
+            (saslInitialResponse <$> coAuth o) `shouldBe`
+                ["\NUL127.0.0.1,127.0.0.2\NULguest"]
+            (isTrusted $ coTLSSettings o) `shouldBe` True
+
+
+isTrusted :: Maybe TLSSettings -> Bool
+isTrusted (Just TLSTrusted) = True
+isTrusted _ = False