TSIGKeys.hs

-- |
-- Module: PowerDNS.API.TSIGKeys
-- Description: TSIGKeys endpoints for PowerDNS API
--
-- Implementation of the API endpoints described at [PowerDNS TSIGKeys API](https://doc.powerdns.com/authoritative/http-api/tsigkey.html)

{-# LANGUAGE CPP                #-}
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE TypeOperators      #-}
{-# LANGUAGE TemplateHaskell    #-}
module PowerDNS.API.TSIGKeys
  (
  -- * API
    TSIGKeysAPI(..)

  -- * Data types
  , TSIGKey(..)
  , TSIGAlgorithm(..)
  )
where

import qualified Control.Monad.Fail as Fail
import           Data.Char (toLower)
import           Data.Data (Data)
import           Data.Functor ((<&>))

import           Control.DeepSeq (NFData)
import           Data.Aeson (FromJSON(..), ToJSON(..), Value(String),
                             object, withObject, (.:), (.:?), (.=))

import           Data.Aeson.TH (allNullaryToStringTag, constructorTagModifier,
                                defaultOptions, deriveJSON)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as BS64
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import           Servant.API
import           Servant.API.Generic

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

data TSIGKeysAPI f = TSIGKeysAPI
  { apiListTSIGKeys  :: f :- Summary "List TSIG keys"
                          :> "servers" :> Capture "server_id" T.Text :> "tsigkeys"
                          :> Get '[JSON] [TSIGKey]

  , apiCreateTSIGKey :: f :- Summary "Create TSIG key"
                          :> "servers" :> Capture "server_id" T.Text :> "tsigkeys"
                          :> ReqBody '[JSON] TSIGKey
                          :> PostCreated '[JSON] TSIGKey

  , apiGetTSIGKey    :: f :- Summary "Get TSIG key"
                          :> "servers" :> Capture "server_id" T.Text :> "tsigkeys" :> Capture "tsigkey_id" T.Text
                          :> Get '[JSON] TSIGKey

  , apiUpdateTSIGKey :: f :- Summary "Update TSIG key"
                          :> "servers" :> Capture "server_id" T.Text :> "tsigkeys" :> Capture "tsigkey_id" T.Text
                          :> ReqBody '[JSON] TSIGKey
                          :> Put '[JSON] TSIGKey

  , apiDeleteTSIGKey :: f :- Summary "DElete TSIG key"
                          :> "servers" :> Capture "server_id" T.Text :> "tsigkeys" :> Capture "tsigkey_id" T.Text
                          :> DeleteNoContent
  } deriving Generic

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

data TSIGKey = TSIGKey
  { tsk_name :: T.Text
  , tsk_id :: T.Text
  , tsk_algorithm :: Maybe TSIGAlgorithm
  , tsk_key :: Maybe BS.ByteString
  -- ^ Unlike the original PowerDNS API we do not require the key to be base64 encoded.
  } deriving (Eq, Ord, Read, Show, Generic, NFData, Data)

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

-- | Supported algorithms according to [PowerDNS TSIG Documentation](https://doc.powerdns.com/authoritative/tsig.html#tsig)
data TSIGAlgorithm = HMAC_MD5
                   | HMAC_SHA1
                   | HMAC_SHA224
                   | HMAC_SHA256
                   | HMAC_SHA384
                   | HMAC_SHA512
                   deriving (Eq, Ord, Read, Show, Generic, NFData, Data)

$(deriveJSON defaultOptions { allNullaryToStringTag = True
                            , constructorTagModifier = fmap $ \c ->
                                if c == '_' then '-' else toLower c
                            } ''TSIGAlgorithm)


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

instance ToJSON TSIGKey where
  toJSON key = object [ "name" .= tsk_name key
                      , "id" .= tsk_id key
                      , "type" .= String "TSIGKey"
                      , "algorithm" .= tsk_algorithm key
                      , "key" .= (tsk_key key <&> encode64)
                      ]

instance FromJSON TSIGKey where
  parseJSON = withObject "TSIGKey" $ \o -> do
    tsk_name      <- o .: "name"
    tsk_id        <- o .: "id"
    tsk_algorithm <- o .:? "algorithm"
    tsk_key       <- o .:? "key" >>= traverse decode64
    pure TSIGKey{..}

encode64 :: BS.ByteString -> T.Text
encode64 = T.decodeUtf8 . BS64.encode

decode64 :: Fail.MonadFail m => T.Text -> m BS.ByteString
decode64 i = case BS64.decode (T.encodeUtf8 i) of
  Left err -> Fail.fail err
  Right k  -> pure k