servant-pushbullet-client 0.0.1.0 → 0.0.2.0
raw patch · 14 files changed
+247/−147 lines, 14 filesdep +microlensdep +microlens-th
Dependencies added: microlens, microlens-th
Files
- ChangeLog.md +4/−0
- servant-pushbullet-client.cabal +4/−1
- src/Network/Pushbullet/Api.hs +2/−4
- src/Network/Pushbullet/Client.hs +44/−7
- src/Network/Pushbullet/Misc.hs +1/−1
- src/Network/Pushbullet/Reflection.hs +17/−0
- src/Network/Pushbullet/Types/Device.hs +83/−79
- src/Network/Pushbullet/Types/Ephemeral.hs +18/−15
- src/Network/Pushbullet/Types/Pagination.hs +12/−4
- src/Network/Pushbullet/Types/Permanent.hs +6/−6
- src/Network/Pushbullet/Types/Push.hs +1/−1
- src/Network/Pushbullet/Types/SMS.hs +26/−18
- src/Network/Pushbullet/Types/Status.hs +14/−0
- src/Network/Pushbullet/Types/User.hs +15/−11
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for servant-pushbullet-client +## 0.0.2.0 -- 2017-02-10++Still prerelease. This just adds a bunch of lenses using `microlens-th`.+ ## 0.0.1.0 -- 2017-02-07 Prerelease version that contains a (small) subset of the Pushbullet API. We
servant-pushbullet-client.cabal view
@@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/ name: servant-pushbullet-client-version: 0.0.1.0+version: 0.0.2.0 synopsis: Bindings to the Pushbullet API using servant-client description: This library describes the Pushbullet API as a type, and uses servant-client@@ -25,6 +25,7 @@ Network.Pushbullet.Misc, Network.Pushbullet.Types other-modules:+ Network.Pushbullet.Reflection Network.Pushbullet.Types.Device, Network.Pushbullet.Types.Ephemeral, Network.Pushbullet.Types.Misc,@@ -56,6 +57,8 @@ http-api-data >=0.3 && <0.4, http-client-tls >=0.3 && <0.4, http-client,+ microlens >=0.4 && <0.5,+ microlens-th >=0.4 && <0.5, scientific >=0.3 && <0.4, servant >=0.9 && <0.10, servant-client >=0.9 && <0.10,
src/Network/Pushbullet/Api.hs view
@@ -7,12 +7,10 @@ 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 @@ -53,10 +51,10 @@ ) :<|> "permanents" :> (- Capture "permanent" (Permanent 'ThreadListK)+ Capture "permanent" (Permanent 'ThreadList) :> Get '[JSON] SmsThreads :<|>- Capture "permanent" (Permanent 'MessageListK)+ Capture "permanent" (Permanent 'MessageList) :> Get '[JSON] SmsMessages ) )
src/Network/Pushbullet/Client.hs view
@@ -11,18 +11,55 @@ import Servant.Common.Req ( addHeader ) import Servant.API hiding ( addHeader ) -type instance AuthClientData (AuthProtect PushbulletAuth) = PushbulletKey--pushbulletApiClient :: Client PushbulletApi-pushbulletApiClient = client pushbulletApi-+createPush+ :: Auth+ -> Push 'New+ -> ClientM (Push 'Existing)+getPushes+ :: Auth+ -> Maybe PushbulletTime+ -> Maybe Bool+ -> Maybe Cursor+ -> Maybe Int+ -> ClientM (Paginated ExistingPushes)+createEphemeral :: Auth -> Ephemeral -> ClientM TrivialObject+getMe :: Auth -> ClientM User+getDevices+ :: Auth+ -> Maybe Bool+ -> Maybe Cursor+ -> ClientM (Paginated ExistingDevices)+createDevice+ :: Auth+ -> Device 'New+ -> ClientM (Device 'Existing)+deleteDevice+ :: Auth+ -> DeviceId+ -> ClientM TrivialObject+getSmsThreads+ :: Auth+ -> Permanent 'ThreadList+ -> ClientM SmsThreads+getSmsMessages+ :: Auth+ -> Permanent 'MessageList+ -> ClientM SmsMessages (createPush :<|> getPushes) :<|> createEphemeral :<|> getMe :<|> (getDevices :<|> createDevice :<|> deleteDevice) :<|> (getSmsThreads :<|> getSmsMessages)- = pushbulletApiClient+ = client pushbulletApi -pushbulletAuth :: PushbulletKey -> AuthenticateReq (AuthProtect PushbulletAuth)+-- | Constructs an authenticator from a pushbullet key.+--+-- This authenticator adds the necessary @Access-Token@ header to the request.+pushbulletAuth :: PushbulletKey -> Auth pushbulletAuth key = mkAuthenticateReq key f where f = addHeader "Access-Token"++-- | A shorter name of the auth type we use.+type Auth = AuthenticateReq (AuthProtect PushbulletAuth)++type instance AuthClientData (AuthProtect PushbulletAuth) = PushbulletKey
src/Network/Pushbullet/Misc.hs view
@@ -4,7 +4,7 @@ module Network.Pushbullet.Misc where -import Network.Pushbullet.Types ( Cursor(..), Paginated(..) )+import Network.Pushbullet.Types ( Cursor, Paginated(..) ) -- | A count of items to retrieve from the API. data Count
+ src/Network/Pushbullet/Reflection.hs view
@@ -0,0 +1,17 @@+module Network.Pushbullet.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/Device.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} module Network.Pushbullet.Types.Device where @@ -7,66 +8,9 @@ import Data.Aeson import Data.Text ( Text )+import Lens.Micro.TH 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) @@ -94,6 +38,66 @@ 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@@ -110,20 +114,20 @@ 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+ [ "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@@ -146,13 +150,13 @@ 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+ [ "nickname" .= _deviceNickname+ , "model" .= _deviceModel+ , "manufacturer" .= _deviceManufacturer+ , "push_token" .= _devicePushToken+ , "app_version" .= _deviceAppVersion+ , "icon" .= _deviceIcon+ , "has_sms" .= _deviceHasSms ] instance FromJSON ExistingDevices where
src/Network/Pushbullet/Types/Ephemeral.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} module Network.Pushbullet.Types.Ephemeral where @@ -8,21 +9,24 @@ import Data.Aeson import Data.Text ( Text )+import Lens.Micro.TH data Ephemeral = Sms- { ephSmsSourceUser :: !UserId- , ephSmsTargetDevice :: !DeviceId- , ephSmsConversation :: !PhoneNumber- , ephSmsMessage :: !Text+ { _ephSmsSourceUser :: !UserId+ , _ephSmsTargetDevice :: !DeviceId+ , _ephSmsConversation :: !PhoneNumber+ , _ephSmsMessage :: !Text } | Clipboard- { ephClipBody :: !Text- , ephClipSourceUser :: !UserId- , ephClipSourceDevice :: !DeviceId+ { _ephClipBody :: !Text+ , _ephClipSourceUser :: !UserId+ , _ephClipSourceDevice :: !DeviceId } deriving (Eq, Show) +makeLenses ''Ephemeral+ instance ToJSON Ephemeral where toJSON o = case o of Sms{..} -> object@@ -30,19 +34,18 @@ , "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+ , "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+ , "body" .= _ephClipBody+ , "source_user_iden" .= _ephClipSourceUser+ , "source_device_iden" .= _ephClipSourceDevice ] ]-
src/Network/Pushbullet/Types/Pagination.hs view
@@ -1,20 +1,28 @@ {-# 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 !a !(Maybe Cursor)+data Paginated a+ = Page+ { _pageData :: !a+ , _pageCursor :: !(Maybe Cursor)+ } deriving (Eq, Functor, Show) --- | Cursors are opaque.-newtype Cursor = Cursor Text- deriving (Eq, FromJSON, Show, ToJSON, ToHttpApiData)+makeLenses ''Paginated instance FromJSON a => FromJSON (Paginated a) where parseJSON j@(Object o) = Page <$> parseJSON j <*> o .:? "cursor"
src/Network/Pushbullet/Types/Permanent.hs view
@@ -9,17 +9,17 @@ import Web.HttpApiData ( ToHttpApiData(..) ) data PermanentK- = ThreadListK- | MessageListK+ = ThreadList+ | MessageList data Permanent (p :: PermanentK) where- ThreadsOf :: !DeviceId -> Permanent 'ThreadListK- MessagesIn :: !DeviceId -> !SmsThreadId -> Permanent 'MessageListK+ ThreadsOf :: !DeviceId -> Permanent 'ThreadList+ MessagesIn :: !DeviceId -> !SmsThreadId -> Permanent 'MessageList -instance ToHttpApiData (Permanent 'ThreadListK) where+instance ToHttpApiData (Permanent 'ThreadList) where toUrlPiece p = case p of ThreadsOf (DeviceId d) -> d <> "_threads" -instance ToHttpApiData (Permanent 'MessageListK) where+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
@@ -213,7 +213,7 @@ target = case pushTarget of ToAll -> []- ToDevice deviceId -> [ "device_iden" .= deviceId ]+ ToDevice d -> [ "device_iden" .= d ] ToEmail email -> [ "email" .= email ] ToChannel tag -> [ "channel_tag" .= tag ] ToClient client -> [ "client_iden" .= client ]
src/Network/Pushbullet/Types/SMS.hs view
@@ -1,10 +1,12 @@ {-# 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@@ -24,43 +26,49 @@ data SmsMessage = SmsMessage- { smsDirection :: !SmsDirection- , smsTime :: !PushbulletTime- , smsBody :: !Text- , smsId :: !SmsId- , smsSent :: !(Maybe Bool)- , smsType :: !SmsMessageType+ { _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) -newtype SmsThreads- = SmsThreads- { unSmsThreads :: [SmsThread]- }- deriving (Eq, Show)- data SmsThreadRecipient = SmsThreadRecipient- { recipientName :: !Name- , recipientAddress :: !PhoneNumber- , recipientNumber :: !PhoneNumber+ { _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+ { _threadId :: SmsThreadId+ , _threadRecipients :: NonEmpty SmsThreadRecipient+ , _threadLatest :: SmsMessage+ }+ deriving (Eq, Show)++makeLenses ''SmsThread++newtype SmsThreads+ = SmsThreads+ { unSmsThreads :: [SmsThread] } deriving (Eq, Show)
src/Network/Pushbullet/Types/Status.hs view
@@ -3,9 +3,23 @@ , EqT ) where +import Network.Pushbullet.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. --
src/Network/Pushbullet/Types/User.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} module Network.Pushbullet.Types.User where @@ -7,20 +8,26 @@ 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+ { _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"@@ -32,6 +39,3 @@ <*> o .: "modified" <*> o .: "name" parseJSON _ = fail "cannot parse user from non-object"--newtype UserId = UserId Text- deriving (Eq, FromJSON, Show, ToJSON)