{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Plutus.ChainIndex.Api
  ( API
  , FromHashAPI
  , FullAPI
  , IsUtxoResponse(..)
  , SwaggerAPI
  , UtxoAtAddressRequest(..)
  , UtxosResponse(..)
  , UtxoWithCurrencyRequest(..)
  , swagger
  , TxoAtAddressRequest(..)
  , TxosResponse(..)
  , QueryAtAddressRequest (..)
  , QueryResponse(..)
  , collectQueryResponse
  ) where

import Control.Monad.Freer.Extras.Pagination (Page, PageQuery, PageSize)
import Data.Aeson (FromJSON, ToJSON, Value)
import Data.Default (def)
import Data.OpenApi qualified as OpenApi
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import Ledger.Credential (Credential)
import Ledger.Tx (DatumFromQuery, DecoratedTxOut, TxId, TxOutRef, Versioned)
import Plutus.ChainIndex.Tx (ChainIndexTx)
import Plutus.ChainIndex.Types (Diagnostics, Tip)
import Plutus.V1.Ledger.Api (Datum, DatumHash, MintingPolicy (MintingPolicy), MintingPolicyHash (MintingPolicyHash),
                             PubKeyHash, Redeemer, RedeemerHash (RedeemerHash), StakeValidator (StakeValidator),
                             StakeValidatorHash (StakeValidatorHash), StakingCredential, Validator,
                             ValidatorHash (ValidatorHash))
import Plutus.V1.Ledger.Value (AssetClass (AssetClass))
import Servant qualified
import Servant.API (Description, Get, JSON, NoContent, Post, Put, ReqBody, (:<|>), (:>))
import Servant.OpenApi (toOpenApi)
import Servant.Swagger.UI (SwaggerSchemaUI, SwaggerSchemaUI', swaggerSchemaUIServer)

deriving newtype instance OpenApi.ToSchema ValidatorHash
deriving instance OpenApi.ToSchema DatumFromQuery
deriving anyclass instance OpenApi.ToSchema PubKeyHash
deriving instance OpenApi.ToSchema DecoratedTxOut
deriving newtype instance OpenApi.ToSchema RedeemerHash
deriving newtype instance OpenApi.ToSchema StakeValidator
deriving newtype instance OpenApi.ToSchema MintingPolicy
deriving newtype instance OpenApi.ToSchema MintingPolicyHash
deriving newtype instance OpenApi.ToSchema AssetClass
deriving anyclass instance OpenApi.ToSchema Credential
deriving anyclass instance OpenApi.ToSchema StakingCredential
deriving newtype instance OpenApi.ToSchema StakeValidatorHash

deriving instance OpenApi.ToSchema a => OpenApi.ToSchema (PageQuery a)
deriving anyclass instance OpenApi.ToSchema PageSize
deriving instance OpenApi.ToSchema a => OpenApi.ToSchema (Page a)

-- | When requesting UTxOs of a given address, you need to provide the address,
-- and optionnally the number of elements per page and the last item of the last
-- requested page.
--
-- Here's an example for requesting the first page:
--
-- {
--   "credential": {
--     "tag": "PubKeyCredential",
--     "contents": {
--       "getPubKeyHash": "88ff402b0522f27649ac742238c697c579beeb344eb723099d1f16ce"
--     }
--   }
-- }
--
-- or
--
-- {
--   "pageQuery": {
--     "pageQuerySize": {
--       "getPageSize": 10
--     }
--   },
--   "credential": {
--     "tag": "PubKeyCredential",
--     "contents": {
--       "getPubKeyHash": "88ff402b0522f27649ac742238c697c579beeb344eb723099d1f16ce"
--     }
--   }
-- }
--
-- Here's an example for requesting the next page:
--
-- {
--   "pageQuery": {
--     "pageQuerySize": {
--       "getPageSize": 10
--     },
--     "pageQueryLastItem": {
--       "txOutRefId": {
--         "getTxId": "009b8c674b878cc68bd1d40562c5f14cdbb21be9266f605cfb68ed978e1a965b"
--       },
--       "txOutRefIdx": 0
--     }
--   },
--   "credential": {
--     "tag": "PubKeyCredential",
--     "contents": {
--       "getPubKeyHash": "88ff402b0522f27649ac742238c697c579beeb344eb723099d1f16ce"
--     }
--   }
-- }
data UtxoAtAddressRequest = UtxoAtAddressRequest
    { UtxoAtAddressRequest -> Maybe (PageQuery TxOutRef)
pageQuery  :: Maybe (PageQuery TxOutRef)
    , UtxoAtAddressRequest -> Credential
credential :: Credential
    }
    deriving (Int -> UtxoAtAddressRequest -> ShowS
[UtxoAtAddressRequest] -> ShowS
UtxoAtAddressRequest -> String
(Int -> UtxoAtAddressRequest -> ShowS)
-> (UtxoAtAddressRequest -> String)
-> ([UtxoAtAddressRequest] -> ShowS)
-> Show UtxoAtAddressRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UtxoAtAddressRequest] -> ShowS
$cshowList :: [UtxoAtAddressRequest] -> ShowS
show :: UtxoAtAddressRequest -> String
$cshow :: UtxoAtAddressRequest -> String
showsPrec :: Int -> UtxoAtAddressRequest -> ShowS
$cshowsPrec :: Int -> UtxoAtAddressRequest -> ShowS
Show, UtxoAtAddressRequest -> UtxoAtAddressRequest -> Bool
(UtxoAtAddressRequest -> UtxoAtAddressRequest -> Bool)
-> (UtxoAtAddressRequest -> UtxoAtAddressRequest -> Bool)
-> Eq UtxoAtAddressRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UtxoAtAddressRequest -> UtxoAtAddressRequest -> Bool
$c/= :: UtxoAtAddressRequest -> UtxoAtAddressRequest -> Bool
== :: UtxoAtAddressRequest -> UtxoAtAddressRequest -> Bool
$c== :: UtxoAtAddressRequest -> UtxoAtAddressRequest -> Bool
Eq, (forall x. UtxoAtAddressRequest -> Rep UtxoAtAddressRequest x)
-> (forall x. Rep UtxoAtAddressRequest x -> UtxoAtAddressRequest)
-> Generic UtxoAtAddressRequest
forall x. Rep UtxoAtAddressRequest x -> UtxoAtAddressRequest
forall x. UtxoAtAddressRequest -> Rep UtxoAtAddressRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UtxoAtAddressRequest x -> UtxoAtAddressRequest
$cfrom :: forall x. UtxoAtAddressRequest -> Rep UtxoAtAddressRequest x
Generic, Value -> Parser [UtxoAtAddressRequest]
Value -> Parser UtxoAtAddressRequest
(Value -> Parser UtxoAtAddressRequest)
-> (Value -> Parser [UtxoAtAddressRequest])
-> FromJSON UtxoAtAddressRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UtxoAtAddressRequest]
$cparseJSONList :: Value -> Parser [UtxoAtAddressRequest]
parseJSON :: Value -> Parser UtxoAtAddressRequest
$cparseJSON :: Value -> Parser UtxoAtAddressRequest
FromJSON, [UtxoAtAddressRequest] -> Encoding
[UtxoAtAddressRequest] -> Value
UtxoAtAddressRequest -> Encoding
UtxoAtAddressRequest -> Value
(UtxoAtAddressRequest -> Value)
-> (UtxoAtAddressRequest -> Encoding)
-> ([UtxoAtAddressRequest] -> Value)
-> ([UtxoAtAddressRequest] -> Encoding)
-> ToJSON UtxoAtAddressRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UtxoAtAddressRequest] -> Encoding
$ctoEncodingList :: [UtxoAtAddressRequest] -> Encoding
toJSONList :: [UtxoAtAddressRequest] -> Value
$ctoJSONList :: [UtxoAtAddressRequest] -> Value
toEncoding :: UtxoAtAddressRequest -> Encoding
$ctoEncoding :: UtxoAtAddressRequest -> Encoding
toJSON :: UtxoAtAddressRequest -> Value
$ctoJSON :: UtxoAtAddressRequest -> Value
ToJSON, Typeable UtxoAtAddressRequest
Typeable UtxoAtAddressRequest
-> (Proxy UtxoAtAddressRequest
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UtxoAtAddressRequest
Proxy UtxoAtAddressRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy UtxoAtAddressRequest
-> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy UtxoAtAddressRequest
-> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable UtxoAtAddressRequest
OpenApi.ToSchema)

