signal-messaging-dbus 1.0.0.2 → 1.0.1.0
raw patch · 4 files changed
+60/−37 lines, 4 filesdep +timePVP ok
version bump matches the API change (PVP)
Dependencies added: time
API changes (from Hackage documentation)
+ SignalDBus: fromUTCTime :: UTCTime -> Timestamp
+ SignalDBus: reactTo :: MonadIO m => ReceivedMessage -> String -> Bool -> SignalConn -> m Timestamp
+ SignalDBus: replyTo :: MonadIO m => ReceivedMessage -> String -> [String] -> SignalConn -> m Timestamp
+ SignalDBus: toUTCTime :: Timestamp -> UTCTime
+ SignalDBus.Types: fromUTCTime :: UTCTime -> Timestamp
+ SignalDBus.Types: toUTCTime :: Timestamp -> UTCTime
Files
- CHANGELOG.md +4/−0
- signal-messaging-dbus.cabal +4/−2
- src/SignalDBus.hs +32/−1
- src/SignalDBus/Types.hs +20/−34
CHANGELOG.md view
@@ -1,3 +1,7 @@+# 1.0.1.0+- add Timestamp conversion from/to UTCTime+- add replyTo, reactTo+ # 1.0.0.2 - add version bounds on deps - add changelog
signal-messaging-dbus.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.0.+-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack name: signal-messaging-dbus-version: 1.0.0.2+version: 1.0.1.0 synopsis: Bindings for signal-cli's DBus interface description: This library aims provides a way to interact programmatically with the private messenger signal <https://signal.org/>. To use this, you need an instance of [signal-cli] (https://github.com/AsamK/signal-cli) running in daemon mode, with the DBus interface enabled. Support exists for almost the whole api, which should be sufficient for your bot-writing needs. category: web@@ -38,6 +38,7 @@ base >=4.7 && <5 , bytestring <0.12 , dbus >=1.2.12 && <1.3+ , time >=1.8 && <1.13 , unliftio ==0.2.* default-language: Haskell2010 @@ -53,5 +54,6 @@ , bytestring <0.12 , dbus >=1.2.12 && <1.3 , signal-messaging-dbus+ , time >=1.8 && <1.13 , unliftio ==0.2.* default-language: Haskell2010
src/SignalDBus.hs view
@@ -65,6 +65,10 @@ -- * Receiving Messages SignalDBus.Interface.withReceiveMessages, + -- * Utility functions+ reactTo,+ replyTo,+ -- * Control interface -- $control link,@@ -156,14 +160,41 @@ SignalDBus.Types.Device, SignalDBus.Types.Group, SignalDBus.Types.ReceivedMessage(..),+ fromUTCTime,+ toUTCTime, ) where import Data.ByteString (ByteString) import Data.Int (Int32, Int64) import DBus.Internal.Types (toVariant, ObjectPath(..))+import DBus.Client (clientError) import SignalDBus.Interface import SignalDBus.Types-import UnliftIO (MonadIO)+import UnliftIO (MonadIO, throwIO)++-- |Utility function for sending a message in the same chat as you received a message from+replyTo :: MonadIO m+ => ReceivedMessage -- ^ Message in whoose chat the reply should be sent+ -> String -- ^ Message content+ -> [String] -- ^ Paths to attachments. Resolves using the working dir of the signal-cli daemon, not this process+ -> SignalConn -- ^ Connection object+ -> m Timestamp -- ^ Timestamp of sent message+replyTo (Message _ _ (Just gId) _ _) msg as sc = sendGroupMessage msg as gId sc+replyTo (Message _ n Nothing _ _) msg as sc = sendMessage msg as [n] sc+replyTo (SyncMessage _ _ _ _ _) _ _ _ = throwIO $ clientError $ "replyTo called on SyncMessage"+replyTo (Receipt _ _) _ _ _ = throwIO $ clientError $ "replyTo called on SyncMessage"++-- |Utility function for reacting to a received message+reactTo :: MonadIO m+ => ReceivedMessage -- ^ Message which to react to+ -> String -- ^ Unicode grapheme cluster. Only tested with "😂"+ -> Bool -- ^ whether to remove an existing reaction+ -> SignalConn -- ^ Connection object+ -> m Timestamp -- ^ Timestamp of sent message+reactTo (Message ts n (Just gId) _ _) emoji rm sc = sendGroupMessageReaction emoji rm n ts gId sc+reactTo (Message ts n Nothing _ _) emoji rm sc = sendMessageReaction emoji rm n ts n sc+reactTo (SyncMessage _ _ _ _ _) _ _ _ = throwIO $ clientError $ "replyTo called on SyncMessage"+reactTo (Receipt _ _) _ _ _ = throwIO $ clientError $ "replyTo called on SyncMessage" -- $control --
src/SignalDBus/Types.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-orphans #-} -- :/+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-| Module: SignalDBus.Types@@ -18,9 +19,14 @@ Device(..), Group(..), ReceivedMessage(..),++ toUTCTime,+ fromUTCTime, ) where import Data.Int (Int64)+import Data.Time (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import DBus.Client (Client) import DBus.Internal.Types import Text.Read (readPrec)@@ -30,59 +36,39 @@ data SignalConn = SignalConn !ObjectPath !Client -- |Timestamp, represented as an ms-precision unix timestamp-newtype Timestamp = Timestamp Int64 deriving (Show, Read, Eq, Ord)--instance IsVariant Timestamp where- toVariant (Timestamp ts) = toVariant ts- fromVariant v = Timestamp <$> fromVariant v--instance IsValue Timestamp where- typeOf_ _ = TypeInt64- toValue (Timestamp ts) = toValue ts- fromValue v = Timestamp <$> fromValue v+newtype Timestamp = Timestamp Int64 deriving (Show, Read, Eq, Ord, IsVariant, IsValue)+-- |Conversion to 'UTCTime'. This retains precision, so converting back-and-forth+-- is unproblematic.+toUTCTime :: Timestamp -> UTCTime+toUTCTime (Timestamp ts) = posixSecondsToUTCTime (fromIntegral ts * 0.001)+-- |Conversion from 'UTCTime'. This retains precision, so converting back-and-forth+-- is unproblematic.+fromUTCTime :: UTCTime -> Timestamp+fromUTCTime t = Timestamp $ floor $ utcTimeToPOSIXSeconds t * 1000 -- |Opaque object representing a linked device-newtype Device = Device Int64 deriving (Show, Read, Eq)-instance IsVariant Device where- toVariant (Device i) = toVariant i- fromVariant v = Device <$> fromVariant v--instance IsValue Device where- typeOf_ _ = TypeInt64- toValue (Device i) = toValue i- fromValue v = Device <$> fromValue v+newtype Device = Device Int64 deriving (Show, Read, Eq, IsVariant, IsValue) instance Read ObjectPath where -- :/ readPrec = ObjectPath <$> readPrec -- |Opaque Group object, aquired by 'SignalDBus.listGroups' or 'SignalDBus.getGroup'-newtype Group = Group ObjectPath deriving (Show, Read, Eq, Ord)-instance IsVariant Group where- toVariant (Group i) = toVariant i- fromVariant v = Group <$> fromVariant v--instance IsValue Group where- typeOf_ _ = TypeObjectPath- toValue (Group i) = toValue i- fromValue v = Group <$> fromValue v+newtype Group = Group ObjectPath deriving (Show, Read, Eq, Ord, IsVariant, IsValue) -- |Received message data ReceivedMessage =- -- |Message sent by a linked device to someone else- SyncMessage+ SyncMessage -- ^ Message sent by a linked device to someone else Timestamp -- ^ When this message was sent String -- ^ Message sender (TODO: always yourself?) (Maybe Group) -- ^ If sent in a group, corresponding group object String -- ^ Message text [String] -- ^ Paths to stored attachments - -- |Read receipt sent by someone else in response to one of your messages- | Receipt+ | Receipt -- ^ Read receipt sent by someone else in response to one of your messages Timestamp -- ^ Which message was read String -- ^ Phone number of the receipt sender - -- |Message sent to you by someone else- | Message+ | Message -- ^ Message sent to you by someone else Timestamp -- ^ When this message was sent String -- ^ Message sender (Maybe Group) -- ^ If sent in a group, corresponding group object