{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- This module provides support for writing handlers for JSON-RPC endpoints
module Marconi.Api.Types
    (TargetAddresses
    , RpcPortNumber
    , CliArgs (..)
    , DBQueryEnv (..)
    , HasDBQueryEnv (..)
    , JsonRpcEnv (..)
    , HasJsonRpcEnv (..)
    , UtxoRowWrapper (..)
    , UtxoTxOutReport (..)
    , UtxoQueryTMVar (..)
    , QueryExceptions (..)
                         )  where
import Control.Exception (Exception)
import Control.Lens (makeClassy)
import Data.Aeson (ToJSON (toEncoding, toJSON), defaultOptions, genericToEncoding)
import Data.Aeson qualified
import Data.ByteString (ByteString)
import Data.Text (Text, pack)
import Data.Text.Encoding (decodeLatin1)
import GHC.Generics (Generic)
import Network.Wai.Handler.Warp (Settings)

import Cardano.Api qualified as C
import Marconi.Index.Utxo (Utxo, UtxoRow)
import Marconi.Indexers (UtxoQueryTMVar (UtxoQueryTMVar, unUtxoIndex))
import Marconi.Types as Export (TargetAddresses)

-- | Type represents http port for JSON-RPC
type RpcPortNumber = Int

data CliArgs = CliArgs
  { CliArgs -> FilePath
socket          :: FilePath             -- ^ POSIX socket file to communicate with cardano node
  , CliArgs -> FilePath
dbPath          :: FilePath             -- ^ filepath to local sqlite for utxo index table
  , CliArgs -> Maybe Int
httpPort        :: Maybe Int            -- ^ optional tcp/ip port number for JSON-RPC http server
  , CliArgs -> NetworkId
networkId       :: C.NetworkId          -- ^ cardano network id
  , CliArgs -> TargetAddresses
targetAddresses :: TargetAddresses      -- ^ white-space sepparated list of Bech32 Cardano Shelley addresses
  } deriving (Int -> CliArgs -> ShowS
[CliArgs] -> ShowS
CliArgs -> FilePath
(Int -> CliArgs -> ShowS)
-> (CliArgs -> FilePath) -> ([CliArgs] -> ShowS) -> Show CliArgs
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CliArgs] -> ShowS
$cshowList :: [CliArgs] -> ShowS
show :: CliArgs -> FilePath
$cshow :: CliArgs -> FilePath
showsPrec :: Int -> CliArgs -> ShowS
$cshowsPrec :: Int -> CliArgs -> ShowS
Show)

data DBQueryEnv = DBQueryEnv
    { DBQueryEnv -> UtxoQueryTMVar
_queryTMVar     :: UtxoQueryTMVar
    , DBQueryEnv -> TargetAddresses
_queryAddresses :: TargetAddresses        -- ^ user provided addresses to filter
    }
makeClassy ''DBQueryEnv

-- | JSON-RPC configuration
data JsonRpcEnv = JsonRpcEnv
    { JsonRpcEnv -> Settings
_httpSettings :: Settings               -- ^ HTTP server setting
    , JsonRpcEnv -> DBQueryEnv
_queryEnv     :: DBQueryEnv             -- ^ used for query sqlite
    }
makeClassy ''JsonRpcEnv

