diff --git a/lib/okapi.cabal b/lib/okapi.cabal index 368714b..5d2d560 100644 --- a/lib/okapi.cabal +++ b/lib/okapi.cabal @@ -29,11 +29,9 @@ library exposed-modules: Okapi Okapi.Endpoint - Okapi.Executable Okapi.Matchpoint - Okapi.Response + Okapi.Request Okapi.Script - Okapi.Server Okapi.Script.Path Okapi.Script.Query Okapi.Script.Headers diff --git a/lib/src/Okapi/Endpoint.hs b/lib/src/Okapi/Endpoint.hs index e77109e..b554d80 100644 --- a/lib/src/Okapi/Endpoint.hs +++ b/lib/src/Okapi/Endpoint.hs @@ -1,12 +1,17 @@ +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} module Okapi.Endpoint where +import Control.Natural (type (~>)) import Data.Aeson qualified as Aeson +import Data.ByteString qualified as BS import Data.CaseInsensitive qualified as CI import Data.OpenApi qualified as OAPI import Data.OpenApi.Declare qualified as OAPI @@ -14,11 +19,15 @@ import Data.Proxy import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Network.HTTP.Types qualified as HTTP +import Network.Wai qualified as WAI +import Okapi.Request (Request) +import Okapi.Script import Okapi.Script.Body qualified as Body import Okapi.Script.Headers qualified as Headers import Okapi.Script.Path qualified as Path import Okapi.Script.Query qualified as Query import Okapi.Script.Responder qualified as Responder +import Okapi.Script.ResponderHeaders (Response, toWaiResponse) data Endpoint p q h b r = Endpoint { method :: HTTP.StdMethod, @@ -159,3 +168,78 @@ genOAPIPathItem endpoint = (pathName, pathItem) Path.Apply pf px -> renderPath pf <> renderPath px Path.Static t -> "/" <> Text.unpack t Path.Param @p name -> "/{" <> Text.unpack name <> "}" + +data Plan m p q h b r = Plan + { transformer :: m ~> IO, + endpoint :: Endpoint p q h b r, + handler :: Monad m => p -> q -> b -> h -> r -> m Response + } + +data Executable = Run (IO WAI.Response) | Null + +type Compiler = Request -> Executable + +executable :: + forall m p q h b r. + Monad m => + Plan m p q h b r -> + Compiler +executable plan (method, path, query, body, headers) = + if method == plan.endpoint.method + then + let pathResult = fst $ Path.eval plan.endpoint.pathScript path + queryResult = fst $ Query.eval plan.endpoint.queryScript query + bodyResult = fst $ Body.eval plan.endpoint.bodyScript body + headersResult = fst $ Headers.eval plan.endpoint.headersScript headers + responderResult = fst $ Responder.eval plan.endpoint.responderScript () + in case (pathResult, queryResult, bodyResult, headersResult, responderResult) of + (Ok p, Ok q, Ok b, Ok h, Ok r) -> Run do + response <- transformer plan $ handler plan p q b h r + return $ toWaiResponse response + _ -> Null + else Null + +data Info = Info + { author :: Text.Text, + name :: Text.Text + } + +data Server = Server + { info :: Maybe Info, + compilers :: [Compiler], + defaultResponse :: WAI.Response + } + +data Options = Options + +genApplication :: + Options -> + Server -> + WAI.Application +genApplication _ server request respond = do + let Right method = HTTP.parseMethod $ WAI.requestMethod request + path = WAI.pathInfo request + query = WAI.queryString request + headers = WAI.requestHeaders request + body <- WAI.strictRequestBody request + let request = (method, path, query, body, headers) + executables = map ($ request) $ compilers server + case loop executables of + Nothing -> respond server.defaultResponse + Just action -> action >>= respond + where + loop :: [Executable] -> Maybe (IO WAI.Response) + loop [] = Nothing + loop (h : t) = case h of + Run action -> Just action + Null -> loop t + +genOpenAPISpec :: + Server -> + BS.ByteString +genOpenAPISpec = undefined + +genJSClient :: + Server -> + BS.ByteString +genJSClient = undefined diff --git a/lib/src/Okapi/Executable.hs b/lib/src/Okapi/Executable.hs deleted file mode 100644 index 2d2e121..0000000 --- a/lib/src/Okapi/Executable.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE ImportQualifiedPost #-} -{-# LANGUAGE LinearTypes #-} -{-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Okapi.Executable where - -import Control.Natural (type (~>)) -import Data.ByteString.Lazy qualified as LBS -import Data.Text qualified as Text -import GHC.Generics qualified as Generics -import Network.HTTP.Types qualified as HTTP -import Network.Wai qualified as WAI -import Okapi.Endpoint (Endpoint) -import Okapi.Endpoint qualified as Endpoint -import Okapi.Request -import Okapi.Response (Response) -import Okapi.Response qualified as Response -import Okapi.Script -import Okapi.Script.Body qualified as Body -import Okapi.Script.Headers qualified as Headers -import Okapi.Script.Path qualified as Path -import Okapi.Script.Query qualified as Query -import Okapi.Script.Responder qualified as Responder -import Okapi.Script.ResponderHeaders qualified as ResponderHeaders - -data Plan m p q h b r = Plan - { transformer :: m ~> IO, - endpoint :: Endpoint p q h b r, - handler :: Monad m => p -> q -> b -> h -> r -> m Response - } - -data Executable = Run (IO WAI.Response) | Null - -type Compiler = Request -> Executable - -executable :: - forall m p q h b r. - Monad m => - Plan m p q h b r -> - Compiler -executable plan (method, path, query, body, headers) = - if method == plan.endpoint.method - then - let pathResult = fst $ Path.eval plan.endpoint.pathScript path - queryResult = fst $ Query.eval plan.endpoint.queryScript query - bodyResult = fst $ Body.eval plan.endpoint.bodyScript body - headersResult = fst $ Headers.eval plan.endpoint.headersScript headers - responderResult = fst $ Responder.eval plan.endpoint.responderScript () - in case (pathResult, queryResult, bodyResult, headersResult, responderResult) of - (Ok p, Ok q, Ok b, Ok h, Ok r) -> Run do - response <- transformer plan $ handler plan p q b h r - return $ Response.toWaiResponse response - _ -> Null - else Null diff --git a/lib/src/Okapi/Matchpoint.hs b/lib/src/Okapi/Matchpoint.hs index 28a60d9..a79cff4 100644 --- a/lib/src/Okapi/Matchpoint.hs +++ b/lib/src/Okapi/Matchpoint.hs @@ -6,19 +6,26 @@ module Okapi.Matchpoint where import Control.Natural (type (~>)) +import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as LBS import Data.Text qualified as Text import Network.HTTP.Types qualified as HTTP import Network.Wai qualified as WAI import Okapi.Request (Request) -import Okapi.Response (Response) -import Okapi.Response qualified as Response pattern Matchpoint :: HTTP.StdMethod -> [Text.Text] -> HTTP.Query -> LBS.ByteString -> HTTP.RequestHeaders -> Request pattern Matchpoint method path query body headers <- (method, path, query, body, headers) type Server m = Monad m => Request -> m Response +data Response = Response + { status :: HTTP.Status, + headers :: [ResponseHeader], + body :: LBS.ByteString + } + +data ResponseHeader = ResponseHeader HTTP.HeaderName BS.ByteString + instantiate :: Monad m => (m ~> IO) -> Server m -> WAI.Application instantiate transformer server waiRequest respond = do let Right method = HTTP.parseMethod $ WAI.requestMethod waiRequest @@ -28,4 +35,7 @@ instantiate transformer server waiRequest respond = do body <- WAI.strictRequestBody waiRequest let request = (method, path, query, body, headers) response <- transformer $ server request - respond $ Response.toWaiResponse response + respond $ toWaiResponse response + +toWaiResponse :: Response -> WAI.Response +toWaiResponse = undefined diff --git a/lib/src/Okapi/Response.hs b/lib/src/Okapi/Response.hs deleted file mode 100644 index 482ac26..0000000 --- a/lib/src/Okapi/Response.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Okapi.Response where - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS -import qualified Network.HTTP.Types as HTTP -import qualified Network.Wai as WAI - -data Response = Response - { status :: HTTP.Status, - headers :: [ResponseHeader], - body :: LBS.ByteString - } - -data ResponseHeader = ResponseHeader HTTP.HeaderName BS.ByteString - -toWaiResponse :: Response -> WAI.Response -toWaiResponse = undefined diff --git a/lib/src/Okapi/Script/Responder.hs b/lib/src/Okapi/Script/Responder.hs index 95c81c7..1910b55 100644 --- a/lib/src/Okapi/Script/Responder.hs +++ b/lib/src/Okapi/Script/Responder.hs @@ -19,10 +19,8 @@ import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import GHC.Generics qualified as Generics import Network.HTTP.Types qualified as HTTP -import Okapi.Response -import Okapi.Response qualified as Response -import Okapi.Response qualified as ResponseHeaders import Okapi.Script +import Okapi.Script.ResponderHeaders (Response (..)) import Okapi.Script.ResponderHeaders qualified as ResponderHeaders import Web.Cookie qualified as Web import Web.HttpApiData qualified as Web @@ -44,9 +42,9 @@ data Script a where HTTP.Status -> ResponderHeaders.Script h -> Script - ( (h %1 -> (ResponseHeaders.Response -> ResponseHeaders.Response)) -> + ( (h %1 -> (Response -> Response)) -> a -> - ResponseHeaders.Response + Response ) instance Functor Script where @@ -74,10 +72,10 @@ eval op state = case op of JSON status responderHeaders -> case ResponderHeaders.eval responderHeaders () of (Ok h, _) -> let f headerApplicator payload = - Response.Response - { Response.status = status, - Response.body = Aeson.encode payload, - Response.headers = [] + Response + { status = status, + body = Aeson.encode payload, + headers = [] } in (Ok f, state) (left, _) -> (Fail ResponderHeadersError, state) @@ -87,8 +85,8 @@ json :: HTTP.Status -> ResponderHeaders.Script h -> Script - ( (h %1 -> (ResponseHeaders.Response -> ResponseHeaders.Response)) -> + ( (h %1 -> (Response -> Response)) -> a -> - ResponseHeaders.Response + Response ) json = JSON \ No newline at end of file diff --git a/lib/src/Okapi/Script/ResponderHeaders.hs b/lib/src/Okapi/Script/ResponderHeaders.hs index b4de1b8..5969cb2 100644 --- a/lib/src/Okapi/Script/ResponderHeaders.hs +++ b/lib/src/Okapi/Script/ResponderHeaders.hs @@ -19,7 +19,7 @@ import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import GHC.Generics qualified as Generics import Network.HTTP.Types qualified as HTTP -import Okapi.Response +import Network.Wai qualified as WAI import Okapi.Script import Web.Cookie qualified as Web import Web.HttpApiData qualified as Web @@ -45,6 +45,17 @@ instance Applicative Script where pure = Pure (<*>) = Apply +data Response = Response + { status :: HTTP.Status, + headers :: [ResponseHeader], + body :: LBS.ByteString + } + +data ResponseHeader = ResponseHeader HTTP.HeaderName BS.ByteString + +toWaiResponse :: Response -> WAI.Response +toWaiResponse = undefined + eval :: Script a -> () -> @@ -69,4 +80,4 @@ has :: HTTP.HeaderName -> Script (a -> Response -> Response) -has = Has \ No newline at end of file +has = Has diff --git a/lib/src/Okapi/Server.hs b/lib/src/Okapi/Server.hs deleted file mode 100644 index 52afc17..0000000 --- a/lib/src/Okapi/Server.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE OverloadedStrings #-} - -module Okapi.Server where - -import qualified Control.Monad.Par as Par -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS -import Data.List.NonEmpty (NonEmpty ((:|))) -import qualified Data.Text as Text -import qualified Network.HTTP.Types as HTTP -import qualified Network.Wai as WAI -import Okapi.Executable -import qualified Okapi.Executable as Executable - -data Info = Info - { author :: Text.Text, - name :: Text.Text - } - -data Server = Server - { info :: Maybe Info, - compilers :: [Compiler], - defaultResponse :: WAI.Response - } - -data Options = Options - -genApplication :: - Options -> - Server -> - WAI.Application -genApplication _ server request respond = do - let Right method = HTTP.parseMethod $ WAI.requestMethod request - path = WAI.pathInfo request - query = WAI.queryString request - headers = WAI.requestHeaders request - body <- WAI.strictRequestBody request - let request = (method, path, query, body, headers) - executables = map ($ request) $ compilers server - case loop executables of - Nothing -> respond server.defaultResponse - Just action -> action >>= respond - where - loop :: [Executable] -> Maybe (IO WAI.Response) - loop [] = Nothing - loop (h : t) = case h of - Run action -> Just action - Null -> loop t - -genOpenAPISpec :: - Server -> - BS.ByteString -genOpenAPISpec = undefined - -genJSClient :: - Server -> - BS.ByteString -genJSClient = undefined