diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2020-02-04 23:28:46 +0100 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2020-02-04 23:28:46 +0100 |
commit | 8dc945aae35fffd8e64c524b71d7316297721daf (patch) | |
tree | d1a000e303f6a22fdcf522b2b4729a81ea0c2fcc /src/Message.hs | |
parent | 6f0bcff200598d085c89d167aa126d25fc5df3ed (diff) |
Service: unify service and packet types
Also provide default unit definition for the service state.
Diffstat (limited to 'src/Message.hs')
-rw-r--r-- | src/Message.hs | 25 |
1 files changed, 5 insertions, 20 deletions
diff --git a/src/Message.hs b/src/Message.hs index ee59dad..0039d7e 100644 --- a/src/Message.hs +++ b/src/Message.hs @@ -1,8 +1,5 @@ module Message ( DirectMessage(..), - DirectMessageService, - ServicePacket(DirectMessagePacket), - sendDirectMessage, DirectMessageThread(..), @@ -50,19 +47,11 @@ instance Storable DirectMessage where <*> loadDate "time" <*> loadText "text" -data DirectMessageService - -instance Service DirectMessageService where +instance Service DirectMessage where serviceID _ = mkServiceID "c702076c-4928-4415-8b6b-3e839eafcb0d" - data ServiceState DirectMessageService = DirectMessageService - emptyServiceState = DirectMessageService - - newtype ServicePacket DirectMessageService = DirectMessagePacket (Stored DirectMessage) - - serviceHandler packet = do - let DirectMessagePacket smsg = fromStored packet - msg = fromStored smsg + serviceHandler smsg = do + let msg = fromStored smsg powner <- asks $ finalOwner . svcPeer tzone <- liftIO $ getCurrentTimeZone erb <- svcGetLocal @@ -86,14 +75,10 @@ instance Service DirectMessageService where svcSetLocal erb' when (powner `sameIdentity` msgFrom msg) $ do svcPrint $ formatMessage tzone msg - replyStoredRef packet + replyStoredRef smsg else svcPrint "Owner mismatch" -instance Storable (ServicePacket DirectMessageService) where - store' (DirectMessagePacket smsg) = store' smsg - load' = DirectMessagePacket <$> load' - data MessageState = MessageState { msPrev :: [Stored MessageState] @@ -155,7 +140,7 @@ sendDirectMessage self peer text = do } return ([next], smsg) - sendToPeer self peer $ DirectMessagePacket smsg + sendToPeerStored self peer smsg return smsg |