RunLight

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
-- -fno-warn-unused-matches.

module Vertigo.Dsl.RunLight (runLight) where

import           Control.Exception           (SomeException(..), throw)
import           Control.Exception.Enclosed  (tryAny)
import           Control.Lens                ((&), (?~), (^.), view)
import           Control.Monad.Except        (MonadError, lift)
import           Control.Monad.Free          (iterM)
import           Control.Monad.Catch         (MonadThrow)
import           Control.Monad.IO.Class      (MonadIO, liftIO)
import           Control.Monad.Reader        (MonadReader, ask, asks)
import           Control.Monad.Trans.Control (MonadBaseControl)
import           Control.Monad.Trans.Resource(runResourceT)
import           Data.HashMap.Strict         (toList)
import           Data.Aeson                  (decode, encode)
import           Data.Maybe                  (fromMaybe, fromJust)
import           Data.Monoid                 ((<>))
import           Data.Text                   (Text, pack, unpack)
import           Data.Text.Encoding          (encodeUtf8)
import           Network.HTTP.Client         (Manager, Request(..), Response(..))
import           Network.HTTP.Conduit        (RequestBody(..), httpLbs, parseUrl)

import qualified Data.ByteString.Char8        as B
import qualified Data.Map                     as M
import qualified System.Logging.Facade        as Log

import           Vertigo.Dsl.Notify
import           Vertigo.Ext                  (Ext, awsEnv, manager, userServiceUrl)
import           Vertigo.Token                (createToken)
import           Vertigo.Types.DeviceInfo
import           Vertigo.Types.Error          (MyException(MyException), ErrorEnum (..))

import qualified Vertigo.Types.Notification.Ids      as N
import qualified Vertigo.Types.Notification.UserCore as N
import qualified Vertigo.Types.Notification.Vuid     as N

-- run the service without SNS, it's behavior is emulated
runLight :: (MonadBaseControl IO m, MonadError ErrorEnum m, MonadIO m, MonadReader Ext m, MonadThrow m, Log.Logging m) =>
  FreeNotifyDsl a -> m a
runLight fnd = do
  -- m is the manager from Ext
  m <- asks (^. manager)
  iterM (run m) fnd
  where
    run :: (MonadBaseControl IO m, MonadError ErrorEnum m, MonadIO m, MonadReader Ext m, MonadThrow m, Log.Logging m) =>
      Manager -> NotifyDsl (m a) -> m a
    run m (UserServiceGetUser uid next) = do
      let meth = "UserServiceGetDevices: "
      Log.debug $ meth <> show uid
      user0 <- userServiceGetUser_ m uid
      Log.debug $ meth <> show user0
      case user0 of
        Left err -> do
          Log.debug $ meth <> " err = " <> show err
          next Nothing
        Right usr -> next $ Just usr
    run m (UserServiceGetDevices uid next) = do
      let meth = "UserServiceGetDevices: "
      Log.debug $ meth <> show uid
      devices0 <- userServiceGetDevices_ m uid
      Log.debug $ meth <> show devices0
      case devices0 of
        Left err -> do
          Log.debug $ meth <> show err
          next Nothing
        Right des -> next $ Just des
    run m (UserServiceUpdateDevice uid device next) = do
      let meth = "UserServiceUpdateDevice: "
      Log.debug $ meth <> show uid
      r0 <- userServiceUpdateDevice_ m uid device
      Log.debug $ meth <> show r0
      next
    run _m (SnsCreatePlatformEndpoint applicationArn deviceToken customData next) = do
      let meth = "SnsCreatePlatformEndpoint: "
      Log.debug $ meth <> show applicationArn
      r0 <- snsCreatePlatformEndpoint_ applicationArn deviceToken customData
      case r0 of
        Left err -> do
          Log.debug $ meth <> show err
          next Nothing
        Right endpArn -> next $ Just endpArn
    run _m (SnsPublish endpointArn msg next) = do
      let meth = "SnsPublish: "
      Log.debug $ meth <> show (endpointArn, msg)
      r0 <- snsPublish_ endpointArn msg
      case r0 of
        Left err -> do
          Log.debug $ meth <> show err
          next Nothing
        Right _ -> next $ Just ()
    run _m (SnsGetEndpointAttributes endpointArn next) = do
      let meth = "SnsGetEndpointAttributes: "
      Log.debug $ meth <> show endpointArn
      r0 <- snsGetEndpointAttributes_ endpointArn
      Log.debug $ meth <> show r0
      case r0 of
        Left err -> do
          Log.debug $ meth <> show err
          next Nothing
        Right attributes ->
          next $ Just attributes
    run _m (SnsDeleteEndpoint endpointArn next) = do
      let meth = "SnsDeleteEndpoint: "
      Log.debug $ meth <> show endpointArn
      r0 <- snsDeleteEndpoint_ endpointArn
      Log.debug $ meth <> show r0
      case r0 of
        Left err -> Log.debug $ meth <> show err
        Right _ -> return ()
      next
