-- |
-- 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
  { forall f.
TSIGKeysAPI f
-> f
   :- ("servers"
       :> (Capture "server_id" Text
           :> ("tsigkeys" :> Get '[JSON] [TSIGKey])))
apiListTSIGKeys  :: f :- "servers" :> Capture "server_id" T.Text :> "tsigkeys"
                          :> Get '[JSON] [TSIGKey]

  , forall f.
TSIGKeysAPI f
-> f
   :- ("servers"
       :> (Capture "server_id" Text
           :> ("tsigkeys"
               :> (ReqBody '[JSON] TSIGKey :> PostCreated '[JSON] TSIGKey))))
apiCreateTSIGKey :: f :- "servers" :> Capture "server_id" T.Text :> "tsigkeys"
                          :> ReqBody '[JSON] TSIGKey
                          :> PostCreated '[JSON] TSIGKey

  , forall f.
TSIGKeysAPI f
-> f
   :- ("servers"
       :> (Capture "server_id" Text
           :> ("tsigkeys"
               :> (Capture "tsigkey_id" Text :> Get '[JSON] TSIGKey))))
apiGetTSIGKey    :: f :- "servers" :> Capture "server_id" T.Text :> "tsigkeys" :> Capture "tsigkey_id" T.Text
                          :> Get '[JSON] TSIGKey

  , forall f.
TSIGKeysAPI f
-> f
   :- ("servers"
       :> (Capture "server_id" Text
           :> ("tsigkeys"
               :> (Capture "tsigkey_id" Text
                   :> (ReqBody '[JSON] TSIGKey :> Put '[JSON] TSIGKey)))))
apiUpdateTSIGKey :: f :- "servers" :> Capture "server_id" T.Text :> "tsigkeys" :> Capture "tsigkey_id" T.Text
                          :> ReqBody '[JSON] TSIGKey
                          :> Put '[JSON] TSIGKey

  , forall f.
TSIGKeysAPI f
-> f
   :- ("servers"
       :> (Capture "server_id" Text
           :> ("tsigkeys" :> (Capture "tsigkey_id" Text :> DeleteNoContent))))
apiDeleteTSIGKey :: f :- "servers" :> Capture "server_id" T.Text :> "tsigkeys" :> Capture "tsigkey_id" T.Text
                          :> DeleteNoContent
  } deriving (forall x. TSIGKeysAPI f -> Rep (TSIGKeysAPI f) x)
-> (forall x. Rep (TSIGKeysAPI f) x -> TSIGKeysAPI f)
-> Generic (TSIGKeysAPI f)
forall x. Rep (TSIGKeysAPI f) x -> TSIGKeysAPI f
forall x. TSIGKeysAPI f -> Rep (TSIGKeysAPI f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall f x. Rep (TSIGKeysAPI f) x -> TSIGKeysAPI f
forall f x. TSIGKeysAPI f -> Rep (TSIGKeysAPI f) x
$cfrom :: forall f x. TSIGKeysAPI f -> Rep (TSIGKeysAPI f) x
from :: forall x. TSIGKeysAPI f -> Rep (TSIGKeysAPI f) x
$cto :: forall f x. Rep (TSIGKeysAPI f) x -> TSIGKeysAPI f
to :: forall x. Rep (TSIGKeysAPI f) x -> TSIGKeysAPI f
Generic

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

data TSIGKey = TSIGKey
  { TSIGKey -> Text
tsk_name :: T.Text
  , TSIGKey -> Text
tsk_id :: T.Text
  , TSIGKey -> Maybe TSIGAlgorithm
tsk_algorithm :: Maybe TSIGAlgorithm
  , TSIGKey -> Maybe ByteString
tsk_key :: Maybe BS.ByteString
  -- ^ Unlike the original PowerDNS API we do not require the key to be base64 encoded.
  } deriving (TSIGKey -> TSIGKey -> Bool
(TSIGKey -> TSIGKey -> Bool)
-> (TSIGKey -> TSIGKey -> Bool) -> Eq TSIGKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TSIGKey -> TSIGKey -> Bool
== :: TSIGKey -> TSIGKey -> Bool
$c/= :: TSIGKey -> TSIGKey -> Bool
/= :: TSIGKey -> TSIGKey -> Bool
Eq, Eq TSIGKey
Eq TSIGKey
-> (TSIGKey -> TSIGKey -> Ordering)
-> (TSIGKey -> TSIGKey -> Bool)
-> (TSIGKey -> TSIGKey -> Bool)
-> (TSIGKey -> TSIGKey -> Bool)
-> (TSIGKey -> TSIGKey -> Bool)
-> (TSIGKey -> TSIGKey -> TSIGKey)
-> (TSIGKey -> TSIGKey -> TSIGKey)
-> Ord TSIGKey
TSIGKey -> TSIGKey -> Bool
TSIGKey -> TSIGKey -> Ordering
TSIGKey -> TSIGKey -> TSIGKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TSIGKey -> TSIGKey -> Ordering
compare :: TSIGKey -> TSIGKey -> Ordering
$c< :: TSIGKey -> TSIGKey -> Bool
< :: TSIGKey -> TSIGKey -> Bool
$c<= :: TSIGKey -> TSIGKey -> Bool
<= :: TSIGKey -> TSIGKey -> Bool
$c> :: TSIGKey -> TSIGKey -> Bool
> :: TSIGKey -> TSIGKey -> Bool
$c>= :: TSIGKey -> TSIGKey -> Bool
>= :: TSIGKey -> TSIGKey -> Bool
$cmax :: TSIGKey -> TSIGKey -> TSIGKey
max :: TSIGKey -> TSIGKey -> TSIGKey
$cmin :: TSIGKey -> TSIGKey -> TSIGKey
min :: TSIGKey -> TSIGKey -> TSIGKey
Ord, Int -> TSIGKey -> ShowS
[TSIGKey] -> ShowS
TSIGKey -> String
(Int -> TSIGKey -> ShowS)
-> (TSIGKey -> String) -> ([TSIGKey] -> ShowS) -> Show TSIGKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TSIGKey -> ShowS
showsPrec :: Int -> TSIGKey -> ShowS
$cshow :: TSIGKey -> String
show :: TSIGKey -> String
$cshowList :: [TSIGKey] -> ShowS
showList :: [TSIGKey] -> ShowS
Show, (forall x. TSIGKey -> Rep TSIGKey x)
-> (forall x. Rep TSIGKey x -> TSIGKey) -> Generic TSIGKey
forall x. Rep TSIGKey x -> TSIGKey
forall x. TSIGKey -> Rep TSIGKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TSIGKey -> Rep TSIGKey x
from :: forall x. TSIGKey -> Rep TSIGKey x
$cto :: forall x. Rep TSIGKey x -> TSIGKey
to :: forall x. Rep TSIGKey x -> TSIGKey
Generic, TSIGKey -> ()
(TSIGKey -> ()) -> NFData TSIGKey
forall a. (a -> ()) -> NFData a
$crnf :: TSIGKey -> ()
rnf :: TSIGKey -> ()
NFData, Typeable TSIGKey
Typeable TSIGKey
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TSIGKey -> c TSIGKey)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TSIGKey)
-> (TSIGKey -> Constr)
-> (TSIGKey -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TSIGKey))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TSIGKey))
-> ((forall b. Data b => b -> b) -> TSIGKey -> TSIGKey)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TSIGKey -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TSIGKey -> r)
-> (forall u. (forall d. Data d => d -> u) -> TSIGKey -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> TSIGKey -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TSIGKey -> m TSIGKey)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TSIGKey -> m TSIGKey)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TSIGKey -> m TSIGKey)
-> Data TSIGKey
TSIGKey -> Constr
TSIGKey -> DataType
(forall b. Data b => b -> b) -> TSIGKey -> TSIGKey
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TSIGKey -> u
forall u. (forall d. Data d => d -> u) -> TSIGKey -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGKey -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGKey -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TSIGKey -> m TSIGKey
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TSIGKey -> m TSIGKey
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TSIGKey
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TSIGKey -> c TSIGKey
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TSIGKey)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TSIGKey)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TSIGKey -> c TSIGKey
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TSIGKey -> c TSIGKey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TSIGKey
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TSIGKey
$ctoConstr :: TSIGKey -> Constr
toConstr :: TSIGKey -> Constr
$cdataTypeOf :: TSIGKey -> DataType
dataTypeOf :: TSIGKey -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TSIGKey)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TSIGKey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TSIGKey)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TSIGKey)
$cgmapT :: (forall b. Data b => b -> b) -> TSIGKey -> TSIGKey
gmapT :: (forall b. Data b => b -> b) -> TSIGKey -> TSIGKey
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGKey -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGKey -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGKey -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGKey -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TSIGKey -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TSIGKey -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TSIGKey -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TSIGKey -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TSIGKey -> m TSIGKey
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TSIGKey -> m TSIGKey
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TSIGKey -> m TSIGKey
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TSIGKey -> m TSIGKey
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TSIGKey -> m TSIGKey
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TSIGKey -> m TSIGKey
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 (TSIGAlgorithm -> TSIGAlgorithm -> Bool
(TSIGAlgorithm -> TSIGAlgorithm -> Bool)
-> (TSIGAlgorithm -> TSIGAlgorithm -> Bool) -> Eq TSIGAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
== :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
$c/= :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
/= :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
Eq, Eq TSIGAlgorithm
Eq TSIGAlgorithm
-> (TSIGAlgorithm -> TSIGAlgorithm -> Ordering)
-> (TSIGAlgorithm -> TSIGAlgorithm -> Bool)
-> (TSIGAlgorithm -> TSIGAlgorithm -> Bool)
-> (TSIGAlgorithm -> TSIGAlgorithm -> Bool)
-> (TSIGAlgorithm -> TSIGAlgorithm -> Bool)
-> (TSIGAlgorithm -> TSIGAlgorithm -> TSIGAlgorithm)
-> (TSIGAlgorithm -> TSIGAlgorithm -> TSIGAlgorithm)
-> Ord TSIGAlgorithm
TSIGAlgorithm -> TSIGAlgorithm -> Bool
TSIGAlgorithm -> TSIGAlgorithm -> Ordering
TSIGAlgorithm -> TSIGAlgorithm -> TSIGAlgorithm
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TSIGAlgorithm -> TSIGAlgorithm -> Ordering
compare :: TSIGAlgorithm -> TSIGAlgorithm -> Ordering
$c< :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
< :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
$c<= :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
<= :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
$c> :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
> :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
$c>= :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
>= :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
$cmax :: TSIGAlgorithm -> TSIGAlgorithm -> TSIGAlgorithm
max :: TSIGAlgorithm -> TSIGAlgorithm -> TSIGAlgorithm
$cmin :: TSIGAlgorithm -> TSIGAlgorithm -> TSIGAlgorithm
min :: TSIGAlgorithm -> TSIGAlgorithm -> TSIGAlgorithm
Ord, Int -> TSIGAlgorithm -> ShowS
[TSIGAlgorithm] -> ShowS
TSIGAlgorithm -> String
(Int -> TSIGAlgorithm -> ShowS)
-> (TSIGAlgorithm -> String)
-> ([TSIGAlgorithm] -> ShowS)
-> Show TSIGAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TSIGAlgorithm -> ShowS
showsPrec :: Int -> TSIGAlgorithm -> ShowS
$cshow :: TSIGAlgorithm -> String
show :: TSIGAlgorithm -> String
$cshowList :: [TSIGAlgorithm] -> ShowS
showList :: [TSIGAlgorithm] -> ShowS
Show, (forall x. TSIGAlgorithm -> Rep TSIGAlgorithm x)
-> (forall x. Rep TSIGAlgorithm x -> TSIGAlgorithm)
-> Generic TSIGAlgorithm
forall x. Rep TSIGAlgorithm x -> TSIGAlgorithm
forall x. TSIGAlgorithm -> Rep TSIGAlgorithm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TSIGAlgorithm -> Rep TSIGAlgorithm x
from :: forall x. TSIGAlgorithm -> Rep TSIGAlgorithm x
$cto :: forall x. Rep TSIGAlgorithm x -> TSIGAlgorithm
to :: forall x. Rep TSIGAlgorithm x -> TSIGAlgorithm
Generic, TSIGAlgorithm -> ()
(TSIGAlgorithm -> ()) -> NFData TSIGAlgorithm
forall a. (a -> ()) -> NFData a
$crnf :: TSIGAlgorithm -> ()
rnf :: TSIGAlgorithm -> ()
NFData, Typeable TSIGAlgorithm
Typeable TSIGAlgorithm
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TSIGAlgorithm -> c TSIGAlgorithm)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TSIGAlgorithm)
-> (TSIGAlgorithm -> Constr)
-> (TSIGAlgorithm -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TSIGAlgorithm))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TSIGAlgorithm))
-> ((forall b. Data b => b -> b) -> TSIGAlgorithm -> TSIGAlgorithm)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TSIGAlgorithm -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TSIGAlgorithm -> r)
-> (forall u. (forall d. Data d => d -> u) -> TSIGAlgorithm -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TSIGAlgorithm -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TSIGAlgorithm -> m TSIGAlgorithm)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TSIGAlgorithm -> m TSIGAlgorithm)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TSIGAlgorithm -> m TSIGAlgorithm)
-> Data TSIGAlgorithm
TSIGAlgorithm -> Constr
TSIGAlgorithm -> DataType
(forall b. Data b => b -> b) -> TSIGAlgorithm -> TSIGAlgorithm
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TSIGAlgorithm -> u
forall u. (forall d. Data d => d -> u) -> TSIGAlgorithm -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGAlgorithm -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGAlgorithm -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TSIGAlgorithm -> m TSIGAlgorithm
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TSIGAlgorithm -> m TSIGAlgorithm
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TSIGAlgorithm
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TSIGAlgorithm -> c TSIGAlgorithm
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TSIGAlgorithm)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TSIGAlgorithm)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TSIGAlgorithm -> c TSIGAlgorithm
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TSIGAlgorithm -> c TSIGAlgorithm
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TSIGAlgorithm
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TSIGAlgorithm
$ctoConstr :: TSIGAlgorithm -> Constr
toConstr :: TSIGAlgorithm -> Constr
$cdataTypeOf :: TSIGAlgorithm -> DataType
dataTypeOf :: TSIGAlgorithm -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TSIGAlgorithm)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TSIGAlgorithm)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TSIGAlgorithm)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TSIGAlgorithm)
$cgmapT :: (forall b. Data b => b -> b) -> TSIGAlgorithm -> TSIGAlgorithm
gmapT :: (forall b. Data b => b -> b) -> TSIGAlgorithm -> TSIGAlgorithm
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGAlgorithm -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGAlgorithm -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGAlgorithm -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGAlgorithm -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TSIGAlgorithm -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TSIGAlgorithm -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TSIGAlgorithm -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TSIGAlgorithm -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TSIGAlgorithm -> m TSIGAlgorithm
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TSIGAlgorithm -> m TSIGAlgorithm
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TSIGAlgorithm -> m TSIGAlgorithm
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TSIGAlgorithm -> m TSIGAlgorithm
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TSIGAlgorithm -> m TSIGAlgorithm
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TSIGAlgorithm -> m TSIGAlgorithm
Data)

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


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