data UtxoTxOutReport = UtxoTxOutReport
    { UtxoTxOutReport -> Text
bech32Address :: Text
    , UtxoTxOutReport -> [UtxoRow]
utxoReport    :: [UtxoRow]
    } deriving (UtxoTxOutReport -> UtxoTxOutReport -> Bool
(UtxoTxOutReport -> UtxoTxOutReport -> Bool)
-> (UtxoTxOutReport -> UtxoTxOutReport -> Bool)
-> Eq UtxoTxOutReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UtxoTxOutReport -> UtxoTxOutReport -> Bool
$c/= :: UtxoTxOutReport -> UtxoTxOutReport -> Bool
== :: UtxoTxOutReport -> UtxoTxOutReport -> Bool
$c== :: UtxoTxOutReport -> UtxoTxOutReport -> Bool
Eq, Eq UtxoTxOutReport
Eq UtxoTxOutReport
-> (UtxoTxOutReport -> UtxoTxOutReport -> Ordering)
-> (UtxoTxOutReport -> UtxoTxOutReport -> Bool)
-> (UtxoTxOutReport -> UtxoTxOutReport -> Bool)
-> (UtxoTxOutReport -> UtxoTxOutReport -> Bool)
-> (UtxoTxOutReport -> UtxoTxOutReport -> Bool)
-> (UtxoTxOutReport -> UtxoTxOutReport -> UtxoTxOutReport)
-> (UtxoTxOutReport -> UtxoTxOutReport -> UtxoTxOutReport)
-> Ord UtxoTxOutReport
UtxoTxOutReport -> UtxoTxOutReport -> Bool
UtxoTxOutReport -> UtxoTxOutReport -> Ordering
UtxoTxOutReport -> UtxoTxOutReport -> UtxoTxOutReport
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 :: UtxoTxOutReport -> UtxoTxOutReport -> UtxoTxOutReport
$cmin :: UtxoTxOutReport -> UtxoTxOutReport -> UtxoTxOutReport
max :: UtxoTxOutReport -> UtxoTxOutReport -> UtxoTxOutReport
$cmax :: UtxoTxOutReport -> UtxoTxOutReport -> UtxoTxOutReport
>= :: UtxoTxOutReport -> UtxoTxOutReport -> Bool
$c>= :: UtxoTxOutReport -> UtxoTxOutReport -> Bool
> :: UtxoTxOutReport -> UtxoTxOutReport -> Bool
$c> :: UtxoTxOutReport -> UtxoTxOutReport -> Bool
<= :: UtxoTxOutReport -> UtxoTxOutReport -> Bool
$c<= :: UtxoTxOutReport -> UtxoTxOutReport -> Bool
< :: UtxoTxOutReport -> UtxoTxOutReport -> Bool
$c< :: UtxoTxOutReport -> UtxoTxOutReport -> Bool
compare :: UtxoTxOutReport -> UtxoTxOutReport -> Ordering
$ccompare :: UtxoTxOutReport -> UtxoTxOutReport -> Ordering
$cp1Ord :: Eq UtxoTxOutReport
Ord, (forall x. UtxoTxOutReport -> Rep UtxoTxOutReport x)
-> (forall x. Rep UtxoTxOutReport x -> UtxoTxOutReport)
-> Generic UtxoTxOutReport
forall x. Rep UtxoTxOutReport x -> UtxoTxOutReport
forall x. UtxoTxOutReport -> Rep UtxoTxOutReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UtxoTxOutReport x -> UtxoTxOutReport
$cfrom :: forall x. UtxoTxOutReport -> Rep UtxoTxOutReport x
Generic)

instance ToJSON UtxoTxOutReport where
    toEncoding :: UtxoTxOutReport -> Encoding
toEncoding = Options -> UtxoTxOutReport -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

newtype UtxoRowWrapper = UtxoRowWrapper UtxoRow deriving (UtxoRowWrapper -> UtxoRowWrapper -> Bool
(UtxoRowWrapper -> UtxoRowWrapper -> Bool)
-> (UtxoRowWrapper -> UtxoRowWrapper -> Bool) -> Eq UtxoRowWrapper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UtxoRowWrapper -> UtxoRowWrapper -> Bool
$c/= :: UtxoRowWrapper -> UtxoRowWrapper -> Bool
== :: UtxoRowWrapper -> UtxoRowWrapper -> Bool
$c== :: UtxoRowWrapper -> UtxoRowWrapper -> Bool
Eq, Eq UtxoRowWrapper
Eq UtxoRowWrapper
-> (UtxoRowWrapper -> UtxoRowWrapper -> Ordering)
-> (UtxoRowWrapper -> UtxoRowWrapper -> Bool)
-> (UtxoRowWrapper -> UtxoRowWrapper -> Bool)
-> (UtxoRowWrapper -> UtxoRowWrapper -> Bool)
-> (UtxoRowWrapper -> UtxoRowWrapper -> Bool)
-> (UtxoRowWrapper -> UtxoRowWrapper -> UtxoRowWrapper)
-> (UtxoRowWrapper -> UtxoRowWrapper -> UtxoRowWrapper)
-> Ord UtxoRowWrapper
UtxoRowWrapper -> UtxoRowWrapper -> Bool
UtxoRowWrapper -> UtxoRowWrapper -> Ordering
UtxoRowWrapper -> UtxoRowWrapper -> UtxoRowWrapper
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 :: UtxoRowWrapper -> UtxoRowWrapper -> UtxoRowWrapper
$cmin :: UtxoRowWrapper -> UtxoRowWrapper -> UtxoRowWrapper
max :: UtxoRowWrapper -> UtxoRowWrapper -> UtxoRowWrapper
$cmax :: UtxoRowWrapper -> UtxoRowWrapper -> UtxoRowWrapper
>= :: UtxoRowWrapper -> UtxoRowWrapper -> Bool
$c>= :: UtxoRowWrapper -> UtxoRowWrapper -> Bool
> :: UtxoRowWrapper -> UtxoRowWrapper -> Bool
$c> :: UtxoRowWrapper -> UtxoRowWrapper -> Bool
<= :: UtxoRowWrapper -> UtxoRowWrapper -> Bool
$c<= :: UtxoRowWrapper -> UtxoRowWrapper -> Bool
< :: UtxoRowWrapper -> UtxoRowWrapper -> Bool
$c< :: UtxoRowWrapper -> UtxoRowWrapper -> Bool
compare :: UtxoRowWrapper -> UtxoRowWrapper -> Ordering
$ccompare :: UtxoRowWrapper -> UtxoRowWrapper -> Ordering
$cp1Ord :: Eq UtxoRowWrapper
Ord, Int -> UtxoRowWrapper -> ShowS
[UtxoRowWrapper] -> ShowS
UtxoRowWrapper -> FilePath
(Int -> UtxoRowWrapper -> ShowS)
-> (UtxoRowWrapper -> FilePath)
-> ([UtxoRowWrapper] -> ShowS)
-> Show UtxoRowWrapper
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UtxoRowWrapper] -> ShowS
$cshowList :: [UtxoRowWrapper] -> ShowS
show :: UtxoRowWrapper -> FilePath
$cshow :: UtxoRowWrapper -> FilePath
showsPrec :: Int -> UtxoRowWrapper -> ShowS
$cshowsPrec :: Int -> UtxoRowWrapper -> ShowS
Show, (forall x. UtxoRowWrapper -> Rep UtxoRowWrapper x)
-> (forall x. Rep UtxoRowWrapper x -> UtxoRowWrapper)
-> Generic UtxoRowWrapper
forall x. Rep UtxoRowWrapper x -> UtxoRowWrapper
forall x. UtxoRowWrapper -> Rep UtxoRowWrapper x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UtxoRowWrapper x -> UtxoRowWrapper
$cfrom :: forall x. UtxoRowWrapper -> Rep UtxoRowWrapper x
Generic)