-- concatenate and create access token for other services call
prepareRequest :: MonadThrow m => Text -> Ext -> Text -> m Request
prepareRequest endpoint ext token = do
  let url = ext ^. userServiceUrl
  rq <- parseUrl $ unpack $ url <> endpoint
  return rq
    { redirectCount = 0
    , requestHeaders = ("X-Access-Token", encodeUtf8 token): requestHeaders rq
    }

-- call to http://user.qavmg.com/rest/profile/305bc11d-66dd-4577-84c9-2af0b3578949
userServiceGetUser_ :: (MonadBaseControl IO m, MonadIO m, MonadReader Ext m,  MonadThrow m, Log.Logging m) =>
  Manager -> N.UserId -> m (Either SomeException N.UserCore)
userServiceGetUser_ manager uid = tryAny $ do
  ext <- ask
  token <- createToken uid
  let N.UserId vid = uid
  rawJson <- liftIO $ runResourceT $ do
    req <- prepareRequest ("/profile/" <> N.toText vid) ext token
    lift $ Log.debug $ "req = " <> show req
    res <- httpLbs req manager
    return $ responseBody res
  let usrMb = decode rawJson :: Maybe N.UserCore
  return $ fromMaybe (throw $ MyException "User not found") usrMb

-- call to http://user.qavmg.com/rest/device
-- token is the user
userServiceGetDevices_ :: (MonadBaseControl IO m, MonadIO m, MonadReader Ext m,  MonadThrow m, Log.Logging m) =>
  Manager -> N.UserId -> m (Either SomeException [DeviceInfo])
userServiceGetDevices_ manager uid = tryAny $ do
  ext <- ask
  token <- createToken uid
  rawJson <- liftIO $ runResourceT $ do
    req <- prepareRequest "/device" ext token
    lift $ Log.debug $ "req = " <> show req
    res <- httpLbs req manager
    return $ responseBody res
  let dsMb = decode rawJson :: Maybe [DeviceInfo]
  return $ fromMaybe [] dsMb

-- | userServiceUpdateDevice
-- update the device info
userServiceUpdateDevice_ :: (MonadBaseControl IO m, MonadIO m, MonadReader Ext m, MonadThrow m, Log.Logging m) =>
  Manager -> N.UserId -> DeviceInfo -> m (Either SomeException ())
userServiceUpdateDevice_ manager uid device = tryAny $ do
  ext <- ask
  token <- createToken uid
  _rawJson <- liftIO $ runResourceT $ do
    req <- prepareRequest_ ext token device
    lift $ Log.debug $ "req = " <> show req
    res <- httpLbs req manager
    return $ responseBody res
  return ()
  where
    prepareRequest_ ext token device = do
      let url = ext ^. userServiceUrl
      req0 <- parseUrl $ unpack url
      -- update should be in the form of PUT /rest/device/123456 where 123456 is diDeviceId
      let newPath :: B.ByteString
          newPath = path req0 <> "/device/" <> encodeUtf8 (device ^. diDeviceId)
      return req0
        { method = "PUT"
        , path = newPath
        , redirectCount = 0
        , requestBody = RequestBodyLBS $ encode device
        , requestHeaders =
            ("X-Access-Token", encodeUtf8 token):
            ("Content-Type", "application/json"):
            requestHeaders req0
        }

-- paArn - platformApplicationARN
-- deviceToken - device token for iOS or registrationId for Android
snsCreatePlatformEndpoint_ :: (MonadBaseControl IO m, MonadIO m, MonadReader Ext m, Log.Logging m) =>
  ApplicationArn -> DeviceToken -> Text -> m (Either SomeException EndpointArn)
snsCreatePlatformEndpoint_ (ApplicationArn paArn) (DeviceToken deviceToken) customData = tryAny $ do
  -- TODO return arn:aws:sns:us-west-2:877422789438:endpoint/APNS/vertigo-ios-dev-prod/610edbfa-b5ca-3275-ab07-100a5c10310f
  EndpointArn <$> return "arn:aws:sns:us-west-2:877422789438:endpoint/APNS/vertigo-ios-dev-prod/610edbfa-b5ca-3275-ab07-100a5c10310f"

-- endpointArn - endpointArn of the device to send message to
-- msq - message to send
snsPublish_ :: (MonadBaseControl IO m, MonadIO m, MonadReader Ext m) =>
  EndpointArn -> Text -> m (Either SomeException ())
snsPublish_ (EndpointArn endpointArn) msg = tryAny $ do
  return ()

snsGetEndpointAttributes_ :: (MonadBaseControl IO m, MonadIO m, MonadReader Ext m) =>
  EndpointArn -> m (Either SomeException (M.Map Text Text))
snsGetEndpointAttributes_ (EndpointArn endpointArn) = tryAny $ do
  return $ M.fromList $ [(pack "size", pack "10")]

snsDeleteEndpoint_ :: (MonadBaseControl IO m, MonadIO m, MonadReader Ext m) =>
  EndpointArn -> m (Either SomeException ())
snsDeleteEndpoint_ (EndpointArn endpointArn) = tryAny $ do
  return ()