instance ToJSON TSIGKey where
  toJSON :: TSIGKey -> Value
toJSON TSIGKey
key = [Pair] -> Value
object [ Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TSIGKey -> Text
tsk_name TSIGKey
key
                      , Key
"id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TSIGKey -> Text
tsk_id TSIGKey
key
                      , Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"TSIGKey"
                      , Key
"algorithm" Key -> Maybe TSIGAlgorithm -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TSIGKey -> Maybe TSIGAlgorithm
tsk_algorithm TSIGKey
key
                      , Key
"key" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (TSIGKey -> Maybe ByteString
tsk_key TSIGKey
key Maybe ByteString -> (ByteString -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ByteString -> Text
encode64)
                      ]

instance FromJSON TSIGKey where
  parseJSON :: Value -> Parser TSIGKey
parseJSON = String -> (Object -> Parser TSIGKey) -> Value -> Parser TSIGKey
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TSIGKey" ((Object -> Parser TSIGKey) -> Value -> Parser TSIGKey)
-> (Object -> Parser TSIGKey) -> Value -> Parser TSIGKey
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
tsk_name      <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Text
tsk_id        <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Maybe TSIGAlgorithm
tsk_algorithm <- Object
o Object -> Key -> Parser (Maybe TSIGAlgorithm)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"algorithm"
    Maybe ByteString
tsk_key       <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"key" Parser (Maybe Text)
-> (Maybe Text -> Parser (Maybe ByteString))
-> Parser (Maybe ByteString)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Parser ByteString)
-> Maybe Text -> Parser (Maybe ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Text -> Parser ByteString
forall (m :: * -> *). MonadFail m => Text -> m ByteString
decode64
    TSIGKey -> Parser TSIGKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TSIGKey{Maybe ByteString
Maybe TSIGAlgorithm
Text
tsk_name :: Text
tsk_id :: Text
tsk_algorithm :: Maybe TSIGAlgorithm
tsk_key :: Maybe ByteString
tsk_name :: Text
tsk_id :: Text
tsk_algorithm :: Maybe TSIGAlgorithm
tsk_key :: Maybe ByteString
..}

encode64 :: BS.ByteString -> T.Text
encode64 :: ByteString -> Text
encode64 = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS64.encode

decode64 :: Fail.MonadFail m => T.Text -> m BS.ByteString
decode64 :: forall (m :: * -> *). MonadFail m => Text -> m ByteString
decode64 Text
i = case ByteString -> Either String ByteString
BS64.decode (Text -> ByteString
T.encodeUtf8 Text
i) of
  Left String
err -> String -> m ByteString
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
err
  Right ByteString
k  -> ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
k