-- | See the comment on 'UtxoAtAddressRequest'.
--
-- The difference is using @currency@ field instead of @credential@.
-- {
--   "pageQuery": {
--     ...
--   },
--   "currency": {
--     "unAssetClass": [
--       {
--         "unCurrencySymbol": ""
--       },
--       {
--         "unTokenName": ""
--       }
--     ]
--   }
-- }
data UtxoWithCurrencyRequest = UtxoWithCurrencyRequest
    { UtxoWithCurrencyRequest -> Maybe (PageQuery TxOutRef)
pageQuery :: Maybe (PageQuery TxOutRef)
    , UtxoWithCurrencyRequest -> AssetClass
currency  :: AssetClass
    }
    deriving (Int -> UtxoWithCurrencyRequest -> ShowS
[UtxoWithCurrencyRequest] -> ShowS
UtxoWithCurrencyRequest -> String
(Int -> UtxoWithCurrencyRequest -> ShowS)
-> (UtxoWithCurrencyRequest -> String)
-> ([UtxoWithCurrencyRequest] -> ShowS)
-> Show UtxoWithCurrencyRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UtxoWithCurrencyRequest] -> ShowS
$cshowList :: [UtxoWithCurrencyRequest] -> ShowS
show :: UtxoWithCurrencyRequest -> String
$cshow :: UtxoWithCurrencyRequest -> String
showsPrec :: Int -> UtxoWithCurrencyRequest -> ShowS
$cshowsPrec :: Int -> UtxoWithCurrencyRequest -> ShowS
Show, UtxoWithCurrencyRequest -> UtxoWithCurrencyRequest -> Bool
(UtxoWithCurrencyRequest -> UtxoWithCurrencyRequest -> Bool)
-> (UtxoWithCurrencyRequest -> UtxoWithCurrencyRequest -> Bool)
-> Eq UtxoWithCurrencyRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UtxoWithCurrencyRequest -> UtxoWithCurrencyRequest -> Bool
$c/= :: UtxoWithCurrencyRequest -> UtxoWithCurrencyRequest -> Bool
== :: UtxoWithCurrencyRequest -> UtxoWithCurrencyRequest -> Bool
$c== :: UtxoWithCurrencyRequest -> UtxoWithCurrencyRequest -> Bool
Eq, (forall x.
 UtxoWithCurrencyRequest -> Rep UtxoWithCurrencyRequest x)
