{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

module HipBot
  ( HipBot
  , HipBotAPI(..)
  , OnUninstall
  , OAuthId
  , RoomName
  , RoomId
  , RoomEvent(..)
  , newHipBot
  , newHipBot'
  , hipBotResources
  , configResource
  , verifySignature
  , sendNotification
  , module HipBot.AbsoluteURI
  , module HipBot.Descriptor
  , module HipBot.Notification
  ) where

import Control.Applicative
import Control.Lens hiding ((.=))
import Control.Monad.Catch
import Control.Monad.Trans
import Control.Monad.Trans.Either
import qualified Data.Aeson as A
import Data.Bifunctor
import qualified Data.ByteString.UTF8 as B
import qualified Data.List as List
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Network.HTTP.Client
import Network.HTTP.Types
import qualified Network.Wreq as Wreq
import Prelude
import Safe

import HipBot.AbsoluteURI
import HipBot.API
import HipBot.Descriptor
import HipBot.Internal.HipBot
import HipBot.Internal.OAuth
import HipBot.Internal.Resources
import HipBot.Internal.Types
import HipBot.Notification

data NotificationError
  = NoSuchRegistration OAuthId
  | TokenError OAuthError
  | RateLimitExceeded (Maybe UTCTime)
  | HttpError HttpException
  deriving Show

sendNotification
  :: (Applicative m, MonadCatch m, MonadIO m)
  => HipBot m
  -> OAuthId
  -> Either RoomName RoomId
  -> Notification
  -> m (Maybe NotificationError)
sendNotification bot oid room n =
  let
    msg = A.encode n
    opts tok = wreqDefaults bot
      & Wreq.header hAuthorization .~
          [("Bearer " <>) .  T.encodeUtf8 . view accessToken $ tok]
      & Wreq.header hContentType .~ ["application/json"]
    nurl = show .
      relativeTo ["room", either id (T.pack . show) room, "notification"] .
      view capabilitiesUrl
    send reg tok = Nothing <$ Wreq.postWith (opts tok) (nurl reg) msg
    trySend reg tok onAuthErr = liftIO (send reg tok) `catch` handler onAuthErr
    handler onAuthErr e = case e of
      StatusCodeException s hdrs _
        | s == unauthorized401 -> onAuthErr
        | s ^. Wreq.statusCode == 429 ->
            return . Just . RateLimitExceeded . rateLimitReset $ hdrs
      httpExc -> return . Just . HttpError $ httpExc
    reauth reg = updatedToken bot reg >>= \tok -> trySend reg tok (authFailed reg)
    authFailed = return . Just . TokenError . InvalidOAuthCreds
    firstTry = getToken bot oid >>= \(reg, tok) -> trySend reg tok (reauth reg)
  in
    either Just id <$> runEitherT firstTry

rateLimitReset :: ResponseHeaders -> Maybe UTCTime
rateLimitReset =
  let
    hdr = List.find ((==) "X-RateLimit-Reset" . fst)
    readMayInt :: (HeaderName, B.ByteString) -> Maybe Int
    readMayInt = readMay . B.toString . snd
  in
    fmap (posixSecondsToUTCTime . realToFrac) . (readMayInt =<<) . hdr

getToken
  :: (Applicative m, MonadCatch m, MonadIO m)
  => HipBot m
  -> OAuthId
  -> EitherT NotificationError m (Registration, AccessToken)
getToken bot oid = lookupReg >>= fetch where
  lookupReg = EitherT .
    fmap (maybe (Left . NoSuchRegistration $ oid) Right) .
    apiLookupRegistration (view hipBotAPI bot) $
    oid
  fetch (reg, tok) = do
    now <- liftIO getCurrentTime
    if addUTCTime 300 now < tok ^. expires
      then right (reg, tok)
      else updatedToken bot reg <&> (reg,)

updatedToken
  :: (MonadCatch m, MonadIO m, Applicative m)
  => HipBot m
  -> Registration
  -> EitherT NotificationError m AccessToken
updatedToken bot reg = do
  tok <- EitherT .
    fmap (first TokenError) .
    obtainAccessToken bot $
    reg
  lift . apiUpdateAccessToken (bot ^. hipBotAPI) (reg ^. oauthId) $ tok
  return tok