module Database.InfluxDB.Types where
import Control.Exception
import Data.Data (Data)
import Data.Int (Int64)
import Data.String
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Control.Lens
import Data.Text (Text)
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Network.HTTP.Client (Manager, ManagerSettings, Request)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
newtype Query = Query T.Text deriving IsString
instance Show Query where
show (Query q) = show q
data Server = Server
{ _host :: !Text
, _port :: !Int
, _ssl :: !Bool
} deriving (Show, Generic, Eq)
localServer :: Server
localServer = Server
{ _host = "localhost"
, _port = 8086
, _ssl = False
}
makeLensesWith (lensRules & generateSignatures .~ False) ''Server
host :: Lens' Server Text
port :: Lens' Server Int
ssl :: Lens' Server Bool
data Credentials = Credentials
{ _user :: !Text
, _password :: !Text
}
makeLensesWith (lensRules & generateSignatures .~ False) ''Credentials
user :: Lens' Credentials Text
password :: Lens' Credentials Text
newtype Database = Database { databaseName :: Text } deriving (Eq, Ord)
newtype Key = Key Text deriving (Eq, Ord)
instance IsString Database where
fromString xs = Database $ fromNonEmptyString "Database" xs
instance IsString Key where
fromString xs = Key $ fromNonEmptyString "Key" xs
fromNonEmptyString :: String -> String -> Text
fromNonEmptyString ty xs
| null xs = error $ ty ++ " should never be empty"
| otherwise = fromString xs
instance Show Database where
show (Database name) = show name
instance Show Key where
show (Key name) = show name
data FieldValue
= FieldInt !Int64
| FieldFloat !Double
| FieldString !Text
| FieldBool !Bool
| FieldNull
deriving (Eq, Show, Data, Typeable, Generic)
instance IsString FieldValue where
fromString = FieldString . T.pack
data RequestType
= QueryRequest
| WriteRequest
deriving Show
data Precision (ty :: RequestType) where
Nanosecond :: Precision ty
Microsecond :: Precision ty
Millisecond :: Precision ty
Second :: Precision ty
Minute :: Precision ty
Hour :: Precision ty
RFC3339 :: Precision 'QueryRequest
deriving instance Show (Precision a)
precisionName :: Precision ty -> Text
precisionName = \case
Nanosecond -> "n"
Microsecond -> "u"
Millisecond -> "ms"
Second -> "s"
Minute -> "m"
Hour -> "h"
RFC3339 -> "rfc3339"
class Timestamp time where
roundTo :: Precision 'WriteRequest -> time -> Int64
scaleTo :: Precision 'WriteRequest -> time -> Int64
roundAt :: RealFrac a => a -> a -> a
roundAt scale x = fromIntegral (round (x / scale) :: Int) * scale
precisionScale :: Fractional a => Precision ty -> a
precisionScale = \case
RFC3339 -> 10^^(9 :: Int)
Nanosecond -> 10^^(9 :: Int)
Microsecond -> 10^^(6 :: Int)
Millisecond -> 10^^(3 :: Int)
Second -> 1
Minute -> 60
Hour -> 60 * 60
instance Timestamp UTCTime where
roundTo prec = roundTo prec . utcTimeToPOSIXSeconds
scaleTo prec = scaleTo prec . utcTimeToPOSIXSeconds
instance Timestamp NominalDiffTime where
roundTo prec time =
round $ 10^(9 :: Int) * roundAt (precisionScale prec) time
scaleTo prec time = round $ time / precisionScale prec
data InfluxException
= ServerError String
| BadRequest String Request
| IllformedJSON String BL.ByteString
deriving (Show, Typeable)
instance Exception InfluxException
class HasServer a where
server :: Lens' a Server
class HasDatabase a where
database :: Lens' a Database
class HasPrecision (ty :: RequestType) a | a -> ty where
precision :: Lens' a (Precision ty)
class HasManager a where
manager :: Lens' a (Either ManagerSettings Manager)
class HasCredentials a where
authentication :: Lens' a (Maybe Credentials)