-> (forall x.
    Rep UtxoWithCurrencyRequest x -> UtxoWithCurrencyRequest)
-> Generic UtxoWithCurrencyRequest
forall x. Rep UtxoWithCurrencyRequest x -> UtxoWithCurrencyRequest
forall x. UtxoWithCurrencyRequest -> Rep UtxoWithCurrencyRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UtxoWithCurrencyRequest x -> UtxoWithCurrencyRequest
$cfrom :: forall x. UtxoWithCurrencyRequest -> Rep UtxoWithCurrencyRequest x
Generic, Value -> Parser [UtxoWithCurrencyRequest]
Value -> Parser UtxoWithCurrencyRequest
(Value -> Parser UtxoWithCurrencyRequest)
-> (Value -> Parser [UtxoWithCurrencyRequest])
-> FromJSON UtxoWithCurrencyRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UtxoWithCurrencyRequest]
$cparseJSONList :: Value -> Parser [UtxoWithCurrencyRequest]
parseJSON :: Value -> Parser UtxoWithCurrencyRequest
$cparseJSON :: Value -> Parser UtxoWithCurrencyRequest
FromJSON, [UtxoWithCurrencyRequest] -> Encoding
[UtxoWithCurrencyRequest] -> Value
UtxoWithCurrencyRequest -> Encoding
UtxoWithCurrencyRequest -> Value
(UtxoWithCurrencyRequest -> Value)
-> (UtxoWithCurrencyRequest -> Encoding)
-> ([UtxoWithCurrencyRequest] -> Value)
-> ([UtxoWithCurrencyRequest] -> Encoding)
-> ToJSON UtxoWithCurrencyRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UtxoWithCurrencyRequest] -> Encoding
$ctoEncodingList :: [UtxoWithCurrencyRequest] -> Encoding
toJSONList :: [UtxoWithCurrencyRequest] -> Value
$ctoJSONList :: [UtxoWithCurrencyRequest] -> Value
toEncoding :: UtxoWithCurrencyRequest -> Encoding
$ctoEncoding :: UtxoWithCurrencyRequest -> Encoding
toJSON :: UtxoWithCurrencyRequest -> Value
$ctoJSON :: UtxoWithCurrencyRequest -> Value
ToJSON, Typeable UtxoWithCurrencyRequest
Typeable UtxoWithCurrencyRequest
-> (Proxy UtxoWithCurrencyRequest
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UtxoWithCurrencyRequest
Proxy UtxoWithCurrencyRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy UtxoWithCurrencyRequest
-> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy UtxoWithCurrencyRequest
-> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable UtxoWithCurrencyRequest
OpenApi.ToSchema)

