module Network.PushNotify.General.Types
(
Device(..)
, PushServiceConfig(..)
, RegisterResult(..)
, GCMConfig(..)
, PushConfig(..)
, PushManager(..)
, PushNotification(..)
, generalNotif
, PushResult(..)
, IsPushResult(..)
) where
import Network.PushNotify.Gcm
import Network.PushNotify.Apns
import Network.PushNotify.Mpns
import Network.PushNotify.Ccs
import Network.HTTP.Conduit
import Network.HTTP.Types.Status
import Control.Exception
import qualified Data.Map as M
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as E
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import Data.Aeson
import Data.Default
import Data.Hashable
import Data.List
import Data.Monoid
import Data.Text (Text,pack)
import Text.XML
data Device = GCM RegId
| APNS DeviceToken
| MPNS DeviceURI
deriving (Show, Read, Eq)
instance Hashable Device where
hashWithSalt s (GCM n) = s `hashWithSalt`
(0::Int) `hashWithSalt` n
hashWithSalt s (MPNS n) = s `hashWithSalt`
(1::Int) `hashWithSalt` n
hashWithSalt s (APNS n) = s `hashWithSalt`
(2::Int) `hashWithSalt` n
data PushNotification = PushNotification {
apnsNotif :: Maybe APNSmessage
, gcmNotif :: Maybe GCMmessage
, mpnsNotif :: Maybe MPNSmessage
} deriving Show
instance Default PushNotification where
def = PushNotification Nothing Nothing Nothing
generalNotif :: Object -> IO PushNotification
generalNotif dat = do
let msg = PushNotification {
apnsNotif = Just def{ rest = Just dat}
, gcmNotif = Just def{ data_object = Just dat}
, mpnsNotif = Just def{ restXML = Document (Prologue [] Nothing [])
(Element (Name "jsonData" Nothing Nothing)
M.empty
[NodeContent $ E.decodeUtf8 $
BS.concat . BL.toChunks $ encode dat])
[]
}
}
if ((BL.length . encode . apnsNotif) msg > 256)
then fail "Too long payload"
else return msg
data GCMConfig = Http GCMHttpConfig | Ccs GCMCcsConfig
data PushConfig = PushConfig{
gcmConfig :: Maybe GCMConfig
, apnsConfig :: Maybe APNSConfig
, mpnsConfig :: Maybe MPNSConfig
}
instance Default PushConfig where
def = PushConfig Nothing Nothing Nothing
data RegisterResult = SuccessfulReg | ErrorReg Text
data PushServiceConfig = PushServiceConfig {
pushConfig :: PushConfig
, newMessageCallback :: Device -> Value -> IO ()
, newDeviceCallback :: Device -> Value -> IO RegisterResult
, unRegisteredCallback :: Device -> IO ()
, newIdCallback :: (Device,Device) -> IO ()
}
instance Default PushServiceConfig where
def = PushServiceConfig {
pushConfig = def
, newMessageCallback = \_ _ -> return ()
, newDeviceCallback = \_ _ -> return SuccessfulReg
, unRegisteredCallback = \_ -> return ()
, newIdCallback = \_ -> return ()
}
data PushManager = PushManager {
httpManager :: Maybe Manager
, apnsManager :: Maybe APNSManager
, ccsManager :: Maybe CCSManager
, serviceConfig :: PushServiceConfig
}
data PushResult = PushResult {
successful :: HS.HashSet Device
, failed :: HM.HashMap Device (Either Text SomeException)
, toResend :: HS.HashSet Device
, unRegistered :: HS.HashSet Device
, newIds :: HM.HashMap Device Device
} deriving Show
instance Default PushResult where
def = PushResult HS.empty HM.empty HS.empty HS.empty HM.empty
instance Monoid PushResult where
mempty = def
mappend (PushResult a1 b1 c1 d1 e1)
(PushResult a2 b2 c2 d2 e2) = PushResult (HS.union a1 a2) (HM.union b1 b2)
(HS.union c1 c2) (HS.union d1 d2) (HM.union e1 e2)
class IsPushResult a where
toPushResult :: a -> PushResult
instance IsPushResult GCMresult where
toPushResult r = def {
successful = HS.map GCM $ HS.fromList $ HM.keys $ messagesIds r
, failed = HM.fromList $ map (\(x,y) -> (GCM x,Left y)) (HM.toList $ errorRest r)
<> map (\x -> (GCM x,Left "UnregisteredError")) (HS.toList $ errorUnRegistered r)
<> map (\x -> (GCM x,Left "InternalError")) (HS.toList $ errorToReSend r)
, toResend = HS.map GCM $ errorToReSend r
, unRegistered = HS.map GCM $ errorUnRegistered r <> (HS.fromList . HM.keys . errorRest) r
, newIds = HM.fromList $ map (\(x,y) -> (GCM x,GCM y)) $ HM.toList $ newRegids r
}
instance IsPushResult APNSresult where
toPushResult r = def {
successful = HS.map APNS $ successfulTokens r
, failed = HM.fromList $ map (\x -> (APNS x , Left "CommunicatingError")) $ HS.toList $ toReSendTokens r
, toResend = HS.map APNS $ toReSendTokens r
}
instance IsPushResult APNSFeedBackresult where
toPushResult r = def {
unRegistered = HS.fromList $ map APNS $ HM.keys $ unRegisteredTokens r
}
instance IsPushResult MPNSresult where
toPushResult r = let (successList,failureList) = partition ((== Just Received) . notificationStatus . snd ) $
HM.toList $ successfullResults r
in def {
successful = HS.fromList $ map (MPNS . fst) successList
, failed = (HM.fromList $ map (\(x,y) -> (MPNS x , Right y)) (HM.toList $ errorException r))
<> (HM.fromList $ map (\(x,y) -> (MPNS x , Left $ pack $ show $ notificationStatus y)) failureList)
, toResend = HS.map MPNS . HS.fromList . HM.keys . HM.filter error500 $ errorException r
, unRegistered = HS.map MPNS . HS.fromList . HM.keys . HM.filter ((== Just Expired) . subscriptionStatus) $ successfullResults r
} where
error500 :: SomeException -> Bool
error500 e = case (fromException e) :: Maybe HttpException of
Just (StatusCodeException status _ _) -> (statusCode status) >= 500
_ -> False