Split out SecureServerM (#60)
This commit is contained in:
parent
61a66c324a
commit
ea1bfbe182
@ -27,7 +27,7 @@ sayHello :: forall e. HTTPure.Request -> HTTPure.ResponseM e
|
|||||||
sayHello _ = pure $ HTTPure.OK StrMap.empty "hello world!"
|
sayHello _ = pure $ HTTPure.OK StrMap.empty "hello world!"
|
||||||
|
|
||||||
-- | Boot up the server
|
-- | Boot up the server
|
||||||
main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e)
|
main :: forall e. HTTPure.SecureServerM (console :: Console.CONSOLE | e)
|
||||||
main = HTTPure.serve' port cert key sayHello do
|
main = HTTPure.serve' port cert key sayHello do
|
||||||
Console.log $ " ┌───────────────────────────────────────────┐"
|
Console.log $ " ┌───────────────────────────────────────────┐"
|
||||||
Console.log $ " │ Server now up on port " <> portS <> " │"
|
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||||
|
@ -8,4 +8,4 @@ module HTTPure
|
|||||||
import HTTPure.Headers (Headers, lookup)
|
import HTTPure.Headers (Headers, lookup)
|
||||||
import HTTPure.Request (Request(..))
|
import HTTPure.Request (Request(..))
|
||||||
import HTTPure.Response (ResponseM, Response(..))
|
import HTTPure.Response (ResponseM, Response(..))
|
||||||
import HTTPure.Server (ServerM, serve, serve')
|
import HTTPure.Server (SecureServerM, ServerM, serve, serve')
|
||||||
|
@ -6,7 +6,6 @@ module HTTPure.HTTPureM
|
|||||||
import Control.Monad.Eff as Eff
|
import Control.Monad.Eff as Eff
|
||||||
import Control.Monad.Eff.Exception as Exception
|
import Control.Monad.Eff.Exception as Exception
|
||||||
import Control.Monad.ST as ST
|
import Control.Monad.ST as ST
|
||||||
import Node.FS as FS
|
|
||||||
import Node.HTTP as HTTP
|
import Node.HTTP as HTTP
|
||||||
|
|
||||||
-- | A row of types that are used by an HTTPure server.
|
-- | A row of types that are used by an HTTPure server.
|
||||||
@ -14,7 +13,6 @@ type HTTPureEffects e =
|
|||||||
( http :: HTTP.HTTP
|
( http :: HTTP.HTTP
|
||||||
, st :: ST.ST String
|
, st :: ST.ST String
|
||||||
, exception :: Exception.EXCEPTION
|
, exception :: Exception.EXCEPTION
|
||||||
, fs :: FS.FS
|
|
||||||
| e
|
| e
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -1,5 +1,6 @@
|
|||||||
module HTTPure.Server
|
module HTTPure.Server
|
||||||
( ServerM
|
( ServerM
|
||||||
|
, SecureServerM
|
||||||
, serve
|
, serve
|
||||||
, serve'
|
, serve'
|
||||||
) where
|
) where
|
||||||
@ -11,6 +12,7 @@ import Control.Monad.Eff.Class as EffClass
|
|||||||
import Data.Maybe as Maybe
|
import Data.Maybe as Maybe
|
||||||
import Data.Options ((:=))
|
import Data.Options ((:=))
|
||||||
import Node.Encoding as Encoding
|
import Node.Encoding as Encoding
|
||||||
|
import Node.FS as FS
|
||||||
import Node.FS.Sync as FSSync
|
import Node.FS.Sync as FSSync
|
||||||
import Node.HTTP as HTTP
|
import Node.HTTP as HTTP
|
||||||
import Node.HTTP.Secure as HTTPS
|
import Node.HTTP.Secure as HTTPS
|
||||||
@ -24,6 +26,10 @@ import HTTPure.Response as Response
|
|||||||
-- | related methods.
|
-- | related methods.
|
||||||
type ServerM e = HTTPureM.HTTPureM e Unit
|
type ServerM e = HTTPureM.HTTPureM e Unit
|
||||||
|
|
||||||
|
-- | The SecureServerM type is the same as the ServerM type, but it includes
|
||||||
|
-- | effects for working with the filesystem (to load the key and certificate).
|
||||||
|
type SecureServerM e = ServerM (fs :: FS.FS | e)
|
||||||
|
|
||||||
-- | This function takes a method which takes a request and returns a ResponseM,
|
-- | This function takes a method which takes a request and returns a ResponseM,
|
||||||
-- | an HTTP request, and an HTTP response. It runs the request, extracts the
|
-- | an HTTP request, and an HTTP response. It runs the request, extracts the
|
||||||
-- | Response from the ResponseM, and sends the Response to the HTTP Response.
|
-- | Response from the ResponseM, and sends the Response to the HTTP Response.
|
||||||
@ -57,9 +63,9 @@ bootHTTPS :: forall e.
|
|||||||
HTTP.ListenOptions ->
|
HTTP.ListenOptions ->
|
||||||
String ->
|
String ->
|
||||||
String ->
|
String ->
|
||||||
(Request.Request -> Response.ResponseM e) ->
|
(Request.Request -> Response.ResponseM (fs :: FS.FS | e)) ->
|
||||||
ServerM e ->
|
SecureServerM e ->
|
||||||
ServerM e
|
SecureServerM e
|
||||||
bootHTTPS options cert key router onStarted = do
|
bootHTTPS options cert key router onStarted = do
|
||||||
cert' <- FSSync.readTextFile Encoding.UTF8 cert
|
cert' <- FSSync.readTextFile Encoding.UTF8 cert
|
||||||
key' <- FSSync.readTextFile Encoding.UTF8 key
|
key' <- FSSync.readTextFile Encoding.UTF8 key
|
||||||
@ -100,7 +106,7 @@ serve' :: forall e.
|
|||||||
Int ->
|
Int ->
|
||||||
String ->
|
String ->
|
||||||
String ->
|
String ->
|
||||||
(Request.Request -> Response.ResponseM e) ->
|
(Request.Request -> Response.ResponseM (fs :: FS.FS | e)) ->
|
||||||
ServerM e ->
|
SecureServerM e ->
|
||||||
ServerM e
|
SecureServerM e
|
||||||
serve' = bootHTTPS <<< listenOptions
|
serve' = bootHTTPS <<< listenOptions
|
||||||
|
Loading…
Reference in New Issue
Block a user