<commit_before>-- GSoC 2013 - Communicating with mobile devices.

{-# LANGUAGE OverloadedStrings, TypeFamilies, TemplateHaskell,
             QuasiQuotes, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, GADTs #-}

-- | This Module define the main function to send Push Notifications through Cloud Connection Server (GCM).
module Send
    ( startCCS
    , closeCCS
    , sendCCS
    ) where

import Constants
import Types
import Network.PushNotify.Gcm.Types

import Data.XML.Types
import Control.Applicative
import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.Chan
import Control.Monad
import Data.Aeson
import Data.Aeson.Types
import Data.Aeson.Parser
import Data.Default
import Data.Functor
import Data.IORef
import Data.Int
import Data.Text
import Data.Text.Encoding
import Data.Monoid                          ((<>))
import qualified Data.Attoparsec.ByteString as AB
import qualified Control.Exception          as CE
import qualified Data.HashMap.Strict        as HM
import Network
import Network.Xmpp
import System.Log.Logger

-- 'connectCCS' starts a secure connection with CCS servers.
connectCCS :: GCMAppConfig -> IO Session
connectCCS config = do
    updateGlobalLogger "Pontarius.Xmpp" $ setLevel DEBUG
    result <- session
                (unpack cCCS_URL)
                (Just ( \_ -> [plain (senderID config <> "@" <> cCCS_URL) Nothing (apiKey config) ] , Nothing))
                def{ sessionStreamConfiguration = def{ 
                         connectionDetails = UseHost (unpack cCCS_URL) (PortNumber (fromIntegral cCCS_PORT))}
                   }
    case result of
        Right s -> return s
        Left e  -> error $ "XmppFailure: " ++ (show e)


-- | 'startCCS' starts the CCS service.
startCCS :: GCMAppConfig -> (RegId -> Value -> IO ()) -> IO CCSManager
startCCS config newMessageCallbackFunction = do
        c      <- newChan
        ref    <- newIORef $ Just ()
        tID    <- forkIO $ CE.catch (ccsWorker config c newMessageCallbackFunction) (\e -> let _ = (e :: CE.SomeException) 
                                                                  in atomicModifyIORef ref (\_ -> (Nothing,())))
        return $ CCSManager ref c tID 0


ccsWorker :: GCMAppConfig -> Chan (MVar GCMresult , GCMmessage) -> (RegId -> Value -> IO ()) -> IO ()
ccsWorker config requestChan callBackF = do
        sess   <- connectCCS config
        cont   <- newMVar 1000
        hmap   <- newMVar HM.empty
        lock   <- newEmptyMVar
        s      <- async (sender 1 cont lock hmap requestChan sess)<commit_msg>I continue with ccs api<commit_after>-- GSoC 2013 - Communicating with mobile devices.

{-# LANGUAGE OverloadedStrings, TypeFamilies, TemplateHaskell,
             QuasiQuotes, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, GADTs , ScopedTypeVariables #-}

-- | This Module define the main function to send Push Notifications through Cloud Connection Server (GCM).
module Send
    ( startCCS
    , closeCCS
    , sendCCS
    ) where

import Constants
import Types
import Network.PushNotify.Gcm.Types

import Control.Applicative
import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.Chan
import Control.Monad
import Data.Aeson
import Data.Aeson.Types
import Data.Aeson.Parser
import Data.Default
import Data.Functor
import Data.IORef
import Data.Int
import Data.Text
import Data.Text.Encoding
import Data.Monoid                          ((<>))
import Data.XML.Types
import qualified Data.Attoparsec.ByteString as AB
import qualified Control.Exception          as CE
import qualified Data.HashMap.Strict        as HM
import qualified Data.ByteString.Lazy       as BL
import qualified Data.ByteString            as BS
import Network
import Network.Xmpp
import Network.Xmpp.Internal
import Network.TLS
import Network.TLS.Extra
import Crypto.Random.API
import GHC.IO.Handle
import System.Log.Logger

-- 'connectCCS' starts a secure connection with CCS servers.
connectCCS :: GCMAppConfig -> IO Session
connectCCS config = do
    updateGlobalLogger "Pontarius.Xmpp" $ setLevel DEBUG
    let getStreamHandle = do
            hdl <- connectTo (unpack cCCS_URL) (PortNumber (fromIntegral cCCS_PORT))
            let bck = Backend { backendFlush = hFlush hdl
                              , backendClose = hClose hdl
                              , backendSend  = BS.hPut hdl
                              , backendRecv  = BS.hGet hdl
                              }
            gen <- getSystemRandomGen
            ctx <- contextNew
                       bck
                       (defaultParamsClient { pCiphers = ciphersuite_medium })
                       gen
            handshake ctx
            return StreamHandle { streamSend = \bs -> CE.catch
                                      (sendData ctx (BL.fromChunks [bs]) >>
                                           return True)
                                      (\(_e :: CE.SomeException) -> return False)
                                , streamReceive = \bs -> recvData ctx
                                , streamFlush = contextFlush ctx
                                , streamClose = bye ctx }
    result <- session
                (unpack cCCS_URL)
                (Just ( \_ -> [plain (senderID config <> "@" <> cCCS_URL) Nothing (apiKey config) ] , Nothing))
                def{ sessionStreamConfiguration = def{
                         connectionDetails = UseConnection getStreamHandle }
                   }
    case result of
        Right s -> return s
        Left e  -> fail $ "XmppFailure: " ++ (show e)

-- | 'startCCS' starts the CCS service.
startCCS :: GCMAppConfig -> (RegId -> Value -> IO ()) -> IO CCSManager
startCCS config newMessageCallbackFunction = do
        c      <- newChan
        ref    <- newIORef $ Just ()
        tID    <- forkIO $ CE.catch (ccsWorker config c newMessageCallbackFunction) (\e -> let _ = (e :: CE.SomeException) 
                                                                  in atomicModifyIORef ref (\_ -> (Nothing,())))
        return $ CCSManager ref c tID 0


ccsWorker :: GCMAppConfig -> Chan (MVar GCMresult , GCMmessage) -> (RegId -> Value -> IO ()) -> IO ()
ccsWorker config requestChan callBackF = do
        sess   <- connectCCS config
        cont   <- newMVar 1000
        hmap   <- newMVar HM.empty
        lock   <- newEmptyMVar
        s      <- async (sender 1 cont lock hmap requestChan sess)
{'fraction_non_alphanumeric': 0.08021059151440074, 'fraction_numerical': 0.003096934035305048, 'mean_word_length': 2.0510155880963628, 'pattern_counts': {'":': 0, '<': 30, '<?xml version=': 0, '>': 44, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 13, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3925911', 'n_tokens_mistral': 1826, 'n_tokens_neox': 1715, 'n_words': 537}