{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module SimFin.Internal
  ( SimFinContext(..)
  , QueryParam
  , createKeyedRow
  , createKeyedRows
  , toCommaQueryParam
  , toBoolQueryParam
  , toTextCommaQueryParam
  , toShownCommaQueryParam
  , baseRequest
  , makeRequest
  , performGenericRequest
  ) where

import Control.Monad.IO.Class
import Data.Aeson
import Data.Aeson.Types (parse, Parser)

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
#else
import qualified Data.HashMap.Strict as HM
#endif

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as LBS
import Data.Functor.Syntax
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import Network.HTTP.Client
import Network.HTTP.Types.Status

-- | The context needed to call every fetch* function.

data SimFinContext = SimFinContext
  { SimFinContext -> ByteString
simFinApiKey :: ByteString
  , SimFinContext -> Manager
simFinManager :: Manager
  }

baseRequest :: Request
baseRequest :: Request
baseRequest = Request
defaultRequest
  { host :: ByteString
host = ByteString
"simfin.com"
  , port :: Int
port = Int
443
  , secure :: Bool
secure = Bool
True
  , requestHeaders :: RequestHeaders
requestHeaders =
    [ (HeaderName
"Accept", ByteString
"application/json")
    ]
  }

basePath :: ByteString
basePath :: ByteString
basePath = ByteString
"/api/v2/"

makeRequest :: ByteString -> ByteString -> [QueryParam] -> Request
makeRequest :: ByteString -> ByteString -> [QueryParam] -> Request
makeRequest ByteString
apiKey ByteString
path [QueryParam]
query =
  [QueryParam] -> Request -> Request
setQueryString ((ByteString
"api-key", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
apiKey) QueryParam -> [QueryParam] -> [QueryParam]
forall a. a -> [a] -> [a]
: [QueryParam]
query)
  (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
baseRequest { path :: ByteString
path = ByteString
basePath ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
path }

performGenericRequest
  :: ( MonadIO m
     , FromJSON a
     , FromJSON e
     )
  => (LBS.ByteString -> String -> e)
  -> (Value -> String -> e)
  -> SimFinContext
  -> ByteString
  -> [QueryParam]
  -> m (Either e a)
performGenericRequest :: (ByteString -> String -> e)
-> (Value -> String -> e)
-> SimFinContext
-> ByteString
-> [QueryParam]
-> m (Either e a)
performGenericRequest ByteString -> String -> e
mkDecodeErr Value -> String -> e
mkParseErr SimFinContext{ByteString
Manager
simFinManager :: Manager
simFinApiKey :: ByteString
simFinManager :: SimFinContext -> Manager
simFinApiKey :: SimFinContext -> ByteString
..} ByteString
path [QueryParam]
query = do
  let req :: Request
req = ByteString -> ByteString -> [QueryParam] -> Request
makeRequest ByteString
simFinApiKey ByteString
path [QueryParam]
query
  Response ByteString
res <- IO (Response ByteString) -> m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
httpLbs Request
req Manager
simFinManager
  let body :: ByteString
body = Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
res
  -- Try to parse body into generic JSON
  Either e a -> m (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a)) -> Either e a -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String Value)
-> ByteString -> Either String Value
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
res of
    Left String
err -> e -> Either e a
forall a b. a -> Either a b
Left (e -> Either e a) -> e -> Either e a
forall a b. (a -> b) -> a -> b
$ ByteString -> String -> e
mkDecodeErr ByteString
body String
err
    Right Value
value -> case Status -> Int
statusCode (Status -> Int) -> Status -> Int
forall a b. (a -> b) -> a -> b
$ Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
res of
      Int
200 -> case (Value -> Parser a) -> Value -> Result a
forall a b. (a -> Parser b) -> a -> Result b
parse Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value of
        Error String
err -> e -> Either e a
forall a b. a -> Either a b
Left (e -> Either e a) -> e -> Either e a
forall a b. (a -> b) -> a -> b
$ Value -> String -> e
mkParseErr Value
value String
err
        Success a
a -> a -> Either e a
forall a b. b -> Either a b
Right a
a
      Int
_ -> case (Value -> Parser e) -> Value -> Result e
forall a b. (a -> Parser b) -> a -> Result b
parse Value -> Parser e
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value of
        Error String
err -> e -> Either e a
forall a b. a -> Either a b
Left (e -> Either e a) -> e -> Either e a
forall a b. (a -> b) -> a -> b
$ Value -> String -> e
mkParseErr Value
value String
err
        Success e
a -> e -> Either e a
forall a b. a -> Either a b
Left e
a

