{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Ledger.CanonicalState.BasicTypes (
  OnChain (..),
  DecodeOnChain (..),
) where

import Cardano.SCLS.CBOR.Canonical (CanonicalDecoder)
import Cardano.SCLS.CBOR.Canonical.Decoder (FromCanonicalCBOR (..))
import Cardano.SCLS.CBOR.Canonical.Encoder (ToCanonicalCBOR (..))
import Cardano.SCLS.Versioned
import qualified Data.ByteString as BS (ByteString)
import qualified Data.ByteString.Base16 as Base16
import Data.Kind (Type)
import GHC.Generics (Generic)
import GHC.TypeLits (Symbol)

-- | Wrapper type that tells that the type is the type that is kept on-chain
-- for such types we want to keep exactly the same encoding as on the wire.
--
-- We still tag the type with an original one to be able to distinguish between
-- them.
data OnChain (a :: Type) = OnChain {forall a. OnChain a -> a
getValue :: !a, forall a. OnChain a -> ByteString
getWireEncoding :: !BS.ByteString}
  deriving stock ((forall x. OnChain a -> Rep (OnChain a) x)
-> (forall x. Rep (OnChain a) x -> OnChain a)
-> Generic (OnChain a)
forall x. Rep (OnChain a) x -> OnChain a
forall x. OnChain a -> Rep (OnChain a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (OnChain a) x -> OnChain a
forall a x. OnChain a -> Rep (OnChain a) x
$cfrom :: forall a x. OnChain a -> Rep (OnChain a) x
from :: forall x. OnChain a -> Rep (OnChain a) x
$cto :: forall a x. Rep (OnChain a) x -> OnChain a
to :: forall x. Rep (OnChain a) x -> OnChain a
Generic)

instance Eq a => Eq (OnChain a) where
  (OnChain a
_ ByteString
bs1) == :: OnChain a -> OnChain a -> Bool
== (OnChain a
_ ByteString
bs2) = ByteString
bs1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bs2

instance Ord a => Ord (OnChain a) where
  compare :: OnChain a -> OnChain a -> Ordering
compare (OnChain a
_ ByteString
bs1) (OnChain a
_ ByteString
bs2) = ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ByteString
bs1 ByteString
bs2

instance Show a => Show (OnChain a) where
  show :: OnChain a -> String
show (OnChain a
a ByteString
b) = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> ByteString
Base16.encode ByteString
b) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a

instance ToCanonicalCBOR v (OnChain a) where
  toCanonicalCBOR :: forall (proxy :: Symbol -> *).
proxy v -> OnChain a -> CanonicalEncoding
toCanonicalCBOR proxy v
v (OnChain a
_ ByteString
bs) = proxy v -> ByteString -> CanonicalEncoding
forall (v :: Symbol) a (proxy :: Symbol -> *).
ToCanonicalCBOR v a =>
proxy v -> a -> CanonicalEncoding
forall (proxy :: Symbol -> *).
proxy v -> ByteString -> CanonicalEncoding
toCanonicalCBOR proxy v
v ByteString
bs

instance DecodeOnChain v a => FromCanonicalCBOR v (OnChain a) where
  fromCanonicalCBOR :: forall s. CanonicalDecoder s (Versioned v (OnChain a))
fromCanonicalCBOR = do
    Versioned bs <- CanonicalDecoder s (Versioned (ZonkAny 0) ByteString)
forall s. CanonicalDecoder s (Versioned (ZonkAny 0) ByteString)
forall (v :: Symbol) a s.
FromCanonicalCBOR v a =>
CanonicalDecoder s (Versioned v a)
fromCanonicalCBOR
    a <- decodeOnChain @v bs
    return $ Versioned (OnChain a bs)

-- | Helper types to encode on-chain types, it's used so
-- it would be possible to pass input bytestring to
-- `toPlainDecoder`.
class DecodeOnChain (v :: Symbol) (a :: Type) where
  decodeOnChain :: BS.ByteString -> CanonicalDecoder s a