{-# 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 (..),
    defSetWebhook,
    defDeleteWebhook
  )
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)
import Telegram.Bot.API.Internal.TH (makeDefault)


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. SetWebhookRequest -> Rep SetWebhookRequest x)
-> (forall x. Rep SetWebhookRequest x -> SetWebhookRequest)
-> Generic SetWebhookRequest
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
$cfrom :: forall x. SetWebhookRequest -> Rep SetWebhookRequest x
from :: forall x. SetWebhookRequest -> Rep SetWebhookRequest x
$cto :: forall x. Rep SetWebhookRequest x -> SetWebhookRequest
to :: forall x. Rep SetWebhookRequest x -> SetWebhookRequest
Generic)

instance ToJSON SetWebhookRequest where toJSON :: SetWebhookRequest -> Value
toJSON = SetWebhookRequest -> Value
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. DeleteWebhookRequest -> Rep DeleteWebhookRequest x)
-> (forall x. Rep DeleteWebhookRequest x -> DeleteWebhookRequest)
-> Generic DeleteWebhookRequest
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
$cfrom :: forall x. DeleteWebhookRequest -> Rep DeleteWebhookRequest x
from :: forall x. DeleteWebhookRequest -> Rep DeleteWebhookRequest x
$cto :: forall x. Rep DeleteWebhookRequest x -> DeleteWebhookRequest
to :: forall x. Rep DeleteWebhookRequest x -> DeleteWebhookRequest
Generic)

instance ToJSON DeleteWebhookRequest where toJSON :: DeleteWebhookRequest -> Value
toJSON = DeleteWebhookRequest -> Value
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
setWebhookUrl :: SetWebhookRequest -> String
setWebhookCertificate :: SetWebhookRequest -> Maybe InputFile
setWebhookIpAddress :: SetWebhookRequest -> Maybe String
setWebhookMaxConnections :: SetWebhookRequest -> Maybe Int
setWebhookAllowedUpdates :: SetWebhookRequest -> Maybe [String]
setWebhookDropPendingUpdates :: SetWebhookRequest -> Maybe Bool
setWebhookSecretToken :: SetWebhookRequest -> Maybe String
setWebhookUrl :: String
setWebhookCertificate :: Maybe InputFile
setWebhookIpAddress :: Maybe String
setWebhookMaxConnections :: Maybe Int
setWebhookAllowedUpdates :: Maybe [String]
setWebhookDropPendingUpdates :: Maybe Bool
setWebhookSecretToken :: Maybe String
..} =
    Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp
makeFile Text
"certificate" (Maybe InputFile -> InputFile
forall a. HasCallStack => Maybe a -> a
fromJust Maybe InputFile
setWebhookCertificate) ([Input] -> [FileData Tmp] -> MultipartData Tmp
forall tag. [Input] -> [FileData tag] -> MultipartData tag
MultipartData [Input]
fields [])
    where
      fields :: [Input]
fields =
        [Text -> Text -> Input
Input Text
"url" (Text -> Input) -> Text -> Input
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
setWebhookUrl]
          [Input] -> [Input] -> [Input]
forall a. Semigroup a => a -> a -> a
<> [Maybe Input] -> [Input]
forall a. [Maybe a] -> [a]
catMaybes
            [ Maybe String
setWebhookSecretToken Maybe String -> (String -> Input) -> Maybe Input
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String
t -> Text -> Text -> Input
Input Text
"secret_token" (Text -> Input) -> Text -> Input
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
t,
              Maybe String
setWebhookIpAddress Maybe String -> (String -> Input) -> Maybe Input
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String
t -> Text -> Text -> Input
Input Text
"ip_address" (Text -> Input) -> Text -> Input
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
t,
              Maybe Int
setWebhookMaxConnections Maybe Int -> (Int -> Input) -> Maybe Input
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
t -> Text -> Text -> Input
Input Text
"max_connections" (Text -> Input) -> Text -> Input
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
t,
              Maybe Bool
setWebhookDropPendingUpdates Maybe Bool -> (Bool -> Input) -> Maybe Input
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
t -> Text -> Text -> Input
Input Text
"drop_pending_updates" (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t),
              Maybe [String]
setWebhookAllowedUpdates Maybe [String] -> ([String] -> Input) -> Maybe Input
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
"," ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
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 = (Either ClientError (Response Bool) -> Either ClientError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Either ClientError (Response Bool) -> Either ClientError ())
-> IO (Either ClientError (Response Bool))
-> IO (Either ClientError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO (Either ClientError (Response Bool))
 -> IO (Either ClientError ()))
-> (ClientEnv -> IO (Either ClientError (Response Bool)))
-> ClientEnv
-> IO (Either ClientError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientM (Response Bool)
-> ClientEnv -> IO (Either ClientError (Response Bool))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM (Response Bool)
setUpWebhookRequest
  where
    setUpWebhookRequest :: ClientM (Response Bool)
setUpWebhookRequest =
      if Maybe InputFile -> Bool
forall a. Maybe a -> Bool
isJust (Maybe InputFile -> Bool) -> Maybe InputFile -> Bool
forall a b. (a -> b) -> a -> b
$ SetWebhookRequest -> Maybe InputFile
setWebhookCertificate SetWebhookRequest
requestData
        then do
          ByteString
boundary <- IO ByteString -> ClientM ByteString
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
genBoundary
          Proxy SetWebhookForm -> Client ClientM SetWebhookForm
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SetWebhookForm) (ByteString
boundary, SetWebhookRequest
requestData)
        else Proxy SetWebhookJson -> Client ClientM SetWebhookJson
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SetWebhookJson) SetWebhookRequest
requestData

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


foldMap makeDefault
  [ ''SetWebhookRequest
  , ''DeleteWebhookRequest
  ]