module Database.InfluxDB.Types
(
Series(..)
, seriesColumns
, seriesPoints
, SeriesData(..)
, Column
, Value(..)
, Credentials(..)
, Server(..)
, Database(..)
, ScheduledDelete(..)
, User(..)
, Admin(..)
, Ping(..)
, Interface
, ServerPool
, serverRetrySettings
, newServerPool
, newServerPoolWithRetrySettings
, activeServer
, failover
, InfluxException(..)
, jsonDecodeError
, seriesDecodeError
) where
import Control.Applicative (empty)
import Control.Exception (Exception, throwIO)
import Data.Data (Data)
import Data.IORef
import Data.Int (Int64)
import Data.Sequence (Seq, ViewL(..), (|>))
import Data.Text (Text)
import Data.Typeable (Typeable)
import Data.Vector (Vector)
import qualified Data.Sequence as Seq
import Control.Retry (RetrySettings(..), limitedRetries)
import Data.Aeson ((.=), (.:))
import Data.Aeson.TH
import qualified Data.Aeson as A
import Database.InfluxDB.Types.Internal (stripPrefixOptions)
#if MIN_VERSION_aeson(0, 7, 0)
import Data.Scientific
#else
import Data.Attoparsec.Number
#endif
#if __GLASGOW_HASKELL__ < 706
import Control.Exception (evaluate)
atomicModifyIORef' :: IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' ref f = do
b <- atomicModifyIORef ref $ \x ->
let (a, b) = f x
in (a, a `seq` b)
evaluate b
#endif
data Series = Series
{ seriesName :: !Text
, seriesData :: !SeriesData
}
seriesColumns :: Series -> Vector Column
seriesColumns = seriesDataColumns . seriesData
seriesPoints :: Series -> [Vector Value]
seriesPoints = seriesDataPoints . seriesData
instance A.ToJSON Series where
toJSON Series {..} = A.object
[ "name" .= seriesName
, "columns" .= seriesDataColumns
, "points" .= seriesDataPoints
]
where
SeriesData {..} = seriesData
instance A.FromJSON Series where
parseJSON (A.Object v) = do
name <- v .: "name"
columns <- v .: "columns"
points <- v .: "points"
return Series
{ seriesName = name
, seriesData = SeriesData
{ seriesDataColumns = columns
, seriesDataPoints = points
}
}
parseJSON _ = empty
data SeriesData = SeriesData
{ seriesDataColumns :: Vector Column
, seriesDataPoints :: [Vector Value]
} deriving (Eq, Show)
type Column = Text
data Value
= Int !Int64
| Float !Double
| String !Text
| Bool !Bool
| Null
deriving (Eq, Show, Data, Typeable)
instance A.ToJSON Value where
toJSON (Int n) = A.toJSON n
toJSON (Float d) = A.toJSON d
toJSON (String xs) = A.toJSON xs
toJSON (Bool b) = A.toJSON b
toJSON Null = A.Null
instance A.FromJSON Value where
parseJSON (A.Object o) = fail $ "Unexpected object: " ++ show o
parseJSON (A.Array a) = fail $ "Unexpected array: " ++ show a
parseJSON (A.String xs) = return $ String xs
parseJSON (A.Bool b) = return $ Bool b
parseJSON A.Null = return Null
parseJSON (A.Number n) = return $! numberToValue
where
#if MIN_VERSION_aeson(0, 7, 0)
numberToValue
| n > maxInt = Float $ toRealFloat n
| e < 0 = Float $ realToFrac n
| otherwise = Int $ fromIntegral $ coefficient n * 10 ^ e
where
e = base10Exponent n
#if !MIN_VERSION_scientific(0, 3, 0)
toRealFloat = realToFrac
#endif
#else
numberToValue = case n of
I i
| i > maxInt -> Float $ fromIntegral i
| otherwise -> Int $ fromIntegral i
D d -> Float d
#endif
maxInt = fromIntegral (maxBound :: Int64)
data Credentials = Credentials
{ credsUser :: !Text
, credsPassword :: !Text
} deriving Show
data Server = Server
{ serverHost :: !Text
, serverPort :: !Int
, serverSsl :: !Bool
} deriving Show
data ServerPool = ServerPool
{ serverActive :: !Server
, serverBackup :: !(Seq Server)
, serverRetrySettings :: !RetrySettings
}
newtype Database = Database
{ databaseName :: Text
} deriving Show
newtype ScheduledDelete = ScheduledDelete
{ scheduledDeleteId :: Int
} deriving Show
data User = User
{ userName :: Text
, userIsAdmin :: Bool
} deriving Show
newtype Admin = Admin
{ adminName :: Text
} deriving Show
newtype Ping = Ping
{ pingStatus :: Text
} deriving Show
type Interface = Text
newServerPool :: Server -> [Server] -> IO (IORef ServerPool)
newServerPool = newServerPoolWithRetrySettings defaultRetrySettings
where
defaultRetrySettings = RetrySettings
{ numRetries = limitedRetries 5
, backoff = True
, baseDelay = 50
}
newServerPoolWithRetrySettings
:: RetrySettings -> Server -> [Server] -> IO (IORef ServerPool)
newServerPoolWithRetrySettings retrySettings active backups =
newIORef ServerPool
{ serverActive = active
, serverBackup = Seq.fromList backups
, serverRetrySettings = retrySettings
}
activeServer :: IORef ServerPool -> IO Server
activeServer ref = do
ServerPool { serverActive } <- readIORef ref
return serverActive
failover :: IORef ServerPool -> IO ()
failover ref = atomicModifyIORef' ref $ \pool@ServerPool {..} ->
case Seq.viewl serverBackup of
EmptyL -> (pool, ())
active :< rest -> (newPool, ())
where
newPool = pool
{ serverActive = active
, serverBackup = rest |> serverActive
}
data InfluxException
= JsonDecodeError String
| SeriesDecodeError String
deriving (Show, Typeable)
instance Exception InfluxException
jsonDecodeError :: String -> IO a
jsonDecodeError = throwIO . JsonDecodeError
seriesDecodeError :: String -> IO a
seriesDecodeError = throwIO . SeriesDecodeError
deriveFromJSON (stripPrefixOptions "database") ''Database
deriveFromJSON (stripPrefixOptions "admin") ''Admin
deriveFromJSON (stripPrefixOptions "user") ''User
deriveFromJSON (stripPrefixOptions "ping") ''Ping