{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Chain.Delegation.Payload (
  APayload (..),
  Payload,
  unsafePayload,
) where

import qualified Cardano.Chain.Delegation.Certificate as Delegation
import Cardano.Ledger.Binary (
  Annotated (..),
  ByteSpan,
  DecCBOR (..),
  Decoded (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  annotatedDecoder,
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude
import Data.Aeson (ToJSON)
import Formatting (bprint, int)
import Formatting.Buildable (Buildable (..))

-- | The delegation 'Payload' contains a list of delegation 'Certificate's
data APayload a = UnsafeAPayload
  { forall a. APayload a -> [ACertificate a]
getPayload :: [Delegation.ACertificate a]
  , forall a. APayload a -> a
getAnnotation :: a
  }
  deriving (Int -> APayload a -> ShowS
[APayload a] -> ShowS
APayload a -> String
(Int -> APayload a -> ShowS)
-> (APayload a -> String)
-> ([APayload a] -> ShowS)
-> Show (APayload a)
forall a. Show a => Int -> APayload a -> ShowS
forall a. Show a => [APayload a] -> ShowS
forall a. Show a => APayload a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> APayload a -> ShowS
showsPrec :: Int -> APayload a -> ShowS
$cshow :: forall a. Show a => APayload a -> String
show :: APayload a -> String
$cshowList :: forall a. Show a => [APayload a] -> ShowS
showList :: [APayload a] -> ShowS
Show, APayload a -> APayload a -> Bool
(APayload a -> APayload a -> Bool)
-> (APayload a -> APayload a -> Bool) -> Eq (APayload a)
forall a. Eq a => APayload a -> APayload a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => APayload a -> APayload a -> Bool
== :: APayload a -> APayload a -> Bool
$c/= :: forall a. Eq a => APayload a -> APayload a -> Bool
/= :: APayload a -> APayload a -> Bool
Eq, (forall x. APayload a -> Rep (APayload a) x)
-> (forall x. Rep (APayload a) x -> APayload a)
-> Generic (APayload a)
forall x. Rep (APayload a) x -> APayload a
forall x. APayload a -> Rep (APayload a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (APayload a) x -> APayload a
forall a x. APayload a -> Rep (APayload a) x
$cfrom :: forall a x. APayload a -> Rep (APayload a) x
from :: forall x. APayload a -> Rep (APayload a) x
$cto :: forall a x. Rep (APayload a) x -> APayload a
to :: forall x. Rep (APayload a) x -> APayload a
Generic, (forall a b. (a -> b) -> APayload a -> APayload b)
-> (forall a b. a -> APayload b -> APayload a) -> Functor APayload
forall a b. a -> APayload b -> APayload a
forall a b. (a -> b) -> APayload a -> APayload b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> APayload a -> APayload b
fmap :: forall a b. (a -> b) -> APayload a -> APayload b
$c<$ :: forall a b. a -> APayload b -> APayload a
<$ :: forall a b. a -> APayload b -> APayload a
Functor)
  deriving anyclass (APayload a -> ()
(APayload a -> ()) -> NFData (APayload a)
forall a. NFData a => APayload a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => APayload a -> ()
rnf :: APayload a -> ()
NFData)

type Payload = APayload ()

unsafePayload :: [Delegation.Certificate] -> Payload
unsafePayload :: [Certificate] -> Payload
unsafePayload [Certificate]
sks = [Certificate] -> () -> Payload
forall a. [ACertificate a] -> a -> APayload a
UnsafeAPayload [Certificate]
sks ()

instance Decoded (APayload ByteString) where
  type BaseType (APayload ByteString) = Payload
  recoverBytes :: APayload ByteString -> ByteString
recoverBytes = APayload ByteString -> ByteString
forall a. APayload a -> a
getAnnotation

instance Buildable (APayload a) where
  build :: APayload a -> Builder
build (UnsafeAPayload [ACertificate a]
psks a
_) =
    Format Builder (Int -> [ACertificate a] -> Builder)
-> Int -> [ACertificate a] -> Builder
forall a. Format Builder a -> a
bprint
      (Format
  (Int -> [ACertificate a] -> Builder)
  (Int -> [ACertificate a] -> Builder)
"proxy signing keys (" Format
  (Int -> [ACertificate a] -> Builder)
  (Int -> [ACertificate a] -> Builder)
-> Format Builder (Int -> [ACertificate a] -> Builder)
-> Format Builder (Int -> [ACertificate a] -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  ([ACertificate a] -> Builder) (Int -> [ACertificate a] -> Builder)
forall a r. Integral a => Format r (a -> r)
int Format
  ([ACertificate a] -> Builder) (Int -> [ACertificate a] -> Builder)
-> Format Builder ([ACertificate a] -> Builder)
-> Format Builder (Int -> [ACertificate a] -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format ([ACertificate a] -> Builder) ([ACertificate a] -> Builder)
" items): " Format ([ACertificate a] -> Builder) ([ACertificate a] -> Builder)
-> Format Builder ([ACertificate a] -> Builder)
-> Format Builder ([ACertificate a] -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder ([ACertificate a] -> Builder)
forall (t :: * -> *) a r.
(Foldable t, Buildable a) =>
Format r (t a -> r)
listJson Format Builder ([ACertificate a] -> Builder)
-> Format Builder Builder
-> Format Builder ([ACertificate a] -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
"\n")
      ([ACertificate a] -> Int
forall a. HasLength a => a -> Int
length [ACertificate a]
psks)
      [ACertificate a]
psks

-- Used for debugging purposes only
instance ToJSON a => ToJSON (APayload a)

instance ToCBOR Payload where
  toCBOR :: Payload -> Encoding
toCBOR = Payload -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR Payload where
  fromCBOR :: forall s. Decoder s Payload
fromCBOR = Decoder s Payload
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR Payload where
  encCBOR :: Payload -> Encoding
encCBOR = [Certificate] -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ([Certificate] -> Encoding)
-> (Payload -> [Certificate]) -> Payload -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Payload -> [Certificate]
forall a. APayload a -> [ACertificate a]
getPayload

instance DecCBOR Payload where
  decCBOR :: forall s. Decoder s Payload
decCBOR = APayload ByteSpan -> Payload
forall (f :: * -> *) a. Functor f => f a -> f ()
void (APayload ByteSpan -> Payload)
-> Decoder s (APayload ByteSpan) -> Decoder s Payload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR @(APayload ByteSpan)

instance FromCBOR (APayload ByteSpan) where
  fromCBOR :: forall s. Decoder s (APayload ByteSpan)
fromCBOR = Decoder s (APayload ByteSpan)
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance DecCBOR (APayload ByteSpan) where
  decCBOR :: forall s. Decoder s (APayload ByteSpan)
decCBOR = do
    (Annotated [ACertificate ByteSpan]
p ByteSpan
a) <- Decoder s [ACertificate ByteSpan]
-> Decoder s (Annotated [ACertificate ByteSpan] ByteSpan)
forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder Decoder s [ACertificate ByteSpan]
forall s. Decoder s [ACertificate ByteSpan]
forall a s. DecCBOR a => Decoder s a
decCBOR
    APayload ByteSpan -> Decoder s (APayload ByteSpan)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ACertificate ByteSpan] -> ByteSpan -> APayload ByteSpan
forall a. [ACertificate a] -> a -> APayload a
UnsafeAPayload [ACertificate ByteSpan]
p ByteSpan
a)