pusher-http-haskell 0.2.1.0 → 0.3.0.0

raw patch · 7 files changed

+79/−88 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• pusher-http-haskell.cabal +1/−1
• src/Data/Pusher.hs +20/−7
• src/Network/Pusher.hs +12/−10
• src/Network/Pusher/Internal/Auth.hs +2/−2
• src/Network/Pusher/Internal/HTTP.hs +3/−2
• src/Network/Pusher/Protocol.hs +32/−57
• test/Protocol.hs +9/−9

@@ -1,5 +1,5 @@ name:                 pusher-http-haskell-version:              0.2.1.0+version:              0.3.0.0 cabal-version:        >=1.18 build-type:           Simple license:              MIT

@@ -13,12 +13,14 @@   ( Pusher(..)   , Credentials(..)   , getPusher+  , getPusherWithHost   , getPusherWithConnManager   ) where  import Control.Applicative ((<$>), (<*>)) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson ((.:))+import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Data.Text.Encoding (encodeUtf8) import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)@@ -26,7 +28,7 @@ import qualified Data.ByteString as B import qualified Data.Text as T -import Network.Pusher.Internal.Util (failExpectObj)+import Network.Pusher.Internal.Util (failExpectObj, show')  -- |All the required configuration needed to interact with the API. data Pusher = Pusher@@ -54,15 +56,26 @@ -- automatically. getPusher :: MonadIO m => Credentials -> m Pusher getPusher cred = do-  connManager <- liftIO $ newManager defaultManagerSettings-  return $ getPusherWithConnManager connManager cred+    connManager <- getConnManager+    return $ getPusherWithConnManager connManager Nothing cred -getPusherWithConnManager :: Manager -> Credentials -> Pusher-getPusherWithConnManager connManager cred =-  let path = "/apps/" <> T.pack (show $ credentialsAppID cred) <> "/" in+-- |Get a Pusher instance that uses a specific API endpoint.+getPusherWithHost :: MonadIO m => T.Text -> Credentials -> m Pusher+getPusherWithHost apiHost cred = do+  connManager <- getConnManager+  return $ getPusherWithConnManager connManager (Just apiHost) cred++-- |Get a Pusher instance with a given connection manager. This can be useful+-- if you want to share a connection with your application code.+getPusherWithConnManager :: Manager -> Maybe T.Text -> Credentials -> Pusher+getPusherWithConnManager connManager apiHost cred =+  let path = "/apps/" <> show' (credentialsAppID cred) <> "/" in   Pusher-    { pusherHost = "http://api.pusherapp.com"+    { pusherHost = fromMaybe "http://api.pusherapp.com" apiHost     , pusherPath = path     , pusherCredentials = cred     , pusherConnectionManager = connManager     }++getConnManager :: MonadIO m => m Manager+getConnManager = liftIO $ newManager defaultManagerSettings

@@ -29,12 +29,13 @@  @   let-    pusher = getPusher $ Credentials-      { credentials'appID = 123-      , credentials'appKey = wrd12344rcd234-      , credentials'appSecret = 124df34d545v+    credentials = Credentials+      { credentialsAppID = 123+      , credentialsAppKey = wrd12344rcd234+      , credentialsAppSecret = 124df34d545v       }-  result <- runPusherT (Pusher.trigger ["my-channel"] "my-event" "my-data") pusher+  pusher <- getPusher credentials+  result <- runPusherT (trigger [Channel Public "my-channel"] "my-event" "my-data" Nothing) pusher   case result of     Right resp -> print resp     Left e -> error e@@ -77,7 +78,6 @@   , makeQS   ) import Network.Pusher.Internal.HTTP (get, post)-import Network.Pusher.Internal.Util (show') import Network.Pusher.Protocol   ( Channel   , ChannelInfo@@ -87,6 +87,8 @@   , ChannelType   , FullChannelInfo   , Users+  , renderChannel+  , renderChannelPrefix   , toURLParam   ) @@ -106,7 +108,7 @@   let     body = A.object $       [ ("name", A.String event)-      , ("channels", A.toJSON (map (A.String . show') chans))+      , ("channels", A.toJSON (map (A.String . renderChannel) chans))       , ("data", A.String dat)       ] ++ maybeToList (fmap (\sID ->  ("socket_id", A.String sID)) socketId)     bodyBS = BL.toStrict $ A.encode body@@ -128,7 +130,7 @@   -> m ChannelsInfo -- ^The returned data channels channelTypeFilter prefixFilter attributes = do   let-    prefix = maybe "" show' channelTypeFilter <> prefixFilter+    prefix = maybe "" renderChannelPrefix channelTypeFilter <> prefixFilter     params =       [ ("info", encodeUtf8 $ toURLParam attributes)       , ("filter_by_prefix", encodeUtf8 prefix)@@ -146,7 +148,7 @@   -> m FullChannelInfo channel chan attributes = do   let params = [("info", encodeUtf8 $ toURLParam attributes)]-  (ep, path) <- getEndpoint $ "channels/" <> show' chan+  (ep, path) <- getEndpoint $ "channels/" <> renderChannel chan   qs <- makeQSWithTS "GET" path params ""   connManager <- asks pusherConnectionManager   get connManager (encodeUtf8 ep) qs@@ -157,7 +159,7 @@  => Channel  -> m Users users chan = do-  (ep, path) <- getEndpoint $ "channels/" <> show' chan <> "/users"+  (ep, path) <- getEndpoint $ "channels/" <> renderChannel chan <> "/users"   qs <- makeQSWithTS "GET" path [] ""   connManager <- asks pusherConnectionManager   get connManager (encodeUtf8 ep) qs

@@ -32,6 +32,7 @@ import qualified Crypto.MAC.HMAC as HMAC  import Data.Pusher (Credentials(..))+import Network.Pusher.Internal.Util (show')  -- |Generate the required query string parameters required to send API requests -- to Pusher.@@ -49,7 +50,7 @@     -- Generate all required parameters and add them to the list of existing ones     allParams = sortWith fst $ params ++       [ ("auth_key", appKey)-      , ("auth_timestamp", BC.pack $ show ts)+      , ("auth_timestamp", show' ts)       , ("auth_version", "1.0")       , ("body_md5", B16.encode (MD5.hash body))       ]@@ -113,4 +114,3 @@       )   in     credentialsAppKey cred <> ":" <> sig-

@@ -40,6 +40,7 @@ import qualified Data.Text as T  import Control.Monad.Pusher.HTTP (MonadHTTP(httpLbs))+import Network.Pusher.Internal.Util (show')  import Debug.Trace @@ -84,7 +85,7 @@   -> Maybe BL.ByteString   -> m (Response BL.ByteString) makeRequest connManager ep qs body = do-  req <- either (throwError . T.pack . show) return (parseUrl $ BC.unpack ep)+  req <- either (throwError . show') return (parseUrl $ BC.unpack ep)   let     req' = setQueryString (map (second Just) qs) req     req'' = case body of@@ -102,7 +103,7 @@   if statusCode status == 200 then      run   else-     throwError $ either (T.pack . show) id $ decodeUtf8' $ statusMessage status+     throwError $ either show' id $ decodeUtf8' $ statusMessage status  errorOn200 :: (MonadError T.Text m) => Response BL.ByteString -> m () errorOn200 response = when200 response (return ())

@@ -18,17 +18,17 @@   ( Channel(..)   , ChannelInfo(..)   , ChannelInfoAttributes(..)-  , ChannelInfoAttributeResp(..)   , ChannelInfoQuery(..)   , ChannelsInfo(..)   , ChannelsInfoQuery(..)   , ChannelsInfoAttributes(..)   , ChannelType(..)   , FullChannelInfo(..)-  , FullChannelAttributeResp(..)   , User(..)   , Users(..)   , parseChannel+  , renderChannel+  , renderChannelPrefix   , toURLParam   ) where @@ -37,6 +37,7 @@ import Data.Foldable (asum) import Data.Hashable (Hashable) import Data.Maybe (fromMaybe)+import Data.Monoid ((<>)) import GHC.Generics (Generic) import Test.QuickCheck (Arbitrary, arbitrary, elements) import qualified Data.Aeson as A@@ -44,35 +45,35 @@ import qualified Data.HashSet as HS import qualified Data.Text as T -import Network.Pusher.Internal.Util (failExpectObj, show')+import Network.Pusher.Internal.Util (failExpectObj)  -- |The possible types of Pusher channe.-data ChannelType = Public | Private | Presence deriving (Eq, Generic)+data ChannelType = Public | Private | Presence deriving (Eq, Generic, Show)  instance Hashable ChannelType -instance Show ChannelType where-  show Public = ""-  show Private = "private-"-  show Presence = "presence-"- instance Arbitrary ChannelType where   arbitrary = elements [Public, Private, Presence] +renderChannelPrefix :: ChannelType -> T.Text+renderChannelPrefix Public = ""+renderChannelPrefix Private = "private-"+renderChannelPrefix Presence = "presence-"+ -- |The channel name (not including the channel type prefix) and its type. data Channel = Channel   { channelType :: ChannelType   , channelName :: T.Text-  } deriving (Eq, Generic)+  } deriving (Eq, Generic, Show)  instance Hashable Channel -instance Show Channel where-  show (Channel chanType name) = show chanType ++ T.unpack name- instance Arbitrary Channel where   arbitrary = Channel <$> arbitrary <*> (T.pack <$> arbitrary) +renderChannel :: Channel -> T.Text+renderChannel (Channel cType cName) = renderChannelPrefix cType <> cName+ -- |Convert string representation, e.g. private-chan into the datatype parseChannel :: T.Text -> Channel parseChannel chan =@@ -82,7 +83,7 @@     (asum [parseChanAs Private,  parseChanAs Presence])  where   parseChanAs chanType =-    let split = T.splitOn (show' chanType) chan in+    let split = T.splitOn (renderChannelPrefix chanType) chan in     -- If the prefix appears at the start, then the first element will be empty     if length split > 1 && T.null (head split) then       Just $ Channel chanType (T.concat $ tail split)@@ -144,56 +145,30 @@       v1 -> failExpectObj v1   parseJSON v2 = failExpectObj v2 --- |A set of returned channel attributes for a single channel.-newtype ChannelInfo =-  ChannelInfo (HS.HashSet ChannelInfoAttributeResp)-  deriving (Eq, Show)+-- |The possible returned channel attributes when multiple when multiple+-- channels are queried.+data ChannelInfo = ChannelInfo+  { channelInfoUserCount :: Maybe Int+  } deriving (Eq, Show)  instance A.FromJSON ChannelInfo where-  parseJSON (A.Object v) = do-    maybeUserCount <- v .:? "user_count"-    return $ ChannelInfo $ maybe-      HS.empty-      (HS.singleton . UserCountResp)-      maybeUserCount+  parseJSON (A.Object v) = ChannelInfo <$> v .:? "user_count"   parseJSON v = failExpectObj v --- |An enumeration of possible returned channel attributes when multiple--- when multiple channels are queried.-data ChannelInfoAttributeResp = UserCountResp Int deriving (Eq, Generic, Show)--instance Hashable ChannelInfoAttributeResp---- |A set of returned channel attributes for a single channel.-newtype FullChannelInfo =-  FullChannelInfo (HS.HashSet FullChannelAttributeResp)-  deriving (Eq, Show)+-- |The possible values returned by a query to a single channel+data FullChannelInfo = FullChannelInfo+  { fullChannelInfoOccupied :: Bool+  , fullChannelInfoUserCount :: Maybe Int+  , fullChannelInfoSubCount :: Maybe Int+  } deriving (Eq, Show)  instance A.FromJSON FullChannelInfo where-  parseJSON (A.Object v) = do-    occupied <- v .: "occupied"-    maybeUserCount <- v .:? "user_count"-    maybeSubCount <- v .:? "subscription_count"-    let-      hs = HS.singleton (OccupiedResp occupied)-      hs' =  maybeInsert (FullUserCountResp <$> maybeUserCount) hs-      hs'' =  maybeInsert (SubscriptionCountResp <$> maybeSubCount) hs'-    return $ FullChannelInfo hs''-   where-    maybeInsert :: (Eq a, Hashable a) => Maybe a -> HS.HashSet a -> HS.HashSet a-    maybeInsert maybeVal hs = maybe hs (`HS.insert` hs) maybeVal-+  parseJSON (A.Object v) =+    FullChannelInfo+      <$> v .: "occupied"+      <*> v .:? "user_count"+      <*> v .:? "subscription_count"   parseJSON v = failExpectObj v---- |An enumeration of possible returned channel attributes when a single--- channel is queried-data FullChannelAttributeResp-  = OccupiedResp Bool-  | FullUserCountResp Int-  | SubscriptionCountResp Int-  deriving (Eq, Generic, Show)--instance Hashable FullChannelAttributeResp  -- |A list of users returned by querying for users in a presence channel. newtype Users = Users [User] deriving (Eq, Show)

@@ -10,25 +10,26 @@ import Network.Pusher.Protocol   ( Channel(..)   , ChannelInfo(..)-  , ChannelInfoAttributeResp(UserCountResp)   , ChannelsInfo(..)   , ChannelType(Public, Presence, Private)+  , FullChannelInfo(..)   , User(..)   , Users(..)   , parseChannel+  , renderChannel   )  test :: Spec test = do   describe "Protocol.Channel" $ do     it "show instance works for public channels" $-      show (Channel Public "test") `shouldBe` "test"+      renderChannel (Channel Public "test") `shouldBe` "test"      it "show instance works for private channels" $-      show (Channel Private "test") `shouldBe` "private-test"+      renderChannel (Channel Private "test") `shouldBe` "private-test"      it "show instance is an inverse of parseChannel" $-      property $ \chan -> parseChannel (T.pack $ show chan) == chan+      property $ \chan -> parseChannel (renderChannel chan) == chan    describe "Protocol.ChannelsInfo" $     it "parsing works" $@@ -46,11 +47,11 @@ \       }"       `shouldBe`         (Just $ ChannelsInfo $ HM.fromList-          [ (Channel Presence "foobar", ChannelInfo $ HS.fromList [UserCountResp 42])-          , (Channel Presence "another", ChannelInfo $ HS.fromList [UserCountResp 123])+          [ (Channel Presence "foobar", ChannelInfo $ Just 42)+          , (Channel Presence "another", ChannelInfo $ Just 123)           ]) -  describe "Protocol.ChannelInfo" $+  describe "Protocol.FullChannelInfo" $     it "parsing works" $       -- Data from https://pusher.com/docs/rest_api#successful-response-2       A.decode@@ -60,8 +61,7 @@ \         \"subscription_count\": 42\ \       }"       `shouldBe`-        -- TODO: Currently incomplete due to ChannelInfo being incomplete-        (Just $ ChannelInfo $ HS.fromList [UserCountResp 42])+        (Just $ FullChannelInfo True (Just 42) (Just 42))    describe "Protocol.Users" $     it "parsing works" $