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

module Cardano.Ledger.Shelley.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 Cardano.Ledger.BaseTypes (Network (..))
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.Keys (KeyHash (..))
import Control.DeepSeq (NFData)
import Data.Aeson
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.Class (Default (..))
import Data.IP (IPv4, IPv6)
import Data.Proxy
import qualified Data.Sequence.Strict as SS
import qualified Data.Text as Text
import NoThunks.Class (NoThunks (..))
import Text.Read (readEither)

instance FromJSON IPv4 where
  parseJSON :: Value -> Parser IPv4
parseJSON =
    String -> (Text -> Parser IPv4) -> Value -> Parser IPv4
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"IPv4" ((Text -> Parser IPv4) -> Value -> Parser IPv4)
-> (Text -> Parser IPv4) -> Value -> Parser IPv4
forall a b. (a -> b) -> a -> b
$ \Text
txt -> case String -> Either String IPv4
forall a. Read a => String -> Either String a
readEither (Text -> String
Text.unpack Text
txt) of
      Right IPv4
ipv4 -> IPv4 -> Parser IPv4
forall (m :: * -> *) a. Monad m => a -> m a
return IPv4
ipv4
      Left String
_ -> String -> Parser IPv4
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser IPv4) -> String -> Parser IPv4
forall a b. (a -> b) -> a -> b
$ String
"failed to read as IPv4 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
txt

instance ToJSON IPv4 where
  toJSON :: IPv4 -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (IPv4 -> String) -> IPv4 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> String
forall a. Show a => a -> String
show

instance FromJSON IPv6 where
  parseJSON :: Value -> Parser IPv6
parseJSON =
    String -> (Text -> Parser IPv6) -> Value -> Parser IPv6
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"IPv6" ((Text -> Parser IPv6) -> Value -> Parser IPv6)
-> (Text -> Parser IPv6) -> Value -> Parser IPv6
forall a b. (a -> b) -> a -> b
$ \Text
txt -> case String -> Either String IPv6
forall a. Read a => String -> Either String a
readEither (Text -> String
Text.unpack Text
txt) of
      Right IPv6
ipv6 -> IPv6 -> Parser IPv6
forall (m :: * -> *) a. Monad m => a -> m a
return IPv6
ipv6
      Left String
_ -> String -> Parser IPv6
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser IPv6) -> String -> Parser IPv6
forall a b. (a -> b) -> a -> b
$ String
"failed to read as IPv6 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
txt

instance ToJSON IPv6 where
  toJSON :: IPv6 -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (IPv6 -> String) -> IPv6 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> String
forall a. Show a => a -> String
show

instance NoThunks IPv4

instance NoThunks IPv6

instance NFData IPv4

instance NFData IPv6

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"

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

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

instance Default Network where
  def :: Network
def = Network
Mainnet

instance Crypto b => Default (KeyHash a b) where
  def :: KeyHash a b
def = Hash (ADDRHASH b) (VerKeyDSIGN (DSIGN b)) -> KeyHash a b
forall (discriminator :: KeyRole) crypto.
Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> KeyHash discriminator crypto
KeyHash Hash (ADDRHASH b) (VerKeyDSIGN (DSIGN b))
forall a. Default a => a
def

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 => 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.sizeHash (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h))) Word8
0

instance Default Bool where
  def :: Bool
def = Bool
False