Join.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Join (
    APIKey(..)
  , DeviceId(..)
  , SMS(..)
  , sendSMS
  , sendPush
  ) where

import Data.Aeson
import Data.Text (Text)
import qualified Data.Text as T
import Data.String
import Network.URL
import Network.Wreq
import Data.ByteString.Lazy (ByteString)
import Control.Lens

-- | API Key for the account
newtype APIKey = APIKey {
  unAPIKey :: Text
} deriving (Eq, Ord, Show, IsString)

-- | Device ID to send the message to/through
newtype DeviceId = DeviceId {
  unDeviceId :: Text
} deriving (Eq, Ord, Show, IsString)

-- | SMS Message with phone number to send the
-- message to
data SMS = SMS {
  smsNumber :: Text
, smsText :: Text
} deriving (Eq, Ord, Show)

joinUrlType :: URLType
joinUrlType =
  Absolute $
    Host (HTTP True) "joinjoaomgcd.appspot.com" Nothing

joinPath :: String
joinPath = "_ah/api/messaging/v1/sendPush"

data JoinResponse = JoinResponse {
  joinSuccess :: Bool
, joinUserAuthError :: Bool
, joinKind :: Text
, joinETag :: Text
}

instance FromJSON JoinResponse where
  parseJSON (Object o) =
    JoinResponse
      <$> (o .: "success")
      <*> (o .: "userAuthError")
      <*> (o .: "kind")
      <*> (o .: "etag")

-- | Send an SMS from the given device.
-- If the device doesn't allow join to send SMS,
-- there will be an error in the response
sendSMS :: APIKey -> DeviceId -> SMS -> IO JoinResponse
sendSMS (APIKey key) (DeviceId i) (SMS number msg) = do
  resp <- asJSON =<< (get $ exportURL smsUrl)
  return $ resp ^. responseBody
  where
    smsUrl = URL joinUrlType joinPath params
    params = (fmap T.unpack) <$> [
        ("deviceId", i)
      , ("apikey", key)
      , ("smsnumber", number)
      , ("smstext", msg)
      ]

-- | Send a push notification to a given device
sendPush :: APIKey -> DeviceId -> Text -> IO JoinResponse
sendPush (APIKey key) (DeviceId i) msg = do
  resp <- asJSON =<< (get $ exportURL smsUrl)
  return $ resp ^. responseBody
  where
    smsUrl = URL joinUrlType joinPath params
    params = (fmap T.unpack) <$> [
        ("deviceId", i)
      , ("apikey", key)
      , ("text", msg)
      ]