{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}

module Telegram.Bot.API.Webhook
  ( setUpWebhook,
    deleteWebhook,
    SetWebhookRequest (..),
  )
where

import           Control.Monad.IO.Class              (MonadIO (liftIO))
import           Data.Aeson                          (ToJSON (toJSON))
import           Data.Bool                           (bool)
import           Data.Functor                        (void, (<&>))
import           Data.Maybe                          (catMaybes, fromJust,
                                                      isJust)
import qualified Data.Text                           as Text
import           GHC.Generics                        (Generic)
import           Servant
import           Servant.Client                      (ClientEnv, ClientError,
                                                      client, runClientM)
import           Servant.Multipart.API
import           Servant.Multipart.Client            (genBoundary)

import           Telegram.Bot.API.Internal.Utils     (gtoJSON)
import           Telegram.Bot.API.MakingRequests     (Response)
import           Telegram.Bot.API.Types              (InputFile, makeFile)


data SetWebhookRequest = SetWebhookRequest
  { SetWebhookRequest -> String
setWebhookUrl                :: String,
    SetWebhookRequest -> Maybe InputFile
setWebhookCertificate        :: Maybe InputFile,
    SetWebhookRequest -> Maybe String
setWebhookIpAddress          :: Maybe String,
    SetWebhookRequest -> Maybe Int
setWebhookMaxConnections     :: Maybe Int,
    SetWebhookRequest -> Maybe [String]
setWebhookAllowedUpdates     :: Maybe [String],
    SetWebhookRequest -> Maybe Bool
setWebhookDropPendingUpdates :: Maybe Bool,
    SetWebhookRequest -> Maybe String
setWebhookSecretToken        :: Maybe String
  }
  deriving (forall x. Rep SetWebhookRequest x -> SetWebhookRequest
forall x. SetWebhookRequest -> Rep SetWebhookRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetWebhookRequest x -> SetWebhookRequest
$cfrom :: forall x. SetWebhookRequest -> Rep SetWebhookRequest x
Generic)

instance ToJSON SetWebhookRequest where toJSON :: SetWebhookRequest -> Value
toJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

newtype DeleteWebhookRequest = DeleteWebhookRequest
  { DeleteWebhookRequest -> Maybe Bool
deleteWebhookDropPendingUpdates :: Maybe Bool
  }
  deriving (forall x. Rep DeleteWebhookRequest x -> DeleteWebhookRequest
forall x. DeleteWebhookRequest -> Rep DeleteWebhookRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteWebhookRequest x -> DeleteWebhookRequest
$cfrom :: forall x. DeleteWebhookRequest -> Rep DeleteWebhookRequest x
Generic)

instance ToJSON DeleteWebhookRequest where toJSON :: DeleteWebhookRequest -> Value
toJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

instance ToMultipart Tmp SetWebhookRequest where
  toMultipart :: SetWebhookRequest -> MultipartData Tmp
toMultipart SetWebhookRequest {String
Maybe Bool
Maybe Int
Maybe String
Maybe [String]
Maybe InputFile
setWebhookSecretToken :: Maybe String
setWebhookDropPendingUpdates :: Maybe Bool
setWebhookAllowedUpdates :: Maybe [String]
setWebhookMaxConnections :: Maybe Int
setWebhookIpAddress :: Maybe String
setWebhookCertificate :: Maybe InputFile
setWebhookUrl :: String
setWebhookSecretToken :: SetWebhookRequest -> Maybe String
setWebhookDropPendingUpdates :: SetWebhookRequest -> Maybe Bool
setWebhookAllowedUpdates :: SetWebhookRequest -> Maybe [String]
setWebhookMaxConnections :: SetWebhookRequest -> Maybe Int
setWebhookIpAddress :: SetWebhookRequest -> Maybe String
setWebhookCertificate :: SetWebhookRequest -> Maybe InputFile
setWebhookUrl :: SetWebhookRequest -> String
..} =
    Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp
makeFile Text
"certificate" (forall a. HasCallStack => Maybe a -> a
fromJust Maybe InputFile
setWebhookCertificate) (forall tag. [Input] -> [FileData tag] -> MultipartData tag
MultipartData [Input]
fields [])
    where
      fields :: [Input]
fields =
        [Text -> Text -> Input
Input Text
"url" forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
setWebhookUrl]
          forall a. Semigroup a => a -> a -> a
<> forall a. [Maybe a] -> [a]
catMaybes
            [ Maybe String
setWebhookSecretToken forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String
t -> Text -> Text -> Input
Input Text
"secret_token" forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
t,
              Maybe String
setWebhookIpAddress forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String
t -> Text -> Text -> Input
Input Text
"ip_address" forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
t,
              Maybe Int
setWebhookMaxConnections forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
t -> Text -> Text -> Input
Input Text
"max_connections" forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
t,
              Maybe Bool
setWebhookDropPendingUpdates forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
t -> Text -> Text -> Input
Input Text
"drop_pending_updates" (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t),
              Maybe [String]
setWebhookAllowedUpdates forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[String]
t -> Text -> Text -> Input
Input Text
"allowed_updates" ([String] -> Text
arrToJson [String]
t)
            ]
      arrToJson :: [String] -> Text
arrToJson [String]
arr = Text -> [Text] -> Text
Text.intercalate Text
"" [Text
"[", Text -> [Text] -> Text
Text.intercalate Text
"," (forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
"\"" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"\"") [String]
arr), Text
"]"]

type SetWebhookForm =
  "setWebhook" :> MultipartForm Tmp SetWebhookRequest :> Get '[JSON] (Response Bool)

type SetWebhookJson =
  "setWebhook" :> ReqBody '[JSON] SetWebhookRequest :> Get '[JSON] (Response Bool)

type DeleteWebhook =
  "deleteWebhook" :> ReqBody '[JSON] DeleteWebhookRequest :> Get '[JSON] (Response Bool)

setUpWebhook :: SetWebhookRequest -> ClientEnv -> IO (Either ClientError ())
setUpWebhook :: SetWebhookRequest -> ClientEnv -> IO (Either ClientError ())
setUpWebhook SetWebhookRequest
requestData = (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM (Response Bool)
setUpWebhookRequest
  where
    setUpWebhookRequest :: ClientM (Response Bool)
setUpWebhookRequest =
      if forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ SetWebhookRequest -> Maybe InputFile
setWebhookCertificate SetWebhookRequest
requestData
        then do
          ByteString
boundary <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
genBoundary
          forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @SetWebhookForm) (ByteString
boundary, SetWebhookRequest
requestData)
        else forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @SetWebhookJson) SetWebhookRequest
requestData

deleteWebhook :: ClientEnv -> IO (Either ClientError ())
deleteWebhook :: ClientEnv -> IO (Either ClientError ())
deleteWebhook = (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM (Response Bool)
deleteWebhookRequest
  where
    requestData :: DeleteWebhookRequest
requestData = DeleteWebhookRequest {deleteWebhookDropPendingUpdates :: Maybe Bool
deleteWebhookDropPendingUpdates = forall a. Maybe a
Nothing}
    deleteWebhookRequest :: ClientM (Response Bool)
deleteWebhookRequest = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @DeleteWebhook) DeleteWebhookRequest
requestData