{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

module Cardano.Chain.Common.Compact (
  CompactAddress,
  toCompactAddress,
  fromCompactAddress,
  unsafeGetCompactAddress,
)
where

import Cardano.Chain.Common.Address (Address (..))
import Cardano.HeapWords (HeapWords)
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  byronProtVer,
  decodeFull',
  fromByronCBOR,
  serialize',
  toByronCBOR,
 )
import Cardano.Prelude
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as BSS (fromShort, toShort)
import NoThunks.Class (NoThunks (..))

--------------------------------------------------------------------------------
-- Compact Address
--------------------------------------------------------------------------------

-- | A compact in-memory representation for an 'Address'.
--
-- Convert using 'toCompactAddress' and 'fromCompactAddress'.
newtype CompactAddress = CompactAddress ShortByteString
  deriving (CompactAddress -> CompactAddress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompactAddress -> CompactAddress -> Bool
$c/= :: CompactAddress -> CompactAddress -> Bool
== :: CompactAddress -> CompactAddress -> Bool
$c== :: CompactAddress -> CompactAddress -> Bool
Eq, Eq CompactAddress
CompactAddress -> CompactAddress -> Bool
CompactAddress -> CompactAddress -> Ordering
CompactAddress -> CompactAddress -> CompactAddress
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
min :: CompactAddress -> CompactAddress -> CompactAddress
$cmin :: CompactAddress -> CompactAddress -> CompactAddress
max :: CompactAddress -> CompactAddress -> CompactAddress
$cmax :: CompactAddress -> CompactAddress -> CompactAddress
>= :: CompactAddress -> CompactAddress -> Bool
$c>= :: CompactAddress -> CompactAddress -> Bool
> :: CompactAddress -> CompactAddress -> Bool
$c> :: CompactAddress -> CompactAddress -> Bool
<= :: CompactAddress -> CompactAddress -> Bool
$c<= :: CompactAddress -> CompactAddress -> Bool
< :: CompactAddress -> CompactAddress -> Bool
$c< :: CompactAddress -> CompactAddress -> Bool
compare :: CompactAddress -> CompactAddress -> Ordering
$ccompare :: CompactAddress -> CompactAddress -> Ordering
Ord, forall x. Rep CompactAddress x -> CompactAddress
forall x. CompactAddress -> Rep CompactAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompactAddress x -> CompactAddress
$cfrom :: forall x. CompactAddress -> Rep CompactAddress x
Generic, Int -> CompactAddress -> ShowS
[CompactAddress] -> ShowS
CompactAddress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompactAddress] -> ShowS
$cshowList :: [CompactAddress] -> ShowS
show :: CompactAddress -> String
$cshow :: CompactAddress -> String
showsPrec :: Int -> CompactAddress -> ShowS
$cshowsPrec :: Int -> CompactAddress -> ShowS
Show)
  deriving newtype (CompactAddress -> Int
forall a. (a -> Int) -> HeapWords a
heapWords :: CompactAddress -> Int
$cheapWords :: CompactAddress -> Int
HeapWords, Context -> CompactAddress -> IO (Maybe ThunkInfo)
Proxy CompactAddress -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy CompactAddress -> String
$cshowTypeOf :: Proxy CompactAddress -> String
wNoThunks :: Context -> CompactAddress -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactAddress -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactAddress -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> CompactAddress -> IO (Maybe ThunkInfo)
NoThunks)
  deriving anyclass (CompactAddress -> ()
forall a. (a -> ()) -> NFData a
rnf :: CompactAddress -> ()
$crnf :: CompactAddress -> ()
NFData)

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

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

instance DecCBOR CompactAddress where
  decCBOR :: forall s. Decoder s CompactAddress
decCBOR = ShortByteString -> CompactAddress
CompactAddress forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ShortByteString
BSS.toShort forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

instance EncCBOR CompactAddress where
  encCBOR :: CompactAddress -> Encoding
encCBOR (CompactAddress ShortByteString
sbs) = forall a. EncCBOR a => a -> Encoding
encCBOR (ShortByteString -> ByteString
BSS.fromShort ShortByteString
sbs)

toCompactAddress :: Address -> CompactAddress
toCompactAddress :: Address -> CompactAddress
toCompactAddress Address
addr =
  ShortByteString -> CompactAddress
CompactAddress (ByteString -> ShortByteString
BSS.toShort (forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer Address
addr))

fromCompactAddress :: CompactAddress -> Address
fromCompactAddress :: CompactAddress -> Address
fromCompactAddress (CompactAddress ShortByteString
addr) =
  case forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull' Version
byronProtVer (ShortByteString -> ByteString
BSS.fromShort ShortByteString
addr) of
    Left DecoderError
err -> forall a. HasCallStack => Text -> a
panic (Text
"fromCompactAddress: impossible: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, ConvertText String b) => a -> b
show DecoderError
err)
    Right Address
decAddr -> Address
decAddr

unsafeGetCompactAddress :: CompactAddress -> ShortByteString
unsafeGetCompactAddress :: CompactAddress -> ShortByteString
unsafeGetCompactAddress (CompactAddress ShortByteString
sbs) = ShortByteString
sbs