-- | Response type for the utxo-{at-address|with-currency} endpoints.
data UtxosResponse = UtxosResponse
    { UtxosResponse -> Tip
currentTip :: Tip
    , UtxosResponse -> Page TxOutRef
page       :: Page TxOutRef
    }
    deriving (Int -> UtxosResponse -> ShowS
[UtxosResponse] -> ShowS
UtxosResponse -> String
(Int -> UtxosResponse -> ShowS)
-> (UtxosResponse -> String)
-> ([UtxosResponse] -> ShowS)
-> Show UtxosResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UtxosResponse] -> ShowS
$cshowList :: [UtxosResponse] -> ShowS
show :: UtxosResponse -> String
$cshow :: UtxosResponse -> String
showsPrec :: Int -> UtxosResponse -> ShowS
$cshowsPrec :: Int -> UtxosResponse -> ShowS
Show, UtxosResponse -> UtxosResponse -> Bool
(UtxosResponse -> UtxosResponse -> Bool)
-> (UtxosResponse -> UtxosResponse -> Bool) -> Eq UtxosResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UtxosResponse -> UtxosResponse -> Bool
$c/= :: UtxosResponse -> UtxosResponse -> Bool
== :: UtxosResponse -> UtxosResponse -> Bool
$c== :: UtxosResponse -> UtxosResponse -> Bool
Eq, (forall x. UtxosResponse -> Rep UtxosResponse x)
-> (forall x. Rep UtxosResponse x -> UtxosResponse)
-> Generic UtxosResponse
forall x. Rep UtxosResponse x -> UtxosResponse
forall x. UtxosResponse -> Rep UtxosResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UtxosResponse x -> UtxosResponse
$cfrom :: forall x. UtxosResponse -> Rep UtxosResponse x
Generic, Value -> Parser [UtxosResponse]
Value -> Parser UtxosResponse
(Value -> Parser UtxosResponse)
-> (Value -> Parser [UtxosResponse]) -> FromJSON UtxosResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UtxosResponse]
$cparseJSONList :: Value -> Parser [UtxosResponse]
parseJSON :: Value -> Parser UtxosResponse
$cparseJSON :: Value -> Parser UtxosResponse
FromJSON, [UtxosResponse] -> Encoding
[UtxosResponse] -> Value
UtxosResponse -> Encoding
UtxosResponse -> Value
(UtxosResponse -> Value)
-> (UtxosResponse -> Encoding)
-> ([UtxosResponse] -> Value)
-> ([UtxosResponse] -> Encoding)
-> ToJSON UtxosResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UtxosResponse] -> Encoding
$ctoEncodingList :: [UtxosResponse] -> Encoding
toJSONList :: [UtxosResponse] -> Value
$ctoJSONList :: [UtxosResponse] -> Value
toEncoding :: UtxosResponse -> Encoding
$ctoEncoding :: UtxosResponse -> Encoding
toJSON :: UtxosResponse -> Value
$ctoJSON :: UtxosResponse -> Value
ToJSON, Typeable UtxosResponse
Typeable UtxosResponse
-> (Proxy UtxosResponse
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UtxosResponse
Proxy UtxosResponse -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy UtxosResponse -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy UtxosResponse -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable UtxosResponse
OpenApi.ToSchema)

-- | Response type for the is-utxo endpoint.
data IsUtxoResponse = IsUtxoResponse
    { IsUtxoResponse -> Tip
currentTip :: Tip
    , IsUtxoResponse -> Bool
isUtxo     :: Bool
    }
    deriving (Int -> IsUtxoResponse -> ShowS
[IsUtxoResponse] -> ShowS
IsUtxoResponse -> String
(Int -> IsUtxoResponse -> ShowS)
-> (IsUtxoResponse -> String)
-> ([IsUtxoResponse] -> ShowS)
-> Show IsUtxoResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsUtxoResponse] -> ShowS
$cshowList :: [IsUtxoResponse] -> ShowS
show :: IsUtxoResponse -> String
$cshow :: IsUtxoResponse -> String
showsPrec :: Int -> IsUtxoResponse -> ShowS
$cshowsPrec :: Int -> IsUtxoResponse -> ShowS
Show, IsUtxoResponse -> IsUtxoResponse -> Bool
(IsUtxoResponse -> IsUtxoResponse -> Bool)
-> (IsUtxoResponse -> IsUtxoResponse -> Bool) -> Eq IsUtxoResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsUtxoResponse -> IsUtxoResponse -> Bool
$c/= :: IsUtxoResponse -> IsUtxoResponse -> Bool
== :: IsUtxoResponse -> IsUtxoResponse -> Bool
$c== :: IsUtxoResponse -> IsUtxoResponse -> Bool
Eq, (forall x. IsUtxoResponse -> Rep IsUtxoResponse x)
-> (forall x. Rep IsUtxoResponse x -> IsUtxoResponse)
-> Generic IsUtxoResponse
forall x. Rep IsUtxoResponse x -> IsUtxoResponse
forall x. IsUtxoResponse -> Rep IsUtxoResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IsUtxoResponse x -> IsUtxoResponse
$cfrom :: forall x. IsUtxoResponse -> Rep IsUtxoResponse x
Generic, Value -> Parser [IsUtxoResponse]
Value -> Parser IsUtxoResponse
(Value -> Parser IsUtxoResponse)
-> (Value -> Parser [IsUtxoResponse]) -> FromJSON IsUtxoResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [IsUtxoResponse]
$cparseJSONList :: Value -> Parser [IsUtxoResponse]
parseJSON :: Value -> Parser IsUtxoResponse
$cparseJSON :: Value -> Parser IsUtxoResponse
FromJSON, [IsUtxoResponse] -> Encoding
[IsUtxoResponse] -> Value
IsUtxoResponse -> Encoding
IsUtxoResponse -> Value
(IsUtxoResponse -> Value)
-> (IsUtxoResponse -> Encoding)
-> ([IsUtxoResponse] -> Value)
-> ([IsUtxoResponse] -> Encoding)
-> ToJSON IsUtxoResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [IsUtxoResponse] -> Encoding
$ctoEncodingList :: [IsUtxoResponse] -> Encoding
toJSONList :: [IsUtxoResponse] -> Value
$ctoJSONList :: [IsUtxoResponse] -> Value
toEncoding :: IsUtxoResponse -> Encoding
$ctoEncoding :: IsUtxoResponse -> Encoding
toJSON :: IsUtxoResponse -> Value
$ctoJSON :: IsUtxoResponse -> Value
ToJSON, Typeable IsUtxoResponse
Typeable IsUtxoResponse
-> (Proxy IsUtxoResponse
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema IsUtxoResponse
Proxy IsUtxoResponse -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy IsUtxoResponse -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy IsUtxoResponse -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable IsUtxoResponse
OpenApi.ToSchema)

