{- | Description: DohApi implementation. -}
module OM.DoH.Server (
  server,
) where


import Control.Monad.IO.Class (MonadIO(liftIO))
import Network.DNS (sendRaw)
import OM.DoH.Api (DoHApi(DoHApi, getQuery, postQuery), Query(unQuery),
  Response(Response))
import Servant.Server.Generic (AsServerT)


{- |
  An implementation of the DoH api that delegates to the local machine's
  DNS resolver, using the @resolv@ package (see "Network.DNS").
-}
server :: (MonadIO m) => DoHApi (AsServerT m)
server :: forall (m :: * -> *). MonadIO m => DoHApi (AsServerT m)
server = DoHApi {
    getQuery :: AsServerT m
:- (Summary "Submit a raw DNS query on the query string."
    :> (QueryParam' '[Required, Strict] "dns" Query
        :> Get '[DnsMsgCT] Response))
getQuery = IO Response -> m Response
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Response -> m Response)
-> (Query -> IO Response) -> Query -> m Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Response) -> IO ByteString -> IO Response
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Response
Response (IO ByteString -> IO Response)
-> (Query -> IO ByteString) -> Query -> IO Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ByteString
sendRaw (ByteString -> IO ByteString)
-> (Query -> ByteString) -> Query -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> ByteString
unQuery,
    postQuery :: AsServerT m
:- (Summary "Submit a raw DNS query in the POST body."
    :> (ReqBody '[DnsMsgCT] Query :> Post '[DnsMsgCT] Response))
postQuery = IO Response -> m Response
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Response -> m Response)
-> (Query -> IO Response) -> Query -> m Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Response) -> IO ByteString -> IO Response
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Response
Response (IO ByteString -> IO Response)
-> (Query -> IO ByteString) -> Query -> IO Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ByteString
sendRaw (ByteString -> IO ByteString)
-> (Query -> ByteString) -> Query -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> ByteString
unQuery
  }