{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLabels #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Rpc.Server.Internal.Orphans () where

import Cardano.Api.Block (ChainPoint (..), Hash (..), SlotNo (..))
import Cardano.Api.Era (Inject (..))
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc

import Cardano.Ledger.Plutus qualified as L

import RIO

import Data.ByteString.Short qualified as SBS
import Data.ProtoLens (defMessage)
import Data.Ratio (Ratio, denominator, numerator, (%))
import Network.GRPC.Spec

instance Inject (Proto UtxoRpc.RationalNumber) (Ratio Integer) where
  inject :: Proto RationalNumber -> Ratio Integer
inject Proto RationalNumber
r = Proto RationalNumber
r Proto RationalNumber
-> Getting Integer (Proto RationalNumber) Integer -> Integer
forall s a. s -> Getting a s a -> a
^. (Int32 -> Const Integer Int32)
-> Proto RationalNumber -> Const Integer (Proto RationalNumber)
#numerator ((Int32 -> Const Integer Int32)
 -> Proto RationalNumber -> Const Integer (Proto RationalNumber))
-> ((Integer -> Const Integer Integer)
    -> Int32 -> Const Integer Int32)
-> Getting Integer (Proto RationalNumber) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Integer) -> SimpleGetter Int32 Integer
forall s a. (s -> a) -> SimpleGetter s a
to Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Proto RationalNumber
r Proto RationalNumber
-> Getting Integer (Proto RationalNumber) Integer -> Integer
forall s a. s -> Getting a s a -> a
^. (Word32 -> Const Integer Word32)
-> Proto RationalNumber -> Const Integer (Proto RationalNumber)
#denominator ((Word32 -> Const Integer Word32)
 -> Proto RationalNumber -> Const Integer (Proto RationalNumber))
-> ((Integer -> Const Integer Integer)
    -> Word32 -> Const Integer Word32)
-> Getting Integer (Proto RationalNumber) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Integer) -> SimpleGetter Word32 Integer
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Inject (Ratio Integer) (Proto UtxoRpc.RationalNumber) where
  inject :: Ratio Integer -> Proto RationalNumber
inject Ratio Integer
r =
    Proto RationalNumber
forall msg. Message msg => msg
defMessage
      Proto RationalNumber
-> (Proto RationalNumber -> Proto RationalNumber)
-> Proto RationalNumber
forall a b. a -> (a -> b) -> b
& ASetter (Proto RationalNumber) (Proto RationalNumber) Int32 Int32
#numerator ASetter (Proto RationalNumber) (Proto RationalNumber) Int32 Int32
-> Int32 -> Proto RationalNumber -> Proto RationalNumber
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ratio Integer -> Integer
forall a. Ratio a -> a
numerator Ratio Integer
r)
      Proto RationalNumber
-> (Proto RationalNumber -> Proto RationalNumber)
-> Proto RationalNumber
forall a b. a -> (a -> b) -> b
& ASetter (Proto RationalNumber) (Proto RationalNumber) Word32 Word32
#denominator ASetter (Proto RationalNumber) (Proto RationalNumber) Word32 Word32
-> Word32 -> Proto RationalNumber -> Proto RationalNumber
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ratio Integer -> Integer
forall a. Ratio a -> a
denominator Ratio Integer
r)

instance Inject (Proto UtxoRpc.ExUnits) L.ExUnits where
  inject :: Proto ExUnits -> ExUnits
inject Proto ExUnits
r =
    L.ExUnits
      { exUnitsMem :: Natural
L.exUnitsMem = Proto ExUnits
r Proto ExUnits -> Getting Natural (Proto ExUnits) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Natural Word64)
-> Proto ExUnits -> Const Natural (Proto ExUnits)
#memory ((Word64 -> Const Natural Word64)
 -> Proto ExUnits -> Const Natural (Proto ExUnits))
-> ((Natural -> Const Natural Natural)
    -> Word64 -> Const Natural Word64)
-> Getting Natural (Proto ExUnits) Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Natural) -> SimpleGetter Word64 Natural
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      , exUnitsSteps :: Natural
L.exUnitsSteps = Proto ExUnits
r Proto ExUnits -> Getting Natural (Proto ExUnits) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Natural Word64)
-> Proto ExUnits -> Const Natural (Proto ExUnits)
#steps ((Word64 -> Const Natural Word64)
 -> Proto ExUnits -> Const Natural (Proto ExUnits))
-> ((Natural -> Const Natural Natural)
    -> Word64 -> Const Natural Word64)
-> Getting Natural (Proto ExUnits) Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Natural) -> SimpleGetter Word64 Natural
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      }

instance Inject L.ExUnits (Proto UtxoRpc.ExUnits) where
  inject :: ExUnits -> Proto ExUnits
inject L.ExUnits{exUnitsMem :: ExUnits -> Natural
L.exUnitsMem = Natural
mem, exUnitsSteps :: ExUnits -> Natural
L.exUnitsSteps = Natural
steps} =
    Proto ExUnits
forall msg. Message msg => msg
defMessage
      Proto ExUnits -> (Proto ExUnits -> Proto ExUnits) -> Proto ExUnits
forall a b. a -> (a -> b) -> b
& ASetter (Proto ExUnits) (Proto ExUnits) Word64 Word64
#memory ASetter (Proto ExUnits) (Proto ExUnits) Word64 Word64
-> Word64 -> Proto ExUnits -> Proto ExUnits
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
mem
      Proto ExUnits -> (Proto ExUnits -> Proto ExUnits) -> Proto ExUnits
forall a b. a -> (a -> b) -> b
& ASetter (Proto ExUnits) (Proto ExUnits) Word64 Word64
#steps ASetter (Proto ExUnits) (Proto ExUnits) Word64 Word64
-> Word64 -> Proto ExUnits -> Proto ExUnits
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
steps

instance Inject ChainPoint (Proto UtxoRpc.ChainPoint) where
  inject :: ChainPoint -> Proto ChainPoint
inject ChainPoint
chainPoint = do
    let (Word64
slotNo, ByteString
blockHash) =
          case ChainPoint
chainPoint of
            ChainPoint
ChainPointAtGenesis -> (Word64
0, ByteString
forall a. Monoid a => a
mempty)
            ChainPoint (SlotNo Word64
slot) (HeaderHash ShortByteString
hash) -> (Word64
slot, ShortByteString -> ByteString
SBS.fromShort ShortByteString
hash)
    Proto ChainPoint
forall msg. Message msg => msg
defMessage
      Proto ChainPoint
-> (Proto ChainPoint -> Proto ChainPoint) -> Proto ChainPoint
forall a b. a -> (a -> b) -> b
& ASetter (Proto ChainPoint) (Proto ChainPoint) Word64 Word64
#slot ASetter (Proto ChainPoint) (Proto ChainPoint) Word64 Word64
-> Word64 -> Proto ChainPoint -> Proto ChainPoint
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
slotNo
      Proto ChainPoint
-> (Proto ChainPoint -> Proto ChainPoint) -> Proto ChainPoint
forall a b. a -> (a -> b) -> b
& ASetter (Proto ChainPoint) (Proto ChainPoint) ByteString ByteString
#hash ASetter (Proto ChainPoint) (Proto ChainPoint) ByteString ByteString
-> ByteString -> Proto ChainPoint -> Proto ChainPoint
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
blockHash