{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}

module Simplex.Messaging.Agent.Env.SQLite where

import Control.Monad.IO.Unlift
import Crypto.Random
import Data.List.NonEmpty (NonEmpty)
import Network.Socket
import Numeric.Natural
import Simplex.Messaging.Agent.Protocol (SMPServer)
import Simplex.Messaging.Agent.RetryInterval
import Simplex.Messaging.Agent.Store.SQLite
import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
import Simplex.Messaging.Client
import System.Random (StdGen, newStdGen)
import UnliftIO.STM

data AgentConfig = AgentConfig
  { AgentConfig -> ServiceName
tcpPort :: ServiceName,
    AgentConfig -> NonEmpty SMPServer
smpServers :: NonEmpty SMPServer,
    AgentConfig -> Int
rsaKeySize :: Int,
    AgentConfig -> Int
connIdBytes :: Int,
    AgentConfig -> Natural
tbqSize :: Natural,
    AgentConfig -> ServiceName
dbFile :: FilePath,
    AgentConfig -> Int
dbPoolSize :: Int,
    AgentConfig -> SMPClientConfig
smpCfg :: SMPClientConfig,
    AgentConfig -> RetryInterval
retryInterval :: RetryInterval,
    AgentConfig -> RetryInterval
reconnectInterval :: RetryInterval
  }

minute :: Int
minute :: Int
minute = Int
60_000_000

defaultAgentConfig :: AgentConfig
defaultAgentConfig :: AgentConfig
defaultAgentConfig =
  AgentConfig :: ServiceName
-> NonEmpty SMPServer
-> Int
-> Int
-> Natural
-> ServiceName
-> Int
-> SMPClientConfig
-> RetryInterval
-> RetryInterval
-> AgentConfig
AgentConfig
    { $sel:tcpPort:AgentConfig :: ServiceName
tcpPort = ServiceName
"5224",
      $sel:smpServers:AgentConfig :: NonEmpty SMPServer
smpServers = NonEmpty SMPServer
forall a. HasCallStack => a
undefined,
      $sel:rsaKeySize:AgentConfig :: Int
rsaKeySize = Int
2048 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8,
      $sel:connIdBytes:AgentConfig :: Int
connIdBytes = Int
12,
      $sel:tbqSize:AgentConfig :: Natural
tbqSize = Natural
16,
      $sel:dbFile:AgentConfig :: ServiceName
dbFile = ServiceName
"smp-agent.db",
      $sel:dbPoolSize:AgentConfig :: Int
dbPoolSize = Int
4,
      $sel:smpCfg:AgentConfig :: SMPClientConfig
smpCfg = SMPClientConfig
smpDefaultConfig,
      $sel:retryInterval:AgentConfig :: RetryInterval
retryInterval =
        RetryInterval :: Int -> Int -> Int -> RetryInterval
RetryInterval
          { initialInterval :: Int
initialInterval = Int
1_000_000,
            increaseAfter :: Int
increaseAfter = Int
minute,
            maxInterval :: Int
maxInterval = Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
minute
          },
      $sel:reconnectInterval:AgentConfig :: RetryInterval
reconnectInterval =
        RetryInterval :: Int -> Int -> Int -> RetryInterval
RetryInterval
          { initialInterval :: Int
initialInterval = Int
1_000_000,
            increaseAfter :: Int
increaseAfter = Int
10_000_000,
            maxInterval :: Int
maxInterval = Int
10_000_000
          }
    }

data Env = Env
  { Env -> AgentConfig
config :: AgentConfig,
    Env -> SQLiteStore
store :: SQLiteStore,
    Env -> TVar ChaChaDRG
idsDrg :: TVar ChaChaDRG,
    Env -> TVar Int
clientCounter :: TVar Int,
    Env -> Int
reservedMsgSize :: Int,
    Env -> TVar StdGen
randomServer :: TVar StdGen
  }

newSMPAgentEnv :: (MonadUnliftIO m, MonadRandom m) => AgentConfig -> m Env
newSMPAgentEnv :: AgentConfig -> m Env
newSMPAgentEnv AgentConfig
cfg = do
  TVar ChaChaDRG
idsDrg <- ChaChaDRG -> m (TVar ChaChaDRG)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO (ChaChaDRG -> m (TVar ChaChaDRG))
-> m ChaChaDRG -> m (TVar ChaChaDRG)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m ChaChaDRG
forall (randomly :: * -> *).
MonadRandom randomly =>
randomly ChaChaDRG
drgNew
  SQLiteStore
store <- IO SQLiteStore -> m SQLiteStore
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLiteStore -> m SQLiteStore)
-> IO SQLiteStore -> m SQLiteStore
forall a b. (a -> b) -> a -> b
$ ServiceName -> Int -> [Migration] -> IO SQLiteStore
createSQLiteStore (AgentConfig -> ServiceName
dbFile AgentConfig
cfg) (AgentConfig -> Int
dbPoolSize AgentConfig
cfg) [Migration]
Migrations.app
  TVar Int
clientCounter <- Int -> m (TVar Int)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Int
0
  TVar StdGen
randomServer <- StdGen -> m (TVar StdGen)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO (StdGen -> m (TVar StdGen)) -> m StdGen -> m (TVar StdGen)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO StdGen -> m StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
  Env -> m Env
forall (m :: * -> *) a. Monad m => a -> m a
return Env :: AgentConfig
-> SQLiteStore
-> TVar ChaChaDRG
-> TVar Int
-> Int
-> TVar StdGen
-> Env
Env {$sel:config:Env :: AgentConfig
config = AgentConfig
cfg, SQLiteStore
store :: SQLiteStore
$sel:store:Env :: SQLiteStore
store, TVar ChaChaDRG
idsDrg :: TVar ChaChaDRG
$sel:idsDrg:Env :: TVar ChaChaDRG
idsDrg, TVar Int
clientCounter :: TVar Int
$sel:clientCounter:Env :: TVar Int
clientCounter, Int
reservedMsgSize :: Int
$sel:reservedMsgSize:Env :: Int
reservedMsgSize, TVar StdGen
randomServer :: TVar StdGen
$sel:randomServer:Env :: TVar StdGen
randomServer}
  where
    -- 1st rsaKeySize is used by the RSA signature in each command,
    -- 2nd - by encrypted message body header
    -- 3rd - by message signature
    -- smpCommandSize - is the estimated max size for SMP command, queueId, corrId
    reservedMsgSize :: Int
reservedMsgSize = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* AgentConfig -> Int
rsaKeySize AgentConfig
cfg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SMPClientConfig -> Int
smpCommandSize (AgentConfig -> SMPClientConfig
smpCfg AgentConfig
cfg)