# OPTIONS_GHC -fno - warn - orphans #

-- | Internal module for dealing with requests via http-conduit

module OANDA.Internal.Request
  ( OANDARequest (..)
  , makeOandaRequest
  , OANDAStreamingRequest (..)
  , makeOandaStreamingRequest
  , baseApiRequest
  , baseStreamingRequest
  , apiBaseURL
  , streamingBaseURL
  , formatTimeRFC3339
  ) where

import Control.Monad.IO.Class
import Control.Monad.Trans.Resource (MonadResource)
import qualified Data.ByteString as BS
import Data.Conduit
import qualified Network.HTTP.Client as H

import OANDA.Internal.Import
import OANDA.Internal.Types

-- | This is the type returned by the API functions. This is meant to be used
-- with some of our request functions, depending on how safe the user wants to
-- be.
newtype OANDARequest a = OANDARequest { unOANDARequest :: Request }
  deriving (Show)

-- | Simplest way to make requests, but throws exception on errors.
makeOandaRequest :: (MonadIO m, FromJSON a) => OANDARequest a -> m a
makeOandaRequest (OANDARequest request) = getResponseBody <$> httpJSON request

-- | This is the type returned by the streaming API functions. This is meant to
-- be used with some of our streaming request functions, depending on how safe
-- the user wants to be.
newtype OANDAStreamingRequest a = OANDAStreamingRequest { unOANDAStreamingRequest :: Request }
  deriving (Show)

-- | Simplest way to make streaming, but throws exception on errors.
makeOandaStreamingRequest :: (MonadResource m, FromJSON a) => OANDAStreamingRequest a -> Source m a
makeOandaStreamingRequest (OANDAStreamingRequest request) = httpSource request parseBody
  where
    --parseBody :: (MonadIO m) => Response (Source m ByteString) -> Source m a
    parseBody response = mapOutput (either error id . eitherDecodeStrict) $ getResponseBody response

  | Specifies the endpoints for each ` APIType ` . These are the base URLs for
-- each API call.
apiBaseURL :: OandaEnv -> String
apiBaseURL env = apiEndpoint (apiType env)
  where
    apiEndpoint Practice = "-fxpractice.oanda.com"
    apiEndpoint Live     = "-fxtrade.oanda.com"

  | Specifies the streaming endpoints for each ` APIType ` . These are the base
-- URLs for each streaming call.
streamingBaseURL :: OandaEnv -> String
streamingBaseURL env = apiEndpoint (apiType env)
  where
    apiEndpoint Practice = "-fxpractice.oanda.com"
    apiEndpoint Live     = "-fxtrade.oanda.com"

-- | Creates a request with the needed base url and an Authorization header for
  the Bearer token .
baseRequest :: OandaEnv -> String -> String -> String -> Request
baseRequest env baseUrl requestType url =
  unsafeParseRequest (requestType ++ " " ++ baseUrl ++ url)
  & makeAuthHeader (accessToken env)
  where
    makeAuthHeader (AccessToken t) = addRequestHeader "Authorization" ("Bearer " `BS.append` t)

baseApiRequest :: OandaEnv -> String -> String -> Request
baseApiRequest env = baseRequest env (apiBaseURL env)

baseStreamingRequest :: OandaEnv -> String -> String -> Request
baseStreamingRequest env = baseRequest env (streamingBaseURL env)

unsafeParseRequest :: String -> Request
unsafeParseRequest = unsafeParseRequest' . H.parseUrlThrow
  where
    unsafeParseRequest' (Left err) = error $ show err
    unsafeParseRequest' (Right request) = request

  | Formats time according to RFC3339 ( which is the time format used by
-- OANDA). Taken from the < timerep> library.
formatTimeRFC3339 :: ZonedTime -> String
formatTimeRFC3339 zt@(ZonedTime _ z) = formatTime defaultTimeLocale "%FT%T" zt <> printZone
  where timeZoneStr = timeZoneOffsetString z
        printZone = if timeZoneStr == timeZoneOffsetString utc
                    then "Z"
                    else take 3 timeZoneStr <> ":" <> drop 3 timeZoneStr

instance (Show a, Integral a) => ToJSON (DecimalRaw a) where
  toJSON = toJSON . show

instance (Integral a) => FromJSON (DecimalRaw a) where
  parseJSON (Number n) = readDecimalJSON n
  parseJSON (String s) = readDecimalJSON (read (unpack s))
  parseJSON _          = mempty


