module Erebos.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 Data.UUID (UUID) import qualified Data.UUID as U import Erebos.Identity import {-# SOURCE #-} Erebos.Network import Erebos.State import Erebos.Storage class (Typeable s, Storable s, Typeable (ServiceState s), Typeable (ServiceGlobalState s)) => Service s where serviceID :: proxy s -> ServiceID serviceHandler :: Stored s -> ServiceHandler s () serviceNewPeer :: ServiceHandler s () serviceNewPeer = () -> ServiceHandler s () forall a. a -> ServiceHandler s a forall (m :: * -> *) a. Monad m => a -> m a 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 s _ = Proxy s ServiceAttributes s forall {k} (t :: k). Proxy t Proxy type ServiceState s :: Type type ServiceState s = () emptyServiceState :: proxy s -> ServiceState s default emptyServiceState :: ServiceState s ~ () => proxy s -> ServiceState s emptyServiceState proxy s _ = () type ServiceGlobalState s :: Type type ServiceGlobalState s = () emptyServiceGlobalState :: proxy s -> ServiceGlobalState s default emptyServiceGlobalState :: ServiceGlobalState s ~ () => proxy s -> ServiceGlobalState s emptyServiceGlobalState proxy s _ = () serviceStorageWatchers :: proxy s -> [SomeStorageWatcher s] serviceStorageWatchers proxy s _ = [] data SomeService = forall s. Service s => SomeService (Proxy s) (ServiceAttributes s) someService :: forall s proxy. Service s => proxy s -> SomeService someService :: forall s (proxy :: * -> *). Service s => proxy s -> SomeService someService proxy s _ = forall s. Service s => Proxy s -> ServiceAttributes s -> SomeService SomeService @s Proxy s forall {k} (t :: k). Proxy t Proxy (forall s (proxy :: * -> *). Service s => proxy s -> ServiceAttributes s defaultServiceAttributes @s Proxy s forall {k} (t :: k). Proxy t Proxy) someServiceAttr :: forall s. Service s => ServiceAttributes s -> SomeService someServiceAttr :: forall s. Service s => ServiceAttributes s -> SomeService someServiceAttr ServiceAttributes s attr = forall s. Service s => Proxy s -> ServiceAttributes s -> SomeService SomeService @s Proxy s forall {k} (t :: k). Proxy t Proxy ServiceAttributes s attr someServiceID :: SomeService -> ServiceID someServiceID :: SomeService -> ServiceID someServiceID (SomeService Proxy s s ServiceAttributes s _) = Proxy s -> ServiceID forall s (proxy :: * -> *). Service s => proxy s -> ServiceID forall (proxy :: * -> *). proxy s -> ServiceID serviceID Proxy s s data SomeServiceState = forall s. Service s => SomeServiceState (Proxy s) (ServiceState s) fromServiceState :: Service s => proxy s -> SomeServiceState -> Maybe (ServiceState s) fromServiceState :: forall s (proxy :: * -> *). Service s => proxy s -> SomeServiceState -> Maybe (ServiceState s) fromServiceState proxy s _ (SomeServiceState Proxy s _ ServiceState s s) = ServiceState s -> Maybe (ServiceState s) forall a b. (Typeable a, Typeable b) => a -> Maybe b cast ServiceState s s someServiceEmptyState :: SomeService -> SomeServiceState someServiceEmptyState :: SomeService -> SomeServiceState someServiceEmptyState (SomeService Proxy s p ServiceAttributes s _) = Proxy s -> ServiceState s -> SomeServiceState forall s. Service s => Proxy s -> ServiceState s -> SomeServiceState SomeServiceState Proxy s p (Proxy s -> ServiceState s forall s (proxy :: * -> *). Service s => proxy s -> ServiceState s forall (proxy :: * -> *). proxy s -> ServiceState s emptyServiceState Proxy s p) data SomeServiceGlobalState = forall s. Service s => SomeServiceGlobalState (Proxy s) (ServiceGlobalState s) fromServiceGlobalState :: Service s => proxy s -> SomeServiceGlobalState -> Maybe (ServiceGlobalState s) fromServiceGlobalState :: forall s (proxy :: * -> *). Service s => proxy s -> SomeServiceGlobalState -> Maybe (ServiceGlobalState s) fromServiceGlobalState proxy s _ (SomeServiceGlobalState Proxy s _ ServiceGlobalState s s) = ServiceGlobalState s -> Maybe (ServiceGlobalState s) forall a b. (Typeable a, Typeable b) => a -> Maybe b cast ServiceGlobalState s s someServiceEmptyGlobalState :: SomeService -> SomeServiceGlobalState someServiceEmptyGlobalState :: SomeService -> SomeServiceGlobalState someServiceEmptyGlobalState (SomeService Proxy s p ServiceAttributes s _) = Proxy s -> ServiceGlobalState s -> SomeServiceGlobalState forall s. Service s => Proxy s -> ServiceGlobalState s -> SomeServiceGlobalState SomeServiceGlobalState Proxy s p (Proxy s -> ServiceGlobalState s forall s (proxy :: * -> *). Service s => proxy s -> ServiceGlobalState s forall (proxy :: * -> *). proxy s -> ServiceGlobalState s emptyServiceGlobalState Proxy s p) data SomeStorageWatcher s = forall a. Eq a => SomeStorageWatcher (Stored LocalState -> a) (a -> ServiceHandler s ()) newtype ServiceID = ServiceID UUID deriving (ServiceID -> ServiceID -> Bool (ServiceID -> ServiceID -> Bool) -> (ServiceID -> ServiceID -> Bool) -> Eq ServiceID forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: ServiceID -> ServiceID -> Bool == :: ServiceID -> ServiceID -> Bool $c/= :: ServiceID -> ServiceID -> Bool /= :: ServiceID -> ServiceID -> Bool Eq, Eq ServiceID Eq ServiceID => (ServiceID -> ServiceID -> Ordering) -> (ServiceID -> ServiceID -> Bool) -> (ServiceID -> ServiceID -> Bool) -> (ServiceID -> ServiceID -> Bool) -> (ServiceID -> ServiceID -> Bool) -> (ServiceID -> ServiceID -> ServiceID) -> (ServiceID -> ServiceID -> ServiceID) -> Ord ServiceID ServiceID -> ServiceID -> Bool ServiceID -> ServiceID -> Ordering ServiceID -> ServiceID -> ServiceID forall a. Eq a => (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a $ccompare :: ServiceID -> ServiceID -> Ordering compare :: ServiceID -> ServiceID -> Ordering $c< :: ServiceID -> ServiceID -> Bool < :: ServiceID -> ServiceID -> Bool $c<= :: ServiceID -> ServiceID -> Bool <= :: ServiceID -> ServiceID -> Bool $c> :: ServiceID -> ServiceID -> Bool > :: ServiceID -> ServiceID -> Bool $c>= :: ServiceID -> ServiceID -> Bool >= :: ServiceID -> ServiceID -> Bool $cmax :: ServiceID -> ServiceID -> ServiceID max :: ServiceID -> ServiceID -> ServiceID $cmin :: ServiceID -> ServiceID -> ServiceID min :: ServiceID -> ServiceID -> ServiceID Ord, Int -> ServiceID -> ShowS [ServiceID] -> ShowS ServiceID -> String (Int -> ServiceID -> ShowS) -> (ServiceID -> String) -> ([ServiceID] -> ShowS) -> Show ServiceID forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> ServiceID -> ShowS showsPrec :: Int -> ServiceID -> ShowS $cshow :: ServiceID -> String show :: ServiceID -> String $cshowList :: [ServiceID] -> ShowS showList :: [ServiceID] -> ShowS Show, UUID -> ServiceID ServiceID -> UUID (ServiceID -> UUID) -> (UUID -> ServiceID) -> StorableUUID ServiceID forall a. (a -> UUID) -> (UUID -> a) -> StorableUUID a $ctoUUID :: ServiceID -> UUID toUUID :: ServiceID -> UUID $cfromUUID :: UUID -> ServiceID fromUUID :: UUID -> ServiceID StorableUUID) mkServiceID :: String -> ServiceID mkServiceID :: String -> ServiceID mkServiceID = ServiceID -> (UUID -> ServiceID) -> Maybe UUID -> ServiceID forall b a. b -> (a -> b) -> Maybe a -> b maybe (String -> ServiceID forall a. HasCallStack => String -> a error String "Invalid service ID") UUID -> ServiceID ServiceID (Maybe UUID -> ServiceID) -> (String -> Maybe UUID) -> String -> ServiceID forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Maybe UUID U.fromString data ServiceInput s = ServiceInput { forall s. ServiceInput s -> ServiceAttributes s svcAttributes :: ServiceAttributes s , forall s. ServiceInput s -> Peer svcPeer :: Peer , forall s. ServiceInput s -> UnifiedIdentity svcPeerIdentity :: UnifiedIdentity , forall s. ServiceInput s -> Server svcServer :: Server , forall s. ServiceInput s -> String -> IO () svcPrintOp :: String -> IO () } data ServiceReply s = ServiceReply (Either s (Stored s)) Bool | ServiceFinally (IO ()) data ServiceHandlerState s = ServiceHandlerState { forall s. ServiceHandlerState s -> ServiceState s svcValue :: ServiceState s , forall s. ServiceHandlerState s -> ServiceGlobalState s svcGlobal :: ServiceGlobalState s , forall s. ServiceHandlerState s -> Stored LocalState svcLocal :: Stored LocalState } newtype ServiceHandler s a = ServiceHandler (ReaderT (ServiceInput s) (WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO))) a) deriving ((forall a b. (a -> b) -> ServiceHandler s a -> ServiceHandler s b) -> (forall a b. a -> ServiceHandler s b -> ServiceHandler s a) -> Functor (ServiceHandler s) forall a b. a -> ServiceHandler s b -> ServiceHandler s a forall a b. (a -> b) -> ServiceHandler s a -> ServiceHandler s b forall s a b. a -> ServiceHandler s b -> ServiceHandler s a forall s a b. (a -> b) -> ServiceHandler s a -> ServiceHandler s b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f $cfmap :: forall s a b. (a -> b) -> ServiceHandler s a -> ServiceHandler s b fmap :: forall a b. (a -> b) -> ServiceHandler s a -> ServiceHandler s b $c<$ :: forall s a b. a -> ServiceHandler s b -> ServiceHandler s a <$ :: forall a b. a -> ServiceHandler s b -> ServiceHandler s a Functor, Functor (ServiceHandler s) Functor (ServiceHandler s) => (forall a. a -> ServiceHandler s a) -> (forall a b. ServiceHandler s (a -> b) -> ServiceHandler s a -> ServiceHandler s b) -> (forall a b c. (a -> b -> c) -> ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s c) -> (forall a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s b) -> (forall a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s a) -> Applicative (ServiceHandler s) forall s. Functor (ServiceHandler s) forall a. a -> ServiceHandler s a forall s a. a -> ServiceHandler s a forall a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s a forall a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s b forall a b. ServiceHandler s (a -> b) -> ServiceHandler s a -> ServiceHandler s b forall s a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s a forall s a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s b forall s a b. ServiceHandler s (a -> b) -> ServiceHandler s a -> ServiceHandler s b forall a b c. (a -> b -> c) -> ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s c forall s a b c. (a -> b -> c) -> ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s c forall (f :: * -> *). Functor f => (forall a. a -> f a) -> (forall a b. f (a -> b) -> f a -> f b) -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c) -> (forall a b. f a -> f b -> f b) -> (forall a b. f a -> f b -> f a) -> Applicative f $cpure :: forall s a. a -> ServiceHandler s a pure :: forall a. a -> ServiceHandler s a $c<*> :: forall s a b. ServiceHandler s (a -> b) -> ServiceHandler s a -> ServiceHandler s b <*> :: forall a b. ServiceHandler s (a -> b) -> ServiceHandler s a -> ServiceHandler s b $cliftA2 :: forall s a b c. (a -> b -> c) -> ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s c liftA2 :: forall a b c. (a -> b -> c) -> ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s c $c*> :: forall s a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s b *> :: forall a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s b $c<* :: forall s a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s a <* :: forall a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s a Applicative, Applicative (ServiceHandler s) Applicative (ServiceHandler s) => (forall a b. ServiceHandler s a -> (a -> ServiceHandler s b) -> ServiceHandler s b) -> (forall a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s b) -> (forall a. a -> ServiceHandler s a) -> Monad (ServiceHandler s) forall s. Applicative (ServiceHandler s) forall a. a -> ServiceHandler s a forall s a. a -> ServiceHandler s a forall a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s b forall a b. ServiceHandler s a -> (a -> ServiceHandler s b) -> ServiceHandler s b forall s a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s b forall s a b. ServiceHandler s a -> (a -> ServiceHandler s b) -> ServiceHandler s b forall (m :: * -> *). Applicative m => (forall a b. m a -> (a -> m b) -> m b) -> (forall a b. m a -> m b -> m b) -> (forall a. a -> m a) -> Monad m $c>>= :: forall s a b. ServiceHandler s a -> (a -> ServiceHandler s b) -> ServiceHandler s b >>= :: forall a b. ServiceHandler s a -> (a -> ServiceHandler s b) -> ServiceHandler s b $c>> :: forall s a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s b >> :: forall a b. ServiceHandler s a -> ServiceHandler s b -> ServiceHandler s b $creturn :: forall s a. a -> ServiceHandler s a return :: forall a. a -> ServiceHandler s a Monad, MonadReader (ServiceInput s), MonadWriter [ServiceReply s], MonadState (ServiceHandlerState s), MonadError String, Monad (ServiceHandler s) Monad (ServiceHandler s) => (forall a. IO a -> ServiceHandler s a) -> MonadIO (ServiceHandler s) forall s. Monad (ServiceHandler s) forall a. IO a -> ServiceHandler s a forall s a. IO a -> ServiceHandler s a forall (m :: * -> *). Monad m => (forall a. IO a -> m a) -> MonadIO m $cliftIO :: forall s a. IO a -> ServiceHandler s a liftIO :: forall a. IO a -> ServiceHandler s a MonadIO) instance MonadStorage (ServiceHandler s) where getStorage :: ServiceHandler s Storage getStorage = (ServiceInput s -> Storage) -> ServiceHandler s Storage forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((ServiceInput s -> Storage) -> ServiceHandler s Storage) -> (ServiceInput s -> Storage) -> ServiceHandler s Storage forall a b. (a -> b) -> a -> b $ Peer -> Storage peerStorage (Peer -> Storage) -> (ServiceInput s -> Peer) -> ServiceInput s -> Storage forall b c a. (b -> c) -> (a -> b) -> a -> c . ServiceInput s -> Peer forall s. ServiceInput s -> Peer svcPeer instance MonadHead LocalState (ServiceHandler s) where updateLocalHead :: forall b. (Stored LocalState -> ServiceHandler s (Stored LocalState, b)) -> ServiceHandler s b updateLocalHead Stored LocalState -> ServiceHandler s (Stored LocalState, b) f = do (Stored LocalState ls, b x) <- Stored LocalState -> ServiceHandler s (Stored LocalState, b) f (Stored LocalState -> ServiceHandler s (Stored LocalState, b)) -> ServiceHandler s (Stored LocalState) -> ServiceHandler s (Stored LocalState, b) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< (ServiceHandlerState s -> Stored LocalState) -> ServiceHandler s (Stored LocalState) forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a gets ServiceHandlerState s -> Stored LocalState forall s. ServiceHandlerState s -> Stored LocalState svcLocal (ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () modify ((ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s ()) -> (ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s () forall a b. (a -> b) -> a -> b $ \ServiceHandlerState s s -> ServiceHandlerState s s { svcLocal = ls } b -> ServiceHandler s b forall a. a -> ServiceHandler s a forall (m :: * -> *) a. Monad m => a -> m a return b x runServiceHandler :: Service s => Head LocalState -> ServiceInput s -> ServiceState s -> ServiceGlobalState s -> ServiceHandler s () -> IO ([ServiceReply s], (ServiceState s, ServiceGlobalState s)) runServiceHandler :: forall s. Service s => Head LocalState -> ServiceInput s -> ServiceState s -> ServiceGlobalState s -> ServiceHandler s () -> IO ([ServiceReply s], (ServiceState s, ServiceGlobalState s)) runServiceHandler Head LocalState h ServiceInput s input ServiceState s svc ServiceGlobalState s global ServiceHandler s () shandler = do let sstate :: ServiceHandlerState s sstate = ServiceHandlerState { svcValue :: ServiceState s svcValue = ServiceState s svc, svcGlobal :: ServiceGlobalState s svcGlobal = ServiceGlobalState s global, svcLocal :: Stored LocalState svcLocal = Head LocalState -> Stored LocalState forall a. Head a -> Stored a headStoredObject Head LocalState h } ServiceHandler ReaderT (ServiceInput s) (WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO))) () handler = ServiceHandler s () shandler (ExceptT String IO ([ServiceReply s], ServiceHandlerState s) -> IO (Either String ([ServiceReply s], ServiceHandlerState s)) forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) runExceptT (ExceptT String IO ([ServiceReply s], ServiceHandlerState s) -> IO (Either String ([ServiceReply s], ServiceHandlerState s))) -> ExceptT String IO ([ServiceReply s], ServiceHandlerState s) -> IO (Either String ([ServiceReply s], ServiceHandlerState s)) forall a b. (a -> b) -> a -> b $ (StateT (ServiceHandlerState s) (ExceptT String IO) [ServiceReply s] -> ServiceHandlerState s -> ExceptT String IO ([ServiceReply s], ServiceHandlerState s)) -> ServiceHandlerState s -> StateT (ServiceHandlerState s) (ExceptT String IO) [ServiceReply s] -> ExceptT String IO ([ServiceReply s], ServiceHandlerState s) forall a b c. (a -> b -> c) -> b -> a -> c flip StateT (ServiceHandlerState s) (ExceptT String IO) [ServiceReply s] -> ServiceHandlerState s -> ExceptT String IO ([ServiceReply s], ServiceHandlerState s) forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s) runStateT ServiceHandlerState s sstate (StateT (ServiceHandlerState s) (ExceptT String IO) [ServiceReply s] -> ExceptT String IO ([ServiceReply s], ServiceHandlerState s)) -> StateT (ServiceHandlerState s) (ExceptT String IO) [ServiceReply s] -> ExceptT String IO ([ServiceReply s], ServiceHandlerState s) forall a b. (a -> b) -> a -> b $ WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO)) () -> StateT (ServiceHandlerState s) (ExceptT String IO) [ServiceReply s] forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w execWriterT (WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO)) () -> StateT (ServiceHandlerState s) (ExceptT String IO) [ServiceReply s]) -> WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO)) () -> StateT (ServiceHandlerState s) (ExceptT String IO) [ServiceReply s] forall a b. (a -> b) -> a -> b $ (ReaderT (ServiceInput s) (WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO))) () -> ServiceInput s -> WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO)) ()) -> ServiceInput s -> ReaderT (ServiceInput s) (WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO))) () -> WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO)) () forall a b c. (a -> b -> c) -> b -> a -> c flip ReaderT (ServiceInput s) (WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO))) () -> ServiceInput s -> WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO)) () forall r (m :: * -> *) a. ReaderT r m a -> r -> m a runReaderT ServiceInput s input (ReaderT (ServiceInput s) (WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO))) () -> WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO)) ()) -> ReaderT (ServiceInput s) (WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO))) () -> WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO)) () forall a b. (a -> b) -> a -> b $ ReaderT (ServiceInput s) (WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO))) () handler) IO (Either String ([ServiceReply s], ServiceHandlerState s)) -> (Either String ([ServiceReply s], ServiceHandlerState s) -> IO ([ServiceReply s], (ServiceState s, ServiceGlobalState s))) -> IO ([ServiceReply s], (ServiceState s, ServiceGlobalState s)) forall a b. IO a -> (a -> IO b) -> IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Left String err -> do ServiceInput s -> String -> IO () forall s. ServiceInput s -> String -> IO () svcPrintOp ServiceInput s input (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ String "service failed: " String -> ShowS forall a. [a] -> [a] -> [a] ++ String err ([ServiceReply s], (ServiceState s, ServiceGlobalState s)) -> IO ([ServiceReply s], (ServiceState s, ServiceGlobalState s)) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return ([], (ServiceState s svc, ServiceGlobalState s global)) Right ([ServiceReply s] rsp, ServiceHandlerState s sstate') | ServiceHandlerState s -> Stored LocalState forall s. ServiceHandlerState s -> Stored LocalState svcLocal ServiceHandlerState s sstate' Stored LocalState -> Stored LocalState -> Bool forall a. Eq a => a -> a -> Bool == ServiceHandlerState s -> Stored LocalState forall s. ServiceHandlerState s -> Stored LocalState svcLocal ServiceHandlerState s sstate -> ([ServiceReply s], (ServiceState s, ServiceGlobalState s)) -> IO ([ServiceReply s], (ServiceState s, ServiceGlobalState s)) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return ([ServiceReply s] rsp, (ServiceHandlerState s -> ServiceState s forall s. ServiceHandlerState s -> ServiceState s svcValue ServiceHandlerState s sstate', ServiceHandlerState s -> ServiceGlobalState s forall s. ServiceHandlerState s -> ServiceGlobalState s svcGlobal ServiceHandlerState s sstate')) | Bool otherwise -> Head LocalState -> Stored LocalState -> IO (Either (Maybe (Head LocalState)) (Head LocalState)) forall a (m :: * -> *). (HeadType a, MonadIO m) => Head a -> Stored a -> m (Either (Maybe (Head a)) (Head a)) replaceHead Head LocalState h (ServiceHandlerState s -> Stored LocalState forall s. ServiceHandlerState s -> Stored LocalState svcLocal ServiceHandlerState s sstate') IO (Either (Maybe (Head LocalState)) (Head LocalState)) -> (Either (Maybe (Head LocalState)) (Head LocalState) -> IO ([ServiceReply s], (ServiceState s, ServiceGlobalState s))) -> IO ([ServiceReply s], (ServiceState s, ServiceGlobalState s)) forall a b. IO a -> (a -> IO b) -> IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Left (Just Head LocalState h') -> Head LocalState -> ServiceInput s -> ServiceState s -> ServiceGlobalState s -> ServiceHandler s () -> IO ([ServiceReply s], (ServiceState s, ServiceGlobalState s)) forall s. Service s => Head LocalState -> ServiceInput s -> ServiceState s -> ServiceGlobalState s -> ServiceHandler s () -> IO ([ServiceReply s], (ServiceState s, ServiceGlobalState s)) runServiceHandler Head LocalState h' ServiceInput s input ServiceState s svc ServiceGlobalState s global ServiceHandler s () shandler Either (Maybe (Head LocalState)) (Head LocalState) _ -> ([ServiceReply s], (ServiceState s, ServiceGlobalState s)) -> IO ([ServiceReply s], (ServiceState s, ServiceGlobalState s)) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return ([ServiceReply s] rsp, (ServiceHandlerState s -> ServiceState s forall s. ServiceHandlerState s -> ServiceState s svcValue ServiceHandlerState s sstate', ServiceHandlerState s -> ServiceGlobalState s forall s. ServiceHandlerState s -> ServiceGlobalState s svcGlobal ServiceHandlerState s sstate')) svcGet :: ServiceHandler s (ServiceState s) svcGet :: forall s. ServiceHandler s (ServiceState s) svcGet = (ServiceHandlerState s -> ServiceState s) -> ServiceHandler s (ServiceState s) forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a gets ServiceHandlerState s -> ServiceState s forall s. ServiceHandlerState s -> ServiceState s svcValue svcSet :: ServiceState s -> ServiceHandler s () svcSet :: forall s. ServiceState s -> ServiceHandler s () svcSet ServiceState s x = (ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () modify ((ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s ()) -> (ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s () forall a b. (a -> b) -> a -> b $ \ServiceHandlerState s st -> ServiceHandlerState s st { svcValue = x } svcModify :: (ServiceState s -> ServiceState s) -> ServiceHandler s () svcModify :: forall s. (ServiceState s -> ServiceState s) -> ServiceHandler s () svcModify ServiceState s -> ServiceState s f = (ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () modify ((ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s ()) -> (ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s () forall a b. (a -> b) -> a -> b $ \ServiceHandlerState s st -> ServiceHandlerState s st { svcValue = f (svcValue st) } svcGetGlobal :: ServiceHandler s (ServiceGlobalState s) svcGetGlobal :: forall s. ServiceHandler s (ServiceGlobalState s) svcGetGlobal = (ServiceHandlerState s -> ServiceGlobalState s) -> ServiceHandler s (ServiceGlobalState s) forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a gets ServiceHandlerState s -> ServiceGlobalState s forall s. ServiceHandlerState s -> ServiceGlobalState s svcGlobal svcSetGlobal :: ServiceGlobalState s -> ServiceHandler s () svcSetGlobal :: forall s. ServiceGlobalState s -> ServiceHandler s () svcSetGlobal ServiceGlobalState s x = (ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () modify ((ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s ()) -> (ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s () forall a b. (a -> b) -> a -> b $ \ServiceHandlerState s st -> ServiceHandlerState s st { svcGlobal = x } svcModifyGlobal :: (ServiceGlobalState s -> ServiceGlobalState s) -> ServiceHandler s () svcModifyGlobal :: forall s. (ServiceGlobalState s -> ServiceGlobalState s) -> ServiceHandler s () svcModifyGlobal ServiceGlobalState s -> ServiceGlobalState s f = (ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () modify ((ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s ()) -> (ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s () forall a b. (a -> b) -> a -> b $ \ServiceHandlerState s st -> ServiceHandlerState s st { svcGlobal = f (svcGlobal st) } svcGetLocal :: ServiceHandler s (Stored LocalState) svcGetLocal :: forall s. ServiceHandler s (Stored LocalState) svcGetLocal = (ServiceHandlerState s -> Stored LocalState) -> ServiceHandler s (Stored LocalState) forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a gets ServiceHandlerState s -> Stored LocalState forall s. ServiceHandlerState s -> Stored LocalState svcLocal svcSetLocal :: Stored LocalState -> ServiceHandler s () svcSetLocal :: forall s. Stored LocalState -> ServiceHandler s () svcSetLocal Stored LocalState x = (ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () modify ((ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s ()) -> (ServiceHandlerState s -> ServiceHandlerState s) -> ServiceHandler s () forall a b. (a -> b) -> a -> b $ \ServiceHandlerState s st -> ServiceHandlerState s st { svcLocal = x } svcSelf :: ServiceHandler s UnifiedIdentity svcSelf :: forall s. ServiceHandler s UnifiedIdentity svcSelf = ServiceHandler s UnifiedIdentity -> (UnifiedIdentity -> ServiceHandler s UnifiedIdentity) -> Maybe UnifiedIdentity -> ServiceHandler s UnifiedIdentity forall b a. b -> (a -> b) -> Maybe a -> b maybe (String -> ServiceHandler s UnifiedIdentity forall a. String -> ServiceHandler s a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError String "failed to validate own identity") UnifiedIdentity -> ServiceHandler s UnifiedIdentity forall a. a -> ServiceHandler s a forall (m :: * -> *) a. Monad m => a -> m a return (Maybe UnifiedIdentity -> ServiceHandler s UnifiedIdentity) -> (Stored LocalState -> Maybe UnifiedIdentity) -> Stored LocalState -> ServiceHandler s UnifiedIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c . Stored (Signed ExtendedIdentityData) -> Maybe UnifiedIdentity validateExtendedIdentity (Stored (Signed ExtendedIdentityData) -> Maybe UnifiedIdentity) -> (Stored LocalState -> Stored (Signed ExtendedIdentityData)) -> Stored LocalState -> Maybe UnifiedIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c . LocalState -> Stored (Signed ExtendedIdentityData) lsIdentity (LocalState -> Stored (Signed ExtendedIdentityData)) -> (Stored LocalState -> LocalState) -> Stored LocalState -> Stored (Signed ExtendedIdentityData) forall b c a. (b -> c) -> (a -> b) -> a -> c . Stored LocalState -> LocalState forall a. Stored a -> a fromStored (Stored LocalState -> ServiceHandler s UnifiedIdentity) -> ServiceHandler s (Stored LocalState) -> ServiceHandler s UnifiedIdentity forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< ServiceHandler s (Stored LocalState) forall s. ServiceHandler s (Stored LocalState) svcGetLocal svcPrint :: String -> ServiceHandler s () svcPrint :: forall s. String -> ServiceHandler s () svcPrint String str = IO () -> ServiceHandler s () forall s. IO () -> ServiceHandler s () afterCommit (IO () -> ServiceHandler s ()) -> ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> ServiceHandler s () forall b c a. (b -> c) -> (a -> b) -> a -> c . ((String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ String str) ((String -> IO ()) -> ServiceHandler s ()) -> ServiceHandler s (String -> IO ()) -> ServiceHandler s () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< (ServiceInput s -> String -> IO ()) -> ServiceHandler s (String -> IO ()) forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ServiceInput s -> String -> IO () forall s. ServiceInput s -> String -> IO () svcPrintOp replyPacket :: Service s => s -> ServiceHandler s () replyPacket :: forall s. Service s => s -> ServiceHandler s () replyPacket s x = [ServiceReply s] -> ServiceHandler s () forall w (m :: * -> *). MonadWriter w m => w -> m () tell [Either s (Stored s) -> Bool -> ServiceReply s forall s. Either s (Stored s) -> Bool -> ServiceReply s ServiceReply (s -> Either s (Stored s) forall a b. a -> Either a b Left s x) Bool True] replyStored :: Service s => Stored s -> ServiceHandler s () replyStored :: forall s. Service s => Stored s -> ServiceHandler s () replyStored Stored s x = [ServiceReply s] -> ServiceHandler s () forall w (m :: * -> *). MonadWriter w m => w -> m () tell [Either s (Stored s) -> Bool -> ServiceReply s forall s. Either s (Stored s) -> Bool -> ServiceReply s ServiceReply (Stored s -> Either s (Stored s) forall a b. b -> Either a b Right Stored s x) Bool True] replyStoredRef :: Service s => Stored s -> ServiceHandler s () replyStoredRef :: forall s. Service s => Stored s -> ServiceHandler s () replyStoredRef Stored s x = [ServiceReply s] -> ServiceHandler s () forall w (m :: * -> *). MonadWriter w m => w -> m () tell [Either s (Stored s) -> Bool -> ServiceReply s forall s. Either s (Stored s) -> Bool -> ServiceReply s ServiceReply (Stored s -> Either s (Stored s) forall a b. b -> Either a b Right Stored s x) Bool False] afterCommit :: IO () -> ServiceHandler s () afterCommit :: forall s. IO () -> ServiceHandler s () afterCommit IO () x = [ServiceReply s] -> ServiceHandler s () forall w (m :: * -> *). MonadWriter w m => w -> m () tell [IO () -> ServiceReply s forall s. IO () -> ServiceReply s ServiceFinally IO () x]