Split out SecureServerM (#60)

This commit is contained in:
Connor Prussin 2017-08-01 21:58:11 -07:00 committed by Connor Prussin
parent 61a66c324a
commit ea1bfbe182
4 changed files with 14 additions and 10 deletions

View File

@ -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 <> ""

View File

@ -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')

View File

@ -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
) )

View File

@ -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