-- |
-- 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 DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TypeOperators      #-}
{-# LANGUAGE CPP                #-}
module PowerDNS.API.TSIGKeys
  (
  -- * API
    TSIGKeysAPI(..)

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

import           Data.Char (toLower)
import           Data.Functor ((<&>))
import           Data.Data (Data)
#if !(MIN_VERSION_base(4,11,0))
import           Control.Monad.Fail (MonadFail)
#endif

import           Control.DeepSeq (NFData)
import           Data.Aeson ( FromJSON(..), ToJSON(..), Value(String), allNullaryToStringTag
                            , constructorTagModifier, defaultOptions
                            , genericParseJSON
                            , genericToJSON, withObject, object
                            , (.:), (.:?), (.=)
                            )
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
  { TSIGKeysAPI f
-> f
   :- ("servers"
       :> (Capture "server_id" Text
           :> ("tsigkeys" :> Get '[JSON] [TSIGKey])))
apiListTSIGKeys  :: f :- "servers" :> Capture "server_id" T.Text :> "tsigkeys"
                          :> Get '[JSON] [TSIGKey]

  , 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

  , 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

  , 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

  , 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
$cto :: forall f x. Rep (TSIGKeysAPI f) x -> TSIGKeysAPI f
$cfrom :: forall f x. TSIGKeysAPI f -> Rep (TSIGKeysAPI f) x
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
/= :: TSIGKey -> TSIGKey -> Bool
$c/= :: TSIGKey -> TSIGKey -> Bool
== :: TSIGKey -> TSIGKey -> Bool
$c== :: 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
min :: TSIGKey -> TSIGKey -> TSIGKey
$cmin :: TSIGKey -> TSIGKey -> TSIGKey
max :: TSIGKey -> TSIGKey -> TSIGKey
$cmax :: TSIGKey -> TSIGKey -> TSIGKey
>= :: TSIGKey -> TSIGKey -> Bool
$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
compare :: TSIGKey -> TSIGKey -> Ordering
$ccompare :: TSIGKey -> TSIGKey -> Ordering
$cp1Ord :: Eq 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
showList :: [TSIGKey] -> ShowS
$cshowList :: [TSIGKey] -> ShowS
show :: TSIGKey -> String
$cshow :: TSIGKey -> String
showsPrec :: Int -> TSIGKey -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep TSIGKey x -> TSIGKey
$cfrom :: forall x. TSIGKey -> Rep TSIGKey x
Generic, TSIGKey -> ()
(TSIGKey -> ()) -> NFData TSIGKey
forall a. (a -> ()) -> NFData a
rnf :: TSIGKey -> ()
$crnf :: TSIGKey -> ()
NFData, Typeable TSIGKey
DataType
Constr
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 -> DataType
TSIGKey -> Constr
(forall b. Data b => b -> b) -> TSIGKey -> TSIGKey
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TSIGKey -> c TSIGKey
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cTSIGKey :: Constr
$tTSIGKey :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d) -> TSIGKey -> m TSIGKey
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TSIGKey -> m TSIGKey
gmapQi :: Int -> (forall d. Data d => d -> u) -> TSIGKey -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TSIGKey -> u
gmapQ :: (forall d. Data d => d -> u) -> TSIGKey -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TSIGKey -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGKey -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGKey -> r
gmapT :: (forall b. Data b => b -> b) -> TSIGKey -> TSIGKey
$cgmapT :: (forall b. Data b => b -> b) -> TSIGKey -> TSIGKey
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TSIGKey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TSIGKey)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TSIGKey)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TSIGKey)
dataTypeOf :: TSIGKey -> DataType
$cdataTypeOf :: TSIGKey -> DataType
toConstr :: TSIGKey -> Constr
$ctoConstr :: TSIGKey -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TSIGKey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TSIGKey
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TSIGKey -> c TSIGKey
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TSIGKey -> c TSIGKey
$cp1Data :: Typeable TSIGKey
Data)

instance ToJSON TSIGKey where
  toJSON :: TSIGKey -> Value
toJSON key :: TSIGKey
key = [Pair] -> Value
object [ "name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TSIGKey -> Text
tsk_name TSIGKey
key
                      , "id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TSIGKey -> Text
tsk_id TSIGKey
key
                      , "type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "TSIGKey"
                      , "algorithm" Text -> Maybe TSIGAlgorithm -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TSIGKey -> Maybe TSIGAlgorithm
tsk_algorithm TSIGKey
key
                      , "key" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (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 "TSIGKey" ((Object -> Parser TSIGKey) -> Value -> Parser TSIGKey)
-> (Object -> Parser TSIGKey) -> Value -> Parser TSIGKey
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
    Text
tsk_name      <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "name"
    Text
tsk_id        <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "id"
    Maybe TSIGAlgorithm
tsk_algorithm <- Object
o Object -> Text -> Parser (Maybe TSIGAlgorithm)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "algorithm"
    Maybe ByteString
tsk_key       <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "key" Parser (Maybe Text)
-> (Maybe Text -> Parser (Maybe ByteString))
-> Parser (Maybe ByteString)
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)
traverse Text -> Parser ByteString
forall (m :: * -> *). MonadFail m => Text -> m ByteString
decode64
    TSIGKey -> Parser TSIGKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure TSIGKey :: Text -> Text -> Maybe TSIGAlgorithm -> Maybe ByteString -> TSIGKey
TSIGKey{..}

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

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

-- | 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
/= :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
$c/= :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
== :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
$c== :: 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
min :: TSIGAlgorithm -> TSIGAlgorithm -> TSIGAlgorithm
$cmin :: TSIGAlgorithm -> TSIGAlgorithm -> TSIGAlgorithm
max :: TSIGAlgorithm -> TSIGAlgorithm -> TSIGAlgorithm
$cmax :: TSIGAlgorithm -> TSIGAlgorithm -> TSIGAlgorithm
>= :: TSIGAlgorithm -> TSIGAlgorithm -> Bool
$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
compare :: TSIGAlgorithm -> TSIGAlgorithm -> Ordering
$ccompare :: TSIGAlgorithm -> TSIGAlgorithm -> Ordering
$cp1Ord :: Eq 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
showList :: [TSIGAlgorithm] -> ShowS
$cshowList :: [TSIGAlgorithm] -> ShowS
show :: TSIGAlgorithm -> String
$cshow :: TSIGAlgorithm -> String
showsPrec :: Int -> TSIGAlgorithm -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep TSIGAlgorithm x -> TSIGAlgorithm
$cfrom :: forall x. TSIGAlgorithm -> Rep TSIGAlgorithm x
Generic, TSIGAlgorithm -> ()
(TSIGAlgorithm -> ()) -> NFData TSIGAlgorithm
forall a. (a -> ()) -> NFData a
rnf :: TSIGAlgorithm -> ()
$crnf :: TSIGAlgorithm -> ()
NFData, Typeable TSIGAlgorithm
DataType
Constr
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 -> DataType
TSIGAlgorithm -> Constr
(forall b. Data b => b -> b) -> TSIGAlgorithm -> TSIGAlgorithm
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TSIGAlgorithm -> c TSIGAlgorithm
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cHMAC_SHA512 :: Constr
$cHMAC_SHA384 :: Constr
$cHMAC_SHA256 :: Constr
$cHMAC_SHA224 :: Constr
$cHMAC_SHA1 :: Constr
$cHMAC_MD5 :: Constr
$tTSIGAlgorithm :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d) -> TSIGAlgorithm -> m TSIGAlgorithm
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TSIGAlgorithm -> m TSIGAlgorithm
gmapQi :: Int -> (forall d. Data d => d -> u) -> TSIGAlgorithm -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TSIGAlgorithm -> u
gmapQ :: (forall d. Data d => d -> u) -> TSIGAlgorithm -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TSIGAlgorithm -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGAlgorithm -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TSIGAlgorithm -> r
gmapT :: (forall b. Data b => b -> b) -> TSIGAlgorithm -> TSIGAlgorithm
$cgmapT :: (forall b. Data b => b -> b) -> TSIGAlgorithm -> TSIGAlgorithm
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TSIGAlgorithm)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TSIGAlgorithm)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TSIGAlgorithm)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TSIGAlgorithm)
dataTypeOf :: TSIGAlgorithm -> DataType
$cdataTypeOf :: TSIGAlgorithm -> DataType
toConstr :: TSIGAlgorithm -> Constr
$ctoConstr :: TSIGAlgorithm -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TSIGAlgorithm
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TSIGAlgorithm
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TSIGAlgorithm -> c TSIGAlgorithm
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TSIGAlgorithm -> c TSIGAlgorithm
$cp1Data :: Typeable TSIGAlgorithm
Data)

instance ToJSON TSIGAlgorithm where
  toJSON :: TSIGAlgorithm -> Value
toJSON = Options -> TSIGAlgorithm -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions { allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True
                                        , constructorTagModifier :: ShowS
constructorTagModifier = ShowS
algo
                                        }

instance FromJSON TSIGAlgorithm where
  parseJSON :: Value -> Parser TSIGAlgorithm
parseJSON = Options -> Value -> Parser TSIGAlgorithm
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True
                                              , constructorTagModifier :: ShowS
constructorTagModifier = ShowS
algo
                                              }

algo :: String -> String
algo :: ShowS
algo = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c :: Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' then '-' else Char -> Char
toLower Char
c)