YesodPushApp.hs

{-# LANGUAGE OverloadedStrings, TypeFamilies, TemplateHaskell, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, QuasiQuotes #-}
-- | This Module defines the Yesod subsite to be used for the registration and reception of messages from devices.
module Network.PushNotify.General.YesodPushApp(
  PushManager(..)
  ) where

import Network.PushNotify.General.Types
import Network.PushNotify.General.YesodPushAppRoutes
import Yesod
import Control.Concurrent
import Data.Text
import Data.Aeson
import qualified Data.HashMap.Strict as HM

instance (RenderMessage master FormMessage, Yesod master) => YesodSubDispatch PushManager (HandlerT master IO) where
    yesodSubDispatch = $(mkYesodSubDispatch resourcesPushManager)

-- 'postRegister' allows a mobile device to register. (JSON POST messages to '/register')
postSubRegisterR :: (RenderMessage master FormMessage, Yesod master) => HandlerT PushManager (HandlerT master IO) ()
postSubRegisterR = do
    value  <- parseJsonBody_
    case value of
        Object v -> do
                      iden <- lookForIdentifier v
                      pushManager <- getYesod
                      res <- liftIO $ (newDeviceCallback $ serviceConfig pushManager) iden value
                      case res of
                        SuccessfulReg -> sendResponse $ RepJson emptyContent -- successful registration.
                        ErrorReg t    -> permissionDenied t                  -- error in registration.
        _        -> invalidArgs []

lookForIdentifier :: Object -> HandlerT PushManager (HandlerT master IO) Device
lookForIdentifier v = do
                    regId <- case (HM.lookup "regId" v) of
                                 Just (String s) -> return s
                                 _               -> invalidArgs []
                    case (HM.lookup "system" v) of
                      Just (String "ANDROID") -> return $ GCM  regId -- A Android device.
                      Just (String "WPHONE")  -> return $ MPNS regId -- A WPhone device.
                      Just (String "IOS")     -> return $ APNS regId -- A iOS device.
                      _                       -> invalidArgs []

-- 'postMessages' allows a mobile device to send a message. (JSON POST messages to '/messages')
postSubMessagesR :: (RenderMessage master FormMessage, Yesod master) => HandlerT PushManager (HandlerT master IO) ()
postSubMessagesR = do
    value  <- parseJsonBody_
    case value of
        Object v -> do
                      iden <- lookForIdentifier v
                      pushManager <- getYesod
                      liftIO $ forkIO $ (newMessageCallback $ serviceConfig pushManager) iden value
                      sendResponse $ RepJson emptyContent
        _        -> invalidArgs []