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]