summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--erebos.cabal1
-rw-r--r--src/Erebos/Chatroom.hs2
-rw-r--r--src/Erebos/DirectMessage.hs4
-rw-r--r--src/Erebos/Invite.hs2
-rw-r--r--src/Erebos/Network.hs2
-rw-r--r--src/Erebos/Service.hs193
-rw-r--r--src/Erebos/Sync.hs2
-rw-r--r--src/Service.hs218
8 files changed, 237 insertions, 187 deletions
diff --git a/erebos.cabal b/erebos.cabal
index a8178a1..5972a4e 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -133,6 +133,7 @@ library
Erebos.TextFormat.Types
Erebos.UUID
Erebos.Util
+ Service
c-sources:
src/Erebos/Network/ifaddrs.c
diff --git a/src/Erebos/Chatroom.hs b/src/Erebos/Chatroom.hs
index a7ba46d..9c15c57 100644
--- a/src/Erebos/Chatroom.hs
+++ b/src/Erebos/Chatroom.hs
@@ -614,7 +614,7 @@ instance Service ChatroomService where
replyPacket emptyPacket { chatRoomQuery = True }
serviceStorageWatchers _ = (:[]) $
- SomeStorageWatcher (lookupSharedValue . lsShared . fromStored) syncChatroomsToPeer
+ someStorageWatcher (lookupSharedValue . lsShared . fromStored) syncChatroomsToPeer
syncChatroomsToPeer :: Set ChatroomState -> ServiceHandler ChatroomService ()
syncChatroomsToPeer set = do
diff --git a/src/Erebos/DirectMessage.hs b/src/Erebos/DirectMessage.hs
index 6eb8a8c..6697d53 100644
--- a/src/Erebos/DirectMessage.hs
+++ b/src/Erebos/DirectMessage.hs
@@ -152,8 +152,8 @@ instance Service DirectMessage where
updateDirectMessagePeer . finalOwner =<< asks svcPeerIdentity
serviceStorageWatchers _ =
- [ SomeStorageWatcherHC lookupSharedValueHC syncDirectMessageToPeer
- , GlobalStorageWatcherH lookupSharedValueH findMissingPeers
+ [ someStorageWatcherHC lookupSharedValueHC syncDirectMessageToPeer
+ , globalStorageWatcherH lookupSharedValueH findMissingPeers
]
diff --git a/src/Erebos/Invite.hs b/src/Erebos/Invite.hs
index 890450b..65adaa7 100644
--- a/src/Erebos/Invite.hs
+++ b/src/Erebos/Invite.hs
@@ -355,7 +355,7 @@ instance Service InviteService where
_ -> return ()
serviceStorageWatchers _ = (:[]) $
- GlobalStorageWatcher (lookupSharedValue . lsShared . fromStored) sendAcceptedInvites
+ globalStorageWatcher (lookupSharedValue . lsShared . fromStored) sendAcceptedInvites
sendAcceptedInvites :: Server -> Set AcceptedInvite -> ExceptT ErebosError IO ()
diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs
index 64c2c44..fd30b8c 100644
--- a/src/Erebos/Network.hs
+++ b/src/Erebos/Network.hs
@@ -79,6 +79,8 @@ import Erebos.Storage.Head
import Erebos.Storage.Key
import Erebos.Storage.Merge
+import Service
+
discoveryPort :: PortNumber
discoveryPort = 29665
diff --git a/src/Erebos/Service.hs b/src/Erebos/Service.hs
index dcc3df5..e61e3e8 100644
--- a/src/Erebos/Service.hs
+++ b/src/Erebos/Service.hs
@@ -3,7 +3,8 @@ module Erebos.Service (
SomeService(..), someService, someServiceAttr, someServiceID,
SomeServiceState(..), fromServiceState, someServiceEmptyState,
SomeServiceGlobalState(..), fromServiceGlobalState, someServiceEmptyGlobalState,
- SomeStorageWatcher(..),
+ SomeStorageWatcher(SomeStorageWatcher, GlobalStorageWatcher),
+ someStorageWatcher, someStorageWatcherHC, globalStorageWatcher, globalStorageWatcherH,
ServiceID, mkServiceID,
ServiceHandler,
@@ -23,196 +24,24 @@ module Erebos.Service (
) where
import Control.Monad.Except
-import Control.Monad.Reader
-import Control.Monad.State
-import Control.Monad.Writer
-import Data.Kind
-import Data.Typeable
-
-import Erebos.Identity
import {-# SOURCE #-} Erebos.Network
import Erebos.Network.Protocol
import Erebos.State
import Erebos.Storable
import Erebos.Storage.Head
-import Erebos.UUID qualified as U
-
-class (
- Typeable s, Storable s,
- Typeable (ServiceAttributes s),
- Typeable (ServiceState s),
- Typeable (ServiceGlobalState s)
- ) => Service s where
-
- serviceID :: proxy s -> ServiceID
- serviceHandler :: Stored s -> ServiceHandler s ()
-
- serviceNewPeer :: ServiceHandler s ()
- serviceNewPeer = return ()
-
- serviceUpdatedPeer :: ServiceHandler s ()
- serviceUpdatedPeer = return ()
-
- type ServiceAttributes s = attr | attr -> s
- type ServiceAttributes s = Proxy s
- defaultServiceAttributes :: proxy s -> ServiceAttributes s
- default defaultServiceAttributes :: ServiceAttributes s ~ Proxy s => proxy s -> ServiceAttributes s
- defaultServiceAttributes _ = Proxy
-
- type ServiceState s :: Type
- type ServiceState s = ()
- emptyServiceState :: proxy s -> ServiceState s
- default emptyServiceState :: ServiceState s ~ () => proxy s -> ServiceState s
- emptyServiceState _ = ()
-
- type ServiceGlobalState s :: Type
- type ServiceGlobalState s = ()
- emptyServiceGlobalState :: proxy s -> ServiceGlobalState s
- default emptyServiceGlobalState :: ServiceGlobalState s ~ () => proxy s -> ServiceGlobalState s
- emptyServiceGlobalState _ = ()
-
- serviceStorageWatchers :: proxy s -> [SomeStorageWatcher s]
- serviceStorageWatchers _ = []
-
- serviceStopServer :: proxy s -> Server -> ServiceGlobalState s -> [ ( Peer, ServiceState s ) ] -> IO ()
- serviceStopServer _ _ _ _ = return ()
-
-
-data SomeService = forall s. Service s => SomeService (Proxy s) (ServiceAttributes s)
-
-someService :: forall s proxy. Service s => proxy s -> SomeService
-someService _ = SomeService @s Proxy (defaultServiceAttributes @s Proxy)
-
-someServiceAttr :: forall s. Service s => ServiceAttributes s -> SomeService
-someServiceAttr attr = SomeService @s Proxy attr
-
-someServiceID :: SomeService -> ServiceID
-someServiceID (SomeService s _) = serviceID s
-
-data SomeServiceState = forall s. Service s => SomeServiceState (Proxy s) (ServiceState s)
-
-fromServiceState :: Service s => proxy s -> SomeServiceState -> Maybe (ServiceState s)
-fromServiceState _ (SomeServiceState _ s) = cast s
-
-someServiceEmptyState :: SomeService -> SomeServiceState
-someServiceEmptyState (SomeService p _) = SomeServiceState p (emptyServiceState p)
-
-data SomeServiceGlobalState = forall s. Service s => SomeServiceGlobalState (Proxy s) (ServiceGlobalState s)
-
-fromServiceGlobalState :: Service s => proxy s -> SomeServiceGlobalState -> Maybe (ServiceGlobalState s)
-fromServiceGlobalState _ (SomeServiceGlobalState _ s) = cast s
-
-someServiceEmptyGlobalState :: SomeService -> SomeServiceGlobalState
-someServiceEmptyGlobalState (SomeService p _) = SomeServiceGlobalState p (emptyServiceGlobalState p)
-
-
-data SomeStorageWatcher s
- = forall a. Eq a => SomeStorageWatcher (Stored LocalState -> a) (a -> ServiceHandler s ())
- | forall a. Eq a => SomeStorageWatcherHC (Stored LocalState -> HeadCacheType LocalState -> a) (a -> ServiceHandler s ())
- | forall a. Eq a => GlobalStorageWatcher (Stored LocalState -> a) (Server -> a -> ExceptT ErebosError IO ())
- | forall a. Eq a => GlobalStorageWatcherH (Head LocalState -> a) (Server -> a -> ExceptT ErebosError IO ())
-
-
-mkServiceID :: String -> ServiceID
-mkServiceID = maybe (error "Invalid service ID") ServiceID . U.fromString
-
-data ServiceInput s = ServiceInput
- { svcAttributes :: ServiceAttributes s
- , svcPeer :: Peer
- , svcPeerAddress :: PeerAddress
- , svcPeerIdentity :: UnifiedIdentity
- , svcServer :: Server
- , svcPrintOp :: String -> IO ()
- , svcNewStreams :: [ RawStreamReader ]
- }
-
-data ServiceReply s
- = ServiceReply (Either s (Stored s)) Bool
- | ServiceOpenStream (RawStreamWriter -> IO ())
- | ServiceFinally (IO ())
-
-data ServiceHandlerState s = ServiceHandlerState
- { svcValue :: ServiceState s
- , svcGlobal :: ServiceGlobalState s
- , svcLocal :: Stored LocalState
- , svcLocalCache :: HeadCacheType LocalState
- }
-
-newtype ServiceHandler s a = ServiceHandler (ReaderT (ServiceInput s) (WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT ErebosError IO))) a)
- deriving (Functor, Applicative, Monad, MonadReader (ServiceInput s), MonadWriter [ServiceReply s], MonadState (ServiceHandlerState s), MonadError ErebosError, MonadIO)
-
-instance MonadStorage (ServiceHandler s) where
- getStorage = asks $ peerStorage . svcPeer
-
-instance MonadHead LocalState (ServiceHandler s) where
- updateLocalHead f = do
- ls <- gets svcLocal
- c <- gets svcLocalCache
- ( ls', x ) <- f ls
- let c' = headCacheUpdate ls' c
- modify $ \s -> s { svcLocal = ls', svcLocalCache = c' }
- return x
- getLocalHeadCache _ = gets svcLocalCache
-
-runServiceHandler
- :: Service s
- => Head LocalState -> ServiceInput s -> ServiceState s -> ServiceGlobalState s
- -> ServiceHandler s ()
- -> IO ( [ ServiceReply s], ( ServiceState s, ServiceGlobalState s, Head LocalState ) )
-runServiceHandler h input svc global shandler = do
- let sstate = ServiceHandlerState { svcValue = svc, svcGlobal = global, svcLocal = headStoredObject h, svcLocalCache = headCache h }
- ServiceHandler handler = shandler
- (runExceptT $ flip runStateT sstate $ execWriterT $ flip runReaderT input $ handler) >>= \case
- Left err -> do
- svcPrintOp input $ "service failed: " ++ showErebosError err
- return ( [], ( svc, global, h ) )
- Right (rsp, sstate')
- | svcLocal sstate' == svcLocal sstate -> return ( rsp, ( svcValue sstate', svcGlobal sstate', h ))
- | otherwise -> replaceHead h (svcLocal sstate') >>= \case
- Left (Just h') -> runServiceHandler h' input svc global shandler
- Left Nothing -> return ( rsp, ( svcValue sstate', svcGlobal sstate', h ) )
- Right h' -> return ( rsp, ( svcValue sstate', svcGlobal sstate', h' ) )
-
-svcGet :: ServiceHandler s (ServiceState s)
-svcGet = gets svcValue
-
-svcSet :: ServiceState s -> ServiceHandler s ()
-svcSet x = modify $ \st -> st { svcValue = x }
-
-svcModify :: (ServiceState s -> ServiceState s) -> ServiceHandler s ()
-svcModify f = modify $ \st -> st { svcValue = f (svcValue st) }
-
-svcGetGlobal :: ServiceHandler s (ServiceGlobalState s)
-svcGetGlobal = gets svcGlobal
-
-svcSetGlobal :: ServiceGlobalState s -> ServiceHandler s ()
-svcSetGlobal x = modify $ \st -> st { svcGlobal = x }
-
-svcModifyGlobal :: (ServiceGlobalState s -> ServiceGlobalState s) -> ServiceHandler s ()
-svcModifyGlobal f = modify $ \st -> st { svcGlobal = f (svcGlobal st) }
-
-svcGetLocal :: ServiceHandler s (Stored LocalState)
-svcGetLocal = gets svcLocal
-
-svcSetLocal :: Stored LocalState -> ServiceHandler s ()
-svcSetLocal x = modify $ \st -> st { svcLocal = x }
-svcSelf :: ServiceHandler s UnifiedIdentity
-svcSelf = maybe (throwOtherError "failed to validate own identity") return .
- validateExtendedIdentity . lsIdentity . fromStored =<< svcGetLocal
+import Service
-svcPrint :: String -> ServiceHandler s ()
-svcPrint str = afterCommit . ($ str) =<< asks svcPrintOp
-replyPacket :: Service s => s -> ServiceHandler s ()
-replyPacket x = tell [ServiceReply (Left x) True]
+someStorageWatcher :: forall s a. (Service s, Eq a) => (Stored LocalState -> a) -> (a -> ServiceHandler s ()) -> SomeStorageWatcher s
+someStorageWatcher = SomeStorageWatcher
-replyStored :: Service s => Stored s -> ServiceHandler s ()
-replyStored x = tell [ServiceReply (Right x) True]
+someStorageWatcherHC :: forall s a. (Service s, Eq a) => (Stored LocalState -> HeadCacheType LocalState -> a) -> (a -> ServiceHandler s ()) -> SomeStorageWatcher s
+someStorageWatcherHC = SomeStorageWatcherHC
-replyStoredRef :: Service s => Stored s -> ServiceHandler s ()
-replyStoredRef x = tell [ServiceReply (Right x) False]
+globalStorageWatcher :: forall s a. (Service s, Eq a) => (Stored LocalState -> a) -> (Server -> a -> ExceptT ErebosError IO ()) -> SomeStorageWatcher s
+globalStorageWatcher = GlobalStorageWatcher
-afterCommit :: IO () -> ServiceHandler s ()
-afterCommit x = tell [ServiceFinally x]
+globalStorageWatcherH :: forall s a. (Service s, Eq a) => (Head LocalState -> a) -> (Server -> a -> ExceptT ErebosError IO ()) -> SomeStorageWatcher s
+globalStorageWatcherH = GlobalStorageWatcherH
diff --git a/src/Erebos/Sync.hs b/src/Erebos/Sync.hs
index 5f5fdec..52251e3 100644
--- a/src/Erebos/Sync.hs
+++ b/src/Erebos/Sync.hs
@@ -32,7 +32,7 @@ instance Service SyncService where
serviceNewPeer = notifyPeer . lsShared . fromStored =<< svcGetLocal
serviceUpdatedPeer = serviceNewPeer
- serviceStorageWatchers _ = (:[]) $ SomeStorageWatcher (lsShared . fromStored) notifyPeer
+ serviceStorageWatchers _ = (:[]) $ someStorageWatcher (lsShared . fromStored) notifyPeer
instance Storable SyncService where
store' (SyncPacket smsg) = store' smsg
diff --git a/src/Service.hs b/src/Service.hs
new file mode 100644
index 0000000..01b659f
--- /dev/null
+++ b/src/Service.hs
@@ -0,0 +1,218 @@
+module Service (
+ Service(..),
+ SomeService(..), someService, someServiceAttr, someServiceID,
+ SomeServiceState(..), fromServiceState, someServiceEmptyState,
+ SomeServiceGlobalState(..), fromServiceGlobalState, someServiceEmptyGlobalState,
+ SomeStorageWatcher(..),
+ ServiceID, mkServiceID,
+
+ ServiceHandler,
+ ServiceInput(..),
+ ServiceReply(..),
+ runServiceHandler,
+
+ svcGet, svcSet, svcModify,
+ svcGetGlobal, svcSetGlobal, svcModifyGlobal,
+ svcGetLocal, svcSetLocal,
+
+ svcSelf,
+ svcPrint,
+
+ replyPacket, replyStored, replyStoredRef,
+ afterCommit,
+) where
+
+import Control.Monad.Except
+import Control.Monad.Reader
+import Control.Monad.State
+import Control.Monad.Writer
+
+import Data.Kind
+import Data.Typeable
+
+import Erebos.Identity
+import {-# SOURCE #-} Erebos.Network
+import Erebos.Network.Protocol
+import Erebos.State
+import Erebos.Storable
+import Erebos.Storage.Head
+import Erebos.UUID qualified as U
+
+class (
+ Typeable s, Storable s,
+ Typeable (ServiceAttributes s),
+ Typeable (ServiceState s),
+ Typeable (ServiceGlobalState s)
+ ) => Service s where
+
+ serviceID :: proxy s -> ServiceID
+ serviceHandler :: Stored s -> ServiceHandler s ()
+
+ serviceNewPeer :: ServiceHandler s ()
+ serviceNewPeer = return ()
+
+ serviceUpdatedPeer :: ServiceHandler s ()
+ serviceUpdatedPeer = return ()
+
+ type ServiceAttributes s = attr | attr -> s
+ type ServiceAttributes s = Proxy s
+ defaultServiceAttributes :: proxy s -> ServiceAttributes s
+ default defaultServiceAttributes :: ServiceAttributes s ~ Proxy s => proxy s -> ServiceAttributes s
+ defaultServiceAttributes _ = Proxy
+
+ type ServiceState s :: Type
+ type ServiceState s = ()
+ emptyServiceState :: proxy s -> ServiceState s
+ default emptyServiceState :: ServiceState s ~ () => proxy s -> ServiceState s
+ emptyServiceState _ = ()
+
+ type ServiceGlobalState s :: Type
+ type ServiceGlobalState s = ()
+ emptyServiceGlobalState :: proxy s -> ServiceGlobalState s
+ default emptyServiceGlobalState :: ServiceGlobalState s ~ () => proxy s -> ServiceGlobalState s
+ emptyServiceGlobalState _ = ()
+
+ serviceStorageWatchers :: proxy s -> [SomeStorageWatcher s]
+ serviceStorageWatchers _ = []
+
+ serviceStopServer :: proxy s -> Server -> ServiceGlobalState s -> [ ( Peer, ServiceState s ) ] -> IO ()
+ serviceStopServer _ _ _ _ = return ()
+
+
+data SomeService = forall s. Service s => SomeService (Proxy s) (ServiceAttributes s)
+
+someService :: forall s proxy. Service s => proxy s -> SomeService
+someService _ = SomeService @s Proxy (defaultServiceAttributes @s Proxy)
+
+someServiceAttr :: forall s. Service s => ServiceAttributes s -> SomeService
+someServiceAttr attr = SomeService @s Proxy attr
+
+someServiceID :: SomeService -> ServiceID
+someServiceID (SomeService s _) = serviceID s
+
+data SomeServiceState = forall s. Service s => SomeServiceState (Proxy s) (ServiceState s)
+
+fromServiceState :: Service s => proxy s -> SomeServiceState -> Maybe (ServiceState s)
+fromServiceState _ (SomeServiceState _ s) = cast s
+
+someServiceEmptyState :: SomeService -> SomeServiceState
+someServiceEmptyState (SomeService p _) = SomeServiceState p (emptyServiceState p)
+
+data SomeServiceGlobalState = forall s. Service s => SomeServiceGlobalState (Proxy s) (ServiceGlobalState s)
+
+fromServiceGlobalState :: Service s => proxy s -> SomeServiceGlobalState -> Maybe (ServiceGlobalState s)
+fromServiceGlobalState _ (SomeServiceGlobalState _ s) = cast s
+
+someServiceEmptyGlobalState :: SomeService -> SomeServiceGlobalState
+someServiceEmptyGlobalState (SomeService p _) = SomeServiceGlobalState p (emptyServiceGlobalState p)
+
+
+data SomeStorageWatcher s
+ = forall a. Eq a => SomeStorageWatcher (Stored LocalState -> a) (a -> ServiceHandler s ())
+ | forall a. Eq a => SomeStorageWatcherHC (Stored LocalState -> HeadCacheType LocalState -> a) (a -> ServiceHandler s ())
+ | forall a. Eq a => GlobalStorageWatcher (Stored LocalState -> a) (Server -> a -> ExceptT ErebosError IO ())
+ | forall a. Eq a => GlobalStorageWatcherH (Head LocalState -> a) (Server -> a -> ExceptT ErebosError IO ())
+
+
+mkServiceID :: String -> ServiceID
+mkServiceID = maybe (error "Invalid service ID") ServiceID . U.fromString
+
+data ServiceInput s = ServiceInput
+ { svcAttributes :: ServiceAttributes s
+ , svcPeer :: Peer
+ , svcPeerAddress :: PeerAddress
+ , svcPeerIdentity :: UnifiedIdentity
+ , svcServer :: Server
+ , svcPrintOp :: String -> IO ()
+ , svcNewStreams :: [ RawStreamReader ]
+ }
+
+data ServiceReply s
+ = ServiceReply (Either s (Stored s)) Bool
+ | ServiceOpenStream (RawStreamWriter -> IO ())
+ | ServiceFinally (IO ())
+
+data ServiceHandlerState s = ServiceHandlerState
+ { svcValue :: ServiceState s
+ , svcGlobal :: ServiceGlobalState s
+ , svcLocal :: Stored LocalState
+ , svcLocalCache :: HeadCacheType LocalState
+ }
+
+newtype ServiceHandler s a = ServiceHandler (ReaderT (ServiceInput s) (WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT ErebosError IO))) a)
+ deriving (Functor, Applicative, Monad, MonadReader (ServiceInput s), MonadWriter [ServiceReply s], MonadState (ServiceHandlerState s), MonadError ErebosError, MonadIO)
+
+instance MonadStorage (ServiceHandler s) where
+ getStorage = asks $ peerStorage . svcPeer
+
+instance MonadHead LocalState (ServiceHandler s) where
+ updateLocalHead f = do
+ ls <- gets svcLocal
+ c <- gets svcLocalCache
+ ( ls', x ) <- f ls
+ let c' = headCacheUpdate ls' c
+ modify $ \s -> s { svcLocal = ls', svcLocalCache = c' }
+ return x
+ getLocalHeadCache _ = gets svcLocalCache
+
+runServiceHandler
+ :: Service s
+ => Head LocalState -> ServiceInput s -> ServiceState s -> ServiceGlobalState s
+ -> ServiceHandler s ()
+ -> IO ( [ ServiceReply s], ( ServiceState s, ServiceGlobalState s, Head LocalState ) )
+runServiceHandler h input svc global shandler = do
+ let sstate = ServiceHandlerState { svcValue = svc, svcGlobal = global, svcLocal = headStoredObject h, svcLocalCache = headCache h }
+ ServiceHandler handler = shandler
+ (runExceptT $ flip runStateT sstate $ execWriterT $ flip runReaderT input $ handler) >>= \case
+ Left err -> do
+ svcPrintOp input $ "service failed: " ++ showErebosError err
+ return ( [], ( svc, global, h ) )
+ Right (rsp, sstate')
+ | svcLocal sstate' == svcLocal sstate -> return ( rsp, ( svcValue sstate', svcGlobal sstate', h ))
+ | otherwise -> replaceHead h (svcLocal sstate') >>= \case
+ Left (Just h') -> runServiceHandler h' input svc global shandler
+ Left Nothing -> return ( rsp, ( svcValue sstate', svcGlobal sstate', h ) )
+ Right h' -> return ( rsp, ( svcValue sstate', svcGlobal sstate', h' ) )
+
+svcGet :: ServiceHandler s (ServiceState s)
+svcGet = gets svcValue
+
+svcSet :: ServiceState s -> ServiceHandler s ()
+svcSet x = modify $ \st -> st { svcValue = x }
+
+svcModify :: (ServiceState s -> ServiceState s) -> ServiceHandler s ()
+svcModify f = modify $ \st -> st { svcValue = f (svcValue st) }
+
+svcGetGlobal :: ServiceHandler s (ServiceGlobalState s)
+svcGetGlobal = gets svcGlobal
+
+svcSetGlobal :: ServiceGlobalState s -> ServiceHandler s ()
+svcSetGlobal x = modify $ \st -> st { svcGlobal = x }
+
+svcModifyGlobal :: (ServiceGlobalState s -> ServiceGlobalState s) -> ServiceHandler s ()
+svcModifyGlobal f = modify $ \st -> st { svcGlobal = f (svcGlobal st) }
+
+svcGetLocal :: ServiceHandler s (Stored LocalState)
+svcGetLocal = gets svcLocal
+
+svcSetLocal :: Stored LocalState -> ServiceHandler s ()
+svcSetLocal x = modify $ \st -> st { svcLocal = x }
+
+svcSelf :: ServiceHandler s UnifiedIdentity
+svcSelf = maybe (throwOtherError "failed to validate own identity") return .
+ validateExtendedIdentity . lsIdentity . fromStored =<< svcGetLocal
+
+svcPrint :: String -> ServiceHandler s ()
+svcPrint str = afterCommit . ($ str) =<< asks svcPrintOp
+
+replyPacket :: Service s => s -> ServiceHandler s ()
+replyPacket x = tell [ServiceReply (Left x) True]
+
+replyStored :: Service s => Stored s -> ServiceHandler s ()
+replyStored x = tell [ServiceReply (Right x) True]
+
+replyStoredRef :: Service s => Stored s -> ServiceHandler s ()
+replyStoredRef x = tell [ServiceReply (Right x) False]
+
+afterCommit :: IO () -> ServiceHandler s ()
+afterCommit x = tell [ServiceFinally x]
generated by cgit v1.2.3 (git 2.25.1) at 2026-08-19 20:14:47 +0000