discord-gateway (empty) → 0.2.2

raw patch · 3 files changed

+172/−0 lines, 3 filesdep +aesondep +basedep +discord-types

Dependencies added: aeson, base, discord-types, hslogger, transformers, url, websockets, wuss

Files

LICENSE +20/−0
discord-gateway.cabal +35/−0
src/Network/Discord/Gateway.hs +117/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2016 Joshua Koike++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ discord-gateway.cabal view

@@ -0,0 +1,35 @@+name:                discord-gateway+version:             0.2.2+synopsis:            An API wrapper for Discord in Haskell+description:         Provides an api wrapper and framework for writing+                     bots against the Discord <https://discordapp.com/> API.+                     If for some reason hackage/stackage is failing to build+                     documentation, a backup set is hosted at <https://jano017.github.io/Discord.hs/>+homepage:            https://github.com/jano017/Discord.hs+license:             MIT+license-file:        LICENSE+author:              Joshua Koike+maintainer:          jkoike2013@gmail.com+-- copyright:+category:            Network+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  exposed-modules:     Network.Discord.Gateway+  build-depends:       base==4.*+                     , aeson>=1.0 && <1.2+                     , hslogger==1.2.*+                     , transformers==0.5.*+                     , url==2.1.*+                     , websockets==0.10.*+                     , wuss==1.1.*+                     , discord-types+  ghc-options:         -Wall+  hs-source-dirs:      src+  default-language:    Haskell2010++source-repository head+  type : git+  location: https://github.com/jano017/Discord.hs

+ src/Network/Discord/Gateway.hs view

@@ -0,0 +1,117 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}+{-# OPTIONS_HADDOCK prune, not-home #-}+-- | Provides logic code for interacting with the Discord websocket+--   gateway. Reallistically, this is probably lower level than most+--   people will need, and you should use Language.Discord.+module Network.Discord.Gateway where+  import Control.Concurrent (threadDelay)+  import Control.Monad (forever)+  import Control.Monad.IO.Class (liftIO)+  import Data.Maybe (fromJust)++  import Data.Aeson+  import Network.WebSockets hiding (send)+  import Network.URL+  import System.Log.Logger+  import Wuss++  import Network.Discord.Types++  data GatewayState+    = Create+    | Start+    | Running+    | InvalidReconnect+    | InvalidDead++  class DiscordAuth m => DiscordGate m where+    data VaultKey m a+    +    type Vault m :: * -> *+    -- | Retrieve a value from the store, blocking if the store is empty+    get :: Vault m a -> m a+    -- | Place a value into the store, discarding the old value if present.+    put  :: Vault m a -> a -> m ()++    sequenceKey :: VaultKey m Integer+    storeFor :: VaultKey m a -> m ((Vault m) a)++    connection   :: m Connection+    feed :: m () -> Event -> m ()++    run  :: m () -> Connection -> IO ()+    fork :: m () -> m ()++  runGateway :: DiscordGate m => URL -> m () -> IO ()+  runGateway (URL (Absolute h) path _) client =+    runSecureClient (host h) 443 (path ++ "/?v=6")+      $ run client+  runGateway _ _ = return ()++  send :: DiscordGate m => Payload -> m ()+  send payload = do+    conn <- connection+    liftIO . sendTextData conn $ encode payload++  heartbeat :: DiscordGate m => Int -> m ()+  heartbeat interval = fork . forever $ do+    seqNum <- Heartbeat <$> (get =<< storeFor sequenceKey)+    send seqNum+    liftIO $ threadDelay (interval * 1000)++  setSequence :: DiscordGate m => Integer -> m ()+  setSequence sq = do+    seqNum <- storeFor sequenceKey+    put seqNum sq++  eventStream :: DiscordGate m => GatewayState -> m () -> m ()+  eventStream Create m = do+    Hello interval <- step+    heartbeat interval+    eventStream Start m+  eventStream Start m = do+    creds <- auth+    send $ Identify creds False 50 (0, 1)+    eventStream Running m+  eventStream Running m = do+    payload <- step+    case payload of+      Dispatch _ sq _ -> do+        setSequence sq+        case parseDispatch payload of+          Left reason -> liftIO $ errorM "Discord-hs.Gateway.Dispatch" reason+          Right event -> do+            liftIO $ print event+            feed m event+        liftIO $ putStrLn "Stepping app"+        eventStream Running m+      Heartbeat sq -> do+        setSequence sq+        send $ Heartbeat sq+        eventStream Running m+      Reconnect      -> eventStream InvalidReconnect m+      InvalidSession -> eventStream Start m+      HeartbeatAck   -> eventStream Running m+      _              -> do+        liftIO $ errorM "Discord-hs.Gateway.Error" "InvalidPacket"+        liftIO $ putStrLn "DYING RIP ME"+        eventStream InvalidDead m+  eventStream InvalidReconnect m = eventStream InvalidDead m+  eventStream InvalidDead      _ = liftIO $ errorM "Discord-hs.Gateway.Error" "Bot died"++  step :: DiscordGate m => m Payload+  step = do+    conn <- connection+    liftIO $ putStrLn "Waiting for data"+    msg' <- liftIO $ receiveData conn+    liftIO $ putStrLn "Got data"+    case eitherDecode msg' of+      Right msg -> return msg+      Left  err -> +        ( liftIO+          $  errorM "Discord-hs.Gateway.Parse" err+          >> infoM "Discord-hs.Gateway.Raw" (show msg')+        ) >> (return $ ParseError err)+  +  gatewayUrl :: URL+  gatewayUrl = fromJust $ importURL "wss://gateway.discord.gg"