packages feed

servant-pushbullet-client (empty) → 0.0.1.0

raw patch · 18 files changed

+1031/−0 lines, 18 filesdep +aesondep +basedep +http-api-datasetup-changed

Dependencies added: aeson, base, http-api-data, http-client, http-client-tls, scientific, servant, servant-client, text, time, unordered-containers

Files

+ ChangeLog.md view
@@ -0,0 +1,8 @@+# Revision history for servant-pushbullet-client++## 0.0.1.0  -- 2017-02-07++Prerelease version that contains a (small) subset of the Pushbullet API. We+aren't sure yet if all our choices are good, e.g. the use of the `EqT` type+family in conjunction with the `Status` datakind for turning fields on and off+inside datatypes.
+ 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
+ servant-pushbullet-client.cabal view
@@ -0,0 +1,64 @@+-- Initial servant-pushbullet-client.cabal generated by cabal init.  For +-- further documentation, see http://haskell.org/cabal/users-guide/++name:                servant-pushbullet-client+version:             0.0.1.0+synopsis:            Bindings to the Pushbullet API using servant-client+description:+  This library describes the Pushbullet API as a type, and uses servant-client+  to generate Haskell functions for accessing the API. A number of useful types+  are added so that dealing with raw JSON is avoided.+license:             MIT+license-file:        LICENSE+author:              Jacob Errington+maintainer:          git@mail.jerrington.me+copyright:           Jacob Thomas Errington, 2017+category:            Web+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10++library+  exposed-modules:+    Network.Pushbullet.Api,+    Network.Pushbullet.Client,+    Network.Pushbullet.Misc,+    Network.Pushbullet.Types+  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+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:+    -Wall+  default-extensions:+    DataKinds+    DeriveFunctor+    FlexibleInstances+    GADTs+    GeneralizedNewtypeDeriving+    PolyKinds+    RecordWildCards+    StandaloneDeriving+    TypeFamilies+    TypeApplications+  build-depends:+    aeson >=0.11 && <1.1,+    base >=4.9 && <4.10,+    http-api-data >=0.3 && <0.4,+    http-client-tls >=0.3 && <0.4,+    http-client,+    scientific >=0.3 && <0.4,+    servant >=0.9 && <0.10,+    servant-client >=0.9 && <0.10,+    time >=1.6 && <1.7,+    text >=1.2 && <1.3,+    unordered-containers >=0.2 && <0.3
+ src/Network/Pushbullet/Api.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Network.Pushbullet.Api where++import Network.Pushbullet.Types++import Data.Aeson ( Object )+import Data.Proxy+import Data.Text ( Text )+import GHC.TypeLits ( Symbol )+import Servant.API+import Servant.API.Experimental.Auth++data PushbulletAuth++newtype PushbulletKey = PushbulletKey Text+  deriving ToHttpApiData++type PushbulletApi+  = "v2" :> PushbulletApiV2++type PushbulletApiV2+  = PushAuth (AuthProtect PushbulletAuth) (+    "pushes" :> (+        ReqBody '[JSON] (Push 'New) :> Post '[JSON] (Push 'Existing)+      :<|>+        QueryParam "modified_after" PushbulletTime+        :> QueryParam "active" Bool+        :> QueryParam "cursor" Cursor+        :> QueryParam "limit" Int+        :> Get '[JSON] (Paginated ExistingPushes)+    )+  :<|>+    "ephemerals"+      :> ReqBody '[JSON] Ephemeral :> Post '[JSON] TrivialObject+  :<|>+    "users"+      :> "me"+        :> Get '[JSON] User+  :<|> "devices" :> (+      QueryParam "active" Bool+      :> QueryParam "cursor" Cursor+      :> Get '[JSON] (Paginated ExistingDevices)+    :<|>+      ReqBody '[JSON] (Device 'New)+      :> Post '[JSON] (Device 'Existing)+    :<|>+      Capture "deviceId" DeviceId+      :> Delete '[JSON] TrivialObject+    )+  :<|>+    "permanents" :> (+        Capture "permanent" (Permanent 'ThreadListK)+          :> Get '[JSON] SmsThreads+      :<|>+        Capture "permanent" (Permanent 'MessageListK)+          :> Get '[JSON] SmsMessages+    )+  )++pushbulletApi :: Proxy PushbulletApi+pushbulletApi = Proxy++type family PushAuth (auth :: *) (api :: *) :: * where+  PushAuth auth ((s :: Symbol) :> api) = s :> PushAuth auth api+  PushAuth auth (l :<|> r) = PushAuth auth l :<|> PushAuth auth r+  PushAuth auth a = auth :> a
+ src/Network/Pushbullet/Client.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Network.Pushbullet.Client where++import Network.Pushbullet.Api+import Network.Pushbullet.Types++import Servant.Client+import Servant.Common.Req ( addHeader )+import Servant.API hiding ( addHeader )++type instance AuthClientData (AuthProtect PushbulletAuth) = PushbulletKey++pushbulletApiClient :: Client PushbulletApi+pushbulletApiClient = client pushbulletApi++(createPush :<|> getPushes)+  :<|> createEphemeral+  :<|> getMe+  :<|> (getDevices :<|> createDevice :<|> deleteDevice)+  :<|> (getSmsThreads :<|> getSmsMessages)+    = pushbulletApiClient++pushbulletAuth :: PushbulletKey -> AuthenticateReq (AuthProtect PushbulletAuth)+pushbulletAuth key = mkAuthenticateReq key f where+  f = addHeader "Access-Token"
+ src/Network/Pushbullet/Misc.hs view
@@ -0,0 +1,42 @@+{-|+ - Miscellaneous functions and types for dealing with pushbullet data.+ -}++module Network.Pushbullet.Misc where++import Network.Pushbullet.Types ( Cursor(..), Paginated(..) )++-- | A count of items to retrieve from the API.+data Count+  = All+  | Limit Int++-- | Retrieves paginated data as a list.+--+-- Suppose 550 items from a resource with 1100 entries and Pushbullet emits+-- pages of 100 items each. This function takes care of repeatedly calling the+-- API and keeping track of the cursors emitted from subsequent calls until+-- those 550 items have been collected.+getPaginatedLimit+  :: Monad m+  => Count -- ^ The count of items you wish to retrieve from the API.+  -> Paginated [a] -- ^ The first page of data to kick off the process.+  -> (Cursor -> m (Paginated [a]))+    -- ^ How to retrieve the next page given a cursor.+  -> m [a]+getPaginatedLimit All (Page d Nothing) _+  = pure d+getPaginatedLimit All (Page d (Just c)) next = do+  p <- next c+  later <- getPaginatedLimit All p next+  pure (d ++ later)+getPaginatedLimit (Limit n) _ _ | n <= 0+  = pure []+getPaginatedLimit (Limit n) (Page d Nothing) _+  = pure (take n d)+getPaginatedLimit (Limit n) (Page d (Just c)) next = do+  let d' = take n d+  let n' = n - length d'+  p <- next c+  later <- getPaginatedLimit (Limit n') p next+  pure (d' ++ later)
+ src/Network/Pushbullet/Types.hs view
@@ -0,0 +1,65 @@+module Network.Pushbullet.Types+( -- * Pagination+  Paginated(..)+, Cursor+  -- * Pushes+, Push(..)+, PushData(..)+, PushTarget(..)+, simpleNewPush+, ExistingPushes(..)+  -- * Ephemerals+, Ephemeral(..)+  -- * 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+) 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,163 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Pushbullet.Types.Device where++import Network.Pushbullet.Types.Status+import Network.Pushbullet.Types.Time++import Data.Aeson+import Data.Text ( Text )+import Web.HttpApiData ( ToHttpApiData(..) )++-- | 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)+    }++-- | 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)++-- | Whether the device has SMS capabilities.+data HasSms = NoSms | HasSms+  deriving (Eq, Ord, Show)++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)++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,48 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Pushbullet.Types.Ephemeral where++import Network.Pushbullet.Types.Device+import Network.Pushbullet.Types.Misc+import Network.Pushbullet.Types.User++import Data.Aeson+import Data.Text ( Text )++data Ephemeral+  = Sms+    { ephSmsSourceUser :: !UserId+    , ephSmsTargetDevice :: !DeviceId+    , ephSmsConversation :: !PhoneNumber+    , ephSmsMessage :: !Text+    }+  | Clipboard+    { ephClipBody :: !Text+    , ephClipSourceUser :: !UserId+    , ephClipSourceDevice :: !DeviceId+    }+  deriving (Eq, Show)++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+        ]+      ]+
+ 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,21 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Pushbullet.Types.Pagination where++import Data.Aeson+import Data.Text ( Text )+import Web.HttpApiData ( 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 !a !(Maybe Cursor)+  deriving (Eq, Functor, Show)++-- | Cursors are opaque.+newtype Cursor = Cursor Text+  deriving (Eq, FromJSON, Show, ToJSON, ToHttpApiData)++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+  = ThreadListK+  | MessageListK++data Permanent (p :: PermanentK) where+  ThreadsOf :: !DeviceId -> Permanent 'ThreadListK+  MessagesIn :: !DeviceId -> !SmsThreadId -> Permanent 'MessageListK++instance ToHttpApiData (Permanent 'ThreadListK) where+  toUrlPiece p = case p of+    ThreadsOf (DeviceId d) -> d <> "_threads"++instance ToHttpApiData (Permanent 'MessageListK) 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 deviceId -> [ "device_iden" .= deviceId ]+      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,111 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Pushbullet.Types.SMS where++import Data.Aeson+import Data.Text ( Text )+import Data.List.NonEmpty ( NonEmpty )++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)++newtype SmsMessages+  = SmsMessages+    { unSmsMessages :: [SmsMessage]+    }+  deriving (Eq, Show)++newtype SmsThreads+  = SmsThreads+    { unSmsThreads :: [SmsThread]+    }+  deriving (Eq, Show)++data SmsThreadRecipient+  = SmsThreadRecipient+    { recipientName :: !Name+    , recipientAddress :: !PhoneNumber+    , recipientNumber :: !PhoneNumber+    }+  deriving (Eq, Show)++newtype SmsThreadId = SmsThreadId Text+  deriving (Eq, FromJSON, Show, ToJSON)++data SmsThread+  = SmsThread+    { threadId :: SmsThreadId+    , threadRecipients :: NonEmpty SmsThreadRecipient+    , threadLatest :: SmsMessage+    }+  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,16 @@+module Network.Pushbullet.Types.Status+( Status(..)+, EqT+) where++data Status+  = New+  | 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,37 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Pushbullet.Types.User where++import Network.Pushbullet.Types.Misc+import Network.Pushbullet.Types.Time++import Data.Aeson+import Data.Text ( Text )++data User+  = User+    { userCreated :: PushbulletTime+    , userEmail :: EmailAddress+    , userEmailNormalized :: EmailAddress+    , userId :: UserId+    , userImageUrl :: Url+    , userMaxUploadSize :: Double+    , userModified :: PushbulletTime+    , userName :: Name+    }+  deriving (Eq, Show)++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"++newtype UserId = UserId Text+  deriving (Eq, FromJSON, Show, ToJSON)