Skip to content

Instantly share code, notes, and snippets.

@voidlizard
Created March 22, 2024 07:33
Show Gist options
  • Save voidlizard/c6df3b72f9659a803c6d376b26861aa2 to your computer and use it in GitHub Desktop.
Save voidlizard/c6df3b72f9659a803c6d376b26861aa2 to your computer and use it in GitHub Desktop.
import Test.Tasty.HUnit
instance HasFabriq UNIX (ReaderT (AnyStorage, MessagingUnix) IO) where
getFabriq = asks (Fabriq . snd)
instance HasOwnPeer UNIX (ReaderT (AnyStorage, MessagingUnix) IO) where
ownPeer = asks ( msgUnixSelf . snd)
instance Monad m => HasStorage (ReaderT (AnyStorage, MessagingUnix) m) where
getStorage = asks fst
main :: IO ()
main = do
setLogging @DEBUG (logPrefix "[debug] ")
setLogging @INFO (logPrefix "")
withSystemTempDirectory "storageRpcTest" $ \dir -> do
let soname = dir </> "rpc.socket"
let opts = [ StoragePrefix (dir </> ".storage")
]
sto <- simpleStorageInit @HbSync opts
worker <- async (simpleStorageWorker sto)
link worker
let blk1 = "AAAAA"
h1 <- putBlock sto blk1 `orDie` "can't write block"
debug $ "written" <+> pretty h1
let rk1 = SomeRefKey ("SOMEREFKEY1" :: LBS.ByteString)
updateRef sto rk1 h1
rk1val <- getRef sto rk1
info $ "rk1val:" <+> pretty rk1val
rk1val1 <- getRef sto (refAlias rk1)
info $ "rk1val1:" <+> pretty rk1val1
assertBool "ref-alias-works-1" ( fromJust rk1val == fromJust rk1val1 )
server <- newMessagingUnix True 1.0 soname
m1 <- async $ runMessagingUnix server
link m1
proto <- async $ flip runReaderT (AnyStorage sto, server) do
runProto @UNIX
[ makeResponse (makeServer @StorageAPI)
]
link proto
withRPC2 @StorageAPI soname $ \caller -> do
let cto = StorageClient caller
info "does it work?"
size <- callService @RpcStorageHasBlock caller (HashRef h1) `orDie` "can't read block"
size2 <- hasBlock cto h1
info $ "got block size: " <+> pretty size <+> pretty size2
assertBool "block-size-1" (size == Just (fromIntegral $ LBS.length blk1))
assertBool "block-size-1.1" (fromJust size == fromJust size2)
b <- callService @RpcStorageGetBlock caller (HashRef h1) `orDie` "can't read block"
b1 <- getBlock cto h1 `orDie` "cant read block via storage"
info $ "got block (0)" <+> viaShow b <+> viaShow b1
assertBool "block-eq-1" ( b == Just blk1 )
assertBool "block-eq-1.1" ( b1 == blk1 )
let pechen = "PECHENTERSKI"
h2 <- callService @RpcStoragePutBlock caller pechen `orDie` "service error"
info $ "stored block hash:" <+> pretty h2
let hh2 = fromJust h2
let jopakita = "JOPAKITA"
h3 <- putBlock cto jopakita `orDie` "cant store block via client storage"
blk3 <- getBlock cto h3 `orDie` "cant read block via client storage"
info $ "stored block value" <+> viaShow jopakita <+> viaShow blk3
blk2 <- callService @RpcStorageGetBlock caller hh2 `orDie` "block lookup failed"
info $ "stored block value:" <+> viaShow blk2
assertBool "block-eq-2.1" (Just pechen == blk2)
assertBool "block-eq-2.2" (jopakita == blk3)
let rk2 = refAlias rk1
rk2val <- callService @RpcStorageGetRef caller rk2 `orDie` "can't read ref"
info $ "rk2val:" <+> pretty rk2val
assertBool "ref-alias-works-2" (fromJust rk2val == HashRef h1)
callService @RpcStorageUpdateRef caller (rk2, hh2)
rk3val <- callService @RpcStorageGetRef caller rk2 `orDie` "can't update ref"
info $ "rk3val" <+> pretty rk3val
assertBool "ref-alias-update-works-1" (fromJust rk3val == hh2)
rk4val <- getRef sto rk1
info $ "rk4val" <+> pretty rk4val
assertBool "ref-alias-works-2" (fromJust rk4val == fromHashRef hh2)
updateRef cto (SomeRefKey jopakita) h3
vjopa <- getRef cto (SomeRefKey jopakita)
info $ "refkey via client storage" <+> pretty vjopa <+> pretty h3
assertBool "ref-alias-works-3" (vjopa == Just h3)
let aaa = LBS8.replicate (256 * 1024 * 10) 'A'
aaaHref <- OP.writeAsMerkle cto aaa
info $ "writeAsMerkle" <+> pretty aaaHref
aaaWat <- runExceptT (OP.readFromMerkle cto (SimpleKey aaaHref)) `orDie` "readFromMerkle failed"
info $ "readFromMerkle" <+> pretty (LBS.length aaaWat)
assertBool "read/write" (aaa == aaaWat)
pure ()
setLoggingOff @DEBUG
setLoggingOff @INFO
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment