{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Bindings to TDLib Json interface
module TDLib.TDJson
  ( Verbosity (..),
    Client,

    -- * Creating, Destroying and Interacting with clients
    newClient,
    destroyClient,
    clientReceive,
    clientSend,
    clientExecute,

    -- * Managing the internal logging of TDLib
    setLogFilePath,
    setLogMaxFileSize,
    setLogVerbosityLevel,
    setLogFatalErrorCallback,
  )
where

import Data.ByteString
  ( ByteString,
    packCString,
    useAsCString,
  )
import Data.Int
import Foreign.C
import Foreign.ForeignPtr
import Foreign.Ptr

-- | TDLib client, will be automacially destroyed as soon as there are no references pointing to it (backed by 'ForeignPtr')
newtype Client = Client (ForeignPtr ())
  deriving newtype (Client -> Client -> Bool
(Client -> Client -> Bool)
-> (Client -> Client -> Bool) -> Eq Client
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Client -> Client -> Bool
$c/= :: Client -> Client -> Bool
== :: Client -> Client -> Bool
$c== :: Client -> Client -> Bool
Eq, Eq Client
Eq Client =>
(Client -> Client -> Ordering)
-> (Client -> Client -> Bool)
-> (Client -> Client -> Bool)
-> (Client -> Client -> Bool)
-> (Client -> Client -> Bool)
-> (Client -> Client -> Client)
-> (Client -> Client -> Client)
-> Ord Client
Client -> Client -> Bool
Client -> Client -> Ordering
Client -> Client -> Client
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 :: Client -> Client -> Client
$cmin :: Client -> Client -> Client
max :: Client -> Client -> Client
$cmax :: Client -> Client -> Client
>= :: Client -> Client -> Bool
$c>= :: Client -> Client -> Bool
> :: Client -> Client -> Bool
$c> :: Client -> Client -> Bool
<= :: Client -> Client -> Bool
$c<= :: Client -> Client -> Bool
< :: Client -> Client -> Bool
$c< :: Client -> Client -> Bool
compare :: Client -> Client -> Ordering
$ccompare :: Client -> Client -> Ordering
$cp1Ord :: Eq Client
Ord, Int -> Client -> ShowS
[Client] -> ShowS
Client -> String
(Int -> Client -> ShowS)
-> (Client -> String) -> ([Client] -> ShowS) -> Show Client
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Client] -> ShowS
$cshowList :: [Client] -> ShowS
show :: Client -> String
$cshow :: Client -> String
showsPrec :: Int -> Client -> ShowS
$cshowsPrec :: Int -> Client -> ShowS
Show)

type ClientPtr = Ptr ()

-- | Logging verbosity
data Verbosity
  = Fatal
  | Error
  | Warning
  | Info
  | Debug
  | Verbose
  deriving (Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
(Int -> Verbosity -> ShowS)
-> (Verbosity -> String)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> String
$cshow :: Verbosity -> String
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> Verbosity -> ShowS
Show, Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq, Int -> Verbosity
Verbosity -> Int
Verbosity -> [Verbosity]
Verbosity -> Verbosity
Verbosity -> Verbosity -> [Verbosity]
Verbosity -> Verbosity -> Verbosity -> [Verbosity]
(Verbosity -> Verbosity)
-> (Verbosity -> Verbosity)
-> (Int -> Verbosity)
-> (Verbosity -> Int)
-> (Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> Verbosity -> [Verbosity])
-> Enum Verbosity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
$cenumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
enumFromTo :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromTo :: Verbosity -> Verbosity -> [Verbosity]
enumFromThen :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromThen :: Verbosity -> Verbosity -> [Verbosity]
enumFrom :: Verbosity -> [Verbosity]
$cenumFrom :: Verbosity -> [Verbosity]
fromEnum :: Verbosity -> Int
$cfromEnum :: Verbosity -> Int
toEnum :: Int -> Verbosity
$ctoEnum :: Int -> Verbosity
pred :: Verbosity -> Verbosity
$cpred :: Verbosity -> Verbosity
succ :: Verbosity -> Verbosity
$csucc :: Verbosity -> Verbosity
Enum)

foreign import ccall "td_json_client_create"
  tdJsonClientCreate :: IO ClientPtr

foreign import ccall "td_json_client_send"
  tdJsonClientSend :: ClientPtr -> CString -> IO ()

foreign import ccall "td_json_client_receive"
  tdJsonClientReceive :: ClientPtr -> CDouble -> IO CString

foreign import ccall "td_json_client_execute"
  tdJsonClientExecute :: ClientPtr -> CString -> IO ()

foreign import ccall "td_json_client_destroy"
  tdJsonClientDestroy :: ClientPtr -> IO ()

foreign import ccall "&td_json_client_destroy"
  p_clientDestory :: FunPtr (ClientPtr -> IO ())

foreign import ccall "td_set_log_file_path"
  tdSetLogFilePath :: CString -> IO CInt

foreign import ccall "td_set_log_max_file_size"
  tdSetLogMaxFileSize :: CLLong -> IO ()

foreign import ccall "td_set_log_verbosity_level"
  tdSetLogVerbosityLevel :: CInt -> IO ()

type CallbackPtr = FunPtr (CString -> IO ())

foreign import ccall "td_set_log_fatal_error_callback"
  tdSetLogFatalErrorCallback :: CallbackPtr -> IO ()

foreign import ccall "wrapper"
  mkCallbackPtr_ :: (CString -> IO ()) -> IO CallbackPtr

mkCallbackPtr :: (ByteString -> IO ()) -> IO CallbackPtr
mkCallbackPtr :: (ByteString -> IO ()) -> IO CallbackPtr
mkCallbackPtr cont :: ByteString -> IO ()
cont =
  (CString -> IO ()) -> IO CallbackPtr
mkCallbackPtr_ CString -> IO ()
cont'
  where
    cont' :: CString -> IO ()
cont' cs :: CString
cs = do
      ByteString
bs <- CString -> IO ByteString
packCString CString
cs
      ByteString -> IO ()
cont ByteString
bs

-- | Creates a new instance of TDLib.
newClient :: IO Client
newClient :: IO Client
newClient = do
  ClientPtr
cptr <- IO ClientPtr
tdJsonClientCreate
  ForeignPtr ()
fptr <- FinalizerPtr () -> ClientPtr -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
p_clientDestory ClientPtr
cptr
  Client -> IO Client
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Client -> IO Client) -> Client -> IO Client
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> Client
Client ForeignPtr ()
fptr

-- | Sends request to the TDLib client. May be called from any thread.
clientSend ::
  -- | The client.
  Client ->
  -- | JSON-serialized null-terminated request to TDLib.
  ByteString ->
  IO ()
clientSend :: Client -> ByteString -> IO ()
clientSend (Client fptr :: ForeignPtr ()
fptr) msg :: ByteString
msg =
  ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
msg ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \cstr :: CString
cstr ->
    ForeignPtr () -> (ClientPtr -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr ((ClientPtr -> IO ()) -> IO ()) -> (ClientPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: ClientPtr
ptr -> do
      ClientPtr -> CString -> IO ()
tdJsonClientSend ClientPtr
ptr CString
cstr

-- | Receives incoming updates and request responses from the TDLib client. May be called from any thread, but shouldn't be called simultaneously from two different threads. Returned pointer will be deallocated by TDLib during next call to 'clientReceive' or 'clientExecute' in the same thread, so it can't be used after that.
clientReceive ::
  -- | The client.
  Client ->
  -- | The maximum number of seconds allowed for this function to wait for new data.
  Double ->
  -- | JSON-serialized null-terminated incoming update or request response. May be NULL if the timeout expires.
  IO ByteString
clientReceive :: Client -> Double -> IO ByteString
clientReceive (Client fptr :: ForeignPtr ()
fptr) t :: Double
t =
  ForeignPtr () -> (ClientPtr -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr ((ClientPtr -> IO ByteString) -> IO ByteString)
-> (ClientPtr -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ptr :: ClientPtr
ptr -> do
    CString
cs <- ClientPtr -> CDouble -> IO CString
tdJsonClientReceive ClientPtr
ptr (Double -> CDouble
CDouble Double
t)
    CString -> IO ByteString
packCString CString
cs

-- | Synchronously executes TDLib request. May be called from any thread. Only a few requests can be executed synchronously. Returned pointer will be deallocated by TDLib during next call to 'clientReceive' or 'clientExecute' in the same thread, so it can't be used after that.
clientExecute ::
  -- | The client. Currently ignored for all requests, so NULL can be passed.
  Client ->
  -- | JSON-serialized null-terminated request to TDLib.
  ByteString ->
  IO ()
clientExecute :: Client -> ByteString -> IO ()
clientExecute (Client fptr :: ForeignPtr ()
fptr) cmd :: ByteString
cmd =
  ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
cmd ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \cstr :: CString
cstr ->
    ForeignPtr () -> (ClientPtr -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr ((ClientPtr -> IO ()) -> IO ()) -> (ClientPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: ClientPtr
ptr -> do
      ClientPtr -> CString -> IO ()
tdJsonClientExecute ClientPtr
ptr CString
cstr

-- | Destroys the TDLib client instance. After this is called the client instance shouldn't be used anymore.
destroyClient ::
  -- | The client.
  Client ->
  IO ()
destroyClient :: Client -> IO ()
destroyClient (Client fptr :: ForeignPtr ()
fptr) = ForeignPtr () -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr ()
fptr

-- | Sets the path to the file where the internal TDLib log will be written. By default TDLib writes logs to stderr or an OS specific log. Use this method to write the log to a file instead.
setLogFilePath ::
  -- | Null-terminated path to a file where the internal TDLib log will be written. Use an empty path to switch back to the default logging behaviour.
  ByteString ->
  -- | True on success, False otherwise.
  IO Bool
setLogFilePath :: ByteString -> IO Bool
setLogFilePath fp :: ByteString
fp =
  ByteString -> (CString -> IO Bool) -> IO Bool
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
fp ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \cstr :: CString
cstr -> do
    CInt
i <- CString -> IO CInt
tdSetLogFilePath CString
cstr
    if  | CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        | CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        | Bool
otherwise -> String -> IO Bool
forall a. HasCallStack => String -> a
error (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ "Unknown return code" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CInt -> String
forall a. Show a => a -> String
show CInt
i

-- | Sets the maximum size of the file to where the internal TDLib log is written before the file will be auto-rotated. Unused if log is not written to a file. Defaults to 10 MB.
setLogMaxFileSize ::
  -- | The maximum size of the file to where the internal TDLib log is written before the file will be auto-rotated. Should be positive.
  Int64 ->
  IO ()
setLogMaxFileSize :: Int64 -> IO ()
setLogMaxFileSize = CLLong -> IO ()
tdSetLogMaxFileSize (CLLong -> IO ()) -> (Int64 -> CLLong) -> Int64 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CLLong
CLLong

-- | Sets the verbosity level of the internal logging of TDLib. By default the TDLib uses a log verbosity level of 'Verbose'.
setLogVerbosityLevel :: Verbosity -> IO ()
setLogVerbosityLevel :: Verbosity -> IO ()
setLogVerbosityLevel = CInt -> IO ()
tdSetLogVerbosityLevel (CInt -> IO ()) -> (Verbosity -> CInt) -> Verbosity -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a. Enum a => Int -> a
toEnum (Int -> CInt) -> (Verbosity -> Int) -> Verbosity -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> Int
forall a. Enum a => a -> Int
fromEnum

-- | Sets the callback that will be called when a fatal error happens. None of the TDLib methods can be called from the callback. The TDLib will crash as soon as callback returns. By default the callback is not set.
setLogFatalErrorCallback :: (ByteString -> IO ()) -> IO ()
setLogFatalErrorCallback :: (ByteString -> IO ()) -> IO ()
setLogFatalErrorCallback cont :: ByteString -> IO ()
cont = do
  CallbackPtr
cbptr <- (ByteString -> IO ()) -> IO CallbackPtr
mkCallbackPtr ByteString -> IO ()
cont
  CallbackPtr -> IO ()
tdSetLogFatalErrorCallback CallbackPtr
cbptr