{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

{- | Description: Servant spec describing the DoH Api. -}
module OM.DoH.Api (
  DoHApi(..),
  Query(..),
  Response(..),
  DnsMsgCT,
) where


import Data.ByteString (ByteString)
import Data.ByteString.Base64 (decodeBase64)
import Data.Text.Encoding (encodeUtf8)
import GHC.Generics (Generic)
import Servant.API (type (:>), Accept(contentType),
  MimeRender(mimeRender), MimeUnrender(mimeUnrender), Get, Post,
  QueryParam', ReqBody, Required, Strict, Summary)
import Servant.API.Generic (GenericMode((:-)))
import Web.HttpApiData (FromHttpApiData(parseUrlPiece))
import qualified Data.ByteString.Lazy as BSL


{- | The DoH api, defined in the "Servant.API.Generic" style. -}
data DoHApi route = DoHApi {
    DoHApi route
-> route
   :- (Summary "Submit a raw DNS query on the query string."
       :> (QueryParam' '[Required, Strict] "dns" Query
           :> Get '[DnsMsgCT] Response))
getQuery :: route :-
      Summary "Submit a raw DNS query on the query string."
      :> QueryParam' '[Required, Strict] "dns" Query
      :> Get '[DnsMsgCT] Response,
    DoHApi route
-> route
   :- (Summary "Submit a raw DNS query in the POST body."
       :> (ReqBody '[DnsMsgCT] Query :> Post '[DnsMsgCT] Response))
postQuery :: route :-
      Summary "Submit a raw DNS query in the POST body."
      :> ReqBody '[DnsMsgCT] Query
      :> Post '[DnsMsgCT] Response
  }
  deriving stock ((forall x. DoHApi route -> Rep (DoHApi route) x)
-> (forall x. Rep (DoHApi route) x -> DoHApi route)
-> Generic (DoHApi route)
forall x. Rep (DoHApi route) x -> DoHApi route
forall x. DoHApi route -> Rep (DoHApi route) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall route x. Rep (DoHApi route) x -> DoHApi route
forall route x. DoHApi route -> Rep (DoHApi route) x
$cto :: forall route x. Rep (DoHApi route) x -> DoHApi route
$cfrom :: forall route x. DoHApi route -> Rep (DoHApi route) x
Generic)


{- |
  A raw DNS query message. The "Network.DNS" module contains tools for
  encoding and decoding these messages.
-}
newtype Query = Query {Query -> ByteString
unQuery :: ByteString}
  deriving newtype (MimeUnrender DnsMsgCT)
instance FromHttpApiData Query where
  parseUrlPiece :: Text -> Either Text Query
parseUrlPiece txt :: Text
txt = ByteString -> Query
Query (ByteString -> Query)
-> Either Text ByteString -> Either Text Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either Text ByteString
decodeBase64 (Text -> ByteString
encodeUtf8 Text
txt)


{- |
  A raw DNS response message. The "Network.DNS" module contains tools
  for encoding and decoding these messages.
-}
newtype Response = Response {Response -> ByteString
unResponse :: ByteString}
  deriving newtype (MimeRender DnsMsgCT)


{- | The @application/dns-message@ content type. -}
data DnsMsgCT
instance Accept DnsMsgCT where
  contentType :: Proxy DnsMsgCT -> MediaType
contentType _proxy :: Proxy DnsMsgCT
_proxy = "application/dns-message"
instance MimeRender DnsMsgCT ByteString where
  mimeRender :: Proxy DnsMsgCT -> ByteString -> ByteString
mimeRender _proxy :: Proxy DnsMsgCT
_proxy msg :: ByteString
msg = ByteString -> ByteString
BSL.fromStrict ByteString
msg
instance MimeUnrender DnsMsgCT ByteString where
  mimeUnrender :: Proxy DnsMsgCT -> ByteString -> Either String ByteString
mimeUnrender _proxy :: Proxy DnsMsgCT
_proxy = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> Either String ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict