{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Plutus.ChainIndex.Config(
  ChainIndexConfig(..),
  DecodeConfigException(..),
  defaultConfig,
  -- * Lenses
  socketPath,
  dbPath,
  port,
  networkId,
  securityParam,
  slotConfig,
  storeFrom,
  appendTransactionQueueSize
  ) where

import Cardano.Api (BlockNo (BlockNo), NetworkId (Testnet))
import Cardano.Node.Emulator.TimeSlot (SlotConfig (SlotConfig, scSlotLength, scSlotZeroTime))
import Control.Exception (Exception)
import Control.Lens (makeLensesFor)
import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import Ouroboros.Network.Magic (NetworkMagic (NetworkMagic))
import Prettyprinter (Pretty (pretty), viaShow, vsep, (<+>))

data ChainIndexConfig = ChainIndexConfig
  { ChainIndexConfig -> String
cicSocketPath                 :: String
  , ChainIndexConfig -> String
cicDbPath                     :: String
  , ChainIndexConfig -> Int
cicPort                       :: Int
  , ChainIndexConfig -> NetworkId
cicNetworkId                  :: NetworkId
  , ChainIndexConfig -> Int
cicSecurityParam              :: Int -- ^ The number of blocks after which a transaction cannot be rolled back anymore
  , ChainIndexConfig -> SlotConfig
cicSlotConfig                 :: SlotConfig
  , ChainIndexConfig -> BlockNo
cicStoreFrom                  :: BlockNo -- ^ Only store transactions from this block number onward
  , ChainIndexConfig -> Natural
cicAppendTransactionQueueSize :: Natural -- ^ The size of the queue and a number of transactions to collect before writing to the database
  }
  deriving stock (Int -> ChainIndexConfig -> ShowS
[ChainIndexConfig] -> ShowS
ChainIndexConfig -> String
(Int -> ChainIndexConfig -> ShowS)
-> (ChainIndexConfig -> String)
-> ([ChainIndexConfig] -> ShowS)
-> Show ChainIndexConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainIndexConfig] -> ShowS
$cshowList :: [ChainIndexConfig] -> ShowS
show :: ChainIndexConfig -> String
$cshow :: ChainIndexConfig -> String
showsPrec :: Int -> ChainIndexConfig -> ShowS
$cshowsPrec :: Int -> ChainIndexConfig -> ShowS
Show, ChainIndexConfig -> ChainIndexConfig -> Bool
(ChainIndexConfig -> ChainIndexConfig -> Bool)
-> (ChainIndexConfig -> ChainIndexConfig -> Bool)
-> Eq ChainIndexConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainIndexConfig -> ChainIndexConfig -> Bool
$c/= :: ChainIndexConfig -> ChainIndexConfig -> Bool
== :: ChainIndexConfig -> ChainIndexConfig -> Bool
$c== :: ChainIndexConfig -> ChainIndexConfig -> Bool
Eq, (forall x. ChainIndexConfig -> Rep ChainIndexConfig x)
-> (forall x. Rep ChainIndexConfig x -> ChainIndexConfig)
-> Generic ChainIndexConfig
forall x. Rep ChainIndexConfig x -> ChainIndexConfig
forall x. ChainIndexConfig -> Rep ChainIndexConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChainIndexConfig x -> ChainIndexConfig
$cfrom :: forall x. ChainIndexConfig -> Rep ChainIndexConfig x
Generic)
  deriving anyclass (Value -> Parser [ChainIndexConfig]
Value -> Parser ChainIndexConfig
(Value -> Parser ChainIndexConfig)
-> (Value -> Parser [ChainIndexConfig])
-> FromJSON ChainIndexConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ChainIndexConfig]
$cparseJSONList :: Value -> Parser [ChainIndexConfig]
parseJSON :: Value -> Parser ChainIndexConfig
$cparseJSON :: Value -> Parser ChainIndexConfig
FromJSON, [ChainIndexConfig] -> Encoding
[ChainIndexConfig] -> Value
ChainIndexConfig -> Encoding
ChainIndexConfig -> Value
(ChainIndexConfig -> Value)
-> (ChainIndexConfig -> Encoding)
-> ([ChainIndexConfig] -> Value)
-> ([ChainIndexConfig] -> Encoding)
-> ToJSON ChainIndexConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChainIndexConfig] -> Encoding
$ctoEncodingList :: [ChainIndexConfig] -> Encoding
toJSONList :: [ChainIndexConfig] -> Value
$ctoJSONList :: [ChainIndexConfig] -> Value
toEncoding :: ChainIndexConfig -> Encoding
$ctoEncoding :: ChainIndexConfig -> Encoding
toJSON :: ChainIndexConfig -> Value
$ctoJSON :: ChainIndexConfig -> Value
ToJSON)

-- | For some reason these are not defined anywhere, and these are the
--   reason for the -Wno-orphans option.
deriving anyclass instance FromJSON NetworkId
deriving anyclass instance ToJSON NetworkId
deriving anyclass instance FromJSON NetworkMagic
deriving anyclass instance ToJSON NetworkMagic
deriving anyclass instance FromJSON BlockNo
deriving anyclass instance ToJSON BlockNo

-- | These settings work with the main testnet
defaultConfig :: ChainIndexConfig
defaultConfig :: ChainIndexConfig
defaultConfig = ChainIndexConfig :: String
-> String
-> Int
-> NetworkId
-> Int
-> SlotConfig
-> BlockNo
-> Natural
-> ChainIndexConfig
ChainIndexConfig
  { cicSocketPath :: String
cicSocketPath = String
"testnet/node.sock"
  , cicDbPath :: String
cicDbPath     = String
"/tmp/chain-index.db"
  , cicPort :: Int
cicPort       = Int
9083
  , cicNetworkId :: NetworkId
cicNetworkId  = NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId) -> NetworkMagic -> NetworkId
forall a b. (a -> b) -> a -> b
$ Word32 -> NetworkMagic
NetworkMagic Word32
1097911063
  , cicSecurityParam :: Int
cicSecurityParam = Int
2160
  , cicSlotConfig :: SlotConfig
cicSlotConfig =
      SlotConfig :: Integer -> POSIXTime -> SlotConfig
SlotConfig
        { scSlotZeroTime :: POSIXTime
scSlotZeroTime = POSIXTime
1596059091000
        , scSlotLength :: Integer
scSlotLength   = Integer
1000
        }
  , cicStoreFrom :: BlockNo
cicStoreFrom = Word64 -> BlockNo
BlockNo Word64
0
  , cicAppendTransactionQueueSize :: Natural
cicAppendTransactionQueueSize = Natural
500
  }

instance Pretty ChainIndexConfig where
  pretty :: ChainIndexConfig -> Doc ann
pretty ChainIndexConfig{String
cicSocketPath :: String
cicSocketPath :: ChainIndexConfig -> String
cicSocketPath, String
cicDbPath :: String
cicDbPath :: ChainIndexConfig -> String
cicDbPath, Int
cicPort :: Int
cicPort :: ChainIndexConfig -> Int
cicPort, NetworkId
cicNetworkId :: NetworkId
cicNetworkId :: ChainIndexConfig -> NetworkId
cicNetworkId, Int
cicSecurityParam :: Int
cicSecurityParam :: ChainIndexConfig -> Int
cicSecurityParam, BlockNo
cicStoreFrom :: BlockNo
cicStoreFrom :: ChainIndexConfig -> BlockNo
cicStoreFrom, Natural
cicAppendTransactionQueueSize :: Natural
cicAppendTransactionQueueSize :: ChainIndexConfig -> Natural
cicAppendTransactionQueueSize} =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [ Doc ann
"Socket:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
cicSocketPath
         , Doc ann
"Db:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
cicDbPath
         , Doc ann
"Port:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
cicPort
         , Doc ann
"Network Id:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NetworkId -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow NetworkId
cicNetworkId
         , Doc ann
"Security Param:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
cicSecurityParam
         , Doc ann
"Store from:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> BlockNo -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow BlockNo
cicStoreFrom
         , Doc ann
"Append transaction queue size:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Natural -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Natural
cicAppendTransactionQueueSize
         ]

makeLensesFor [
  ("cicSocketPath", "socketPath"),
  ("cicDbPath", "dbPath"),
  ("cicPort", "port"),
  ("cicNetworkId", "networkId"),
  ("cicSecurityParam", "securityParam"),
  ("cicSlotConfig", "slotConfig"),
  ("cicStoreFrom", "storeFrom"),
  ("cicAppendTransactionQueueSize", "appendTransactionQueueSize")
  ] 'ChainIndexConfig

newtype DecodeConfigException = DecodeConfigException String
  deriving stock Int -> DecodeConfigException -> ShowS
[DecodeConfigException] -> ShowS
DecodeConfigException -> String
(Int -> DecodeConfigException -> ShowS)
-> (DecodeConfigException -> String)
-> ([DecodeConfigException] -> ShowS)
-> Show DecodeConfigException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecodeConfigException] -> ShowS
$cshowList :: [DecodeConfigException] -> ShowS
show :: DecodeConfigException -> String
$cshow :: DecodeConfigException -> String
showsPrec :: Int -> DecodeConfigException -> ShowS
$cshowsPrec :: Int -> DecodeConfigException -> ShowS
Show
  deriving anyclass Show DecodeConfigException
Typeable DecodeConfigException
Typeable DecodeConfigException
-> Show DecodeConfigException
-> (DecodeConfigException -> SomeException)
-> (SomeException -> Maybe DecodeConfigException)
-> (DecodeConfigException -> String)
-> Exception DecodeConfigException
SomeException -> Maybe DecodeConfigException
DecodeConfigException -> String
DecodeConfigException -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: DecodeConfigException -> String
$cdisplayException :: DecodeConfigException -> String
fromException :: SomeException -> Maybe DecodeConfigException
$cfromException :: SomeException -> Maybe DecodeConfigException
toException :: DecodeConfigException -> SomeException
$ctoException :: DecodeConfigException -> SomeException
$cp2Exception :: Show DecodeConfigException
$cp1Exception :: Typeable DecodeConfigException
Exception