data TxoAtAddressRequest = TxoAtAddressRequest
    { TxoAtAddressRequest -> Maybe (PageQuery TxOutRef)
pageQuery  :: Maybe (PageQuery TxOutRef)
    , TxoAtAddressRequest -> Credential
credential :: Credential
    }
    deriving (Int -> TxoAtAddressRequest -> ShowS
[TxoAtAddressRequest] -> ShowS
TxoAtAddressRequest -> String
(Int -> TxoAtAddressRequest -> ShowS)
-> (TxoAtAddressRequest -> String)
-> ([TxoAtAddressRequest] -> ShowS)
-> Show TxoAtAddressRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxoAtAddressRequest] -> ShowS
$cshowList :: [TxoAtAddressRequest] -> ShowS
show :: TxoAtAddressRequest -> String
$cshow :: TxoAtAddressRequest -> String
showsPrec :: Int -> TxoAtAddressRequest -> ShowS
$cshowsPrec :: Int -> TxoAtAddressRequest -> ShowS
Show, TxoAtAddressRequest -> TxoAtAddressRequest -> Bool
(TxoAtAddressRequest -> TxoAtAddressRequest -> Bool)
-> (TxoAtAddressRequest -> TxoAtAddressRequest -> Bool)
-> Eq TxoAtAddressRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxoAtAddressRequest -> TxoAtAddressRequest -> Bool
$c/= :: TxoAtAddressRequest -> TxoAtAddressRequest -> Bool
== :: TxoAtAddressRequest -> TxoAtAddressRequest -> Bool
$c== :: TxoAtAddressRequest -> TxoAtAddressRequest -> Bool
Eq, (forall x. TxoAtAddressRequest -> Rep TxoAtAddressRequest x)
-> (forall x. Rep TxoAtAddressRequest x -> TxoAtAddressRequest)
-> Generic TxoAtAddressRequest
forall x. Rep TxoAtAddressRequest x -> TxoAtAddressRequest
forall x. TxoAtAddressRequest -> Rep TxoAtAddressRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxoAtAddressRequest x -> TxoAtAddressRequest
$cfrom :: forall x. TxoAtAddressRequest -> Rep TxoAtAddressRequest x
Generic, Value -> Parser [TxoAtAddressRequest]
Value -> Parser TxoAtAddressRequest
(Value -> Parser TxoAtAddressRequest)
-> (Value -> Parser [TxoAtAddressRequest])
-> FromJSON TxoAtAddressRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TxoAtAddressRequest]
$cparseJSONList :: Value -> Parser [TxoAtAddressRequest]
parseJSON :: Value -> Parser TxoAtAddressRequest
$cparseJSON :: Value -> Parser TxoAtAddressRequest
FromJSON, [TxoAtAddressRequest] -> Encoding
[TxoAtAddressRequest] -> Value
TxoAtAddressRequest -> Encoding
TxoAtAddressRequest -> Value
(TxoAtAddressRequest -> Value)
-> (TxoAtAddressRequest -> Encoding)
-> ([TxoAtAddressRequest] -> Value)
-> ([TxoAtAddressRequest] -> Encoding)
-> ToJSON TxoAtAddressRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TxoAtAddressRequest] -> Encoding
$ctoEncodingList :: [TxoAtAddressRequest] -> Encoding
toJSONList :: [TxoAtAddressRequest] -> Value
$ctoJSONList :: [TxoAtAddressRequest] -> Value
toEncoding :: TxoAtAddressRequest -> Encoding
$ctoEncoding :: TxoAtAddressRequest -> Encoding
toJSON :: TxoAtAddressRequest -> Value
$ctoJSON :: TxoAtAddressRequest -> Value
ToJSON, Typeable TxoAtAddressRequest
Typeable TxoAtAddressRequest
-> (Proxy TxoAtAddressRequest
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema TxoAtAddressRequest
Proxy TxoAtAddressRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy TxoAtAddressRequest
-> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy TxoAtAddressRequest
-> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable TxoAtAddressRequest
OpenApi.ToSchema)

