{-# 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
$cto :: forall x. Rep SetWebhookRequest x -> SetWebhookRequest
$cfrom :: forall x. SetWebhookRequest -> Rep SetWebhookRequest x
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
$cto :: forall x. Rep DeleteWebhookRequest x -> DeleteWebhookRequest
$cfrom :: forall x. DeleteWebhookRequest -> Rep DeleteWebhookRequest x
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
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" (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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
genBoundary
          Proxy SetWebhookForm
-> (ByteString, SetWebhookRequest) -> ClientM (Response Bool)
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy SetWebhookForm
forall k (t :: k). Proxy t
Proxy @SetWebhookForm) (ByteString
boundary, SetWebhookRequest
requestData)
        else Proxy SetWebhookJson
-> SetWebhookRequest -> ClientM (Response Bool)
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy SetWebhookJson
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 :: Maybe Bool -> DeleteWebhookRequest
DeleteWebhookRequest {deleteWebhookDropPendingUpdates :: Maybe Bool
deleteWebhookDropPendingUpdates = Maybe Bool
forall a. Maybe a
Nothing}
    deleteWebhookRequest :: ClientM (Response Bool)
deleteWebhookRequest = Proxy DeleteWebhook
-> DeleteWebhookRequest -> ClientM (Response Bool)
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy DeleteWebhook
forall k (t :: k). Proxy t
Proxy @DeleteWebhook) DeleteWebhookRequest
requestData


foldMap makeDefault
  [ ''SetWebhookRequest
  , ''DeleteWebhookRequest
  ]