summaryrefslogtreecommitdiff
path: root/main/Test
diff options
context:
space:
mode:
Diffstat (limited to 'main/Test')
-rw-r--r--main/Test/Service.hs37
-rw-r--r--main/Test/State.hs24
2 files changed, 59 insertions, 2 deletions
diff --git a/main/Test/Service.hs b/main/Test/Service.hs
index 3e6eb83..c952c86 100644
--- a/main/Test/Service.hs
+++ b/main/Test/Service.hs
@@ -1,20 +1,30 @@
module Test.Service (
TestMessage(..),
TestMessageAttributes(..),
+
+ openTestStreams,
) where
+import Control.Monad
import Control.Monad.Reader
import Data.ByteString.Lazy.Char8 qualified as BL
+import Data.Word
+import Erebos.Identity
import Erebos.Network
+import Erebos.Object
+import Erebos.Object.Deferred
import Erebos.Service
-import Erebos.Storage
+import Erebos.Service.Stream
+import Erebos.Storable
data TestMessage = TestMessage (Stored Object)
data TestMessageAttributes = TestMessageAttributes
{ testMessageReceived :: Object -> String -> String -> String -> ServiceHandler TestMessage ()
+ , testStreamsReceived :: [ StreamReader ] -> ServiceHandler TestMessage ()
+ , testOnDemandReceived :: Word64 -> Deferred Object -> ServiceHandler TestMessage ()
}
instance Storable TestMessage where
@@ -25,7 +35,11 @@ instance Service TestMessage where
serviceID _ = mkServiceID "cb46b92c-9203-4694-8370-8742d8ac9dc8"
type ServiceAttributes TestMessage = TestMessageAttributes
- defaultServiceAttributes _ = TestMessageAttributes (\_ _ _ _ -> return ())
+ defaultServiceAttributes _ = TestMessageAttributes
+ { testMessageReceived = \_ _ _ _ -> return ()
+ , testStreamsReceived = \_ -> return ()
+ , testOnDemandReceived = \_ _ -> return ()
+ }
serviceHandler smsg = do
let TestMessage sobj = fromStored smsg
@@ -35,3 +49,22 @@ instance Service TestMessage where
cb <- asks $ testMessageReceived . svcAttributes
cb obj otype len (show $ refDigest $ storedRef sobj)
_ -> return ()
+
+ streams <- receivedStreams
+ when (not $ null streams) $ do
+ cb <- asks $ testStreamsReceived . svcAttributes
+ cb streams
+
+ case obj of
+ OnDemand size dgst -> do
+ cb <- asks $ testOnDemandReceived . svcAttributes
+ server <- asks svcServer
+ pid <- asks svcPeerIdentity
+ cb size =<< liftIO (deferLoadWithServer dgst (DeferredExactSize size) server [ refDigest $ storedRef $ idData pid ])
+ _ -> return ()
+
+
+openTestStreams :: Int -> ServiceHandler TestMessage [ StreamWriter ]
+openTestStreams count = do
+ replyPacket . TestMessage =<< mstore (Rec [])
+ replicateM count openStream
diff --git a/main/Test/State.hs b/main/Test/State.hs
new file mode 100644
index 0000000..3ef1558
--- /dev/null
+++ b/main/Test/State.hs
@@ -0,0 +1,24 @@
+module Test.State (
+ CustomSharedState(..),
+) where
+
+import Data.Proxy
+
+import GHC.TypeLits
+
+import Erebos.Object
+import Erebos.State
+import Erebos.Storage.Merge
+
+
+data CustomSharedState (tid :: Symbol) = CustomSharedState
+ { customStateComponents :: StoredTips Object
+ }
+
+instance Mergeable (CustomSharedState tid) where
+ type Component (CustomSharedState tid) = Object
+ toComponents = customStateComponents
+ mergeSorted = CustomSharedState
+
+instance KnownSymbol tid => SharedType (CustomSharedState tid) where
+ sharedTypeID _ = mkSharedTypeID (symbolVal @tid Proxy)