-- | -- Module: PowerDNS.API.Servers -- Description: Servers endpoints for PowerDNS API -- -- This module implements the endpoints described at [Servers API](https://doc.powerdns.com/authoritative/http-api/server.html) {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE OverloadedStrings #-} module PowerDNS.API.Servers ( -- * API ServersAPI(..) -- * Data types , Server(..) , ObjectType(..) , SearchResult(..) , CacheFlushResult(..) , AnyStatisticItem(..) , StatisticItem(..) , MapStatisticItem(..) , RingStatisticItem(..) , SimpleStatisticItem(..) ) where import Data.Char (toLower) import Data.Data (Data) import Text.Read (readMaybe) import Control.DeepSeq (NFData) import Data.Aeson.TH (defaultOptions , fieldLabelModifier, constructorTagModifier , deriveJSON , allNullaryToStringTag ) import Data.Aeson (FromJSON(..), ToJSON(..), Value(String), (.:), (.=) , withObject, object ) import Data.Aeson.Types (Parser) import qualified Data.Text as T import Servant.API import Servant.API.Generic import PowerDNS.Internal.Utils (Empty(..), strip, map1) ---------------------------------------------------------------------------------------- data Server = Server { server_type :: Maybe T.Text , server_id :: Maybe T.Text , server_daemon_type :: Maybe T.Text , server_version :: Maybe T.Text , server_url :: Maybe T.Text , server_config_url :: Maybe T.Text , server_zones_url :: Maybe T.Text } deriving (Eq, Ord, Show, Generic, NFData, Data, Empty) $(deriveJSON defaultOptions { fieldLabelModifier = strip "server_" } ''Server) ---------------------------------------------------------------------------------------- data ObjectType = TyAll | TyZone | TyRecord | TyComment deriving (Eq, Ord, Show, Generic, NFData, Data) $(deriveJSON defaultOptions { constructorTagModifier = map1 toLower . strip "Ty" , allNullaryToStringTag = True } ''ObjectType) instance FromHttpApiData ObjectType where parseQueryParam "all" = Right TyAll parseQueryParam "zone" = Right TyZone parseQueryParam "record" = Right TyRecord parseQueryParam "comment" = Right TyComment parseQueryParam x = Left ("Unknown ObjectType: " <> x) instance ToHttpApiData ObjectType where toQueryParam TyAll = "all" toQueryParam TyZone = "zone" toQueryParam TyRecord = "record" toQueryParam TyComment = "comment" ---------------------------------------------------------------------------------------- data SearchResult = SearchResult { sr_content :: T.Text , sr_disabled :: Bool , sr_name :: T.Text , sr_object_type :: ObjectType , sr_zone_id :: T.Text , sr_zone :: T.Text , sr_type :: T.Text , sr_ttl :: Integer } deriving (Eq, Ord, Show, Generic, NFData, Data) $(deriveJSON defaultOptions { fieldLabelModifier = strip "sr_" } ''SearchResult) ---------------------------------------------------------------------------------------- data CacheFlushResult = CacheFlushResult { cfr_count :: Integer , cfr_result :: T.Text } deriving (Eq, Ord, Show, Generic, NFData, Data) $(deriveJSON defaultOptions { fieldLabelModifier = strip "cfr_" } ''CacheFlushResult) ---------------------------------------------------------------------------------------- data SimpleStatisticItem = SimpleStatisticItem { ssi_name :: T.Text , ssi_value :: T.Text } deriving (Eq, Ord, Show, Generic, NFData, Data) $(deriveJSON defaultOptions { fieldLabelModifier = strip "ssi_" } ''SimpleStatisticItem) ---------------------------------------------------------------------------------------- data AnyStatisticItem = AnyStatisticItem StatisticItem | AnyMapStatisticItem MapStatisticItem | AnyRingStatisticItem RingStatisticItem deriving (Eq, Ord, Show, Generic, NFData, Data) instance ToJSON AnyStatisticItem where toJSON (AnyStatisticItem si) = object [ "type" .= String "StatisticItem" , "name" .= si_name si , "value" .= si_value si ] toJSON (AnyMapStatisticItem si) = object [ "type" .= String "MapStatisticItem" , "name" .= msi_name si , "value" .= msi_value si ] toJSON (AnyRingStatisticItem si) = object [ "type" .= String "RingStatisticItem" , "name" .= rsi_name si , "size" .= String (showT (rsi_size si)) , "value" .= rsi_value si ] showT :: Show a => a -> T.Text showT = T.pack . show thruRead :: Read a => T.Text -> Parser a thruRead = maybe (fail "failed to parse") pure . readMaybe . T.unpack instance FromJSON AnyStatisticItem where parseJSON = withObject "Any StatisticItem" $ \o -> do r <- o .: "type" case r of "StatisticItem" -> fmap AnyStatisticItem $ StatisticItem <$> o .: "name" <*> o .: "value" "MapStatisticItem" -> fmap AnyMapStatisticItem $ MapStatisticItem <$> o .: "name" <*> o .: "value" "RingStatisticItem" -> fmap AnyRingStatisticItem $ RingStatisticItem <$> o .: "name" <*> (o .: "size" >>= thruRead) <*> o .: "value" _ -> fail ("Unknown type: " <> T.unpack r) data StatisticItem = StatisticItem { si_name :: T.Text , si_value :: T.Text } deriving (Eq, Ord, Show, Generic, NFData, Data) data MapStatisticItem = MapStatisticItem { msi_name :: T.Text , msi_value :: [SimpleStatisticItem] } deriving (Eq, Ord, Show, Generic, NFData, Data) data RingStatisticItem = RingStatisticItem { rsi_name :: T.Text , rsi_size :: Integer , rsi_value :: [SimpleStatisticItem] } deriving (Eq, Ord, Show, Generic, NFData, Data) ---------------------------------------------------------------------------------------- type QueryParamReq = QueryParam' [Required, Strict] data ServersAPI f = ServersAPI { apiListServers :: f :- "servers" :> Get '[JSON] [Server] , apiGetServer :: f :- "servers" :> Capture "server_id" T.Text :> Get '[JSON] Server , apiSearch :: f :- "servers" :> Capture "server_id" T.Text :> "search-data" :> QueryParamReq "q" T.Text :> QueryParamReq "max" Integer :> QueryParam "object_type" ObjectType :> Get '[JSON] [SearchResult] , apiFlushCache :: f :- "servers" :> Capture "server_id" T.Text :> QueryParamReq "domain" T.Text :> Put '[JSON] CacheFlushResult , apiStatistics :: f :- "servers" :> Capture "server_id" T.Text :> "statistics" :> QueryParam "statistic" T.Text :> QueryParam "includerings" Bool :> Get '[JSON] [AnyStatisticItem] } deriving Generic