Servers.hs

-- |
-- 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 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 (FromJSON(..), ToJSON(..), defaultOptions
                            , Value(String)
                            , fieldLabelModifier, constructorTagModifier
                            , genericParseJSON
                            , allNullaryToStringTag
                            , genericToJSON
                            , (.:), (.=)
                            , 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)

----------------------------------------------------------------------------------------

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

----------------------------------------------------------------------------------------

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)

instance ToJSON Server where
  toJSON = genericToJSON defaultOptions { fieldLabelModifier = strip "server_"}

instance FromJSON Server where
  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = strip "server_"}

----------------------------------------------------------------------------------------

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)

instance ToJSON SearchResult where
  toJSON = genericToJSON defaultOptions { fieldLabelModifier = strip "sr_"}

instance FromJSON SearchResult where
  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = strip "sr_"}

----------------------------------------------------------------------------------------
data ObjectType = TyAll
                | TyZone
                | TyRecord
                | TyComment
                deriving (Eq, Ord, Show, Generic, NFData, Data)

instance ToJSON ObjectType where
  toJSON = genericToJSON defaultOptions { constructorTagModifier = map1 toLower . strip "Ty"
                                        , allNullaryToStringTag = True }

instance FromJSON ObjectType where
  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = map1 toLower . strip "Ty"
                                              , allNullaryToStringTag = True }

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 CacheFlushResult = CacheFlushResult
  { cfr_count :: Integer
  , cfr_result :: T.Text
  } deriving (Eq, Ord, Show, Generic, NFData, Data)

instance ToJSON CacheFlushResult where
  toJSON = genericToJSON defaultOptions { fieldLabelModifier = strip "cfr_"}

instance FromJSON CacheFlushResult where
  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = strip "cfr_"}

----------------------------------------------------------------------------------------

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)

data SimpleStatisticItem = SimpleStatisticItem
  { ssi_name :: T.Text
  , ssi_value :: T.Text
  } deriving (Eq, Ord, Show, Generic, NFData, Data)

instance ToJSON SimpleStatisticItem where
  toJSON = genericToJSON defaultOptions { fieldLabelModifier = strip "ssi_"}

instance FromJSON SimpleStatisticItem where
  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = strip "ssi_"}