WIP: partially implemented runGemServer

gemserv.cabal

@@ -32,6 +32,7 @@ library
   build-depends:
       base >=4.7 && <5
     , bytestring >=0.10.12.0 && <0.11
+    , network
     , tcp-streams >=1.0.1.1 && <1.1
     , text >=1.2.4.1 && <1.3
     , tls
@@ -53,6 +54,7 @@ test-suite gemserv-test
     , bytestring >=0.10.12.0 && <0.11
     , gemserv
     , hspec >=2.7.10 && <2.8
+    , network
     , tcp-streams >=1.0.1.1 && <1.1
     , text >=1.2.4.1 && <1.3
     , tls

package.yaml

@@ -27,6 +27,7 @@ dependencies:
 - bytestring >= 0.10.12.0 && < 0.11
 - tcp-streams >= 1.0.1.1 && < 1.1
 - text >= 1.2.4.1 && < 1.3
+- network
 - tls
 - x509
 

src/Network/GemServ.hs

@@ -27,12 +27,14 @@ License along with this program.  If not, see
 {-# LANGUAGE LambdaCase, OverloadedStrings, RecordWildCards #-}
 
 module Network.GemServ (
+  runGemServer,
   encodeGemURL,
   decodeGemURL,
   escapeString,
   unescapeString
 ) where
 
+import Control.Exception.Base (bracket)
 import qualified Data.ByteString as BS
 import Data.ByteString.Builder (charUtf8, stringUtf8, toLazyByteString)
 import qualified Data.ByteString.Lazy as BSL
@@ -41,9 +43,26 @@ import Data.List (find, intercalate)
 import Data.Maybe (fromJust)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8')
+import Network.Socket (close)
+import System.IO.Streams.TCP (bindAndListen)
 
 import Network.GemServ.Types
 
+-- | Builds and runs a Gemini server
+runGemServer
+  :: GemServSettings
+  -- ^ The server settings
+  -> GemHandler
+  -- ^ The handler
+  -> IO ()
+runGemServer settings _ = bracket
+  ( bindAndListen
+    (servConnections settings)
+    (fromIntegral $ servPort settings)
+  )
+  close
+  undefined
+
 -- | Encodes a 'GemURL' into a 'String'
 encodeGemURL :: GemURL -> String
 encodeGemURL url =

src/Network/GemServ/Types.hs

@@ -25,11 +25,22 @@ License along with this program.  If not, see
 -}
 
 module Network.GemServ.Types (
+  -- * Types
   GemURL (..),
-  newGemURL
+  GemRequest (..),
+  GemResponse (..),
+  GemHandler,
+  GemServSettings (..),
+  -- * Constructors
+  newGemURL,
+  newGemRequest,
+  newGemResponse,
+  newGemServSettings
 ) where
 
-import Data.Word (Word32)
+import qualified Data.ByteString as BS
+import Data.Word (Word8, Word16, Word32)
+import Data.X509 (Certificate)
 
 -- | Gemini URL
 data GemURL = GemURL
@@ -43,6 +54,41 @@ data GemURL = GemURL
   -- ^ The decoded request query (if supplied)
   } deriving (Eq, Show)
 
+-- | Describes a Gemini request
+data GemRequest = GemRequest
+  { reqURL :: GemURL
+  -- ^ The URL being requested
+  , reqCert :: Maybe Certificate
+  -- ^ The client certificate (if available)
+  } deriving (Eq, Show)
+
+-- | Describes a response to a Gemini request
+data GemResponse = GemResponse
+  { respStatus :: Word8
+  -- ^ The response status code
+  , respMeta :: String
+  -- ^ The response metadata
+  , respBody :: Maybe BS.ByteString
+  -- ^ The response body
+  } deriving (Eq, Show)
+
+-- | Handles a 'GemRequest' to produce a 'GemResponse'
+type GemHandler = GemRequest -> IO 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'
 newGemURL
   :: String
@@ -55,4 +101,39 @@ newGemURL host = GemURL
   , gemQuery = Nothing
   }
 
+-- | Builds a 'GemRequest'
+newGemRequest
+  :: GemURL
+  -- ^ The request URL
+  -> GemRequest
+newGemRequest url = GemRequest
+  { reqURL  = url
+  , reqCert = Nothing
+  }
+
+-- | Builds a 'GemResponse'
+newGemResponse :: GemResponse
+newGemResponse = GemResponse
+  { respStatus = 20
+  , respMeta   = "text/gemini"
+  , 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