type QueryParam = (ByteString, Maybe ByteString)

#if MIN_VERSION_aeson(2,0,0)

toKey :: Text -> Key
toKey = K.fromText

toObject :: [(K.Key, Value)] -> Value
toObject = Object . KM.fromList

#else

toKey :: Text -> Text
toKey :: Text -> Text
toKey = Text -> Text
forall a. a -> a
id

toObject :: [(Text, Value)] -> Value
toObject :: [(Text, Value)] -> Value
toObject = Object -> Value
Object (Object -> Value)
-> ([(Text, Value)] -> Object) -> [(Text, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList 

#endif

createKeyedRow :: Value -> Parser Value
createKeyedRow :: Value -> Parser Value
createKeyedRow = String -> (Object -> Parser Value) -> Value -> Parser Value
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Root" ((Object -> Parser Value) -> Value -> Parser Value)
-> (Object -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ \Object
root -> do
  [Text]
cols <- Text -> Text
toKey (Text -> Text) -> Parser [Text] -> Parser [Text]
forall (f0 :: * -> *) (f1 :: * -> *) a b.
(Functor f0, Functor f1) =>
(a -> b) -> f1 (f0 a) -> f1 (f0 b)
<$$> Object
root Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"columns"
  [Value]
row <- Object
root Object -> Text -> Parser [Value]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"data"
  Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ [(Text, Value)] -> Value
toObject ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [Text] -> [Value] -> [(Text, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
cols [Value]
row

createKeyedRows :: Value -> Parser [Value]
createKeyedRows :: Value -> Parser [Value]
createKeyedRows = String -> (Object -> Parser [Value]) -> Value -> Parser [Value]
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Root" ((Object -> Parser [Value]) -> Value -> Parser [Value])
-> (Object -> Parser [Value]) -> Value -> Parser [Value]
forall a b. (a -> b) -> a -> b
$ \Object
root -> do
  [Text]
cols <- Text -> Text
toKey (Text -> Text) -> Parser [Text] -> Parser [Text]
forall (f0 :: * -> *) (f1 :: * -> *) a b.
(Functor f0, Functor f1) =>
(a -> b) -> f1 (f0 a) -> f1 (f0 b)
<$$> Object
root Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"columns"
  [[Value]]
rows <- Object
root Object -> Text -> Parser [[Value]]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"data"
  [Value] -> Parser [Value]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Value] -> Parser [Value]) -> [Value] -> Parser [Value]
forall a b. (a -> b) -> a -> b
$ [(Text, Value)] -> Value
toObject ([(Text, Value)] -> Value)
-> ([Value] -> [(Text, Value)]) -> [Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Value] -> [(Text, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
cols ([Value] -> Value) -> [[Value]] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Value]]
rows

toCommaQueryParam :: ByteString -> (a -> ByteString) -> [a] -> [QueryParam]
toCommaQueryParam :: ByteString -> (a -> ByteString) -> [a] -> [QueryParam]
toCommaQueryParam ByteString
key a -> ByteString
f [a]
as = case [a]
as of
  [] -> []
  [a]
_ -> [(ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
BS8.intercalate ByteString
"," ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
f (a -> ByteString) -> [a] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as)]

-- Chars are truncated to 8-bits
toShownCommaQueryParam :: Show a => ByteString -> [a] -> [QueryParam]
toShownCommaQueryParam :: ByteString -> [a] -> [QueryParam]
toShownCommaQueryParam ByteString
key = ByteString -> (a -> ByteString) -> [a] -> [QueryParam]
forall a. ByteString -> (a -> ByteString) -> [a] -> [QueryParam]
toCommaQueryParam ByteString
key (String -> ByteString
BS8.pack (String -> ByteString) -> (a -> String) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)

toTextCommaQueryParam :: ByteString -> [Text] -> [QueryParam]
toTextCommaQueryParam :: ByteString -> [Text] -> [QueryParam]
toTextCommaQueryParam ByteString
key = ByteString -> (Text -> ByteString) -> [Text] -> [QueryParam]
forall a. ByteString -> (a -> ByteString) -> [a] -> [QueryParam]
toCommaQueryParam ByteString
key Text -> ByteString
T.encodeUtf8

toBoolQueryParam :: ByteString -> Bool -> [QueryParam]
toBoolQueryParam :: ByteString -> Bool -> [QueryParam]
toBoolQueryParam ByteString
key Bool
b = case Bool
b of
  Bool
False -> []
  Bool
True -> [(ByteString
key, Maybe ByteString
forall a. Maybe a
Nothing)]