-- | Response type for the txo-at-address endpoint.
data TxosResponse = TxosResponse
    { TxosResponse -> Page TxOutRef
paget :: Page TxOutRef
    }
    deriving (Int -> TxosResponse -> ShowS
[TxosResponse] -> ShowS
TxosResponse -> String
(Int -> TxosResponse -> ShowS)
-> (TxosResponse -> String)
-> ([TxosResponse] -> ShowS)
-> Show TxosResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxosResponse] -> ShowS
$cshowList :: [TxosResponse] -> ShowS
show :: TxosResponse -> String
$cshow :: TxosResponse -> String
showsPrec :: Int -> TxosResponse -> ShowS
$cshowsPrec :: Int -> TxosResponse -> ShowS
Show, TxosResponse -> TxosResponse -> Bool
(TxosResponse -> TxosResponse -> Bool)
-> (TxosResponse -> TxosResponse -> Bool) -> Eq TxosResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxosResponse -> TxosResponse -> Bool
$c/= :: TxosResponse -> TxosResponse -> Bool
== :: TxosResponse -> TxosResponse -> Bool
$c== :: TxosResponse -> TxosResponse -> Bool
Eq, (forall x. TxosResponse -> Rep TxosResponse x)
-> (forall x. Rep TxosResponse x -> TxosResponse)
-> Generic TxosResponse
forall x. Rep TxosResponse x -> TxosResponse
forall x. TxosResponse -> Rep TxosResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxosResponse x -> TxosResponse
$cfrom :: forall x. TxosResponse -> Rep TxosResponse x
Generic, Value -> Parser [TxosResponse]
Value -> Parser TxosResponse
(Value -> Parser TxosResponse)
-> (Value -> Parser [TxosResponse]) -> FromJSON TxosResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TxosResponse]
$cparseJSONList :: Value -> Parser [TxosResponse]
parseJSON :: Value -> Parser TxosResponse
$cparseJSON :: Value -> Parser TxosResponse
FromJSON, [TxosResponse] -> Encoding
[TxosResponse] -> Value
TxosResponse -> Encoding
TxosResponse -> Value
(TxosResponse -> Value)
-> (TxosResponse -> Encoding)
-> ([TxosResponse] -> Value)
-> ([TxosResponse] -> Encoding)
-> ToJSON TxosResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TxosResponse] -> Encoding
$ctoEncodingList :: [TxosResponse] -> Encoding
toJSONList :: [TxosResponse] -> Value
$ctoJSONList :: [TxosResponse] -> Value
toEncoding :: TxosResponse -> Encoding
$ctoEncoding :: TxosResponse -> Encoding
toJSON :: TxosResponse -> Value
$ctoJSON :: TxosResponse -> Value
ToJSON, Typeable TxosResponse
Typeable TxosResponse
-> (Proxy TxosResponse -> Declare (Definitions Schema) NamedSchema)
-> ToSchema TxosResponse
Proxy TxosResponse -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy TxosResponse -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy TxosResponse -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable TxosResponse
OpenApi.ToSchema)


data QueryAtAddressRequest = QueryAtAddressRequest
    { QueryAtAddressRequest -> Maybe (PageQuery TxOutRef)
pageQuery  :: Maybe (PageQuery TxOutRef)
    , QueryAtAddressRequest -> Credential
credential :: Credential
    }
    deriving (Int -> QueryAtAddressRequest -> ShowS
[QueryAtAddressRequest] -> ShowS
QueryAtAddressRequest -> String
(Int -> QueryAtAddressRequest -> ShowS)
-> (QueryAtAddressRequest -> String)
-> ([QueryAtAddressRequest] -> ShowS)
-> Show QueryAtAddressRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryAtAddressRequest] -> ShowS
$cshowList :: [QueryAtAddressRequest] -> ShowS
show :: QueryAtAddressRequest -> String
$cshow :: QueryAtAddressRequest -> String
showsPrec :: Int -> QueryAtAddressRequest -> ShowS
$cshowsPrec :: Int -> QueryAtAddressRequest -> ShowS
Show, QueryAtAddressRequest -> QueryAtAddressRequest -> Bool
(QueryAtAddressRequest -> QueryAtAddressRequest -> Bool)
-> (QueryAtAddressRequest -> QueryAtAddressRequest -> Bool)
-> Eq QueryAtAddressRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryAtAddressRequest -> QueryAtAddressRequest -> Bool
$c/= :: QueryAtAddressRequest -> QueryAtAddressRequest -> Bool
== :: QueryAtAddressRequest -> QueryAtAddressRequest -> Bool
$c== :: QueryAtAddressRequest -> QueryAtAddressRequest -> Bool
Eq, (forall x. QueryAtAddressRequest -> Rep QueryAtAddressRequest x)
-> (forall x. Rep QueryAtAddressRequest x -> QueryAtAddressRequest)
-> Generic QueryAtAddressRequest
forall x. Rep QueryAtAddressRequest x -> QueryAtAddressRequest
forall x. QueryAtAddressRequest -> Rep QueryAtAddressRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QueryAtAddressRequest x -> QueryAtAddressRequest
$cfrom :: forall x. QueryAtAddressRequest -> Rep QueryAtAddressRequest x
Generic, Value -> Parser [QueryAtAddressRequest]
Value -> Parser QueryAtAddressRequest
(Value -> Parser QueryAtAddressRequest)
-> (Value -> Parser [QueryAtAddressRequest])
-> FromJSON QueryAtAddressRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [QueryAtAddressRequest]
$cparseJSONList :: Value -> Parser [QueryAtAddressRequest]
parseJSON :: Value -> Parser QueryAtAddressRequest
$cparseJSON :: Value -> Parser QueryAtAddressRequest
FromJSON, [QueryAtAddressRequest] -> Encoding
[QueryAtAddressRequest] -> Value
QueryAtAddressRequest -> Encoding
QueryAtAddressRequest -> Value
(QueryAtAddressRequest -> Value)
-> (QueryAtAddressRequest -> Encoding)
-> ([QueryAtAddressRequest] -> Value)
-> ([QueryAtAddressRequest] -> Encoding)
-> ToJSON QueryAtAddressRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [QueryAtAddressRequest] -> Encoding
$ctoEncodingList :: [QueryAtAddressRequest] -> Encoding
toJSONList :: [QueryAtAddressRequest] -> Value
$ctoJSONList :: [QueryAtAddressRequest] -> Value
toEncoding :: QueryAtAddressRequest -> Encoding
$ctoEncoding :: QueryAtAddressRequest -> Encoding
toJSON :: QueryAtAddressRequest -> Value
$ctoJSON :: QueryAtAddressRequest -> Value
ToJSON, Typeable QueryAtAddressRequest
Typeable QueryAtAddressRequest
-> (Proxy QueryAtAddressRequest
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema QueryAtAddressRequest
Proxy QueryAtAddressRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy QueryAtAddressRequest
-> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy QueryAtAddressRequest
-> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable QueryAtAddressRequest
OpenApi.ToSchema)

