Add SSL support (#55)
This commit is contained in:
parent
b88b905dad
commit
bd58415e3b
@ -18,8 +18,9 @@
|
|||||||
],
|
],
|
||||||
"dependencies": {
|
"dependencies": {
|
||||||
"purescript-prelude": "^3.0.0",
|
"purescript-prelude": "^3.0.0",
|
||||||
"purescript-node-http": "^4.0.0",
|
"purescript-node-http": "cprussin/purescript-node-http#dd87dbaec43ffc5312b78b10316023dc7b78a06d",
|
||||||
"purescript-aff": "^3.1.0"
|
"purescript-aff": "^3.1.0",
|
||||||
|
"purescript-node-fs": "^4.0.0"
|
||||||
},
|
},
|
||||||
"devDependencies": {
|
"devDependencies": {
|
||||||
"purescript-psci-support": "^3.0.0",
|
"purescript-psci-support": "^3.0.0",
|
||||||
|
20
docs/Examples/SSL/Certificate.cer
Normal file
20
docs/Examples/SSL/Certificate.cer
Normal file
@ -0,0 +1,20 @@
|
|||||||
|
-----BEGIN CERTIFICATE-----
|
||||||
|
MIIDWDCCAkCgAwIBAgIJAKm4yWuzx7UpMA0GCSqGSIb3DQEBCwUAMEExCzAJBgNV
|
||||||
|
BAYTAlVTMRMwEQYDVQQIDApDYWxpZm9ybmlhMR0wGwYDVQQKDBRwdXJlc2NyaXB0
|
||||||
|
LW5vZGUtaHR0cDAeFw0xNzA3MjMwMTM4MThaFw0xNzA4MjIwMTM4MThaMEExCzAJ
|
||||||
|
BgNVBAYTAlVTMRMwEQYDVQQIDApDYWxpZm9ybmlhMR0wGwYDVQQKDBRwdXJlc2Ny
|
||||||
|
aXB0LW5vZGUtaHR0cDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMrI
|
||||||
|
7YGwOVZJGemgeGm8e6MTydSQozxlHYwshHDb83pB2LUhkguSRHoUe9CO+uDGemKP
|
||||||
|
BHMHFCS1Nuhgal3mnCPNbY/57mA8LDIpjJ/j9UD85Aw5c89yEd8MuLoM1T0q/APa
|
||||||
|
LOmKMgzvfpA0S1/6Hr5Ef/tGdE1gFluVirhgUqvbIBJzqTraQq89jwf+4YmzjCO7
|
||||||
|
/6FIY0pn4xgcSGyd3i2r/DGbL42QlNmq2MarxxdFJo1llK6YIBhS/fAJCp6hsAnX
|
||||||
|
+m4hClvJ17Rt+46q4C7KCP6J1U5jFIMtDF7jw6uBr/macenF/ApAHUW0dAiBP9qG
|
||||||
|
fI2l64syxNSUS3of9p0CAwEAAaNTMFEwHQYDVR0OBBYEFPlsFrLCVM6zgXzKMkDN
|
||||||
|
lzkLLoCfMB8GA1UdIwQYMBaAFPlsFrLCVM6zgXzKMkDNlzkLLoCfMA8GA1UdEwEB
|
||||||
|
/wQFMAMBAf8wDQYJKoZIhvcNAQELBQADggEBAKvNsmnuO65CUnU1U85UlXYSpyA2
|
||||||
|
f1SVCwKsRB9omFCbtJv8nZOrFSfooxdNJ0LiS7t4cs6v1+441+Sg4aLA14qy4ezv
|
||||||
|
Fmjt/0qfS3GNjJRr9KU9ZdZ3oxu7qf2ILUneSJOuU/OjP42rZUV6ruyauZB79PvB
|
||||||
|
25ENUhpA9z90REYjHuZzUeI60/aRwqQgCCwu5XYeIIxkD+WBPh2lxCfASwQ6/1Iq
|
||||||
|
fEkZtgzKvcprF8csbb2RNu2AVF2jdxChtl/FCUlSSX13VCROf6dOYJPid9s/wKpE
|
||||||
|
nN+b2NNE8OJeuskvEckzDe/hbkVptUNi4q2G8tBoKjPPTjdiLjtxuNz7OT0=
|
||||||
|
-----END CERTIFICATE-----
|
28
docs/Examples/SSL/Key.key
Normal file
28
docs/Examples/SSL/Key.key
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
-----BEGIN PRIVATE KEY-----
|
||||||
|
MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQDKyO2BsDlWSRnp
|
||||||
|
oHhpvHujE8nUkKM8ZR2MLIRw2/N6Qdi1IZILkkR6FHvQjvrgxnpijwRzBxQktTbo
|
||||||
|
YGpd5pwjzW2P+e5gPCwyKYyf4/VA/OQMOXPPchHfDLi6DNU9KvwD2izpijIM736Q
|
||||||
|
NEtf+h6+RH/7RnRNYBZblYq4YFKr2yASc6k62kKvPY8H/uGJs4wju/+hSGNKZ+MY
|
||||||
|
HEhsnd4tq/wxmy+NkJTZqtjGq8cXRSaNZZSumCAYUv3wCQqeobAJ1/puIQpbyde0
|
||||||
|
bfuOquAuygj+idVOYxSDLQxe48Orga/5mnHpxfwKQB1FtHQIgT/ahnyNpeuLMsTU
|
||||||
|
lEt6H/adAgMBAAECggEBALSe/54SXx/SAPitbFOSBPYefBmPszXqQsVGKbl00IvG
|
||||||
|
9sVvX2xbHg83C4masS9g2kXLaYUjevevSXb12ghFjjH9mmcxkPe64QrVI2KPYzY9
|
||||||
|
isqwqczOp8hqxmdBYvYWwV6VCIgEBcyrzamYSsL0QEntLamc+Z6pxYBR1LuhYEGd
|
||||||
|
Vq0A+YL/4CZi320+pt05u/635Daon33JqhvDa0QK5xvFYKEcB+IY5eqByOx7nJl8
|
||||||
|
A55oVagBVjpi//rwoge5aCfbcdyHUmBFYkuCI6SJhvwDmfSHWDkyWWsZAJY5sosN
|
||||||
|
a824N7XX5ZiBYir+E4ldC6ZlFOnQK5f6Fr0MJeM8uikCgYEA+HAgYgKBpezCrJ0B
|
||||||
|
I/inIfynaW8k3SCSQhYvqPK591cBKXwghCG2vpUwqIVO/ROP070L9/EtNrFs5fPv
|
||||||
|
xHQA8P3Weeail6gl9UR5oKNU3bcbIFunUtWi1ua86g/aaofub/hBq2xR+HSnV91W
|
||||||
|
Ycwewyfc/0j94kDOAFgSGOz0BscCgYEA0PUQXtuu05YTmz2TDtknCcQOVm/UnEg6
|
||||||
|
1FsKPzmoxWsAMtHXf3FbD3vHql1JfPTJPNcxEEL6fhA1l7ntailHltx8dt9bXmYJ
|
||||||
|
ANM0n8uSKde5MoFbMhmyYTcRxJW9EC2ivqLotd5iL1mbfvdF02cWmr/5KNxUO1Hk
|
||||||
|
7TkJturwo3sCgYBc/gNxDEUhKX05BU/O+hz9QMgdVAf1aWK1r/5I/AoWBhAeSiMV
|
||||||
|
slToA4oCGlwVqMPWWtXnCfSFm2YKsQNXgqBzlGA6otTLdZo3s1jfgyOaFhbmRshb
|
||||||
|
3jGkxRuDdUmpRJZAfSl/k/0exfN5lRTnaHM/U2WKfPTjQqSZRl4HzHIPMwKBgFVE
|
||||||
|
W0zKClou+Is1oifB9wsmJM+izLiFRPRYviK0raj5k9gpBu3rXMRBt2VOsek6nk+k
|
||||||
|
ZFIFcuA0Txo99aKHe74U9PkxBcDMlEnw5Z17XYaTj/ALFyKnl8HRzf9RNxg99xYh
|
||||||
|
tiJYv+ogf7JcxvKQM4osYkkJN5oJPgiLaOpqjo23AoGBAN3g5kvsYj3OKGh89pGk
|
||||||
|
osLeL+NNUBDvFsrvFzPMwPGDup6AB1qX1pc4RfyQGzDJqUSTpioWI5v1O6Pmoiak
|
||||||
|
FO0u08Tb/091Bir5kgglUSi7VnFD3v8ffeKpkkJvtYUj7S9yoH9NQPVhKVCq6mna
|
||||||
|
TbGfXbnVfNmqgQh71+k02p6S
|
||||||
|
-----END PRIVATE KEY-----
|
38
docs/Examples/SSL/Main.purs
Normal file
38
docs/Examples/SSL/Main.purs
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
module SSL where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
import Control.Monad.Eff.Console as Console
|
||||||
|
import Data.StrMap as StrMap
|
||||||
|
import HTTPure as HTTPure
|
||||||
|
|
||||||
|
-- | Serve the example server on this port
|
||||||
|
port :: Int
|
||||||
|
port = 8085
|
||||||
|
|
||||||
|
-- | Shortcut for `show port`
|
||||||
|
portS :: String
|
||||||
|
portS = show port
|
||||||
|
|
||||||
|
-- | The path to the certificate file
|
||||||
|
cert :: String
|
||||||
|
cert = "./docs/Examples/SSL/Certificate.cer"
|
||||||
|
|
||||||
|
-- | The path to the key file
|
||||||
|
key :: String
|
||||||
|
key = "./docs/Examples/SSL/Key.key"
|
||||||
|
|
||||||
|
-- | Say 'hello world!' when run
|
||||||
|
sayHello :: forall e. HTTPure.Request -> HTTPure.ResponseM e
|
||||||
|
sayHello _ = pure $ HTTPure.OK StrMap.empty "hello world!"
|
||||||
|
|
||||||
|
-- | Boot up the server
|
||||||
|
main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e)
|
||||||
|
main = HTTPure.serve' port cert key sayHello do
|
||||||
|
Console.log $ " ┌───────────────────────────────────────────┐"
|
||||||
|
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||||
|
Console.log $ " │ │"
|
||||||
|
Console.log $ " │ To test, run: │"
|
||||||
|
Console.log $ " │ > curl --insecure https://localhost:" <> portS <> " │"
|
||||||
|
Console.log $ " │ # => hello world! │"
|
||||||
|
Console.log $ " └───────────────────────────────────────────┘"
|
13
docs/Examples/SSL/Readme.md
Normal file
13
docs/Examples/SSL/Readme.md
Normal file
@ -0,0 +1,13 @@
|
|||||||
|
# SSL Example
|
||||||
|
|
||||||
|
This is a basic 'hello world' example, that runs over HTTPS. It simply returns
|
||||||
|
'hello world!' when making any request.
|
||||||
|
|
||||||
|
Note that it uses self-signed certificates, so you will need to ignore
|
||||||
|
certificate errors when testing.
|
||||||
|
|
||||||
|
To run the example server, run:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
make example EXAMPLE=SSL
|
||||||
|
```
|
@ -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)
|
import HTTPure.Server (ServerM, serve, serve')
|
||||||
|
@ -6,6 +6,7 @@ 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.
|
||||||
@ -13,6 +14,7 @@ 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,6 +1,7 @@
|
|||||||
module HTTPure.Server
|
module HTTPure.Server
|
||||||
( ServerM
|
( ServerM
|
||||||
, serve
|
, serve
|
||||||
|
, serve'
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Prelude
|
import Prelude
|
||||||
@ -8,6 +9,9 @@ import Prelude
|
|||||||
import Control.Monad.Aff as Aff
|
import Control.Monad.Aff as Aff
|
||||||
import Control.Monad.Eff.Class as EffClass
|
import Control.Monad.Eff.Class as EffClass
|
||||||
import Data.Maybe as Maybe
|
import Data.Maybe as Maybe
|
||||||
|
import Data.Options ((:=))
|
||||||
|
import Node.Encoding as Encoding
|
||||||
|
import Node.FS.Sync as FSSync
|
||||||
import Node.HTTP as HTTP
|
import Node.HTTP as HTTP
|
||||||
|
|
||||||
import HTTPure.HTTPureM as HTTPureM
|
import HTTPure.HTTPureM as HTTPureM
|
||||||
@ -32,18 +36,44 @@ handleRequest router request response =
|
|||||||
req <- Request.fromHTTPRequest request
|
req <- Request.fromHTTPRequest request
|
||||||
EffClass.liftEff $ router req >>= Response.send response
|
EffClass.liftEff $ router req >>= Response.send response
|
||||||
|
|
||||||
-- | Given an options object, a function mapping Request to ResponseM, and an
|
-- | Given a ListenOptions Record, a function mapping Request to ResponseM, and
|
||||||
-- | HTTPureM containing effects to run on boot, creates and runs a HTTPure
|
-- | an HTTPureM containing effects to run on boot, creates and runs a HTTPure
|
||||||
-- | server.
|
-- | server without SSL.
|
||||||
boot :: forall e.
|
bootHTTP :: forall e.
|
||||||
HTTP.ListenOptions ->
|
HTTP.ListenOptions ->
|
||||||
(Request.Request -> Response.ResponseM e) ->
|
(Request.Request -> Response.ResponseM e) ->
|
||||||
ServerM e ->
|
ServerM e ->
|
||||||
ServerM e
|
ServerM e
|
||||||
boot options router onStarted =
|
bootHTTP options router onStarted =
|
||||||
HTTP.createServer (handleRequest router) >>= \server ->
|
HTTP.createServer (handleRequest router) >>= \server ->
|
||||||
HTTP.listen server options onStarted
|
HTTP.listen server options onStarted
|
||||||
|
|
||||||
|
-- | Given a ListenOptions Record, a path to a cert file, a path to a private
|
||||||
|
-- | key file, a function mapping Request to ResponseM, and an HTTPureM
|
||||||
|
-- | containing effects to run on boot, creates and runs a HTTPure server with
|
||||||
|
-- | SSL.
|
||||||
|
bootHTTPS :: forall e.
|
||||||
|
HTTP.ListenOptions ->
|
||||||
|
String ->
|
||||||
|
String ->
|
||||||
|
(Request.Request -> Response.ResponseM e) ->
|
||||||
|
ServerM e ->
|
||||||
|
ServerM e
|
||||||
|
bootHTTPS options cert key router onStarted = do
|
||||||
|
certText <- FSSync.readTextFile Encoding.UTF8 cert
|
||||||
|
keyText <- FSSync.readTextFile Encoding.UTF8 key
|
||||||
|
let sslOptions = HTTP.key := keyText <> HTTP.cert := certText
|
||||||
|
HTTP.createServerS sslOptions (handleRequest router) >>= \server ->
|
||||||
|
HTTP.listen server options onStarted
|
||||||
|
|
||||||
|
-- | Given a port number, return a HTTP.ListenOptions Record.
|
||||||
|
listenOptions :: Int -> HTTP.ListenOptions
|
||||||
|
listenOptions port =
|
||||||
|
{ hostname: "localhost"
|
||||||
|
, port: port
|
||||||
|
, backlog: Maybe.Nothing
|
||||||
|
}
|
||||||
|
|
||||||
-- | Create and start a server. This is the main entry point for HTTPure. Takes
|
-- | Create and start a server. This is the main entry point for HTTPure. Takes
|
||||||
-- | a port number on which to listen, a function mapping Request to ResponseM,
|
-- | a port number on which to listen, a function mapping Request to ResponseM,
|
||||||
-- | and an HTTPureM containing effects to run after the server has booted
|
-- | and an HTTPureM containing effects to run after the server has booted
|
||||||
@ -53,8 +83,20 @@ serve :: forall e.
|
|||||||
(Request.Request -> Response.ResponseM e) ->
|
(Request.Request -> Response.ResponseM e) ->
|
||||||
ServerM e ->
|
ServerM e ->
|
||||||
ServerM e
|
ServerM e
|
||||||
serve port = boot
|
serve = bootHTTP <<< listenOptions
|
||||||
{ hostname: "localhost"
|
|
||||||
, port: port
|
-- | Create and start an SSL server. This method is the same as `serve`, but
|
||||||
, backlog: Maybe.Nothing
|
-- | takes additional SSL arguments. The arguments in order are:
|
||||||
}
|
-- | 1. A port number
|
||||||
|
-- | 2. A path to a cert file
|
||||||
|
-- | 3. A path to a private key file
|
||||||
|
-- | 4. A handler method which maps Request to ResponseM
|
||||||
|
-- | 5. A callback to call when the server is up
|
||||||
|
serve' :: forall e.
|
||||||
|
Int ->
|
||||||
|
String ->
|
||||||
|
String ->
|
||||||
|
(Request.Request -> Response.ResponseM e) ->
|
||||||
|
ServerM e ->
|
||||||
|
ServerM e
|
||||||
|
serve' = bootHTTPS <<< listenOptions
|
||||||
|
@ -13,6 +13,7 @@ import Headers as Headers
|
|||||||
import HelloWorld as HelloWorld
|
import HelloWorld as HelloWorld
|
||||||
import MultiRoute as MultiRoute
|
import MultiRoute as MultiRoute
|
||||||
import Post as Post
|
import Post as Post
|
||||||
|
import SSL as SSL
|
||||||
|
|
||||||
headersSpec :: SpecHelpers.Test
|
headersSpec :: SpecHelpers.Test
|
||||||
headersSpec = Spec.it "runs the headers example" do
|
headersSpec = Spec.it "runs the headers example" do
|
||||||
@ -46,9 +47,17 @@ postSpec = Spec.it "runs the post example" do
|
|||||||
response ?= "test"
|
response ?= "test"
|
||||||
where port = Post.port
|
where port = Post.port
|
||||||
|
|
||||||
|
sslSpec :: SpecHelpers.Test
|
||||||
|
sslSpec = Spec.it "runs the ssl example" do
|
||||||
|
EffClass.liftEff SSL.main
|
||||||
|
response <- SpecHelpers.get' port StrMap.empty "/"
|
||||||
|
response ?= "hello world!"
|
||||||
|
where port = SSL.port
|
||||||
|
|
||||||
integrationSpec :: SpecHelpers.Test
|
integrationSpec :: SpecHelpers.Test
|
||||||
integrationSpec = Spec.describe "Integration" do
|
integrationSpec = Spec.describe "Integration" do
|
||||||
headersSpec
|
headersSpec
|
||||||
helloWorldSpec
|
helloWorldSpec
|
||||||
multiRouteSpec
|
multiRouteSpec
|
||||||
postSpec
|
postSpec
|
||||||
|
sslSpec
|
||||||
|
@ -5,6 +5,7 @@ import Prelude
|
|||||||
import Control.Monad.Eff.Class as EffClass
|
import Control.Monad.Eff.Class as EffClass
|
||||||
import Data.StrMap as StrMap
|
import Data.StrMap as StrMap
|
||||||
import Test.Spec as Spec
|
import Test.Spec as Spec
|
||||||
|
import Test.Spec.Assertions.Aff as AffAssertions
|
||||||
|
|
||||||
import HTTPure.Request as Request
|
import HTTPure.Request as Request
|
||||||
import HTTPure.Response as Response
|
import HTTPure.Response as Response
|
||||||
@ -24,6 +25,22 @@ serveSpec = Spec.describe "serve" do
|
|||||||
out <- SpecHelpers.get 7901 StrMap.empty "/test"
|
out <- SpecHelpers.get 7901 StrMap.empty "/test"
|
||||||
out ?= "/test"
|
out ?= "/test"
|
||||||
|
|
||||||
|
serve'Spec :: SpecHelpers.Test
|
||||||
|
serve'Spec = Spec.describe "serve" do
|
||||||
|
Spec.describe "with valid key and cert files" do
|
||||||
|
Spec.it "boots a server on the given port" do
|
||||||
|
EffClass.liftEff $ Server.serve' 7902 cert key mockRouter $ pure unit
|
||||||
|
out <- SpecHelpers.get' 7902 StrMap.empty "/test"
|
||||||
|
out ?= "/test"
|
||||||
|
Spec.describe "with invalid key and cert files" do
|
||||||
|
Spec.it "throws" do
|
||||||
|
AffAssertions.expectError do
|
||||||
|
EffClass.liftEff $ Server.serve' 7903 "" "" mockRouter $ pure unit
|
||||||
|
where
|
||||||
|
cert = "./test/Mocks/Certificate.cer"
|
||||||
|
key = "./test/Mocks/Key.key"
|
||||||
|
|
||||||
serverSpec :: SpecHelpers.Test
|
serverSpec :: SpecHelpers.Test
|
||||||
serverSpec = Spec.describe "Server" do
|
serverSpec = Spec.describe "Server" do
|
||||||
serveSpec
|
serveSpec
|
||||||
|
serve'Spec
|
||||||
|
@ -11,6 +11,7 @@ import Data.Options ((:=))
|
|||||||
import Data.String as StringUtil
|
import Data.String as StringUtil
|
||||||
import Data.StrMap as StrMap
|
import Data.StrMap as StrMap
|
||||||
import Node.Encoding as Encoding
|
import Node.Encoding as Encoding
|
||||||
|
import Node.FS as FS
|
||||||
import Node.HTTP as HTTP
|
import Node.HTTP as HTTP
|
||||||
import Node.HTTP.Client as HTTPClient
|
import Node.HTTP.Client as HTTPClient
|
||||||
import Node.Stream as Stream
|
import Node.Stream as Stream
|
||||||
@ -35,6 +36,7 @@ type TestEffects =
|
|||||||
HTTPRequestEffects
|
HTTPRequestEffects
|
||||||
( mockResponse :: MOCK_RESPONSE
|
( mockResponse :: MOCK_RESPONSE
|
||||||
, mockRequest :: MOCK_REQUEST
|
, mockRequest :: MOCK_REQUEST
|
||||||
|
, fs :: FS.FS
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
@ -47,24 +49,27 @@ type TestSuite = Eff.Eff TestEffects Unit
|
|||||||
-- | Given a URL, a failure handler, and a success handler, create an HTTP
|
-- | Given a URL, a failure handler, and a success handler, create an HTTP
|
||||||
-- | client request.
|
-- | client request.
|
||||||
request :: forall e.
|
request :: forall e.
|
||||||
|
Boolean ->
|
||||||
Int ->
|
Int ->
|
||||||
String ->
|
String ->
|
||||||
StrMap.StrMap String ->
|
StrMap.StrMap String ->
|
||||||
String ->
|
String ->
|
||||||
String ->
|
String ->
|
||||||
Aff.Aff (http :: HTTP.HTTP | e) HTTPClient.Response
|
Aff.Aff (http :: HTTP.HTTP | e) HTTPClient.Response
|
||||||
request port method headers path body = Aff.makeAff \_ success -> void do
|
request secure port method headers path body = Aff.makeAff \_ success -> void do
|
||||||
req <- HTTPClient.request options success
|
req <- HTTPClient.request options success
|
||||||
let stream = HTTPClient.requestAsStream req
|
let stream = HTTPClient.requestAsStream req
|
||||||
_ <- Stream.writeString stream Encoding.UTF8 body $ pure unit
|
_ <- Stream.writeString stream Encoding.UTF8 body $ pure unit
|
||||||
Stream.end stream $ pure unit
|
Stream.end stream $ pure unit
|
||||||
where
|
where
|
||||||
options =
|
options =
|
||||||
|
HTTPClient.protocol := (if secure then "https:" else "http:") <>
|
||||||
HTTPClient.method := method <>
|
HTTPClient.method := method <>
|
||||||
HTTPClient.hostname := "localhost" <>
|
HTTPClient.hostname := "localhost" <>
|
||||||
HTTPClient.port := port <>
|
HTTPClient.port := port <>
|
||||||
HTTPClient.path := path <>
|
HTTPClient.path := path <>
|
||||||
HTTPClient.headers := HTTPClient.RequestHeaders headers
|
HTTPClient.headers := HTTPClient.RequestHeaders headers <>
|
||||||
|
HTTPClient.rejectUnauthorized := false
|
||||||
|
|
||||||
-- | Given an ST String buffer and a new string, concatenate that new string
|
-- | Given an ST String buffer and a new string, concatenate that new string
|
||||||
-- | onto the ST buffer.
|
-- | onto the ST buffer.
|
||||||
@ -88,7 +93,16 @@ get :: forall e.
|
|||||||
StrMap.StrMap String ->
|
StrMap.StrMap String ->
|
||||||
String ->
|
String ->
|
||||||
Aff.Aff (HTTPRequestEffects e) String
|
Aff.Aff (HTTPRequestEffects e) String
|
||||||
get port headers path = request port "GET" headers path "" >>= toString
|
get port headers path = request false port "GET" headers path "" >>= toString
|
||||||
|
|
||||||
|
-- | Run an HTTPS GET with the given url and return an Aff that contains the
|
||||||
|
-- | string with the response body.
|
||||||
|
get' :: forall e.
|
||||||
|
Int ->
|
||||||
|
StrMap.StrMap String ->
|
||||||
|
String ->
|
||||||
|
Aff.Aff (HTTPRequestEffects e) String
|
||||||
|
get' port headers path = request true port "GET" headers path "" >>= toString
|
||||||
|
|
||||||
-- | Run an HTTP POST with the given url and body and return an Aff that
|
-- | Run an HTTP POST with the given url and body and return an Aff that
|
||||||
-- | contains the string with the response body.
|
-- | contains the string with the response body.
|
||||||
@ -98,7 +112,7 @@ post :: forall e.
|
|||||||
String ->
|
String ->
|
||||||
String ->
|
String ->
|
||||||
Aff.Aff (HTTPRequestEffects e) String
|
Aff.Aff (HTTPRequestEffects e) String
|
||||||
post port headers path = request port "POST" headers path >=> toString
|
post port headers path = request false port "POST" headers path >=> toString
|
||||||
|
|
||||||
-- | Convert a request to an Aff containing the string with the given header
|
-- | Convert a request to an Aff containing the string with the given header
|
||||||
-- | value.
|
-- | value.
|
||||||
@ -117,7 +131,7 @@ getHeader :: forall e.
|
|||||||
String ->
|
String ->
|
||||||
Aff.Aff (HTTPRequestEffects e) String
|
Aff.Aff (HTTPRequestEffects e) String
|
||||||
getHeader port headers path header =
|
getHeader port headers path header =
|
||||||
extractHeader header <$> request port "GET" headers path ""
|
extractHeader header <$> request false port "GET" headers path ""
|
||||||
|
|
||||||
-- | An effect encapsulating creating a mock request object
|
-- | An effect encapsulating creating a mock request object
|
||||||
foreign import data MOCK_REQUEST :: Eff.Effect
|
foreign import data MOCK_REQUEST :: Eff.Effect
|
||||||
|
20
test/Mocks/Certificate.cer
Normal file
20
test/Mocks/Certificate.cer
Normal file
@ -0,0 +1,20 @@
|
|||||||
|
-----BEGIN CERTIFICATE-----
|
||||||
|
MIIDWDCCAkCgAwIBAgIJAKm4yWuzx7UpMA0GCSqGSIb3DQEBCwUAMEExCzAJBgNV
|
||||||
|
BAYTAlVTMRMwEQYDVQQIDApDYWxpZm9ybmlhMR0wGwYDVQQKDBRwdXJlc2NyaXB0
|
||||||
|
LW5vZGUtaHR0cDAeFw0xNzA3MjMwMTM4MThaFw0xNzA4MjIwMTM4MThaMEExCzAJ
|
||||||
|
BgNVBAYTAlVTMRMwEQYDVQQIDApDYWxpZm9ybmlhMR0wGwYDVQQKDBRwdXJlc2Ny
|
||||||
|
aXB0LW5vZGUtaHR0cDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMrI
|
||||||
|
7YGwOVZJGemgeGm8e6MTydSQozxlHYwshHDb83pB2LUhkguSRHoUe9CO+uDGemKP
|
||||||
|
BHMHFCS1Nuhgal3mnCPNbY/57mA8LDIpjJ/j9UD85Aw5c89yEd8MuLoM1T0q/APa
|
||||||
|
LOmKMgzvfpA0S1/6Hr5Ef/tGdE1gFluVirhgUqvbIBJzqTraQq89jwf+4YmzjCO7
|
||||||
|
/6FIY0pn4xgcSGyd3i2r/DGbL42QlNmq2MarxxdFJo1llK6YIBhS/fAJCp6hsAnX
|
||||||
|
+m4hClvJ17Rt+46q4C7KCP6J1U5jFIMtDF7jw6uBr/macenF/ApAHUW0dAiBP9qG
|
||||||
|
fI2l64syxNSUS3of9p0CAwEAAaNTMFEwHQYDVR0OBBYEFPlsFrLCVM6zgXzKMkDN
|
||||||
|
lzkLLoCfMB8GA1UdIwQYMBaAFPlsFrLCVM6zgXzKMkDNlzkLLoCfMA8GA1UdEwEB
|
||||||
|
/wQFMAMBAf8wDQYJKoZIhvcNAQELBQADggEBAKvNsmnuO65CUnU1U85UlXYSpyA2
|
||||||
|
f1SVCwKsRB9omFCbtJv8nZOrFSfooxdNJ0LiS7t4cs6v1+441+Sg4aLA14qy4ezv
|
||||||
|
Fmjt/0qfS3GNjJRr9KU9ZdZ3oxu7qf2ILUneSJOuU/OjP42rZUV6ruyauZB79PvB
|
||||||
|
25ENUhpA9z90REYjHuZzUeI60/aRwqQgCCwu5XYeIIxkD+WBPh2lxCfASwQ6/1Iq
|
||||||
|
fEkZtgzKvcprF8csbb2RNu2AVF2jdxChtl/FCUlSSX13VCROf6dOYJPid9s/wKpE
|
||||||
|
nN+b2NNE8OJeuskvEckzDe/hbkVptUNi4q2G8tBoKjPPTjdiLjtxuNz7OT0=
|
||||||
|
-----END CERTIFICATE-----
|
28
test/Mocks/Key.key
Normal file
28
test/Mocks/Key.key
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
-----BEGIN PRIVATE KEY-----
|
||||||
|
MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQDKyO2BsDlWSRnp
|
||||||
|
oHhpvHujE8nUkKM8ZR2MLIRw2/N6Qdi1IZILkkR6FHvQjvrgxnpijwRzBxQktTbo
|
||||||
|
YGpd5pwjzW2P+e5gPCwyKYyf4/VA/OQMOXPPchHfDLi6DNU9KvwD2izpijIM736Q
|
||||||
|
NEtf+h6+RH/7RnRNYBZblYq4YFKr2yASc6k62kKvPY8H/uGJs4wju/+hSGNKZ+MY
|
||||||
|
HEhsnd4tq/wxmy+NkJTZqtjGq8cXRSaNZZSumCAYUv3wCQqeobAJ1/puIQpbyde0
|
||||||
|
bfuOquAuygj+idVOYxSDLQxe48Orga/5mnHpxfwKQB1FtHQIgT/ahnyNpeuLMsTU
|
||||||
|
lEt6H/adAgMBAAECggEBALSe/54SXx/SAPitbFOSBPYefBmPszXqQsVGKbl00IvG
|
||||||
|
9sVvX2xbHg83C4masS9g2kXLaYUjevevSXb12ghFjjH9mmcxkPe64QrVI2KPYzY9
|
||||||
|
isqwqczOp8hqxmdBYvYWwV6VCIgEBcyrzamYSsL0QEntLamc+Z6pxYBR1LuhYEGd
|
||||||
|
Vq0A+YL/4CZi320+pt05u/635Daon33JqhvDa0QK5xvFYKEcB+IY5eqByOx7nJl8
|
||||||
|
A55oVagBVjpi//rwoge5aCfbcdyHUmBFYkuCI6SJhvwDmfSHWDkyWWsZAJY5sosN
|
||||||
|
a824N7XX5ZiBYir+E4ldC6ZlFOnQK5f6Fr0MJeM8uikCgYEA+HAgYgKBpezCrJ0B
|
||||||
|
I/inIfynaW8k3SCSQhYvqPK591cBKXwghCG2vpUwqIVO/ROP070L9/EtNrFs5fPv
|
||||||
|
xHQA8P3Weeail6gl9UR5oKNU3bcbIFunUtWi1ua86g/aaofub/hBq2xR+HSnV91W
|
||||||
|
Ycwewyfc/0j94kDOAFgSGOz0BscCgYEA0PUQXtuu05YTmz2TDtknCcQOVm/UnEg6
|
||||||
|
1FsKPzmoxWsAMtHXf3FbD3vHql1JfPTJPNcxEEL6fhA1l7ntailHltx8dt9bXmYJ
|
||||||
|
ANM0n8uSKde5MoFbMhmyYTcRxJW9EC2ivqLotd5iL1mbfvdF02cWmr/5KNxUO1Hk
|
||||||
|
7TkJturwo3sCgYBc/gNxDEUhKX05BU/O+hz9QMgdVAf1aWK1r/5I/AoWBhAeSiMV
|
||||||
|
slToA4oCGlwVqMPWWtXnCfSFm2YKsQNXgqBzlGA6otTLdZo3s1jfgyOaFhbmRshb
|
||||||
|
3jGkxRuDdUmpRJZAfSl/k/0exfN5lRTnaHM/U2WKfPTjQqSZRl4HzHIPMwKBgFVE
|
||||||
|
W0zKClou+Is1oifB9wsmJM+izLiFRPRYviK0raj5k9gpBu3rXMRBt2VOsek6nk+k
|
||||||
|
ZFIFcuA0Txo99aKHe74U9PkxBcDMlEnw5Z17XYaTj/ALFyKnl8HRzf9RNxg99xYh
|
||||||
|
tiJYv+ogf7JcxvKQM4osYkkJN5oJPgiLaOpqjo23AoGBAN3g5kvsYj3OKGh89pGk
|
||||||
|
osLeL+NNUBDvFsrvFzPMwPGDup6AB1qX1pc4RfyQGzDJqUSTpioWI5v1O6Pmoiak
|
||||||
|
FO0u08Tb/091Bir5kgglUSi7VnFD3v8ffeKpkkJvtYUj7S9yoH9NQPVhKVCq6mna
|
||||||
|
TbGfXbnVfNmqgQh71+k02p6S
|
||||||
|
-----END PRIVATE KEY-----
|
Loading…
Reference in New Issue
Block a user