{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.CanonicalState.Namespace.Blocks.V0 (
  BlockIn (..),
  BlockOut (..),
) where

import Cardano.Ledger.BaseTypes (EpochNo (..))
import Cardano.Ledger.Keys (KeyHash, StakePool)
import Cardano.SCLS.CBOR.Canonical.Decoder as D
import Cardano.SCLS.CBOR.Canonical.Encoder (ToCanonicalCBOR (..))
import Cardano.SCLS.CDDL ()
import Cardano.SCLS.Entry.IsKey (IsKey (..))
import Cardano.SCLS.NamespaceCodec (
  CanonicalCBOREntryDecoder (..),
  CanonicalCBOREntryEncoder (..),
  KnownNamespace (..),
  namespaceKeySize,
 )
import Data.MemPack (MemPack (..))
import Data.MemPack.ByteOrdered (packWord64beM, unpackBigEndianM)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import GHC.Num.Natural (Natural)

-- | Definition of the namespace.
instance KnownNamespace "blocks/v0" where
  type NamespaceKey "blocks/v0" = BlockIn
  type NamespaceEntry "blocks/v0" = BlockOut

data BlockIn = BlockIn
  { BlockIn -> KeyHash StakePool
blockInStakePoolId :: !(KeyHash StakePool)
  , BlockIn -> EpochNo
blockInEpochNo :: !EpochNo
  }
  deriving stock (BlockIn -> BlockIn -> Bool
(BlockIn -> BlockIn -> Bool)
-> (BlockIn -> BlockIn -> Bool) -> Eq BlockIn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockIn -> BlockIn -> Bool
== :: BlockIn -> BlockIn -> Bool
$c/= :: BlockIn -> BlockIn -> Bool
/= :: BlockIn -> BlockIn -> Bool
Eq, Eq BlockIn
Eq BlockIn =>
(BlockIn -> BlockIn -> Ordering)
-> (BlockIn -> BlockIn -> Bool)
-> (BlockIn -> BlockIn -> Bool)
-> (BlockIn -> BlockIn -> Bool)
-> (BlockIn -> BlockIn -> Bool)
-> (BlockIn -> BlockIn -> BlockIn)
-> (BlockIn -> BlockIn -> BlockIn)
-> Ord BlockIn
BlockIn -> BlockIn -> Bool
BlockIn -> BlockIn -> Ordering
BlockIn -> BlockIn -> BlockIn
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 :: BlockIn -> BlockIn -> Ordering
compare :: BlockIn -> BlockIn -> Ordering
$c< :: BlockIn -> BlockIn -> Bool
< :: BlockIn -> BlockIn -> Bool
$c<= :: BlockIn -> BlockIn -> Bool
<= :: BlockIn -> BlockIn -> Bool
$c> :: BlockIn -> BlockIn -> Bool
> :: BlockIn -> BlockIn -> Bool
$c>= :: BlockIn -> BlockIn -> Bool
>= :: BlockIn -> BlockIn -> Bool
$cmax :: BlockIn -> BlockIn -> BlockIn
max :: BlockIn -> BlockIn -> BlockIn
$cmin :: BlockIn -> BlockIn -> BlockIn
min :: BlockIn -> BlockIn -> BlockIn
Ord, Int -> BlockIn -> ShowS
[BlockIn] -> ShowS
BlockIn -> String
(Int -> BlockIn -> ShowS)
-> (BlockIn -> String) -> ([BlockIn] -> ShowS) -> Show BlockIn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockIn -> ShowS
showsPrec :: Int -> BlockIn -> ShowS
$cshow :: BlockIn -> String
show :: BlockIn -> String
$cshowList :: [BlockIn] -> ShowS
showList :: [BlockIn] -> ShowS
Show, (forall x. BlockIn -> Rep BlockIn x)
-> (forall x. Rep BlockIn x -> BlockIn) -> Generic BlockIn
forall x. Rep BlockIn x -> BlockIn
forall x. BlockIn -> Rep BlockIn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockIn -> Rep BlockIn x
from :: forall x. BlockIn -> Rep BlockIn x
$cto :: forall x. Rep BlockIn x -> BlockIn
to :: forall x. Rep BlockIn x -> BlockIn
Generic)

instance IsKey BlockIn where
  keySize :: Int
keySize = forall (ns :: Symbol). KnownNat (NamespaceKeySize ns) => Int
namespaceKeySize @"blocks/v0"
  packKeyM :: forall b. BlockIn -> Pack b ()
packKeyM (BlockIn KeyHash StakePool
kh (EpochNo Word64
epochNo)) = do
    KeyHash StakePool -> Pack b ()
forall s. KeyHash StakePool -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM KeyHash StakePool
kh
    Word64 -> Pack b ()
forall s. Word64 -> Pack s ()
packWord64beM Word64
epochNo
  unpackKeyM :: forall b s. Buffer b => Unpack' s b BlockIn
unpackKeyM = do
    a <- Unpack s b (KeyHash StakePool)
forall a b s. (MemPack a, Buffer b) => Unpack s b a
forall b s. Buffer b => Unpack s b (KeyHash StakePool)
unpackM
    epochNo <- unpackBigEndianM
    return $ BlockIn a (EpochNo epochNo)

-- Top level encoding/decoding

instance CanonicalCBOREntryEncoder "blocks/v0" BlockOut where
  encodeEntry :: BlockOut -> CanonicalEncoding
encodeEntry (BlockOut Natural
n) = Proxy "blocks/v0" -> BlockOut -> CanonicalEncoding
forall (v :: Symbol) a (proxy :: Symbol -> *).
ToCanonicalCBOR v a =>
proxy v -> a -> CanonicalEncoding
forall (proxy :: Symbol -> *).
proxy "blocks/v0" -> BlockOut -> CanonicalEncoding
toCanonicalCBOR (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @"blocks/v0") (Natural -> BlockOut
BlockOut Natural
n)

instance CanonicalCBOREntryDecoder "blocks/v0" BlockOut where
  decodeEntry :: forall s. CanonicalDecoder s (Versioned "blocks/v0" BlockOut)
decodeEntry = CanonicalDecoder s (Versioned "blocks/v0" BlockOut)
forall s. CanonicalDecoder s (Versioned "blocks/v0" BlockOut)
forall (v :: Symbol) a s.
FromCanonicalCBOR v a =>
CanonicalDecoder s (Versioned v a)
fromCanonicalCBOR

newtype BlockOut = BlockOut Natural
  deriving stock (BlockOut -> BlockOut -> Bool
(BlockOut -> BlockOut -> Bool)
-> (BlockOut -> BlockOut -> Bool) -> Eq BlockOut
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockOut -> BlockOut -> Bool
== :: BlockOut -> BlockOut -> Bool
$c/= :: BlockOut -> BlockOut -> Bool
/= :: BlockOut -> BlockOut -> Bool
Eq, Eq BlockOut
Eq BlockOut =>
(BlockOut -> BlockOut -> Ordering)
-> (BlockOut -> BlockOut -> Bool)
-> (BlockOut -> BlockOut -> Bool)
-> (BlockOut -> BlockOut -> Bool)
-> (BlockOut -> BlockOut -> Bool)
-> (BlockOut -> BlockOut -> BlockOut)
-> (BlockOut -> BlockOut -> BlockOut)
-> Ord BlockOut
BlockOut -> BlockOut -> Bool
BlockOut -> BlockOut -> Ordering
BlockOut -> BlockOut -> BlockOut
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 :: BlockOut -> BlockOut -> Ordering
compare :: BlockOut -> BlockOut -> Ordering
$c< :: BlockOut -> BlockOut -> Bool
< :: BlockOut -> BlockOut -> Bool
$c<= :: BlockOut -> BlockOut -> Bool
<= :: BlockOut -> BlockOut -> Bool
$c> :: BlockOut -> BlockOut -> Bool
> :: BlockOut -> BlockOut -> Bool
$c>= :: BlockOut -> BlockOut -> Bool
>= :: BlockOut -> BlockOut -> Bool
$cmax :: BlockOut -> BlockOut -> BlockOut
max :: BlockOut -> BlockOut -> BlockOut
$cmin :: BlockOut -> BlockOut -> BlockOut
min :: BlockOut -> BlockOut -> BlockOut
Ord, Int -> BlockOut -> ShowS
[BlockOut] -> ShowS
BlockOut -> String
(Int -> BlockOut -> ShowS)
-> (BlockOut -> String) -> ([BlockOut] -> ShowS) -> Show BlockOut
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockOut -> ShowS
showsPrec :: Int -> BlockOut -> ShowS
$cshow :: BlockOut -> String
show :: BlockOut -> String
$cshowList :: [BlockOut] -> ShowS
showList :: [BlockOut] -> ShowS
Show, (forall x. BlockOut -> Rep BlockOut x)
-> (forall x. Rep BlockOut x -> BlockOut) -> Generic BlockOut
forall x. Rep BlockOut x -> BlockOut
forall x. BlockOut -> Rep BlockOut x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockOut -> Rep BlockOut x
from :: forall x. BlockOut -> Rep BlockOut x
$cto :: forall x. Rep BlockOut x -> BlockOut
to :: forall x. Rep BlockOut x -> BlockOut
Generic)
  deriving newtype (ToCanonicalCBOR v, FromCanonicalCBOR v)