content: module Marvin.Adapter.Telegram.Internal.Common where
  
  import           Control.Applicative
  import           Control.Concurrent.Async.Lifted
  import           Control.Concurrent.Chan.Lifted
  import           Control.Exception.Lifted
  import           Control.Monad
  import           Control.Monad.IO.Class
  import           Control.Monad.Logger
  import           Data.Aeson                      as A hiding (Error, Success)
  import           Data.Aeson.Types                as A (Parser, parseEither)
  import qualified Data.ByteString.Lazy            as BS
  import           Data.Char                       (isSpace)
  import           Data.Foldable                   (asum)
  import           Data.Maybe
  import qualified Data.Text                       as T
  import qualified Data.Text.Lazy                  as L
  import           Data.Traversable                (for)
  import           Lens.Micro.Platform
  import           Marvin.Adapter                  hiding (mkAdapterId)
  import           Marvin.Interpolate.All
  import           Marvin.Types
  import           Network.Wreq                    as Wreq
  import           Network.Wreq.Types              as Wreq
  import           Util
  
  data APIResponse a
      = Success { description :: Maybe T.Text, result :: a }
      | Error { errorCode :: Int, errDescription :: T.Text }
  
  
  -- | The telegram adapter type for a particular update type. Either 'Push' or 'Poll'
  data TelegramAdapter updateType = TelegramAdapter
  
  
  newtype TelegramFileId = TelegramFileId { unwrapFileId :: T.Text } deriving Eq
  
  
  instance FromJSON TelegramFileId where parseJSON = withText "expected string" (pure . TelegramFileId)
  instance ToJSON TelegramFileId where toJSON = String . unwrapFileId
  
  data TelegramUpdate any
      = Ev (Event (TelegramAdapter any))
      | Ignored
      | Unhandeled
  
  
  -- | Chat type as defined by the telegram api
  data ChatType
      = PrivateChat
      | GroupChat
      | SupergroupChat
      | ChannelChat
  
  class HasId_ s a | s -> a where id_ :: Lens' s a
  
  -- | A user object as contained in the telegram update objects
  data TelegramUser = TelegramUser
      { telegramUserId_       :: Integer
      , telegramUserFirstName :: Maybe L.Text
      , telegramUserLastName  :: Maybe L.Text
      , telegramUserUsername  :: L.Text
      }
  
  data TelegramRemoteFileStruct
      = RemoteAudio
          { telegramRemoteFileStructDuration  :: Integer
          , telegramRemoteFileStructPerformer :: Maybe L.Text
          , telegramRemoteFileStructTitle     :: Maybe L.Text
          }
      | RemoteDocument
      | RemoteSticker
          { telegramRemoteFileStructWidth  :: Integer
          , telegramRemoteFileStructHeight :: Integer
          , telegramRemoteFileStructEmoji  :: Maybe L.Text
          }
      | RemoteVideo
          { telegramRemoteFileStructWidth    :: Integer
          , telegramRemoteFileStructHeight   :: Integer
          , telegramRemoteFileStructDuration :: Integer
          }
      | RemoteVoice
          { telegramRemoteFileStructDuration :: Integer
          }
  
  
  data TelegramRemoteFile a = TelegramRemoteFile
      { telegramRemoteFileStruct   :: TelegramRemoteFileStruct
      , telegramRemoteFileSize     :: Integer
      , telegramRemoteFileFid      :: TelegramFileId
      , telegramRemoteFileFileType :: Maybe L.Text
      , telegramRemoteFileName     :: Maybe L.Text
      }
  
  data TelegramLocalFileStruct
      = LocalPhoto
      | LocalAudio
          { telegramLocalFileStructDuration  :: Maybe Int
          , telegramLocalFileStructPerformer :: Maybe L.Text
          -- , telegramLocalFileStructShowTitle :: Maybe L.Text
          }
      | LocalDocument
      | LocalVideo
          { telegramLocalFileStructDuration :: Maybe Int
          , telegramLocalFileStructWidth    :: Maybe Int
          , telegramLocalFileStructHeight   :: Maybe Int
          }
  
  
  data TelegramLocalFile = TelegramLocalFile
      { telegramLocalFileStruct              :: TelegramLocalFileStruct
      , telegramLocalFileContent             :: FileContent
      , telegramLocalFileName                :: L.Text
      , telegramLocalFileFileType            :: Maybe L.Text
      , telegramLocalFileDisableNotification :: Maybe Bool
      , telegramLocalFileFromRef             :: Maybe TelegramFileId
      , telegramLocalFileCaption             :: Maybe L.Text
      }
  
  makeFields ''TelegramUser
  makeFields ''TelegramRemoteFileStruct
  makeFields ''TelegramRemoteFile
  makeFields ''TelegramLocalFileStruct
  makeFields ''TelegramLocalFile
  
  instance HasUrl (TelegramRemoteFile a) (Maybe L.Text) where url = lens (const Nothing) const
  instance HasCreationDate (TelegramRemoteFile a) (TimeStamp a) where creationDate = lens (const undefined) const
  
  
  instance HasName TelegramUser (Maybe L.Text) where
      name = lens
          (\u -> (mappend <$> u^.firstName <*> (mappend " " <$> u^.lastName)) <|> u^.firstName <|> u^.lastName)
          (flip set_)
        where
          set_ Nothing = (firstName .~ Nothing) . (lastName .~ Nothing)
          set_ (Just n) = (firstName .~ Just first) . (lastName .~ if L.null rest then Nothing else Just rest)
            where
              (first, rest') = L.break (== ' ') n
              rest = L.tail rest'
  
  
  -- | A telegram chat object as contained in telegram updates
  data TelegramChat = TelegramChat
      { telegramChatId_       :: Integer
      , telegramChatType_     :: ChatType
      , telegramChatUsername  :: Maybe L.Text
      , telegramChatFirstName :: Maybe L.Text
      , telegramChatLastName  :: Maybe L.Text
      }
  makeFields ''TelegramChat
  
  instance HasName TelegramChat (Maybe L.Text) where
      name = username
  
  instance FromJSON ChatType where
      parseJSON = withText "expected string" $
          \case
              "private" -> pure PrivateChat
              "group" -> pure GroupChat
              "supergroup" -> pure SupergroupChat
              "channel" -> pure ChannelChat
              a -> fail $(isS "Unknown chat type #{a}")
  
  instance FromJSON TelegramUser where
      parseJSON = withObject "user must be object" $ \o ->
          TelegramUser
              <$> o .: "id"
              <*> (Just <$> o .: "first_name")
              <*> o .:? "last_name"
              <*> (maybe (o .: "first_name") return =<< o .:? "username")
  
  instance FromJSON TelegramChat where
      parseJSON = withObject "channel must be object" $ \o ->
          TelegramChat
              <$> o .: "id"
              <*> o .: "type"
              <*> o .:? "username"
              <*> o .:? "first_name"
              <*> o .:? "last_name"
  
  parseFileHelper :: (Object -> Parser TelegramRemoteFileStruct) -> Value -> Parser (Object, TelegramRemoteFileStruct)
  parseFileHelper f = withObject "expected object" $ \o -> (o, ) <$> f o
  
  parseTelegramAudio :: Object -> Parser TelegramRemoteFileStruct
  parseTelegramAudio o =
      RemoteAudio
          <$> o .: "duration"
          <*> o .:? "performer"
          <*> o .:? "title"
  
  parseTelegramDocument :: Object -> Parser TelegramRemoteFileStruct
  parseTelegramDocument = const (return RemoteDocument)
  
  parseTelegramSticker :: Object -> Parser TelegramRemoteFileStruct
  parseTelegramSticker o =
      RemoteSticker
          <$> o .: "width"
          <*> o .: "height"
          <*> o .:? "emoji"
  
  parseTelegramVideo :: Object -> Parser TelegramRemoteFileStruct
  parseTelegramVideo o =
      RemoteVideo
          <$> o .: "width"
          <*> o .: "height"
          <*> o .: "duration"
  
  parseTelegramVoice :: Object -> Parser TelegramRemoteFileStruct
  parseTelegramVoice o = RemoteVoice <$> o .: "duration"
  
  
  parseTelegramFile :: Object -> Parser (TelegramRemoteFile a)
  parseTelegramFile o = do
      (o', mediaStruct) <- msum
          [ o .: "audio" >>= parseFileHelper parseTelegramAudio
          , o .: "document" >>= parseFileHelper parseTelegramDocument
          , o .: "sticker" >>= parseFileHelper parseTelegramSticker
          , o .: "video" >>= parseFileHelper parseTelegramVideo
          , o .: "voice" >>= parseFileHelper parseTelegramVoice
          ]
      TelegramRemoteFile mediaStruct
          <$> o' .:? "file_size" .!= (-1)
          <*> o' .:  "file_id"
          <*> o' .:  "file_name"
          <*> o' .:? "mime_type"
  
  
  instance MkTelegram a => FromJSON (TelegramUpdate a) where
      parseJSON = withObject "expected object" inner
        where
          inner o = msum [isMessage, isPost, isDocument, isUnhandeled]
            where
              isMessage = Ev <$> (o .: "message" >>= msgParser)
              isPost = Ev <$> (o .: "channel_post" >>= msgParser)
              isUnhandeled = return Unhandeled
              isDocument = do
                  file <- parseTelegramFile o
                  ev <- FileSharedEvent
                      <$> o .: "from"
                      <*> o .: "chat"
                      <*> pure file
                      <*> (o .: "date" >>= timestampFromNumber)
                  pure $ Ev ev
  
  
  telegramSupportedUpdates :: [T.Text]
  telegramSupportedUpdates =
      [ "message"
      , "channel_post"
      ]
  
  
  msgParser :: Value -> Parser (Event (TelegramAdapter a))
  msgParser = withObject "expected message object" $ \o ->
      MessageEvent
          <$> o .: "from"
          <*> o .: "chat"
          <*> o .: "text"
          <*> (o .: "date" >>= timestampFromNumber)
  
  
  
  apiResponseParser :: (Value -> Parser a) -> Value -> Parser (APIResponse a)
  apiResponseParser innerParser = withObject "expected object" $ \o -> do
      ok <- o .: "ok"
      if ok
          then Success <$> o .:? "description" <*> (o .: "result" >>= innerParser)
          else Error <$> o .: "error_code" <*> o .: "description"
  
  
  execAPIMethod :: (MkTelegram b, Postable p)
                => (Value -> Parser a)
                -> String
                -> p
                -> AdapterM (TelegramAdapter b) (Either String (APIResponse a))
  execAPIMethod = execAPIMethodWith defaults
  
  execAPIMethodWith :: (MkTelegram b, Postable p)
                    => Wreq.Options
                    -> (Value -> Parser a)
                    -> String
                    -> p
                    -> AdapterM (TelegramAdapter b) (Either String (APIResponse a))
  execAPIMethodWith opts innerParser methodName fparams = do
      token <- requireFromAdapterConfig "token"
      res <- retry (3 :: Int) (liftIO (postWith opts $(isS "https://api.telegram.org/bot#{token :: String}/#{methodName}") fparams))
      return $ res >>= eitherDecode . (^. responseBody) >>= parseEither (apiResponseParser innerParser)
    where
      retry n a = (Right <$> a) `catch` \e -> if n <= 0
                                                  then -- TODO only catch appropriate exceptions
                                                      return $ Left $ displayException (e :: SomeException)
                                                  else retry (succ n) a
  
  
  getChannelNameImpl :: TelegramChat -> AdapterM (TelegramAdapter a) L.Text
  getChannelNameImpl c = return $ fromMaybe "<unnamed>" $
      c^.username <|> (L.unwords <$> sequence [c^.firstName, c^.lastName]) <|> c^.firstName
  
  
  messageChannelImpl :: MkTelegram a => TelegramChat -> L.Text -> AdapterM (TelegramAdapter a) ()
  messageChannelImpl chat msg = do
      res <- execAPIMethod msgParser "sendMessage" ["chat_id" := (chat^.id_) , "text" := msg]
      case res of
          Left err -> error $(isS "Unparseable JSON #{err}")
          Right Success{} -> return ()
          Right (Error code desc) ->
              logErrorN $(isT "Sending message failed with #{code}: #{desc}")
  
  stripWhiteSpaceMay :: L.Text -> Maybe L.Text
  stripWhiteSpaceMay t =
      case L.uncons t of
          Just (c, _) | isSpace c -> Just $ L.stripStart t
          _           -> Nothing
  
  runnerImpl :: MkTelegram a => EventConsumer (TelegramAdapter a) -> AdapterM (TelegramAdapter a) ()
  runnerImpl handler = do
      msgChan <- newChan
      let eventGetter = mkEventGetter msgChan
      a <- async eventGetter
      link a
  
      forever $ do
          logDebugN "Starting to read"
          d <- readChan msgChan
          logDebugN "Recieved message"
          case d of
              Ev ev@(MessageEvent u chat msg ts) -> do
                  botname <- L.toLower <$> getBotname
                  let strippedMsg = L.stripStart msg
                  let lmsg = L.toLower strippedMsg
                  handler $ case (chat^.type_, asum $ map ((\prefix -> if prefix `L.isPrefixOf` lmsg then Just $ L.drop (L.length prefix) strippedMsg else Nothing) >=> stripWhiteSpaceMay) [botname, L.cons '@' botname, L.cons '/' botname]) of
                      (PrivateChat, _) -> CommandEvent u chat msg ts
                      (_, Nothing)     -> ev
                      (_, Just m')     -> CommandEvent u chat m' ts
              Ev ev -> handler ev
              Ignored -> return ()
              Unhandeled -> logDebugN $(isT "Unhadeled event.")
  
  
  toFtype :: TelegramLocalFileStruct -> (String, T.Text)
  toFtype LocalPhoto    = ("Photo", "photo")
  toFtype LocalAudio{}  = ("Audio", "audio")
  toFtype LocalDocument = ("Document", "document")
  toFtype LocalVideo{}  = ("Video", "video")
  
  
  partShow :: Show a => T.Text -> a -> Part
  partShow name' = partString name' . show
  
  mkStructParts :: TelegramLocalFile -> [Maybe Part]
  mkStructParts f =
      case f^.struct of
          LocalAudio duration' performer' ->
              [ partText "performer" . L.toStrict <$> performer'
              , partShow "duration" <$> duration'
              , Just ("title" `partText` L.toStrict (f^.name)) -- perhaps make this optional
              ]
          LocalVideo duration' width' height' ->
              [ partShow "duration" <$> duration'
              , partShow "width" <$> width'
              , partShow "height" <$> height'
              ]
          _ -> []
  
  
  shareFileImpl :: MkTelegram a => TelegramLocalFile -> [TelegramChat] -> AdapterM (TelegramAdapter a) (Either L.Text (TelegramRemoteFile (TelegramAdapter a)))
  shareFileImpl localFile targets = do
      contentPart <- case localFile^.fromRef of
          Just (TelegramFileId fid') -> return $ propName `partText` fid'
          Nothing ->
              (propName `partLBS`) <$> case localFile^.content of
                                          FileInMemory bs -> return bs
                                          FileOnDisk path -> liftIO $ BS.readFile path
      fmap (handleRes <=< headRes) $ for targets $ \chan ->
          execAPIMethod parser ("send" ++ ftype) $ catMaybes $
              [ Just $ "chat_id" `partString` show (chan ^. id_)
              , Just contentPart
              , partText "caption" . L.toStrict <$> localFile^.caption
              , partText "diable_notofication" . boolToText <$> localFile^.disableNotification
              ] ++ structParts
    where
      parser = withObject "expected object" parseTelegramFile
      (ftype, propName) = toFtype (localFile^.struct)
      structParts = mkStructParts localFile
      boolToText True = "true"
      boolToText _    = "false"
      headRes []    = Left "No targets specified"
      headRes (x:_) = mapLeft L.pack x
      handleRes Success{result=a}       = pure a
      handleRes Error{errDescription=d} = Left $ L.fromStrict d
  
  
  -- | Class to enable polymorphism over update mechanics for 'TelegramAdapter'
  class MkTelegram a where
      mkEventGetter :: Chan (TelegramUpdate a) -> AdapterM (TelegramAdapter a) ()
      mkAdapterId :: AdapterId (TelegramAdapter a)
  
  
  instance MkTelegram a => IsAdapter (TelegramAdapter a) where
      type User (TelegramAdapter a) = TelegramUser
      type Channel (TelegramAdapter a) = TelegramChat
      adapterId = mkAdapterId
      initAdapter = return TelegramAdapter
      runAdapter = runnerImpl
      resolveChannel _ = do
          logErrorN "Channel resolving not supported"
          return Nothing
      resolveUser _ = do
          logErrorN "User resolving not supported"
          return Nothing
      messageChannel = messageChannelImpl
  
  instance MkTelegram a => SupportsFiles (TelegramAdapter a) where
      type RemoteFile (TelegramAdapter a) = TelegramRemoteFile (TelegramAdapter a)
      type LocalFile (TelegramAdapter a) = TelegramLocalFile
      shareFile = shareFileImpl
      readFileBytes remoteFile = do
          res <- execAPIMethod (withObject "expected object" (.: "file_path")) "getFile" ["file_id" := unwrapFileId (remoteFile^.fid)]
          case res of
              Left err -> logErrorN $(isT "Error when downloading file: #{err}") >> return Nothing
              Right Error{errDescription=desc} -> logErrorN $(isT "Error when downloading file: #{desc}") >> return Nothing
              Right Success{result=Nothing} -> logErrorN $(isT "Fetched file had no filepath") >> return Nothing
              Right Success{result=Just fp} -> do
                  token <- requireFromAdapterConfig "token"
                  fres <- liftIO $ get $(is "https://api.telegram.org/bot#{token}/#{fp}")
                  case fres ^. responseStatus . statusCode of
                      200 -> return $ Just $ fres ^. responseBody
                      code -> do
                          logErrorN $(isT "Non 200 Response when downloading file: #{code} - #{view (responseStatus.statusMessage) fres}")
                          return Nothing
      newLocalFile fname content' = pure $ TelegramLocalFile LocalDocument content' fname Nothing Nothing Nothing Nothing
  