readDecimalJSON :: (Integral i, Applicative f) => Scientific -> f (DecimalRaw i)
readDecimalJSON n = pure $ fromRational $ toRational n

 | Internal module for dealing with requests via http-conduit
 | This is the type returned by the API functions. This is meant to be used
 with some of our request functions, depending on how safe the user wants to
 be.
 | Simplest way to make requests, but throws exception on errors.
 | This is the type returned by the streaming API functions. This is meant to
 be used with some of our streaming request functions, depending on how safe
 the user wants to be.
 | Simplest way to make streaming, but throws exception on errors.
parseBody :: (MonadIO m) => Response (Source m ByteString) -> Source m a
 each API call.
 URLs for each streaming call.
 | Creates a request with the needed base url and an Authorization header for
 OANDA). Taken from the < timerep> library.
# OPTIONS_GHC -fno - warn - orphans #


module OANDA.Internal.Request
  ( OANDARequest (..)
  , makeOandaRequest
  , OANDAStreamingRequest (..)
  , makeOandaStreamingRequest
  , baseApiRequest
  , baseStreamingRequest
  , apiBaseURL
  , streamingBaseURL
  , formatTimeRFC3339
  ) where

import Control.Monad.IO.Class
import Control.Monad.Trans.Resource (MonadResource)
import qualified Data.ByteString as BS
import Data.Conduit
import qualified Network.HTTP.Client as H

import OANDA.Internal.Import
import OANDA.Internal.Types

newtype OANDARequest a = OANDARequest { unOANDARequest :: Request }
  deriving (Show)

makeOandaRequest :: (MonadIO m, FromJSON a) => OANDARequest a -> m a
makeOandaRequest (OANDARequest request) = getResponseBody <$> httpJSON request

newtype OANDAStreamingRequest a = OANDAStreamingRequest { unOANDAStreamingRequest :: Request }
  deriving (Show)

makeOandaStreamingRequest :: (MonadResource m, FromJSON a) => OANDAStreamingRequest a -> Source m a
makeOandaStreamingRequest (OANDAStreamingRequest request) = httpSource request parseBody
  where
    parseBody response = mapOutput (either error id . eitherDecodeStrict) $ getResponseBody response

  | Specifies the endpoints for each ` APIType ` . These are the base URLs for
apiBaseURL :: OandaEnv -> String
apiBaseURL env = apiEndpoint (apiType env)
  where
    apiEndpoint Practice = "-fxpractice.oanda.com"
    apiEndpoint Live     = "-fxtrade.oanda.com"

  | Specifies the streaming endpoints for each ` APIType ` . These are the base
streamingBaseURL :: OandaEnv -> String
streamingBaseURL env = apiEndpoint (apiType env)
  where
    apiEndpoint Practice = "-fxpractice.oanda.com"
    apiEndpoint Live     = "-fxtrade.oanda.com"

  the Bearer token .
baseRequest :: OandaEnv -> String -> String -> String -> Request
baseRequest env baseUrl requestType url =
  unsafeParseRequest (requestType ++ " " ++ baseUrl ++ url)
  & makeAuthHeader (accessToken env)
  where
    makeAuthHeader (AccessToken t) = addRequestHeader "Authorization" ("Bearer " `BS.append` t)

baseApiRequest :: OandaEnv -> String -> String -> Request
baseApiRequest env = baseRequest env (apiBaseURL env)

baseStreamingRequest :: OandaEnv -> String -> String -> Request
baseStreamingRequest env = baseRequest env (streamingBaseURL env)

unsafeParseRequest :: String -> Request
unsafeParseRequest = unsafeParseRequest' . H.parseUrlThrow
  where
    unsafeParseRequest' (Left err) = error $ show err
    unsafeParseRequest' (Right request) = request

  | Formats time according to RFC3339 ( which is the time format used by
formatTimeRFC3339 :: ZonedTime -> String
formatTimeRFC3339 zt@(ZonedTime _ z) = formatTime defaultTimeLocale "%FT%T" zt <> printZone
  where timeZoneStr = timeZoneOffsetString z
        printZone = if timeZoneStr == timeZoneOffsetString utc
                    then "Z"
                    else take 3 timeZoneStr <> ":" <> drop 3 timeZoneStr

instance (Show a, Integral a) => ToJSON (DecimalRaw a) where
  toJSON = toJSON . show

instance (Integral a) => FromJSON (DecimalRaw a) where
  parseJSON (Number n) = readDecimalJSON n
  parseJSON (String s) = readDecimalJSON (read (unpack s))
  parseJSON _          = mempty


readDecimalJSON :: (Integral i, Applicative f) => Scientific -> f (DecimalRaw i)
readDecimalJSON n = pure $ fromRational $ toRational n
