{-# OPTIONS_GHC -Wno-orphans #-}

module Shelley.Spec.Ledger.Orphans where

import qualified Cardano.Crypto.Hash as Hash
import Cardano.Crypto.Util (SignableRepresentation (..))
import qualified Cardano.Crypto.Wallet as WC
import Cardano.Prelude (readEither)
import Cardano.Slotting.Slot (WithOrigin (..))
import Control.DeepSeq (NFData (rnf))
import Data.Aeson
import Data.Foldable
import Data.IP (IPv4, IPv6)
import Data.Sequence.Strict (StrictSeq, fromList, getSeq)
import qualified Data.Text as Text
import NoThunks.Class (NoThunks (..))
import Shelley.Spec.Ledger.Slot (BlockNo, EpochNo)

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 FromJSON a => FromJSON (StrictSeq a) where
  parseJSON :: Value -> Parser (StrictSeq a)
parseJSON = ([a] -> StrictSeq a) -> Parser [a] -> Parser (StrictSeq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> StrictSeq a
forall a. [a] -> StrictSeq a
fromList (Parser [a] -> Parser (StrictSeq a))
-> (Value -> Parser [a]) -> Value -> Parser (StrictSeq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToJSON a => ToJSON (StrictSeq a) where
  toJSON :: StrictSeq a -> Value
toJSON = [a] -> Value
forall a. ToJSON a => a -> Value
toJSON ([a] -> Value) -> (StrictSeq a -> [a]) -> StrictSeq a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance NoThunks IPv4

instance NoThunks IPv6

instance NFData IPv4

instance NFData IPv6

{- The following NFData instances probably belong in base -}
instance NFData EpochNo

instance NFData (StrictSeq a) where
  rnf :: StrictSeq a -> ()
rnf StrictSeq a
x = case StrictSeq a -> Seq a
forall a. StrictSeq a -> Seq a
getSeq StrictSeq a
x of Seq a
_any -> ()

-- By defintion it is strict, so as long as the (hidden) constructor is evident, it is in normal form

instance NFData a => NFData (WithOrigin a)

instance NFData BlockNo

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