-- | generic response type endpoint
-- This type is introduced to avoid querying the chain index twice to obtain the expected info.
-- Indeed, it returns the next page query if more items are available
data QueryResponse a = QueryResponse
    { QueryResponse a -> a
queryResult :: a
    , QueryResponse a -> Maybe (PageQuery TxOutRef)
nextQuery   :: Maybe (PageQuery TxOutRef)
    }
    deriving (Int -> QueryResponse a -> ShowS
[QueryResponse a] -> ShowS
QueryResponse a -> String
(Int -> QueryResponse a -> ShowS)
-> (QueryResponse a -> String)
-> ([QueryResponse a] -> ShowS)
-> Show (QueryResponse a)
forall a. Show a => Int -> QueryResponse a -> ShowS
forall a. Show a => [QueryResponse a] -> ShowS
forall a. Show a => QueryResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryResponse a] -> ShowS
$cshowList :: forall a. Show a => [QueryResponse a] -> ShowS
show :: QueryResponse a -> String
$cshow :: forall a. Show a => QueryResponse a -> String
showsPrec :: Int -> QueryResponse a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> QueryResponse a -> ShowS
Show, (forall x. QueryResponse a -> Rep (QueryResponse a) x)
-> (forall x. Rep (QueryResponse a) x -> QueryResponse a)
-> Generic (QueryResponse a)
forall x. Rep (QueryResponse a) x -> QueryResponse a
forall x. QueryResponse a -> Rep (QueryResponse a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (QueryResponse a) x -> QueryResponse a
forall a x. QueryResponse a -> Rep (QueryResponse a) x
$cto :: forall a x. Rep (QueryResponse a) x -> QueryResponse a
$cfrom :: forall a x. QueryResponse a -> Rep (QueryResponse a) x
Generic, QueryResponse a -> QueryResponse a -> Bool
(QueryResponse a -> QueryResponse a -> Bool)
-> (QueryResponse a -> QueryResponse a -> Bool)
-> Eq (QueryResponse a)
forall a. Eq a => QueryResponse a -> QueryResponse a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryResponse a -> QueryResponse a -> Bool
$c/= :: forall a. Eq a => QueryResponse a -> QueryResponse a -> Bool
== :: QueryResponse a -> QueryResponse a -> Bool
$c== :: forall a. Eq a => QueryResponse a -> QueryResponse a -> Bool
Eq)

deriving instance (FromJSON a, Generic a) => FromJSON (QueryResponse a)
deriving instance (ToJSON a, Generic a) => ToJSON (QueryResponse a)
deriving instance (OpenApi.ToSchema a, Generic a) => OpenApi.ToSchema (QueryResponse a)

