{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
module Marconi.Api.HttpServer(
    bootstrap
    ) where

import Control.Lens ((^.))
import Control.Monad.IO.Class (liftIO)
import Data.Bifunctor (first)
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text, pack)
import Data.Time (defaultTimeLocale, formatTime, getCurrentTime)
import Network.Wai.Handler.Warp (runSettings)
import Servant.API (NoContent (NoContent), (:<|>) ((:<|>)))
import Servant.Server (Handler, Server, serve)

import Cardano.Api ()
import Marconi.Api.Routes (API)
import Marconi.Api.Types (DBQueryEnv, HasJsonRpcEnv (httpSettings, queryEnv), JsonRpcEnv, QueryExceptions,
                          UtxoTxOutReport)
import Marconi.Api.UtxoIndexersQuery qualified as Q.Utxo (findAll, findByAddress, reportBech32Addresses)
import Marconi.JsonRpc.Types (JsonRpcErr (JsonRpcErr, errorCode, errorData, errorMessage), parseErrorCode)
import Marconi.Server.Types ()

-- | bootstraps the he http server
bootstrap :: JsonRpcEnv -> IO ()
bootstrap :: JsonRpcEnv -> IO ()
bootstrap JsonRpcEnv
env =  Settings -> Application -> IO ()
runSettings
        (JsonRpcEnv
env JsonRpcEnv -> Getting Settings JsonRpcEnv Settings -> Settings
forall s a. s -> Getting a s a -> a
^. Getting Settings JsonRpcEnv Settings
forall c. HasJsonRpcEnv c => Lens' c Settings
httpSettings)
        (Proxy API -> Server API -> Application
forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (Proxy API
forall k (t :: k). Proxy t
Proxy @API) (DBQueryEnv -> Server API
server (JsonRpcEnv
env JsonRpcEnv
-> Getting DBQueryEnv JsonRpcEnv DBQueryEnv -> DBQueryEnv
forall s a. s -> Getting a s a -> a
^. Getting DBQueryEnv JsonRpcEnv DBQueryEnv
forall c. HasJsonRpcEnv c => Lens' c DBQueryEnv
queryEnv ) ) )

server :: DBQueryEnv -> Server API
server :: DBQueryEnv -> Server API
server DBQueryEnv
env
    = ( String -> Handler (Either (JsonRpcErr String) String)
echo
        (String -> Handler (Either (JsonRpcErr String) String))
-> ((String
     -> Handler (Either (JsonRpcErr String) UtxoTxOutReport))
    :<|> ((Int
           -> Handler (Either (JsonRpcErr String) [UtxoTxOutReport]))
          :<|> ((Int -> Handler (Either (JsonRpcErr String) [Text]))
                :<|> (String -> Handler NoContent))))
-> (String -> Handler (Either (JsonRpcErr String) String))
   :<|> ((String
          -> Handler (Either (JsonRpcErr String) UtxoTxOutReport))
         :<|> ((Int
                -> Handler (Either (JsonRpcErr String) [UtxoTxOutReport]))
               :<|> ((Int -> Handler (Either (JsonRpcErr String) [Text]))
                     :<|> (String -> Handler NoContent))))
forall a b. a -> b -> a :<|> b
:<|> DBQueryEnv
-> String -> Handler (Either (JsonRpcErr String) UtxoTxOutReport)
utxoTxOutReport DBQueryEnv
env
        (String -> Handler (Either (JsonRpcErr String) UtxoTxOutReport))
-> ((Int -> Handler (Either (JsonRpcErr String) [UtxoTxOutReport]))
    :<|> ((Int -> Handler (Either (JsonRpcErr String) [Text]))
          :<|> (String -> Handler NoContent)))
-> (String -> Handler (Either (JsonRpcErr String) UtxoTxOutReport))
   :<|> ((Int
          -> Handler (Either (JsonRpcErr String) [UtxoTxOutReport]))
         :<|> ((Int -> Handler (Either (JsonRpcErr String) [Text]))
               :<|> (String -> Handler NoContent)))
forall a b. a -> b -> a :<|> b
:<|> DBQueryEnv
-> Int -> Handler (Either (JsonRpcErr String) [UtxoTxOutReport])
utxoTxOutReports DBQueryEnv
env
        (Int -> Handler (Either (JsonRpcErr String) [UtxoTxOutReport]))
-> ((Int -> Handler (Either (JsonRpcErr String) [Text]))
    :<|> (String -> Handler NoContent))
-> (Int -> Handler (Either (JsonRpcErr String) [UtxoTxOutReport]))
   :<|> ((Int -> Handler (Either (JsonRpcErr String) [Text]))
         :<|> (String -> Handler NoContent))
forall a b. a -> b -> a :<|> b
:<|> DBQueryEnv -> Int -> Handler (Either (JsonRpcErr String) [Text])
targetAddressesReport DBQueryEnv
env
        (Int -> Handler (Either (JsonRpcErr String) [Text]))
-> (String -> Handler NoContent)
-> (Int -> Handler (Either (JsonRpcErr String) [Text]))
   :<|> (String -> Handler NoContent)
forall a b. a -> b -> a :<|> b
:<|> DBQueryEnv -> String -> Handler NoContent
printMessage DBQueryEnv
env )
      ((String -> Handler (Either (JsonRpcErr String) String))
 :<|> ((String
        -> Handler (Either (JsonRpcErr String) UtxoTxOutReport))
       :<|> ((Int
              -> Handler (Either (JsonRpcErr String) [UtxoTxOutReport]))
             :<|> ((Int -> Handler (Either (JsonRpcErr String) [Text]))
                   :<|> (String -> Handler NoContent)))))
-> (Handler String
    :<|> (Handler [Text] :<|> (String -> Handler NoContent)))
-> ((String -> Handler (Either (JsonRpcErr String) String))
    :<|> ((String
           -> Handler (Either (JsonRpcErr String) UtxoTxOutReport))
          :<|> ((Int
                 -> Handler (Either (JsonRpcErr String) [UtxoTxOutReport]))
                :<|> ((Int -> Handler (Either (JsonRpcErr String) [Text]))
                      :<|> (String -> Handler NoContent)))))
   :<|> (Handler String
         :<|> (Handler [Text] :<|> (String -> Handler NoContent)))
forall a b. a -> b -> a :<|> b
:<|> (Handler String
getTime
            Handler String
-> (Handler [Text] :<|> (String -> Handler NoContent))
-> Handler String
   :<|> (Handler [Text] :<|> (String -> Handler NoContent))
forall a b. a -> b -> a :<|> b
:<|> DBQueryEnv -> Handler [Text]
getTargetAddresses DBQueryEnv
env
            Handler [Text]
-> (String -> Handler NoContent)
-> Handler [Text] :<|> (String -> Handler NoContent)
forall a b. a -> b -> a :<|> b
:<|> DBQueryEnv -> String -> Handler NoContent
printMessage DBQueryEnv
env)

-- | prints message to console
--  Used for testing the server from console
printMessage
    :: DBQueryEnv               -- ^ database configuration
    -> String
    -> Handler NoContent
printMessage :: DBQueryEnv -> String -> Handler NoContent
printMessage DBQueryEnv
env String
msg = NoContent
NoContent NoContent -> Handler () -> Handler NoContent
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  (
    IO () -> Handler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Handler ()) -> IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ do
            String -> IO ()
putStrLn String
msg
            String -> IO ()
putStrLn String
"\n"
            [Text] -> IO ()
forall a. Show a => a -> IO ()
print (DBQueryEnv -> [Text]
Q.Utxo.reportBech32Addresses DBQueryEnv
env)
    )

-- | echos message back as a jsonrpc response
--  Used for testing the server
echo
    :: String
    ->  Handler (Either (JsonRpcErr String) String)
echo :: String -> Handler (Either (JsonRpcErr String) String)
echo  = Either (JsonRpcErr String) String
-> Handler (Either (JsonRpcErr String) String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (JsonRpcErr String) String
 -> Handler (Either (JsonRpcErr String) String))
-> (String -> Either (JsonRpcErr String) String)
-> String
-> Handler (Either (JsonRpcErr String) String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either (JsonRpcErr String) String
forall a b. b -> Either a b
Right

-- | echos current time as REST response
--  Used for testing the http server outside of jsonrpc protocol
getTime :: Handler String
getTime :: Handler String
getTime = UTCTime -> String
timeString (UTCTime -> String) -> Handler UTCTime -> Handler String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> Handler UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    where
    timeString :: UTCTime -> String
timeString = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%T"

getTargetAddresses
    :: DBQueryEnv               -- ^ database configuration
    ->  Handler [Text]
getTargetAddresses :: DBQueryEnv -> Handler [Text]
getTargetAddresses =  [Text] -> Handler [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Handler [Text])
-> (DBQueryEnv -> [Text]) -> DBQueryEnv -> Handler [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBQueryEnv -> [Text]
Q.Utxo.reportBech32Addresses

-- | Retrieves a set of TxOutRef
utxoTxOutReport
    :: DBQueryEnv               -- ^ database configuration
    -> String                   -- ^ bech32 addressCredential
    -> Handler (Either (JsonRpcErr String) UtxoTxOutReport )
utxoTxOutReport :: DBQueryEnv
-> String -> Handler (Either (JsonRpcErr String) UtxoTxOutReport)
utxoTxOutReport DBQueryEnv
env String
address = IO (Either (JsonRpcErr String) UtxoTxOutReport)
-> Handler (Either (JsonRpcErr String) UtxoTxOutReport)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (JsonRpcErr String) UtxoTxOutReport)
 -> Handler (Either (JsonRpcErr String) UtxoTxOutReport))
