pushbullet-types (empty) → 0.1.0.0
raw patch · 16 files changed
+1079/−0 lines, 16 filesdep +aesondep +basedep +http-api-datasetup-changed
Dependencies added: aeson, base, http-api-data, microlens, microlens-th, scientific, text, time, unordered-containers
Files
- ChangeLog.md +17/−0
- LICENSE +20/−0
- Setup.hs +2/−0
- pushbullet-types.cabal +64/−0
- src/Network/Pushbullet/Internal/Reflection.hs +17/−0
- src/Network/Pushbullet/Types.hs +117/−0
- src/Network/Pushbullet/Types/Device.hs +167/−0
- src/Network/Pushbullet/Types/Ephemeral.hs +120/−0
- src/Network/Pushbullet/Types/Misc.hs +46/−0
- src/Network/Pushbullet/Types/Pagination.hs +29/−0
- src/Network/Pushbullet/Types/Permanent.hs +25/−0
- src/Network/Pushbullet/Types/Push.hs +239/−0
- src/Network/Pushbullet/Types/SMS.hs +119/−0
- src/Network/Pushbullet/Types/Status.hs +30/−0
- src/Network/Pushbullet/Types/Time.hs +26/−0
- src/Network/Pushbullet/Types/User.hs +41/−0
+ ChangeLog.md view
@@ -0,0 +1,17 @@+# Revision history for pushbullet-types++## 0.1.0.0 -- 2017-02-20++Define the following core types:++* `Push` -- messages used internally in Pushbullet.+* `Ephemeral` -- messages sent directly into the live event stream. These have+ a multitude of uses, e.g. sending SMS via a phone or seeing whether+ notifications have occurred on a device.+* `Device` -- representation of a device.+* `User` -- representation of a user.+* `Permanant` -- this is an undocumented type in the Pushbullet API. Notably,+ SMS threads and messages are permanents.++Some of these types come in two flavors: `New` and `Existing`. This is+signalled by a type index coming from a datakind.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2017 Jacob Errington++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ pushbullet-types.cabal view
@@ -0,0 +1,64 @@+-- Initial pushbullet-types.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: pushbullet-types+version: 0.1.0.0+synopsis: Datatypes used by the Pushbullet APIs+-- description: +license: MIT+license-file: LICENSE+author: Jacob Thomas Errington+maintainer: hackage@mail.jerrington.me+copyright: Jacob Thomas Errington 2017+category: Web+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/tsani/pushbullet-types++source-repository this+ type: git+ location: https://github.com/tsani/pushbullet-types/releases/tag/v0.1.0.0+ tag: v0.1.0.0++library+ default-language: Haskell2010+ hs-source-dirs: src+ default-extensions:+ DataKinds,+ DeriveFunctor,+ FlexibleInstances,+ GADTs,+ GeneralizedNewtypeDeriving,+ PolyKinds,+ RecordWildCards,+ StandaloneDeriving,+ TypeApplications,+ TypeFamilies+ exposed-modules:+ Network.Pushbullet.Types,+ Network.Pushbullet.Internal.Reflection+ other-modules:+ Network.Pushbullet.Types.Device,+ Network.Pushbullet.Types.Ephemeral,+ Network.Pushbullet.Types.Misc,+ Network.Pushbullet.Types.Pagination,+ Network.Pushbullet.Types.Permanent,+ Network.Pushbullet.Types.Push,+ Network.Pushbullet.Types.SMS,+ Network.Pushbullet.Types.Status,+ Network.Pushbullet.Types.Time,+ Network.Pushbullet.Types.User+ build-depends:+ aeson >=0.11 && <1.1,+ base >=4.9 && <4.10,+ http-api-data >=0.3 && <0.4,+ microlens >=0.4 && <0.5,+ microlens-th >=0.4 && <0.5,+ scientific >=0.3 && <0.4,+ text >=1.0 && <1.3,+ time >=1.6 && <1.7,+ unordered-containers >=0.2 && <0.3
+ src/Network/Pushbullet/Internal/Reflection.hs view
@@ -0,0 +1,17 @@+module Network.Pushbullet.Internal.Reflection+( Demote'+, Demote+, Reflected+, Reflect(..)+, KProxy(..)+) where++import Data.Proxy++type family Demote' (p :: KProxy k) :: k -> *++type Demote (a :: k) = Demote' ('KProxy :: KProxy k)+type Reflected a = Demote a a++class Reflect a where+ reflect :: proxy a -> Reflected a
+ src/Network/Pushbullet/Types.hs view
@@ -0,0 +1,117 @@+module Network.Pushbullet.Types+( -- * Pagination+ Paginated(..)+, Cursor+ -- * Pushes+, Push(..)+, PushData(..)+, PushTarget(..)+, simpleNewPush+, ExistingPushes(..)+ -- * Ephemerals+, Ephemeral(..)+, Notification(..)+ -- * Devices+, Device(..)+, DeviceId(..)+, Nickname(..)+, DeviceIcon(..)+, HasSms(..)+, ExistingDevices(..)+, newDevice+ -- * Users+, User(..)+, UserId(..)+ -- * Permanents+, Permanent(..)+, PermanentK(..)+ -- ** SMS+, SmsThreads(..)+, SmsThread(..)+, SmsThreadId(..)+, SmsThreadRecipient(..)+, SmsMessages(..)+, SmsMessage(..)+, SmsId(..)+, SmsDirection(..)+, SmsMessageType(..)+ -- * Misc+ --+ -- ** Data+, EmailAddress(..)+, ChannelTag(..)+, ClientId(..)+, MimeType(..)+, Url(..)+, Guid(..)+, TrivialObject(..)+, Status(..)+, PushbulletTime(..)+, PhoneNumber(..)+, Name(..)++ -- ** Type-level stuff+, EqT++ -- * Lenses+ -- ** Device+, deviceId+, deviceActive+, deviceCreated+, deviceModified+, deviceIcon+, deviceNickname+, deviceGeneratedNickname+, deviceManufacturer+, deviceModel+, deviceAppVersion+, deviceFingerprint+, deviceKeyFingerprint+, deviceHasSms+, devicePushToken+ -- ** User+, userCreated+, userEmail+, userEmailNormalized+, userId+, userImageUrl+, userMaxUploadSize+, userModified+, userName+ -- ** SMS+, smsDirection+, smsTime+, smsBody+, smsId+, smsSent+, smsType+, recipientName+, recipientAddress+, recipientNumber+, threadId+, threadRecipients+, threadLatest+ -- ** Ephemerals+, ephSmsSourceUser+, ephSmsTargetDevice+, ephSmsConversation+, ephSmsMessage+ -- ** Clipboard+, ephClipBody+, ephClipSourceUser+, ephClipSourceDevice+ -- ** Pagination+, pageData+, pageCursor+) where++import Network.Pushbullet.Types.Device+import Network.Pushbullet.Types.Ephemeral+import Network.Pushbullet.Types.Misc+import Network.Pushbullet.Types.Pagination+import Network.Pushbullet.Types.Permanent+import Network.Pushbullet.Types.Push+import Network.Pushbullet.Types.SMS+import Network.Pushbullet.Types.Status+import Network.Pushbullet.Types.Time+import Network.Pushbullet.Types.User
+ src/Network/Pushbullet/Types/Device.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Network.Pushbullet.Types.Device where++import Network.Pushbullet.Types.Status+import Network.Pushbullet.Types.Time++import Data.Aeson+import Data.Text ( Text )+import Lens.Micro.TH+import Web.HttpApiData ( ToHttpApiData(..) )++newtype DeviceId = DeviceId Text+ deriving (Eq, FromJSON, Show, ToJSON, ToHttpApiData)++newtype DeviceIcon = DeviceIcon Text+ deriving (Eq, ToJSON, Show, FromJSON)++newtype Nickname = Nickname Text+ deriving (Eq, ToJSON, Show, FromJSON)++newtype PushToken = PushToken Text+ deriving (Eq, ToJSON, Show, FromJSON)++newtype Manufacturer = Manufacturer Text+ deriving (Eq, ToJSON, Show, FromJSON)++newtype Fingerprint = Fingerprint Text+ deriving (Eq, ToJSON, Show, FromJSON)++newtype Model = Model Text+ deriving (Eq, ToJSON, Show, FromJSON)++newtype AppVersion = AppVersion Int+ deriving (Eq, ToJSON, Show, FromJSON)++newtype KeyFingerprint = KeyFingerprint Text+ deriving (Eq, ToJSON, Show, FromJSON)++-- | Whether the device has SMS capabilities.+data HasSms = NoSms | HasSms+ deriving (Eq, Ord, Show)++-- | A device attached to a Pushbullet account.+data Device (s :: Status)+ = Device+ { _deviceId :: !(EqT 'Existing s DeviceId)+ , _deviceActive :: !(EqT 'Existing s Bool)+ , _deviceCreated :: !(EqT 'Existing s PushbulletTime)+ , _deviceModified :: !(EqT 'Existing s PushbulletTime)+ , _deviceIcon :: !DeviceIcon+ , _deviceNickname :: !(Maybe Nickname)+ , _deviceGeneratedNickname :: !(EqT 'Existing s Bool)+ , _deviceManufacturer :: !(Maybe Manufacturer)+ , _deviceModel :: !(Maybe Model)+ , _deviceAppVersion :: !(Maybe AppVersion)+ , _deviceFingerprint :: !(EqT 'Existing s (Maybe Fingerprint))+ , _deviceKeyFingerprint :: !(EqT 'Existing s (Maybe KeyFingerprint))+ , _deviceHasSms :: !HasSms+ , _devicePushToken :: !(Maybe PushToken)+ }++makeLenses ''Device++-- | Smart constructor for a new device that fills in the ignored fields.+newDevice+ :: HasSms+ -> DeviceIcon+ -> Nickname+ -> Maybe Manufacturer+ -> Maybe Model+ -> Maybe AppVersion+ -> Device 'New+newDevice sms icon nick man m ver = Device+ { _deviceId = ()+ , _deviceActive = ()+ , _deviceCreated = ()+ , _deviceModified = ()+ , _deviceIcon = icon+ , _deviceNickname = Just nick+ , _deviceGeneratedNickname = ()+ , _deviceManufacturer = man+ , _deviceModel = m+ , _deviceAppVersion = ver+ , _deviceFingerprint = ()+ , _deviceKeyFingerprint = ()+ , _deviceHasSms = sms+ , _devicePushToken = Nothing+ }++-- | A newtype wrapper for a list of existing devices. We need this to get a+-- nonstandard 'FromJSON' instance for the list, because Pushbullet gives us+-- the list wrapped in a trivial object with one key.+newtype ExistingDevices+ = ExistingDevices+ { unExistingDevices :: [Device 'Existing]+ }+ deriving (Eq, Show)++instance ToJSON HasSms where+ toJSON NoSms = Bool False+ toJSON HasSms = Bool True++instance FromJSON HasSms where+ parseJSON (Bool True) = pure HasSms+ parseJSON (Bool False) = pure NoSms+ parseJSON _ = fail "cannot parse SMS ability from non-boolean"++deriving instance Eq (Device 'New)+deriving instance Eq (Device 'Existing)+deriving instance Show (Device 'New)+deriving instance Show (Device 'Existing)++instance ToJSON (Device 'Existing) where+ toJSON Device{..} = object+ [ "iden" .= _deviceId+ , "active" .= _deviceActive+ , "created" .= _deviceCreated+ , "modified" .= _deviceModified+ , "icon" .= _deviceIcon+ , "nickname" .= _deviceNickname+ , "generated_nickname" .= _deviceGeneratedNickname+ , "manufacturer" .= _deviceManufacturer+ , "model" .= _deviceModel+ , "app_version" .= _deviceAppVersion+ , "fingerprint" .= _deviceFingerprint+ , "key_fingerprint" .= _deviceKeyFingerprint+ , "has_sms" .= _deviceHasSms+ , "push_token" .= _devicePushToken+ ]++instance FromJSON (Device 'Existing) where+ parseJSON (Object o) = pure Device+ <*> o .: "iden"+ <*> o .: "active"+ <*> o .: "created"+ <*> o .: "modified"+ <*> o .: "icon"+ <*> o .:? "nickname"+ <*> o .:? "generated_nickname" .!= False+ <*> o .:? "manufacturer"+ <*> o .:? "model"+ <*> o .:? "app_version"+ <*> o .:? "fingerprint"+ <*> o .:? "key_fingerprint"+ <*> o .:? "has_sms" .!= NoSms+ <*> o .:? "push_token"+ parseJSON _ = fail "cannot parse existing device from non-object"++instance ToJSON (Device 'New) where+ toJSON Device{..} = object+ [ "nickname" .= _deviceNickname+ , "model" .= _deviceModel+ , "manufacturer" .= _deviceManufacturer+ , "push_token" .= _devicePushToken+ , "app_version" .= _deviceAppVersion+ , "icon" .= _deviceIcon+ , "has_sms" .= _deviceHasSms+ ]++instance FromJSON ExistingDevices where+ parseJSON (Object o) = ExistingDevices <$> o .: "devices"+ parseJSON _ = fail "cannot parse devices object from non-object"++instance ToJSON ExistingDevices where+ toJSON (ExistingDevices ds) = object [ "devices" .= ds ]
+ src/Network/Pushbullet/Types/Ephemeral.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++module Network.Pushbullet.Types.Ephemeral where++import Network.Pushbullet.Types.Device+import Network.Pushbullet.Types.Misc+import Network.Pushbullet.Types.SMS+import Network.Pushbullet.Types.Time+import Network.Pushbullet.Types.User++import Control.Monad ( guard )+import Data.Aeson+import Data.Monoid ( (<>) )+import Data.Text ( Text )+import Lens.Micro+import Lens.Micro.TH++data Notification+ = Notification+ { _notifThread :: !SmsThreadId+ , _notifTime :: !PushbulletTime+ , _notifTitle :: !Text+ , _notifBody :: !Text+ }+ deriving (Eq, Show)++makeLenses ''Notification++data Ephemeral+ = Sms+ { _ephSmsSourceUser :: !UserId+ , _ephSmsTargetDevice :: !DeviceId+ , _ephSmsConversation :: !PhoneNumber+ , _ephSmsMessage :: !Text+ }+ | Clipboard+ { _ephClipBody :: !Text+ , _ephClipSourceUser :: !UserId+ , _ephClipSourceDevice :: !DeviceId+ }+ | SmsChanged+ { _ephSourceDevice :: !DeviceId+ , _ephNotifications :: ![Notification]+ }+ deriving (Eq, Show)++makeLenses ''Ephemeral++instance ToJSON Ephemeral where+ toJSON o = case o of+ Sms{..} -> object+ [ "type" .= id @Text "push"+ , "push" .= object+ [ "type" .= id @Text "messaging_extension_reply"+ , "package_name" .= id @Text "com.pushbullet.android"+ , "source_user_iden" .= _ephSmsSourceUser+ , "target_device_iden" .= _ephSmsTargetDevice+ , "conversation_iden" .= _ephSmsConversation+ , "message" .= _ephSmsMessage+ ]+ ]+ Clipboard{..} -> object+ [ "type" .= id @Text "push"+ , "push" .= object+ [ "type" .= id @Text "clip"+ , "body" .= _ephClipBody+ , "source_user_iden" .= _ephClipSourceUser+ , "source_device_iden" .= _ephClipSourceDevice+ ]+ ]+ SmsChanged{..} -> object+ [ "type" .= id @Text "push"+ , "push" .= object+ [ "type" .= id @Text "sms_changed"+ , "source_device_iden" .= _ephSourceDevice+ , "notifications" .= _ephNotifications+ ]+ ]++instance FromJSON Ephemeral where+ parseJSON (Object o) = do+ t <- o .: "type"+ guard (t == id @Text "push")+ p <- o .: "push"+ case p of+ Object p' -> do+ t' <- p' .: "type"+ case t' of+ "messaging_extension_reply" -> pure Sms+ <*> p' .: "source_user_iden"+ <*> p' .: "target_device_iden"+ <*> p' .: "conversation_iden"+ <*> p' .: "message"+ "clip" -> pure Clipboard+ <*> p' .: "body"+ <*> p' .: "source_user_iden"+ <*> p' .: "source_device_iden"+ "sms_changed" -> pure SmsChanged+ <*> p' .: "source_device_iden"+ <*> p' .: "notifications"+ _ -> fail $ "unknown push type " <> t'+ _ -> fail "cannot parse push from non-object"++instance ToJSON Notification where+ toJSON n = object+ [ "thread_id" .= (n^.notifThread)+ , "timestamp" .= (n^.notifTime)+ , "title" .= (n^.notifTitle)+ , "body" .= (n^.notifBody)+ ]++instance FromJSON Notification where+ parseJSON (Object o) = pure Notification+ <*> o .: "thread_id"+ <*> o .: "timestamp"+ <*> o .: "title"+ <*> o .: "body"+ parseJSON _ = fail "cannot parse notification from non-object"
+ src/Network/Pushbullet/Types/Misc.hs view
@@ -0,0 +1,46 @@+module Network.Pushbullet.Types.Misc where++import Data.Aeson+import qualified Data.HashMap.Lazy as H+import Data.Text ( Text )++newtype EmailAddress = EmailAddress Text+ deriving (Eq, FromJSON, Show, ToJSON)++newtype ChannelTag = ChannelTag Text+ deriving (Eq, FromJSON, Show, ToJSON)++newtype ChannelId = ChannelId Text+ deriving (Eq, FromJSON, Show, ToJSON)++newtype ClientId = ClientId Text+ deriving (Eq, FromJSON, Show, ToJSON)++newtype MimeType = MimeType Text+ deriving (Eq, FromJSON, Show, ToJSON)++newtype Url = Url Text+ deriving (Eq, FromJSON, Show, ToJSON)++newtype Guid = Guid Text+ deriving (Eq, FromJSON, Show, ToJSON)++newtype PhoneNumber = PhoneNumber Text+ deriving (Eq, FromJSON, Show, ToJSON)++newtype TrivialObject = TrivialObject ()+ deriving (Eq, Ord, Monoid, Show)++newtype Name = Name+ { unName :: Text+ }+ deriving (Eq, FromJSON, Show, ToJSON)++instance ToJSON TrivialObject where+ toJSON _ = object []++instance FromJSON TrivialObject where+ parseJSON (Object o)+ | H.null o = pure mempty+ | otherwise = fail "trivial object has no keys"+ parseJSON _ = fail "cannot parse non-object to trivial object"
+ src/Network/Pushbullet/Types/Pagination.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Network.Pushbullet.Types.Pagination where++import Data.Aeson+import Data.Text ( Text )+import Lens.Micro.TH+import Web.HttpApiData ( ToHttpApiData(..) )++-- | Cursors are opaque.+newtype Cursor = Cursor Text+ deriving (Eq, FromJSON, Show, ToJSON, ToHttpApiData)++-- | A single page of data, possibly with a cursor attached to it.+-- The cursor may be used in routes that return paginated data to produce the+-- next page of data.+data Paginated a+ = Page+ { _pageData :: !a+ , _pageCursor :: !(Maybe Cursor)+ }+ deriving (Eq, Functor, Show)++makeLenses ''Paginated++instance FromJSON a => FromJSON (Paginated a) where+ parseJSON j@(Object o) = Page <$> parseJSON j <*> o .:? "cursor"+ parseJSON _ = fail "cannot parse paginated data from non-object"
+ src/Network/Pushbullet/Types/Permanent.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Pushbullet.Types.Permanent where++import Network.Pushbullet.Types.Device+import Network.Pushbullet.Types.SMS++import Data.Monoid ( (<>) )+import Web.HttpApiData ( ToHttpApiData(..) )++data PermanentK+ = ThreadList+ | MessageList++data Permanent (p :: PermanentK) where+ ThreadsOf :: !DeviceId -> Permanent 'ThreadList+ MessagesIn :: !DeviceId -> !SmsThreadId -> Permanent 'MessageList++instance ToHttpApiData (Permanent 'ThreadList) where+ toUrlPiece p = case p of+ ThreadsOf (DeviceId d) -> d <> "_threads"++instance ToHttpApiData (Permanent 'MessageList) where+ toUrlPiece p = case p of+ MessagesIn (DeviceId d) (SmsThreadId t) -> d <> "_thread_" <> t
+ src/Network/Pushbullet/Types/Push.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Pushbullet.Types.Push+( Push(..)+, PushId(..)+, PushDirection(..)+, PushTarget(..)+, PushData(..)+, PushOrigin(..)+, ExistingPushes(..)+, simpleNewPush+) where++import Network.Pushbullet.Types.Device+import Network.Pushbullet.Types.Misc+import Network.Pushbullet.Types.Status+import Network.Pushbullet.Types.Time+import Network.Pushbullet.Types.User++import Control.Applicative ( (<|>) )+import Data.Aeson+import Data.Text ( Text )++-- | A push. We reuse the same datatype for representing new pushes and+-- existing pushes. The 'EqT' type family is used to enable fields selectively+-- according to whether we're making a new push or representing an existing+-- one.+data Push (s :: Status)+ = Push+ { pushData :: !(PushData s)+ , pushSourceDevice :: !(Maybe DeviceId)+ , pushTarget :: !(PushTarget s)+ , pushGuid :: !(Maybe Guid)+ , pushId :: !(EqT 'Existing s PushId)+ , pushActive :: !(EqT 'Existing s Bool)+ , pushCreated :: !(EqT 'Existing s PushbulletTime)+ , pushModified :: !(EqT 'Existing s PushbulletTime)+ , pushDismissed :: !(EqT 'Existing s Bool)+ , pushDirection :: !(EqT 'Existing s PushDirection)+ , pushSender :: !(EqT 'Existing s UserId)+ , pushSenderEmail :: !(EqT 'Existing s EmailAddress)+ , pushSenderEmailNormalized :: !(EqT 'Existing s EmailAddress)+ , pushSenderName :: !(EqT 'Existing s Name)+ , pushReceiver :: !(EqT 'Existing s UserId)+ , pushReceiverEmail :: !(EqT 'Existing s EmailAddress)+ , pushReceiverEmailNormalized :: !(EqT 'Existing s EmailAddress)+ , pushOrigin :: !(EqT 'Existing s (Maybe PushOrigin))+ }++-- | Unique identifier for a push.+newtype PushId = PushId Text+ deriving (Eq, FromJSON, Show, ToJSON)++-- | The direction of a push.+data PushDirection+ = SelfPush+ | OutgoingPush+ | IncomingPush+ deriving (Eq, Ord, Show)++-- | The target of a push.+data PushTarget (s :: Status) where+ ToAll :: PushTarget 'New+ ToDevice :: !DeviceId -> PushTarget 'New+ ToEmail :: !EmailAddress -> PushTarget 'New+ ToChannel :: !ChannelTag -> PushTarget 'New+ ToClient :: !ClientId -> PushTarget 'New+ SentBroadcast :: PushTarget 'Existing+ SentToDevice :: !DeviceId -> PushTarget 'Existing++-- | The actual contents of a push.+data PushData (s :: Status)+ = NotePush+ { pushTitle :: !Text+ , pushBody :: !Text+ }+ | LinkPush+ { pushTitle :: !Text+ , pushBody :: !Text+ , pushUrl :: !Url+ }+ | FilePush+ { pushBody :: !Text+ , pushFileName :: !Text+ , pushFileType :: !MimeType+ , pushFileUrl :: !Url+ , pushFileTitle :: !(EqT 'Existing s Text)+ , pushImageUrl :: !(EqT 'Existing s (Maybe Url))+ , pushImageWidth :: !(EqT 'Existing s (Maybe Int))+ , pushImageHeight :: !(EqT 'Existing s (Maybe Int))+ }++-- | The origin of a push.+data PushOrigin+ = FromClient !ClientId+ | FromChannel !ChannelId+ deriving (Eq, Show)++-- | A newtype wrapper for a list of existing pushes. We need this to get a+-- nonstandard 'FromJSON' instance for the list, because Pushbullet gives us+-- the list wrapped in a trivial object with one key.+newtype ExistingPushes = ExistingPushes [Push 'Existing]+ deriving (Eq, Show)++-- | Constructs a new @Push@ with the source device and guid set to @Nothing@.+simpleNewPush :: PushTarget 'New -> PushData 'New -> Push 'New+simpleNewPush t d = Push+ { pushData = d+ , pushSourceDevice = Nothing+ , pushTarget = t+ , pushGuid = Nothing+ , pushId = ()+ , pushActive = ()+ , pushCreated = ()+ , pushModified = ()+ , pushDismissed = ()+ , pushDirection = ()+ , pushSender = ()+ , pushSenderEmail = ()+ , pushSenderEmailNormalized = ()+ , pushSenderName = ()+ , pushReceiver = ()+ , pushReceiverEmail = ()+ , pushReceiverEmailNormalized = ()+ , pushOrigin = ()+ }++instance ToJSON PushDirection where+ toJSON SelfPush = String "self"+ toJSON OutgoingPush = String "outgoing"+ toJSON IncomingPush = String "incoming"++instance FromJSON PushDirection where+ parseJSON (String s) = case s of+ "self" -> pure SelfPush+ "outgoing" -> pure OutgoingPush+ "incoming" -> pure IncomingPush+ _ -> fail "invalid direction string"+ parseJSON _ = fail "cannot parse push direction from non-string"++deriving instance Eq (PushTarget s)+deriving instance Show (PushTarget s)++deriving instance Eq (PushData 'New)+deriving instance Eq (PushData 'Existing)+deriving instance Show (PushData 'New)+deriving instance Show (PushData 'Existing)++deriving instance Eq (Push 'New)+deriving instance Eq (Push 'Existing)+deriving instance Show (Push 'New)+deriving instance Show (Push 'Existing)++instance FromJSON (Push 'Existing) where+ parseJSON (Object o) = do+ pushType <- o .: "type"+ d <- case id @Text pushType of+ "note" -> pure NotePush+ <*> o .: "title"+ <*> o .: "body"+ "file" -> pure FilePush+ <*> o .: "body"+ <*> o .: "file_name"+ <*> o .: "file_type"+ <*> o .: "file_url"+ <*> o .: "file_title"+ <*> o .:? "image_url"+ <*> o .:? "image_width"+ <*> o .:? "image_height"+ "link" -> pure LinkPush+ <*> o .: "title"+ <*> o .: "body"+ <*> o .: "url"+ _ -> fail "unrecognized push type"+ client <- o .:? "client_iden"+ channel <- o .:? "channel_iden"+ let origin = (FromClient <$> client) <|> (FromChannel <$> channel)++ pure Push+ <*> pure d+ <*> o .:? "source_device_iden"+ <*> (maybe SentBroadcast SentToDevice <$> o .:? "target_device_iden")+ <*> o .:? "guid"+ <*> o .: "iden"+ <*> o .: "active"+ <*> o .: "created"+ <*> o .: "modified"+ <*> o .: "dismissed"+ <*> o .: "direction"+ <*> o .: "sender_iden"+ <*> o .: "sender_email"+ <*> o .: "sender_email_normalized"+ <*> o .: "sender_name"+ <*> o .: "receiver_iden"+ <*> o .: "receiver_email"+ <*> o .: "receiver_email_normalized"+ <*> pure origin+ parseJSON _ = fail "cannot parse push from non-object"++instance FromJSON ExistingPushes where+ parseJSON (Object o) = ExistingPushes <$> o .: "pushes"+ parseJSON _ = fail "cannot parse existing pushes from non-object"++instance ToJSON (Push 'New) where+ toJSON Push{..} = object (concat pieces) where+ pieces =+ [ [ "source_device_iden" .= pushSourceDevice+ , "guid" .= pushGuid+ ]+ , target+ , thePushData+ ]++ target = case pushTarget of+ ToAll -> []+ ToDevice d -> [ "device_iden" .= d ]+ ToEmail email -> [ "email" .= email ]+ ToChannel tag -> [ "channel_tag" .= tag ]+ ToClient client -> [ "client_iden" .= client ]++ thePushData = case pushData of+ NotePush{..} ->+ [ "type" .= id @Text "note"+ , "title" .= pushTitle+ , "body" .= pushBody+ ]+ LinkPush{..} ->+ [ "type" .= id @Text "link"+ , "title" .= pushTitle+ , "body" .= pushBody+ , "url" .= pushUrl+ ]+ FilePush{..} ->+ [ "type" .= id @Text "file"+ , "body" .= pushBody+ , "file_name" .= pushFileName+ , "file_type" .= pushFileType+ , "file_url" .= pushFileUrl+ ]
+ src/Network/Pushbullet/Types/SMS.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Network.Pushbullet.Types.SMS where++import Data.Aeson+import Data.Text ( Text )+import Data.List.NonEmpty ( NonEmpty )+import Lens.Micro.TH++import Network.Pushbullet.Types.Misc+import Network.Pushbullet.Types.Time++data SmsDirection+ = IncomingSms+ | OutgoingSms+ deriving (Eq, Show)++newtype SmsId = SmsId Text+ deriving (Eq, FromJSON, Show, ToJSON)++data SmsMessageType+ = SMS+ | MMS+ deriving (Eq, Show)++data SmsMessage+ = SmsMessage+ { _smsDirection :: !SmsDirection+ , _smsTime :: !PushbulletTime+ , _smsBody :: !Text+ , _smsId :: !SmsId+ , _smsSent :: !(Maybe Bool)+ , _smsType :: !SmsMessageType+ }+ deriving (Eq, Show)++makeLenses ''SmsMessage++newtype SmsMessages+ = SmsMessages+ { unSmsMessages :: [SmsMessage]+ }+ deriving (Eq, Show)++data SmsThreadRecipient+ = SmsThreadRecipient+ { _recipientName :: !Name+ , _recipientAddress :: !PhoneNumber+ , _recipientNumber :: !PhoneNumber+ }+ deriving (Eq, Show)++makeLenses ''SmsThreadRecipient++newtype SmsThreadId = SmsThreadId Text+ deriving (Eq, FromJSON, Show, ToJSON)++data SmsThread+ = SmsThread+ { _threadId :: SmsThreadId+ , _threadRecipients :: NonEmpty SmsThreadRecipient+ , _threadLatest :: SmsMessage+ }+ deriving (Eq, Show)++makeLenses ''SmsThread++newtype SmsThreads+ = SmsThreads+ { unSmsThreads :: [SmsThread]+ }+ deriving (Eq, Show)++instance FromJSON SmsDirection where+ parseJSON (String s) = case s of+ "incoming" -> pure IncomingSms+ "outgoing" -> pure OutgoingSms+ _ -> fail "invalid SMS direction string"+ parseJSON _ = fail "cannot parse SMS direction from non-string"++instance FromJSON SmsMessageType where+ parseJSON (String s)+ | "sms" <- s = pure SMS+ | "mms" <- s = pure MMS+ | otherwise = fail "invalid SMS type"+ parseJSON _ = fail "cannot parse SMS type from non-string"++instance FromJSON SmsMessage where+ parseJSON (Object o) = pure SmsMessage+ <*> o .: "direction"+ <*> o .: "timestamp"+ <*> o .: "body"+ <*> o .: "id"+ <*> o .:? "sent"+ <*> o .: "type"+ parseJSON _ = fail "cannot parse sms message from non-object"++instance FromJSON SmsMessages where+ parseJSON (Object o) = SmsMessages <$> o .: "thread"+ parseJSON _ = fail "cannot parse sms messages from non-object"++instance FromJSON SmsThreads where+ parseJSON (Object o) = SmsThreads <$> o .: "threads"+ parseJSON _ = fail "cannot parse sms threads from non-object"++instance FromJSON SmsThreadRecipient where+ parseJSON (Object o) = pure SmsThreadRecipient+ <*> o .: "name"+ <*> o .: "address"+ <*> o .: "number"+ parseJSON _ = fail "cannot parse sms thread recipient from non-object"++instance FromJSON SmsThread where+ parseJSON (Object o) = pure SmsThread+ <*> o .: "id"+ <*> o .: "recipients"+ <*> o .: "latest"+ parseJSON _ = fail "cannot parse sms thread from non-object"
+ src/Network/Pushbullet/Types/Status.hs view
@@ -0,0 +1,30 @@+module Network.Pushbullet.Types.Status+( Status(..)+, EqT+) where++import Network.Pushbullet.Internal.Reflection++data Status+ = New+ | Existing++data Status' :: Status -> * where+ New' :: Status' 'New+ Existing' :: Status' 'Existing++type instance Demote' ('KProxy :: KProxy Status) = Status'++instance Reflect 'New where+ reflect _ = New'++instance Reflect 'Existing where+ reflect _ = Existing'++-- | If the first two types are the same, return the third; else, return unit.+--+-- This type family is used to disable certain fields according to the 'Status'+-- datakind.+type family EqT (s :: k) (s' :: k) (a :: *) :: * where+ EqT s s a = a+ EqT _ _ _ = ()
+ src/Network/Pushbullet/Types/Time.hs view
@@ -0,0 +1,26 @@+module Network.Pushbullet.Types.Time where++import Data.Aeson+import Data.String ( fromString )+import Data.Scientific ( toRealFloat )+import Data.Time.Clock ( NominalDiffTime, UTCTime )+import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds, posixSecondsToUTCTime )+import Web.HttpApiData ( ToHttpApiData(..) )++newtype PushbulletTime = PushbulletTime UTCTime+ deriving (Eq, Ord, Show)++instance ToHttpApiData PushbulletTime where+ toUrlPiece (PushbulletTime utc) = fromString (show d) where+ d = fromRational r :: Double+ r = toRational $ utcTimeToPOSIXSeconds utc++instance FromJSON PushbulletTime where+ parseJSON (Number n) = pure (PushbulletTime (posixSecondsToUTCTime p)) where+ p = fromRational (toRational d) :: NominalDiffTime+ d = toRealFloat n :: Double+ parseJSON _ = fail "cannot parse pushbullet time from non-number"++instance ToJSON PushbulletTime where+ toJSON (PushbulletTime utcTime)+ = Number $ fromRational (toRational $ utcTimeToPOSIXSeconds utcTime)
+ src/Network/Pushbullet/Types/User.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Network.Pushbullet.Types.User where++import Network.Pushbullet.Types.Misc+import Network.Pushbullet.Types.Time++import Data.Aeson+import Data.Text ( Text )+import Lens.Micro.TH++newtype UserId = UserId Text+ deriving (Eq, FromJSON, Show, ToJSON)++data User+ = User+ { _userCreated :: PushbulletTime+ , _userEmail :: EmailAddress+ , _userEmailNormalized :: EmailAddress+ , _userId :: UserId+ , _userImageUrl :: Url+ , _userMaxUploadSize :: Double+ , _userModified :: PushbulletTime+ , _userName :: Name+ }+ deriving (Eq, Show)++makeLenses ''User++instance FromJSON User where+ parseJSON (Object o) = pure User+ <*> o .: "created"+ <*> o .: "email"+ <*> o .: "email_normalized"+ <*> o .: "iden"+ <*> o .: "image_url"+ <*> o .: "max_upload_size"+ <*> o .: "modified"+ <*> o .: "name"+ parseJSON _ = fail "cannot parse user from non-object"