{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE PartialTypeSignatures #-}

module Web.Minion (
  -- * Minion
  Router',
  Router,
  MakeError,

  -- * Combinators
  ValueCombinator,
  Combinator,
  alt,
  (/>),
  (.>),
  (!>),
  hideIntrospection,
  description,

  -- ** Header
  module Web.Minion.Request.Header,

  -- ** Query params
  module Web.Minion.Request.Query,

  -- ** URL
  module Web.Minion.Request.Url,

  -- ** Request
  ReqBody (..),
  reqBody,
  reqPlainText,
  reqFormUrlEncoded,
  reqJson,
  LazyBytes (..),
  lazyBytesBody,
  Chunks (..),
  chunksBody,

  -- ** Response
  NoBody (..),
  ToResponse (..),
  CanRespond (..),

  -- ** Handler
  handle,
  handleJson,
  handlePlainText,
  RespBody (..),
  handleBody,
  module Web.Minion.Request.Method,

  -- ** Middleware
  MiddlewareM,
  middleware,

  -- ** Server
  ApplicationM,
  MinionSettings (..),
  serve,
  serveWithSettings,
  defaultMinionSettings,
  defaultErrorBuilders,

  -- ** Exceptions
  NoMatch (..),
  SomethingWentWrong (..),
  ServerError (..),

  -- ** Args
  module Web.Minion.Args,

  -- ** Auth
  module Web.Minion.Auth,

  -- ** Reexports
  Void,
  Exc.MonadCatch (..),
  Exc.MonadThrow (..),
) where

import Control.Monad ((>=>))
import Control.Monad.Catch qualified as Exc
import Control.Monad.IO.Class qualified as IO
import Data.Binary.Builder qualified as Bytes.Builder
import Data.Text qualified as Text
import Data.Void (Void)
import Network.HTTP.Types qualified as Http
import Network.Wai qualified as Http
import Network.Wai qualified as Wai
import Web.Minion.Args
import Web.Minion.Args.Internal
import Web.Minion.Auth
import Web.Minion.Error (
  ErrorBuilders (..),
  NoMatch (..),
  ServerError (..),
  SomethingWentWrong (..),
 )

import Web.Minion.Introspect qualified as I
import Web.Minion.Json (handleJson, reqJson)
import Web.Minion.Raw
import Web.Minion.Request.Body (ReqBody (..), reqBody)
import Web.Minion.Request.Body.FormUrlEncoded
import Web.Minion.Request.Body.PlainText
import Web.Minion.Request.Body.Raw
import Web.Minion.Request.Header
import Web.Minion.Request.Method
import Web.Minion.Request.Query
import Web.Minion.Request.Url
import Web.Minion.Response
import Web.Minion.Response.Body (RespBody (RespBody), handleBody)
import Web.Minion.Response.Body.PlainText (handlePlainText)
import Web.Minion.Router.Internal

-- | Use it if you don't care about value captured by previous combinator
{-# INLINE (!>) #-}
(!>) ::
  (Router' i (ts :+ x) r -> Router' i ts r) ->
  -- | .
  Router' i (ts :+ Hide x) r ->
  Router' i ts r
Router' i (ts :+ x) r -> Router' i ts r
a !> :: forall i ts x (r :: * -> *).
(Router' i (ts :+ x) r -> Router' i ts r)
-> Router' i (ts :+ Hide x) r -> Router' i ts r
!> Router' i (ts :+ Hide x) r
b = Router' i (ts :+ x) r -> Router' i ts r
a (Router' i (ts :+ x) r -> Router' i ts r)
-> Router' i (ts :+ x) r -> Router' i ts r
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> (RHList (ts :+ x) -> RHList (ts :+ Hide x))
-> Router' i (ts :+ Hide x) r -> Router' i (ts :+ x) r
forall (m :: * -> *) ts ts' i.
(RHList ts -> RHList ts') -> Router' i ts' m -> Router' i ts m
MapArgs (\case (t
x :#! RHList ts1
as) -> t -> Hide t
forall a. a -> Hide a
Hide t
x Hide x -> RHList ts1 -> RHList (ts1 :+ Hide x)
forall t ts1. t -> RHList ts1 -> RHList (ts1 :+ t)
:#! RHList ts1
as) (Router' i (ts :+ Hide x) r -> Router' i (ts :+ x) r)
-> Router' i (ts :+ Hide x) r -> Router' i (ts :+ x) r
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> Router' i (ts :+ Hide x) r
b

-- | Use it after 'Combinator'
{-# INLINE (/>) #-}
(/>) ::
  (Router' i ts r -> Router' i ts r) ->
  -- | .
  Router' i ts r ->
  Router' i ts r
/> :: forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
(/>) = (Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
forall a. a -> a
id

-- | Use it after 'ValueCombinator' and 'MapArgs'
{-# INLINE (.>) #-}
(.>) ::
  (Router' i ts' r -> Router' i ts r) ->
  -- | .
  Router' i ts' r ->
  Router' i ts r
.> :: forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
(.>) = (Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
forall a. a -> a
id

infixr 0 .>

infixr 0 />

infixr 0 !>

{- | Could be omitted with `OverloadedLists`

@
{\-# LANGUAGE OverloadedLists #-\}
"foo" '/>'
  [ "bar" '/>' ...
  , "baz" '/>' ...
  ]
@

@
{\-# LANGUAGE NoOverloadedLists #-\}
"foo" '/>' 'alt'
  [ "bar" '/>' ...
  , "baz" '/>' ...
  ]
@
-}
{-# INLINE alt #-}
alt :: [Router' i ts r] -> Router' i ts r
alt :: forall i ts (r :: * -> *). [Router' i ts r] -> Router' i ts r
alt = [Router' i ts r] -> Router' i ts r
forall i ts (r :: * -> *). [Router' i ts r] -> Router' i ts r
Alt

{- | Handles request with specified HTTP method

@
... '/>' 'handle' \@MyResponse GET someEndpoint
@
-}
{-# INLINE handle #-}
handle ::
  forall o m ts i st.
  ( HandleArgs ts st m
  , ToResponse m o
  , CanRespond o
  , I.Introspection i I.Response o
  ) =>
  -- | .
  Http.Method ->
  (DelayedArgs st ~> m o) ->
  Router' i ts m
handle :: forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToResponse m o, CanRespond o,
 Introspection i 'Response o) =>
Method -> (DelayedArgs st ~> m o) -> Router' i ts m
handle Method
method DelayedArgs st ~> m o
f = forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToResponse m o, CanRespond o,
 Introspection i 'Response o) =>
Method -> (HList (DelayedArgs st) -> m o) -> Router' i ts m
Handle @o Method
method ((DelayedArgs st ~> m o) -> HList (DelayedArgs st) -> m o
forall (ts :: [*]) r. FunArgs ts => (ts ~> r) -> HList ts -> r
forall r. (DelayedArgs st ~> r) -> HList (DelayedArgs st) -> r
apply DelayedArgs st ~> m o
f)

-- | Add description for route
description :: (I.Introspection i I.Description a) => a -> Combinator i ts m
description :: forall i a ts (m :: * -> *).
Introspection i 'Description a =>
a -> Combinator i ts m
description = a -> Router' i ts m -> Router' i ts m
forall i a ts (m :: * -> *).
Introspection i 'Description a =>
a -> Combinator i ts m
Description

hideIntrospection :: Router' i ts m -> Router' i' ts m
hideIntrospection :: forall i ts (m :: * -> *) i'. Router' i ts m -> Router' i' ts m
hideIntrospection = Router' i ts m -> Router' i' ts m
forall i i1 ts (m :: * -> *). Router' i1 ts m -> Router' i ts m
HideIntrospection

{- | Injects middleware

@
... '/>' 'middleware' Wai.realIp '/>' ...
@
-}
middleware :: MiddlewareM m -> Combinator i ts m
middleware :: forall (m :: * -> *) i ts. MiddlewareM m -> Combinator i ts m
middleware = MiddlewareM m -> Router' i ts m -> Router' i ts m
forall (m :: * -> *) i ts. MiddlewareM m -> Combinator i ts m
Middleware

data MinionSettings m = MinionSettings
  { forall (m :: * -> *). MinionSettings m -> m Response
notFound :: m Wai.Response
  , forall (m :: * -> *). MinionSettings m -> ServerError -> m Response
httpError :: ServerError -> m Wai.Response
  , forall (m :: * -> *). MinionSettings m -> ErrorBuilders
errorBuilders :: ErrorBuilders
  }

{-# INLINE serve #-}
serve :: (IO.MonadIO m, Exc.MonadCatch m) => Router' i Void m -> ApplicationM m
serve :: forall (m :: * -> *) i.
(MonadIO m, MonadCatch m) =>
Router' i Void m -> ApplicationM m
serve = MinionSettings m -> Router' i Void m -> ApplicationM m
forall (m :: * -> *) i.
(MonadIO m, MonadCatch m) =>
MinionSettings m -> Router' i Void m -> ApplicationM m
serveWithSettings MinionSettings m
forall (m :: * -> *). (MonadIO m, MonadCatch m) => MinionSettings m
defaultMinionSettings

defaultMinionSettings :: (IO.MonadIO m, Exc.MonadCatch m) => MinionSettings m
defaultMinionSettings :: forall (m :: * -> *). (MonadIO m, MonadCatch m) => MinionSettings m
defaultMinionSettings =
  MinionSettings
    { $sel:notFound:MinionSettings :: m Response
notFound = Response -> m Response
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Status -> ResponseHeaders -> Builder -> Response
Wai.responseBuilder Status
Http.status404 [] Builder
forall a. Monoid a => a
mempty)
    , $sel:httpError:MinionSettings :: ServerError -> m Response
httpError = \ServerError{ResponseHeaders
ByteString
Status
code :: Status
headers :: ResponseHeaders
body :: ByteString
$sel:code:ServerError :: ServerError -> Status
$sel:headers:ServerError :: ServerError -> ResponseHeaders
$sel:body:ServerError :: ServerError -> ByteString
..} -> Response -> m Response
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> Builder -> Response
Wai.responseBuilder Status
code ResponseHeaders
headers (ByteString -> Builder
Bytes.Builder.fromLazyByteString ByteString
body)
    , $sel:errorBuilders:MinionSettings :: ErrorBuilders
errorBuilders = ErrorBuilders
defaultErrorBuilders
    }

defaultErrorBuilders :: ErrorBuilders
defaultErrorBuilders :: ErrorBuilders
defaultErrorBuilders =
  ErrorBuilders
    { $sel:headerErrorBuilder:ErrorBuilders :: ErrorBuilder
headerErrorBuilder = ErrorBuilder
forall {p}. p -> Status -> ByteString -> ServerError
defaultBuilder
    , $sel:queryParamsErrorBuilder:ErrorBuilders :: ErrorBuilder
queryParamsErrorBuilder = ErrorBuilder
forall {p}. p -> Status -> ByteString -> ServerError
defaultBuilder
    , $sel:captureErrorBuilder:ErrorBuilders :: ErrorBuilder
captureErrorBuilder = ErrorBuilder
forall {p}. p -> Status -> ByteString -> ServerError
defaultBuilder
    , $sel:bodyErrorBuilder:ErrorBuilders :: ErrorBuilder
bodyErrorBuilder = ErrorBuilder
forall {p}. p -> Status -> ByteString -> ServerError
defaultBuilder
    }
 where
  defaultBuilder :: p -> Status -> ByteString -> ServerError
defaultBuilder p
_ Status
status = Status -> ResponseHeaders -> ByteString -> ServerError
ServerError Status
status []

-- | The same as 'serve' but allows to configure exceptions handlers
{-# INLINE serveWithSettings #-}
serveWithSettings :: (IO.MonadIO m, Exc.MonadCatch m) => MinionSettings m -> Router' i Void m -> ApplicationM m
serveWithSettings :: forall (m :: * -> *) i.
(MonadIO m, MonadCatch m) =>
MinionSettings m -> Router' i Void m -> ApplicationM m
serveWithSettings MinionSettings{m Response
ErrorBuilders
ServerError -> m Response
$sel:notFound:MinionSettings :: forall (m :: * -> *). MinionSettings m -> m Response
$sel:httpError:MinionSettings :: forall (m :: * -> *). MinionSettings m -> ServerError -> m Response
$sel:errorBuilders:MinionSettings :: forall (m :: * -> *). MinionSettings m -> ErrorBuilders
notFound :: m Response
httpError :: ServerError -> m Response
errorBuilders :: ErrorBuilders
..} Router' i Void m
router Request
req Response -> IO ResponseReceived
resp =
  forall (f :: * -> *) (m :: * -> *) a.
(HasCallStack, Foldable f, MonadCatch m) =>
m a -> f (Handler m a) -> m a
Exc.catches @[]
    (ErrorBuilders
-> RoutingState
-> RHList Void
-> Router' i Void m
-> ApplicationM m
forall (m :: * -> *) ts i.
(MonadIO m, MonadCatch m) =>
ErrorBuilders
-> RoutingState -> RHList ts -> Router' i ts m -> ApplicationM m
route ErrorBuilders
errorBuilders ([Text] -> RoutingState
RoutingState ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Request -> [Text]
Http.pathInfo Request
req)) RHList Void
RHNil Router' i Void m
router Request
req Response -> IO ResponseReceived
resp)
    [ (NoMatch -> m ResponseReceived) -> Handler m ResponseReceived
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Exc.Handler \NoMatch
NoMatch -> m Response
notFound m Response
-> (Response -> m ResponseReceived) -> m ResponseReceived
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO ResponseReceived -> m ResponseReceived
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO ResponseReceived -> m ResponseReceived)
-> (Response -> IO ResponseReceived)
-> Response
-> m ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> IO ResponseReceived
resp
    , (ServerError -> m ResponseReceived) -> Handler m ResponseReceived
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Exc.Handler ((ServerError -> m ResponseReceived) -> Handler m ResponseReceived)
-> (ServerError -> m ResponseReceived)
-> Handler m ResponseReceived
forall a b. (a -> b) -> a -> b
$ ServerError -> m Response
httpError (ServerError -> m Response)
-> (Response -> m ResponseReceived)
-> ServerError
-> m ResponseReceived
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IO ResponseReceived -> m ResponseReceived
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO ResponseReceived -> m ResponseReceived)
-> (Response -> IO ResponseReceived)
-> Response
-> m ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> IO ResponseReceived
resp
    ]