{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} module Main (main) where import Control.Concurrent (threadDelay) import Control.Concurrent.MVar (MVar, newMVar) import Control.Exception (AsyncException (UserInterrupt), catch, throwIO) import Control.Monad (forever) import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BS import Data.String (fromString) import Data.Word (Word32) import Foreign.Storable (Storable (..)) import System.Directory (doesFileExist) import System.Exit (exitSuccess) import qualified Network.Tox.C as C bootstrapKey :: BS.ByteString bootstrapKey = fst . Base16.decode . fromString $ "15E9C309CFCB79FDDF0EBA057DABB49FE15F3803B1BFF06536AE2E5BA5E4690E" isMasterKey :: BS.ByteString -> Bool isMasterKey key = (key ==) . fst . Base16.decode . fromString $ "040F75B5C8995F9525F9A8692A6C355286BBD3CF248C984560733421274F0365" botName :: String botName = "groupbot" bootstrapHost :: String bootstrapHost = "tox.ngc.zone" savedataFilename :: String savedataFilename = "groupbot.tox" options :: BS.ByteString -> C.Options options savedata = C.Options { C.ipv6Enabled = True , C.udpEnabled = True , C.proxyType = C.ProxyTypeNone , C.proxyHost = "" , C.proxyPort = 0 , C.startPort = 33445 , C.endPort = 33545 , C.tcpPort = 3128 , C.savedataType = if savedata == BS.empty then C.SavedataTypeNone else C.SavedataTypeToxSave , C.savedataData = savedata } getRight :: (Monad m, Show a) => Either a b -> m b getRight (Left l) = fail $ show l getRight (Right r) = return r must :: Show a => IO (Either a b) -> IO b must = (getRight =<<) newtype UserData = UserData Word32 deriving (Eq, Storable, Read, Show) instance C.CHandler UserData where cSelfConnectionStatus _ conn ud = do putStrLn "SelfConnectionStatusCb" print conn return ud cFriendRequest tox pk msg ud = do putStrLn "FriendRequestCb" Right fn <- C.toxFriendAddNorequest tox pk putStrLn $ (BS.unpack . Base16.encode) pk putStrLn msg print fn return ud cFriendConnectionStatus tox fn status ud@(UserData gn) = do putStrLn "FriendConnectionStatusCb" print fn print status if status /= C.ConnectionNone then do putStrLn "Inviting!" _ <- C.toxConferenceInvite tox fn gn return () else putStrLn "Friend offline" return ud cFriendMessage tox fn msgType msg ud = do putStrLn "FriendMessage" print fn print msgType putStrLn msg _ <- C.toxFriendSendMessage tox fn msgType msg return ud cConferenceInvite tox fn _confType cookie ud = do putStrLn "ConferenceInvite" print fn pk <- getRight =<< C.toxFriendGetPublicKey tox fn if isMasterKey pk then do putStrLn "Joining!" gn <- getRight =<< C.toxConferenceJoin tox fn cookie return $ UserData gn else do putStrLn "Not master!" return ud loop :: MVar ud -> C.Tox ud -> IO a loop ud tox = forever $ do C.toxIterate tox ud interval <- C.tox_iteration_interval tox threadDelay $ fromIntegral $ interval * 10000 main :: IO () main = do exists <- doesFileExist savedataFilename loadedSavedata <- if exists then BS.readFile savedataFilename else return BS.empty must $ C.withOptions (options loadedSavedata) $ \optPtr -> must $ C.withTox optPtr $ \tox -> do must $ C.toxBootstrap tox bootstrapHost 33445 bootstrapKey C.withCHandler tox $ do adr <- C.toxSelfGetAddress tox putStrLn $ (BS.unpack . Base16.encode) adr _ <- C.toxSelfSetName tox botName gn <- getRight =<< C.toxConferenceNew tox ud <- newMVar (UserData gn) catch (loop ud tox) $ \case e@UserInterrupt -> throwIO e _ -> do savedSavedata <- C.toxGetSavedata tox BS.writeFile savedataFilename savedSavedata exitSuccess