packages feed

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 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