instance ToJSON UtxoRowWrapper where
    toEncoding :: UtxoRowWrapper -> Encoding
toEncoding = Options -> UtxoRowWrapper -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

data QueryExceptions
    = AddressNotInListError QueryExceptions
    | AddressConversionError QueryExceptions
    | TxRefConversionError QueryExceptions
    | QueryError String
    deriving stock Int -> QueryExceptions -> ShowS
[QueryExceptions] -> ShowS
QueryExceptions -> FilePath
(Int -> QueryExceptions -> ShowS)
-> (QueryExceptions -> FilePath)
-> ([QueryExceptions] -> ShowS)
-> Show QueryExceptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [QueryExceptions] -> ShowS
$cshowList :: [QueryExceptions] -> ShowS
show :: QueryExceptions -> FilePath
$cshow :: QueryExceptions -> FilePath
showsPrec :: Int -> QueryExceptions -> ShowS
$cshowsPrec :: Int -> QueryExceptions -> ShowS
Show
    deriving anyclass  Show QueryExceptions
Typeable QueryExceptions
Typeable QueryExceptions
-> Show QueryExceptions
-> (QueryExceptions -> SomeException)
-> (SomeException -> Maybe QueryExceptions)
-> (QueryExceptions -> FilePath)
-> Exception QueryExceptions
SomeException -> Maybe QueryExceptions
QueryExceptions -> FilePath
QueryExceptions -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> FilePath)
-> Exception e
displayException :: QueryExceptions -> FilePath
$cdisplayException :: QueryExceptions -> FilePath
fromException :: SomeException -> Maybe QueryExceptions
$cfromException :: SomeException -> Maybe QueryExceptions
toException :: QueryExceptions -> SomeException
$ctoException :: QueryExceptions -> SomeException
$cp2Exception :: Show QueryExceptions
$cp1Exception :: Typeable QueryExceptions
Exception

instance ToJSON C.AddressAny where
    toJSON :: AddressAny -> Value
toJSON = Text -> Value
Data.Aeson.String (Text -> Value) -> (AddressAny -> Text) -> AddressAny -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressAny -> Text
forall addr. SerialiseAddress addr => addr -> Text
C.serialiseAddress

instance ToJSON C.ScriptData where
    toJSON :: ScriptData -> Value
toJSON = Text -> Value
Data.Aeson.String (Text -> Value) -> (ScriptData -> Text) -> ScriptData -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack (FilePath -> Text)
-> (ScriptData -> FilePath) -> ScriptData -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptData -> FilePath
forall a. Show a => a -> FilePath
show

instance ToJSON ByteString where
    toJSON :: ByteString -> Value
toJSON = Text -> Value
Data.Aeson.String (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeLatin1

instance ToJSON Utxo

instance ToJSON C.BlockNo

instance ToJSON UtxoRow