{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Orphans where

import Cardano.Crypto.Hash (Hash (..))
import qualified Cardano.Crypto.Hash as Hash
import qualified Cardano.Crypto.Hash.Class as HS
import Cardano.Crypto.Util (SignableRepresentation (..))
import qualified Cardano.Crypto.Wallet as WC
import Data.Array.Byte (ByteArray)
import qualified Data.ByteString as Long (ByteString, empty)
import qualified Data.ByteString.Lazy as Lazy (ByteString, empty)
import qualified Data.ByteString.Short as Short (ShortByteString, empty, pack)
import Data.Default (Default (..))
import Data.Fixed (Fixed (..))
import Data.Proxy
import qualified Data.Sequence.Strict as SS
import NoThunks.Class (NoThunks (..))

instance NoThunks WC.XSignature where
  wNoThunks :: Context -> XSignature -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt XSignature
s = Context -> ByteString -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt (XSignature -> ByteString
WC.unXSignature XSignature
s)
  showTypeOf :: Proxy XSignature -> String
showTypeOf Proxy XSignature
_proxy = String
"XSignature"

-- | ByteArray is primitive data (unpinned byte array), so it contains no thunks.
-- TODO: Part of nothunks-0.3.2. Remove once we update to a more recent hackage
-- state
instance NoThunks ByteArray where
  wNoThunks :: Context -> ByteArray -> IO (Maybe ThunkInfo)
wNoThunks Context
_ ByteArray
_ = Maybe ThunkInfo -> IO (Maybe ThunkInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ThunkInfo
forall a. Maybe a
Nothing
  showTypeOf :: Proxy ByteArray -> String
showTypeOf Proxy ByteArray
_ = String
"ByteArray"

instance SignableRepresentation (Hash.Hash a b) where
  getSignableRepresentation :: Hash a b -> ByteString
getSignableRepresentation = Hash a b -> ByteString
forall a b. Hash a b -> ByteString
Hash.hashToBytes

-- | TODO: We should upstream instance
-- HasResolution p => NoThunks (Fixed p) into the nothunks package.
deriving newtype instance NoThunks (Fixed p)

-- ===============================================
-- Blank instance needed to compute Provenance

instance Default (SS.StrictSeq t) where
  def :: StrictSeq t
def = StrictSeq t
forall t. StrictSeq t
SS.Empty

instance Default Short.ShortByteString where
  def :: ShortByteString
def = ShortByteString
Short.empty

instance Default Long.ByteString where
  def :: ByteString
def = ByteString
Long.empty

instance Default Lazy.ByteString where
  def :: ByteString
def = ByteString
Lazy.empty

instance HS.HashAlgorithm h => Default (Hash h b) where
  def :: Hash h b
def =
    ShortByteString -> Hash h b
forall h a.
(HashAlgorithm h, HasCallStack) =>
ShortByteString -> Hash h a
UnsafeHash (ShortByteString -> Hash h b) -> ShortByteString -> Hash h b
forall a b. (a -> b) -> a -> b
$
      [Word8] -> ShortByteString
Short.pack ([Word8] -> ShortByteString) -> [Word8] -> ShortByteString
forall a b. (a -> b) -> a -> b
$
        Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.hashSize (Proxy h
forall {k} (t :: k). Proxy t
Proxy :: Proxy h))) Word8
0