implemented GemServSettings type and constructor

This commit is contained in:
Jonathan Lamothe 2021-10-28 20:16:54 -04:00
parent 8c50721309
commit f943b50a20

View File

@ -30,15 +30,17 @@ module Network.GemServ.Types (
GemRequest (..), GemRequest (..),
GemResponse (..), GemResponse (..),
GemHandler, GemHandler,
GemServSettings (..),
-- * Constructors -- * Constructors
newGemURL, newGemURL,
newGemRequest, newGemRequest,
newGemResponse, newGemResponse,
newGemServSettings
) where ) where
import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Reader (ReaderT)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.Word (Word8, Word32) import Data.Word (Word8, Word16, Word32)
import Data.X509 (Certificate) import Data.X509 (Certificate)
-- | Gemini URL -- | Gemini URL
@ -74,6 +76,20 @@ data GemResponse = GemResponse
-- | Handles a 'GemRequest' to produce a 'GemResponse' -- | Handles a 'GemRequest' to produce a 'GemResponse'
type GemHandler m = ReaderT GemRequest m GemResponse type GemHandler m = ReaderT GemRequest m GemResponse
-- | The settings required to set up a Gemini server
data GemServSettings = GemServSettings
{ servConnections :: Int
-- ^ Number of simultaneous connections allowed
, servPort :: Word16
-- ^ The server port number
, servCert :: FilePath
-- ^ The path to the server certificate
, servCertChain :: [FilePath]
-- ^ The paths to the chain certificates
, servKey :: FilePath
-- ^ The path to the private key
} deriving (Eq, Show)
-- | Builds a new 'GemURL' -- | Builds a new 'GemURL'
newGemURL newGemURL
:: String :: String
@ -104,4 +120,21 @@ newGemResponse = GemResponse
, respBody = Nothing , respBody = Nothing
} }
-- | Builds a reasonable set of server settings.
newGemServSettings
:: FilePath
-- ^ Path to the server certificate
-> [FilePath]
-- ^ Path to the chain certificates
-> FilePath
-- ^ Path to the private key
-> GemServSettings
newGemServSettings cert chain key = GemServSettings
{ servConnections = 100
, servPort = 1965
, servCert = cert
, servCertChain = chain
, servKey = key
}
--jl --jl