{-# LANGUAGE TypeApplications #-}

module Test.Ouroboros.Storage.LedgerDB.Serialisation (tests) where

import           Codec.CBOR.FlatTerm (FlatTerm, TermToken (..), fromFlatTerm,
                     toFlatTerm)
import           Codec.Serialise (decode, encode)
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Storage.LedgerDB.Snapshots
import           Test.Tasty
import           Test.Tasty.HUnit
import           Test.Util.Orphans.Arbitrary ()
import           Test.Util.TestBlock

tests :: TestTree
tests :: TestTree
tests = String -> [TestTree] -> TestTree
testGroup String
"Serialisation" [
          String -> Assertion -> TestTree
testCase     String
"encode"                 Assertion
test_encode_ledger
        , String -> Assertion -> TestTree
testCase     String
"decode"                 Assertion
test_decode_ledger
        , String -> Assertion -> TestTree
testCase     String
"decode ChainSummary"    Assertion
test_decode_ChainSummary
        ]

{-------------------------------------------------------------------------------
  Serialisation
-------------------------------------------------------------------------------}

-- | The LedgerDB is parametric in the ledger @l@. We use @Int@ for simplicity.
example_ledger :: Int
example_ledger :: Int
example_ledger = Int
100

golden_ledger :: FlatTerm
golden_ledger :: FlatTerm
golden_ledger =
    [ Word -> TermToken
TkListLen Word
2
      -- VersionNumber
    , Int -> TermToken
TkInt Int
1
      -- ledger: Int
    , Int -> TermToken
TkInt Int
100
    ]

-- | The old format based on the @ChainSummary@. To remain backwards compatible
-- we still accept this old format.
golden_ChainSummary :: FlatTerm
golden_ChainSummary :: FlatTerm
golden_ChainSummary =
    [ Word -> TermToken
TkListLen Word
3
      -- tip: WithOrigin (RealPoint TestBlock)
    , Word -> TermToken
TkListLen Word
1
    , Word -> TermToken
TkListLen Word
2
    , Int -> TermToken
TkInt Int
3
    , TermToken
TkListBegin, Int -> TermToken
TkInt Int
0, Int -> TermToken
TkInt Int
0, TermToken
TkBreak
      -- chain length: Word64
    , Int -> TermToken
TkInt Int
10
      -- ledger: Int for simplicity
    , Int -> TermToken
TkInt Int
100
    ]

test_encode_ledger :: Assertion
test_encode_ledger :: Assertion
test_encode_ledger =
    Encoding -> FlatTerm
toFlatTerm (Int -> Encoding
enc Int
example_ledger) FlatTerm -> FlatTerm -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= FlatTerm
golden_ledger
  where
    enc :: Int -> Encoding
enc = (Int -> Encoding) -> Int -> Encoding
forall l. (l -> Encoding) -> l -> Encoding
encodeL Int -> Encoding
forall a. Serialise a => a -> Encoding
encode

test_decode_ledger :: Assertion
test_decode_ledger :: Assertion
test_decode_ledger =
    (forall s. Decoder s Int) -> FlatTerm -> Either String Int
forall a. (forall s. Decoder s a) -> FlatTerm -> Either String a
fromFlatTerm Decoder s Int
forall s. Decoder s Int
dec FlatTerm
golden_ledger Either String Int -> Either String Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int -> Either String Int
forall a b. b -> Either a b
Right Int
example_ledger
  where
    dec :: Decoder s Int
dec = Proxy TestBlock
-> (forall s. Decoder s Int)
-> (forall s. Decoder s (HeaderHash TestBlock))
-> forall s. Decoder s Int
forall l blk.
Proxy blk
-> (forall s. Decoder s l)
-> (forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s l
decodeLBackwardsCompatible (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @TestBlock) Decoder s Int
forall s. Decoder s Int
forall a s. Serialise a => Decoder s a
decode Decoder s (HeaderHash TestBlock)
Decoder s TestHash
forall s. Decoder s (HeaderHash TestBlock)
forall s. Decoder s TestHash
forall a s. Serialise a => Decoder s a
decode

-- | For backwards compatibility
test_decode_ChainSummary :: Assertion
test_decode_ChainSummary :: Assertion
test_decode_ChainSummary =
    (forall s. Decoder s Int) -> FlatTerm -> Either String Int
forall a. (forall s. Decoder s a) -> FlatTerm -> Either String a
fromFlatTerm Decoder s Int
forall s. Decoder s Int
dec FlatTerm
golden_ChainSummary Either String Int -> Either String Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int -> Either String Int
forall a b. b -> Either a b
Right Int
example_ledger
  where
    dec :: Decoder s Int
dec = Proxy TestBlock
-> (forall s. Decoder s Int)
-> (forall s. Decoder s (HeaderHash TestBlock))
-> forall s. Decoder s Int
forall l blk.
Proxy blk
-> (forall s. Decoder s l)
-> (forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s l
decodeLBackwardsCompatible (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @TestBlock) Decoder s Int
forall s. Decoder s Int
forall a s. Serialise a => Decoder s a
decode Decoder s (HeaderHash TestBlock)
Decoder s TestHash
forall s. Decoder s (HeaderHash TestBlock)
forall s. Decoder s TestHash
forall a s. Serialise a => Decoder s a
decode