pubnub 0.1.0.0 → 1.0.0
raw patch · 4 files changed
+119/−45 lines, 4 filesdep +timedep ~data-defaultPVP ok
version bump matches the API change (PVP)
Dependencies added: time
Dependency ranges changed: data-default
API changes (from Hackage documentation)
- Network.Pubnub.Types: uid :: SubscribeOptions a -> Maybe UUID
+ Network.Pubnub: audit :: PN -> Auth -> IO (Maybe Value)
+ Network.Pubnub: auth :: PN -> Text -> PN
+ Network.Pubnub: auth_key :: PN -> Maybe Text
+ Network.Pubnub: grant :: PN -> Auth -> IO (Maybe Value)
+ Network.Pubnub: uuid_key :: PN -> Maybe UUID
+ Network.Pubnub.Types: Auth :: Maybe Text -> [Text] -> Bool -> Bool -> Int -> Auth
+ Network.Pubnub.Types: authKeys :: Auth -> [Text]
+ Network.Pubnub.Types: auth_key :: PN -> Maybe Text
+ Network.Pubnub.Types: chan :: Auth -> Maybe Text
+ Network.Pubnub.Types: data Auth
+ Network.Pubnub.Types: defaultAuth :: Auth
+ Network.Pubnub.Types: instance Show Auth
+ Network.Pubnub.Types: r :: Auth -> Bool
+ Network.Pubnub.Types: ttl :: Auth -> Int
+ Network.Pubnub.Types: uuid_key :: PN -> Maybe UUID
+ Network.Pubnub.Types: w :: Auth -> Bool
- Network.Pubnub: PN :: Text -> Text -> Text -> Text -> [Text] -> Integer -> Timestamp -> ByteString -> Maybe AES -> Maybe (IV AES) -> Bool -> PN
+ Network.Pubnub: PN :: Text -> Text -> Text -> Text -> Maybe UUID -> Maybe Text -> [Text] -> Integer -> Timestamp -> ByteString -> Maybe AES -> Maybe (IV AES) -> Bool -> PN
- Network.Pubnub.Types: PN :: Text -> Text -> Text -> Text -> [Text] -> Integer -> Timestamp -> ByteString -> Maybe AES -> Maybe (IV AES) -> Bool -> PN
+ Network.Pubnub.Types: PN :: Text -> Text -> Text -> Text -> Maybe UUID -> Maybe Text -> [Text] -> Integer -> Timestamp -> ByteString -> Maybe AES -> Maybe (IV AES) -> Bool -> PN
- Network.Pubnub.Types: SubscribeOptions :: Maybe UUID -> (a -> IO ()) -> IO () -> IO () -> (Maybe Int -> Maybe ByteString -> IO ()) -> Maybe (Presence -> IO ()) -> IO () -> Maybe Int -> Bool -> Maybe Integer -> SubscribeOptions a
+ Network.Pubnub.Types: SubscribeOptions :: (a -> IO ()) -> IO () -> IO () -> (Maybe Int -> Maybe ByteString -> IO ()) -> Maybe (Presence -> IO ()) -> IO () -> Maybe Int -> Bool -> Maybe Integer -> SubscribeOptions a
Files
- examples/Chat/Main.hs +12/−19
- pubnub.cabal +4/−3
- src/Network/Pubnub.hs +81/−17
- src/Network/Pubnub/Types.hs +22/−6
examples/Chat/Main.hs view
@@ -9,6 +9,7 @@ import GHC.Generics import Data.Aeson+import Data.Maybe import Control.Concurrent.Async import Control.Monad@@ -24,53 +25,45 @@ instance FromJSON Msg -type ClientName = T.Text--data Client = Client { clientName :: ClientName- , pn :: PN }- main :: IO () main = do putStrLn "Enter Username: " username <- I.getLine runClient $ newClient username True -newClient :: ClientName -> Bool -> Client+newClient :: T.Text -> Bool -> PN newClient name encrypt- | encrypt = either (error . show) (\x -> Client { clientName = name- , pn = x}) encKey- | otherwise = Client { clientName = name- , pn = newPN}+ | encrypt = either (error . show) (\x -> x{ uuid_key = (Just name) }) encKey+ | otherwise = newPN where encKey = setEncryptionKey newPN "enigma" - newPN = defaultPN { channels = ["testchathaskell2"]+ newPN = defaultPN { uuid_key = (Just name)+ , channels = ["testchathaskell2"] , sub_key = "demo" , pub_key = "demo" , ssl = False } -runClient :: Client -> IO ()-runClient Client{..} = do+runClient :: PN -> IO ()+runClient pn = do a <- receiver withAsync (cli a) $ \b -> do _ <- waitAnyCancel [a, b] return ()- where+ where cli a = forever $ do msg <- I.getLine case msg of "/leave" -> do- leave pn (head $ channels pn) clientName+ leave pn (head $ channels pn) (fromJust $ uuid_key pn) unsubscribe a mzero _ ->- publish pn (head $ channels pn) Msg { username=clientName+ publish pn (head $ channels pn) Msg { username=(fromJust $ uuid_key pn) , msg=msg } receiver =- subscribe pn defaultSubscribeOptions{ uid = Just clientName-- , onPresence = Just outputPresence+ subscribe pn defaultSubscribeOptions{ onPresence = Just outputPresence , onMsg = output , onConnect = putStrLn "Connected..." }
pubnub.cabal view
@@ -2,9 +2,9 @@ -- see http://haskell.org/cabal/users-guide/ name: pubnub-version: 0.1.0.0+version: 1.0.0 synopsis: PubNub Haskell SDK--- description:+description: The PubNub Network makes Real-time easy with a Simple Communications API. Two Functions: Send/Receive (Publish/Subscribe). We provide a web-service API for businesses to build scalable Data Push communication apps on Mobile, Tablet and Web. Bidirectional JSON. homepage: http://github.com/pubnub/haskell license: MIT license-file: LICENSE@@ -34,12 +34,13 @@ , http-types >= 0.8.3 , uuid >= 1.3.3 , async >= 2.0.1.4- , data-default+ , data-default >= 0.5.3 , SHA >= 1.6.1 , cipher-aes >= 0.2.6 , crypto-api >= 0.12.2.2 , crypto-cipher-types >= 0.0.9 , base64-bytestring >= 1.0.0.1+ , time >= 1.4.0.1 ghc-options: -Wall hs-source-dirs: src default-language: Haskell2010
src/Network/Pubnub.hs view
@@ -17,6 +17,11 @@ , leave , getUuid , unsubscribe++ -- PAM API functions+ , audit+ , auth+ , grant ) where import Network.Pubnub.Types@@ -32,6 +37,7 @@ import Control.Exception.Lifted (try) import Data.Text.Encoding import Data.Maybe+import Data.Time.Clock.POSIX import Data.Digest.Pure.SHA import Crypto.Cipher.AES@@ -45,7 +51,7 @@ time :: IO (Maybe Timestamp) time = do- let req = buildRequest defaultPN ["time", "0"] [] Nothing+ let req = buildRequest defaultPN ["time", "0"] [] Nothing res <- withManager $ httpLbs req return (decode $ responseBody res :: Maybe Timestamp) @@ -54,14 +60,14 @@ case onPresence subOpts of Nothing -> subscribeInternal pn subOpts Just onPresenceCallback ->- case uid subOpts of- Nothing -> getUuid >>= \u -> subscribe' subOpts{uid = Just u}- _ -> subscribe' subOpts+ case uuid_key pn of+ Nothing -> getUuid >>= \u -> subscribe' pn{uuid_key = Just u}+ _ -> subscribe' pn where- subscribe' subOpts' =+ subscribe' pn' = do- a <- presence pn (uid subOpts') onPresenceCallback- b <- subscribeInternal pn subOpts'+ a <- presence pn' (uuid_key pn') onPresenceCallback+ b <- subscribeInternal pn' subOpts link2 a b return a @@ -96,17 +102,17 @@ let req = buildSubscribeRequest pn' $ head . L.toChunks $ encode (time_token pn') eres <- try $ httpLbs req manager :: IO (Either HttpException (Response L.ByteString)) case eres of- Right r ->+ Right res -> case (ctx pn', iv pn') of (Just c, Just i) ->- case decode $ responseBody r of+ case decode $ responseBody res of Just (EncryptedSubscribeResponse (resp, t)) -> do _ <- liftIO $ mapM (onMsg subOpts . decodeEncrypted c i) resp subscribe' manager (pn' { time_token=t }) Nothing -> subscribe' manager pn' (_, _) ->- case decode $ responseBody r of+ case decode $ responseBody res of Just (SubscribeResponse (resp, t)) -> do _ <- liftIO $ mapM (onMsg subOpts) resp subscribe' manager (pn' { time_token=t })@@ -129,7 +135,7 @@ , encodeUtf8 $ T.intercalate "," (channels pn') , bsFromInteger $ jsonp_callback pn' , tt ]- (maybe [] (\u -> [("uuid", encodeUtf8 u)]) (uid subOpts))+ (userIdOptions pn') (subTimeout subOpts) decodeEncrypted c i m = decodeUnencrypted $ decrypt c i m@@ -154,7 +160,9 @@ , sig , encodeUtf8 channel , bsFromInteger $ jsonp_callback pn- , encrypt (ctx pn) (iv pn) encoded_msg] [] Nothing+ , encrypt (ctx pn) (iv pn) encoded_msg]+ (userIdOptions pn)+ Nothing res <- withManager $ httpLbs req return (decode $ responseBody res) where@@ -180,9 +188,8 @@ presence :: (FromJSON b) => PN -> Maybe UUID -> (b -> IO ()) -> IO (Async ()) presence pn u fn =- let subOpts = defaultSubscribeOptions{ onMsg = fn- , uid = u }- pn' = pn { ctx=Nothing, channels=presence_channels }+ let subOpts = defaultSubscribeOptions{ onMsg = fn }+ pn' = pn { uuid_key=u, ctx=Nothing, channels=presence_channels } in subscribeInternal pn' subOpts where@@ -196,7 +203,10 @@ , "sub-key" , encodeUtf8 $ sub_key pn , "channel"- , encodeUtf8 channel] (convertHistoryOptions options) Nothing+ , encodeUtf8 channel]+ ((convertHistoryOptions options) +++ (userIdOptions pn))+ Nothing res <- withManager $ httpLbs req return (decode $ responseBody res) @@ -219,6 +229,60 @@ unsubscribe :: Async () -> IO () unsubscribe = cancel ++-- PAM functions++audit :: PN -> Auth -> IO (Maybe Value)+audit = pamDo "audit"++grant :: PN -> Auth -> IO (Maybe Value)+grant = pamDo "grant"++auth :: PN -> T.Text -> PN+auth pn k = pn{auth_key = (Just k)}++pamDo :: B.ByteString -> PN -> Auth -> IO (Maybe Value)+pamDo pamMethod pn authR = do + ts <- (bsFromInteger . round) <$> getPOSIXTime + let req = buildRequest pn pamURI ((pamQS ts) ++ [("signature", signature ts)]) Nothing + res <- withManager $ httpLbs req+ return (decode $ responseBody res) + where+ authK = T.intercalate "," $ authKeys authR+ channel = fromJust $ chan authR+ authRead = r authR+ authWrite = w authR+ + pubKey = encodeUtf8 $ pub_key pn+ subKey = encodeUtf8 $ sub_key pn+ secKey = L.fromStrict . encodeUtf8 $ sec_key pn+ + signature ts = B64.encode . L.toStrict . bytestringDigest $ hmacSha256 secKey (msg ts)++ msg ts = L.fromStrict $ B.intercalate B.empty [ subKey, "\n"+ , pubKey, "\n"+ , pamMethod, "\n"+ , B.tail $ renderSimpleQuery True $ pamQS ts]++ pamURI = [ "v1"+ , "auth" + , pamMethod+ , "sub-key"+ , subKey]++ pamQS ts = [ ("auth", encodeUtf8 authK)+ , ("channel", encodeUtf8 channel)+ , ("r", if authRead then "1" else "0")+ , ("timestamp", ts)+ , ("w", if authWrite then "1" else "0")]+++-- internal functions+userIdOptions :: PN -> [(B.ByteString, B.ByteString)]+userIdOptions pn =+ (maybe [] (\u -> [("uuid", encodeUtf8 u)]) (uuid_key pn)) +++ (maybe [] (\a -> [("auth", encodeUtf8 a)]) (auth_key pn))+ buildRequest :: PN -> [B.ByteString] -> SimpleQuery -> Maybe Int -> Request buildRequest pn elems qs timeout = def { host = encodeUtf8 $ origin pn@@ -228,7 +292,7 @@ , requestHeaders = [ ("V", "3.1") , ("User-Agent", "Haskell") , ("Accept", "*/*")]- , queryString = renderSimpleQuery True qs+ , queryString = renderSimpleQuery True qs , secure = ssl pn , responseTimeout = Just (maybe 5000000 (* 1000000) timeout) }
src/Network/Pubnub/Types.hs view
@@ -12,6 +12,8 @@ , defaultPN , SubscribeOptions(..) , defaultSubscribeOptions+ , Auth(..)+ , defaultAuth , ConnectResponse(..) , SubscribeResponse(..) , EncryptedSubscribeResponse(..)@@ -47,6 +49,8 @@ , pub_key :: T.Text , sub_key :: T.Text , sec_key :: T.Text+ , uuid_key :: Maybe UUID+ , auth_key :: Maybe T.Text , channels :: [T.Text] , jsonp_callback :: Integer , time_token :: Timestamp@@ -60,6 +64,8 @@ , pub_key = T.empty , sub_key = T.empty , sec_key = "0"+ , uuid_key = Nothing+ , auth_key = Nothing , channels = [] , jsonp_callback = 0 , time_token = Timestamp 0@@ -68,9 +74,7 @@ , iv = makeIV (B.pack "0123456789012345") , ssl = False } -data SubscribeOptions a = SubscribeOptions { uid :: Maybe UUID-- , onMsg :: a -> IO ()+data SubscribeOptions a = SubscribeOptions { onMsg :: a -> IO () , onConnect :: IO () , onDisconnect :: IO () , onError :: Maybe Int -> Maybe B.ByteString -> IO ()@@ -82,9 +86,7 @@ , windowing :: Maybe Integer } defaultSubscribeOptions :: SubscribeOptions a-defaultSubscribeOptions = SubscribeOptions { uid = Nothing-- , onMsg = \_ -> return ()+defaultSubscribeOptions = SubscribeOptions { onMsg = \_ -> return () , onConnect = return () , onDisconnect = return () , onError = \_ _ -> return ()@@ -94,6 +96,20 @@ , subTimeout = Just 310 , resumeOnReconnect = True , windowing = Nothing }++data Auth = Auth { chan :: Maybe T.Text+ , authKeys :: [T.Text]+ , r :: Bool+ , w :: Bool+ , ttl :: Int }+ deriving (Show)++defaultAuth :: Auth+defaultAuth = Auth { chan = Nothing+ , authKeys = []+ , r = False+ , w = False+ , ttl = 0 } setEncryptionKey :: PN -> B.ByteString -> Either KeyError PN setEncryptionKey pn key =