type API
    = "healthcheck" :> Description "Is the server alive?" :> Get '[JSON] NoContent
    :<|> "from-hash" :> FromHashAPI
    :<|> "tx-out" :> Description "Get a transaction output from its reference." :> ReqBody '[JSON] TxOutRef :> Post '[JSON] DecoratedTxOut
    :<|> "unspent-tx-out" :> Description "Get a unspent transaction output from its reference." :> ReqBody '[JSON] TxOutRef :> Post '[JSON] DecoratedTxOut
    :<|> "tx" :> Description "Get a transaction from its id." :> ReqBody '[JSON] TxId :> Post '[JSON] ChainIndexTx
    :<|> "is-utxo" :> Description "Check if the reference is an UTxO." :> ReqBody '[JSON] TxOutRef :> Post '[JSON] IsUtxoResponse
    :<|> "utxo-at-address" :> Description "Get all UTxOs at an address." :> ReqBody '[JSON] UtxoAtAddressRequest :> Post '[JSON] UtxosResponse
    :<|> "unspent-txouts-at-address" :> Description "Get all unspent transaction output at an address." :> ReqBody '[JSON] QueryAtAddressRequest :> Post '[JSON] (QueryResponse [(TxOutRef, DecoratedTxOut)])
    :<|> "datums-at-address" :> Description "Get all Datums at an address." :> ReqBody '[JSON] QueryAtAddressRequest :> Post '[JSON] (QueryResponse [Datum])
    :<|> "utxo-with-currency" :> Description "Get all UTxOs with a currency." :> ReqBody '[JSON] UtxoWithCurrencyRequest :> Post '[JSON] UtxosResponse
    :<|> "txs" :> Description "Get transactions from a list of their ids." :> ReqBody '[JSON] [TxId] :> Post '[JSON] [ChainIndexTx]
    :<|> "txo-at-address" :> Description "Get TxOs at an address." :> ReqBody '[JSON] TxoAtAddressRequest :> Post '[JSON] TxosResponse
    :<|> "tip" :> Description "Get the current synced tip." :> Get '[JSON] Tip
    :<|> "collect-garbage" :> Description "Collect chain index garbage to free up space." :> Put '[JSON] NoContent
    :<|> "diagnostics" :> Description "Get the current stats of the chain index." :> Get '[JSON] Diagnostics

type FromHashAPI =
    "datum" :> Description "Get a datum from its hash." :> ReqBody '[JSON] DatumHash :> Post '[JSON] Datum
    :<|> "validator" :> Description "Get a validator script from its hash." :> ReqBody '[JSON] ValidatorHash :> Post '[JSON] (Versioned Validator)
    :<|> "minting-policy" :> Description "Get a minting policy from its hash." :> ReqBody '[JSON] MintingPolicyHash :> Post '[JSON] (Versioned MintingPolicy)
    :<|> "stake-validator" :> Description "Get a stake validator from its hash." :> ReqBody '[JSON] StakeValidatorHash :> Post '[JSON] (Versioned StakeValidator)
    :<|> "redeemer" :> Description "Get a redeemer from its hash." :> ReqBody '[JSON] RedeemerHash :> Post '[JSON] Redeemer

type SwaggerAPI = "swagger" :> SwaggerSchemaUI "swagger-ui" "swagger.json"

swagger :: forall dir api. Servant.Server api ~ Servant.Handler Value => Servant.Server (SwaggerSchemaUI' dir api)
swagger :: Server (SwaggerSchemaUI' dir api)
swagger = OpenApi -> Server (SwaggerSchemaUI' dir api)
forall api a (dir :: Symbol).
(Server api ~ Handler Value, ToJSON a) =>
a -> Server (SwaggerSchemaUI' dir api)
swaggerSchemaUIServer (Proxy API -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy API
forall k (t :: k). Proxy t
Proxy @API))

-- We don't include `SwaggerAPI` into `API` to exclude it from the effects code.
type FullAPI = API :<|> SwaggerAPI

-- | Go through each 'Page's of 'QueryResponse', and collect the results.
collectQueryResponse ::
    ( Monad m )
    => (PageQuery TxOutRef -> m (QueryResponse a)) -- ^ query response function
    -> m [a]
collectQueryResponse :: (PageQuery TxOutRef -> m (QueryResponse a)) -> m [a]
collectQueryResponse PageQuery TxOutRef -> m (QueryResponse a)
q = Maybe (PageQuery TxOutRef) -> m [a]
go (PageQuery TxOutRef -> Maybe (PageQuery TxOutRef)
forall a. a -> Maybe a
Just PageQuery TxOutRef
forall a. Default a => a
def)
  where
    go :: Maybe (PageQuery TxOutRef) -> m [a]
go Maybe (PageQuery TxOutRef)
Nothing = [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    go (Just PageQuery TxOutRef
pq) = do
      QueryResponse a
res <- PageQuery TxOutRef -> m (QueryResponse a)
q PageQuery TxOutRef
pq
      (QueryResponse a -> a
forall a. QueryResponse a -> a
queryResult QueryResponse a
res a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PageQuery TxOutRef) -> m [a]
go (QueryResponse a -> Maybe (PageQuery TxOutRef)
forall a. QueryResponse a -> Maybe (PageQuery TxOutRef)
nextQuery QueryResponse a
res)