-> IO (Either (JsonRpcErr String) UtxoTxOutReport)
-> Handler (Either (JsonRpcErr String) UtxoTxOutReport)
forall a b. (a -> b) -> a -> b
$
    (QueryExceptions -> JsonRpcErr String)
-> Either QueryExceptions UtxoTxOutReport
-> Either (JsonRpcErr String) UtxoTxOutReport
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first QueryExceptions -> JsonRpcErr String
toRpcErr (Either QueryExceptions UtxoTxOutReport
 -> Either (JsonRpcErr String) UtxoTxOutReport)
-> IO (Either QueryExceptions UtxoTxOutReport)
-> IO (Either (JsonRpcErr String) UtxoTxOutReport)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DBQueryEnv -> Text -> IO (Either QueryExceptions UtxoTxOutReport)
Q.Utxo.findByAddress DBQueryEnv
env (Text -> IO (Either QueryExceptions UtxoTxOutReport))
-> (String -> Text)
-> String
-> IO (Either QueryExceptions UtxoTxOutReport)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> IO (Either QueryExceptions UtxoTxOutReport))
-> String -> IO (Either QueryExceptions UtxoTxOutReport)
forall a b. (a -> b) -> a -> b
$ String
address)

-- | Retrieves a set of TxOutRef
-- TODO convert this to stream
utxoTxOutReports
    :: DBQueryEnv                   -- ^ database configuration
    -> Int                          -- ^ limit, for now we are ignoring this param and return 100
    -> Handler (Either (JsonRpcErr String) [UtxoTxOutReport])
utxoTxOutReports :: DBQueryEnv
-> Int -> Handler (Either (JsonRpcErr String) [UtxoTxOutReport])
utxoTxOutReports DBQueryEnv
env Int
_ =
    IO (Either (JsonRpcErr String) [UtxoTxOutReport])
-> Handler (Either (JsonRpcErr String) [UtxoTxOutReport])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (JsonRpcErr String) [UtxoTxOutReport])
 -> Handler (Either (JsonRpcErr String) [UtxoTxOutReport]))
-> IO (Either (JsonRpcErr String) [UtxoTxOutReport])
-> Handler (Either (JsonRpcErr String) [UtxoTxOutReport])
forall a b. (a -> b) -> a -> b
$ [UtxoTxOutReport] -> Either (JsonRpcErr String) [UtxoTxOutReport]
forall a b. b -> Either a b
Right ([UtxoTxOutReport] -> Either (JsonRpcErr String) [UtxoTxOutReport])
-> IO [UtxoTxOutReport]
-> IO (Either (JsonRpcErr String) [UtxoTxOutReport])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DBQueryEnv -> IO [UtxoTxOutReport]
Q.Utxo.findAll DBQueryEnv
env

targetAddressesReport
    :: DBQueryEnv                   -- ^ database configuration
    -> Int                          -- ^ limit, for now we are ignoring this param and return 100
    -> Handler (Either (JsonRpcErr String) [Text] )
targetAddressesReport :: DBQueryEnv -> Int -> Handler (Either (JsonRpcErr String) [Text])
targetAddressesReport DBQueryEnv
env Int
_ = Either (JsonRpcErr String) [Text]
-> Handler (Either (JsonRpcErr String) [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (JsonRpcErr String) [Text]
 -> Handler (Either (JsonRpcErr String) [Text]))
-> (DBQueryEnv -> Either (JsonRpcErr String) [Text])
-> DBQueryEnv
-> Handler (Either (JsonRpcErr String) [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Either (JsonRpcErr String) [Text]
forall a b. b -> Either a b
Right ([Text] -> Either (JsonRpcErr String) [Text])
-> (DBQueryEnv -> [Text])
-> DBQueryEnv
-> Either (JsonRpcErr String) [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBQueryEnv -> [Text]
Q.Utxo.reportBech32Addresses (DBQueryEnv -> Handler (Either (JsonRpcErr String) [Text]))
-> DBQueryEnv -> Handler (Either (JsonRpcErr String) [Text])
forall a b. (a -> b) -> a -> b
$ DBQueryEnv
env

-- | convert form to jsonrpc protocal error
toRpcErr
    :: QueryExceptions
    -> JsonRpcErr String
toRpcErr :: QueryExceptions -> JsonRpcErr String
toRpcErr QueryExceptions
e = JsonRpcErr :: forall e. Int -> String -> Maybe e -> JsonRpcErr e
JsonRpcErr {
           errorCode :: Int
errorCode = Int
parseErrorCode
           , errorMessage :: String
errorMessage = String
"marconi RPC query related error!"
           , errorData :: Maybe String
errorData = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (QueryExceptions -> String) -> QueryExceptions -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryExceptions -> String
forall a. Show a => a -> String
show (QueryExceptions -> Maybe String)
-> QueryExceptions -> Maybe String
forall a b. (a -> b) -> a -> b
$ QueryExceptions
e
           }