spacecookie-1.0.0.2: Gopher server library and daemon
Stabilityexperimental
PortabilityPOSIX
Safe HaskellSafe-Inferred
LanguageHaskell2010

Network.Gopher

Description

Overview

This is the main module of the spacecookie library. It allows to write gopher applications by taking care of handling gopher requests while leaving the application logic to a user-supplied function.

For a small tutorial an example of a trivial pure gopher application:

import Network.Gopher
import Network.Gopher.Util

cfg :: GopherConfig
cfg = defaultConfig
  { cServerName = "localhost"
  , cServerPort = 7000
  }

handler :: GopherRequest -> GopherResponse
handler request =
  case requestSelector request of
    "hello" -> FileResponse "Hello, stranger!"
    "" -> rootMenu
    "/" -> rootMenu
    _ -> ErrorResponse "Not found"
  where rootMenu = MenuResponse
          [ Item File "greeting" "hello" Nothing Nothing ]

main :: IO ()
main = runGopherPure cfg handler

There are three possibilities for a GopherResponse:

If you use runGopher, it is the same story like in the example above, but you can do IO effects. To see a more elaborate example, have a look at the server code in this package.

Synopsis

Main API

The runGopher function variants will generally not throw exceptions, but handle them somehow (usually by logging that a non-fatal exception occurred) except if the exception occurrs in the setup step of runGopherManual.

You'll have to handle those exceptions yourself. To see which exceptions can be thrown by runGopher and runGopherPure, read the documentation of setupGopherSocket.

runGopher :: GopherConfig -> (GopherRequest -> IO GopherResponse) -> IO () Source #

Run a gopher application that may cause effects in IO. The application function is given the GopherRequest sent by the client and must produce a GopherResponse.

runGopherPure :: GopherConfig -> (GopherRequest -> GopherResponse) -> IO () Source #

Like runGopher, but may not cause effects in IO (or anywhere else).

runGopherManual Source #

Arguments

:: IO (Socket Inet6 Stream TCP)

action to set up listening socket

-> IO ()

ready action called after startup

-> (Socket Inet6 Stream TCP -> IO ())

socket clean up action

-> GopherConfig

server config

-> (GopherRequest -> IO GopherResponse)

request handler

-> IO () 

Same as runGopher, but allows you to setup the Socket manually and calls an user provided action soon as the server is ready to accept requests. When the server terminates, it calls the given clean up action which must close the socket and may perform other shutdown tasks (like notifying a supervisor it is stopping).

Spacecookie assumes the Socket is properly set up to listen on the port and host specified in the GopherConfig (i. e. bind and listen have been called). This can be achieved using setupGopherSocket. Especially note that spacecookie does not check if the listening address and port of the given socket match cListenAddr and cServerPort.

This is intended for supporting systemd socket activation and storage, but may also be used to support other use cases where more control is necessary. Always use runGopher if possible, as it offers less ways of messing things up.

data GopherConfig Source #

Necessary information to handle gopher requests

Constructors

GopherConfig 

Fields

defaultConfig :: GopherConfig Source #

Default GopherConfig describing a server on localhost:70 with no registered log handler.

Requests

data GopherRequest Source #

Constructors

GopherRequest 

Fields

Instances

Instances details
Show GopherRequest Source # 
Instance details

Defined in Network.Gopher

Eq GopherRequest Source # 
Instance details

Defined in Network.Gopher

Responses

data GopherResponse Source #

Constructors

MenuResponse [GopherMenuItem]

gopher menu, wrapper around a list of GopherMenuItems

FileResponse ByteString

return the given ByteString as a file

ErrorResponse ByteString

gopher menu containing a single error with the given ByteString as text

Instances

Instances details
Show GopherResponse Source # 
Instance details

Defined in Network.Gopher.Types

Eq GopherResponse Source # 
Instance details

Defined in Network.Gopher.Types

data GopherMenuItem Source #

entry in a gopher menu

Constructors

Item GopherFileType ByteString ByteString (Maybe ByteString) (Maybe Integer)

file type, menu text, selector, server name (optional), port (optional). None of the given ByteStrings may contain tab characters.

Instances

Instances details
Show GopherMenuItem Source # 
Instance details

Defined in Network.Gopher.Types

Eq GopherMenuItem Source # 
Instance details

Defined in Network.Gopher.Types

data GopherFileType Source #

rfc-defined gopher file types plus info line and HTML

Constructors

File

text file, default type

Directory

a gopher menu

PhoneBookServer 
Error

error entry in menu

BinHexMacintoshFile 
DOSArchive 
UnixUuencodedFile 
IndexSearchServer 
TelnetSession 
BinaryFile

binary file

RedundantServer 
Tn3270Session 
GifFile

gif

ImageFile

image of any format

InfoLine

menu entry without associated file

Html

Special type for HTML, most commonly used for links to other protocols

Helper Functions

Logging

Logging may be enabled by providing GopherConfig with an optional GopherLogHandler which implements processing, formatting and outputting of log messages. While this requires extra work for the library user it also allows the maximum freedom in used logging mechanisms.

A trivial log handler could look like this:

logHandler :: GopherLogHandler
logHandler level str = do
  putStr $ show level ++ ": "
  putStrLn $ fromGopherLogStr str

If you only want to log errors you can use the Ord instance of GopherLogLevel:

logHandler' :: GopherLogHandler
logHandler' level str = when (level <= GopherLogLevelError)
  $ logHandler level str

The library marks parts of GopherLogStr which contain user related data like IP addresses as sensitive using makeSensitive. If you don't want to e. g. write personal information to disk in plain text, you can use hideSensitive to transparently remove that information. Here's a quick example in GHCi:

>>> hideSensitive $ "Look at my " <> makeSensitive "secret"
"Look at my [redacted]"

type GopherLogHandler = GopherLogLevel -> GopherLogStr -> IO () Source #

Type for an user defined IO action which handles logging a given GopherLogStr of a given GopherLogLevel. It may process the string and format in any way desired, but it must be thread safe and should not block (too long) since it is called syncronously.

data GopherLogStr Source #

UTF-8 encoded string which may have parts of it marked as sensitive (see makeSensitive). Use its ToGopherLogStr, Semigroup and IsString instances to construct GopherLogStrs and FromGopherLogStr to convert to the commonly used Haskell string types.

makeSensitive :: GopherLogStr -> GopherLogStr Source #

Mark a GopherLogStr as sensitive. This is used by this library mostly to mark IP addresses of connecting clients. By using hideSensitive on a GopherLogStr sensitive parts will be hidden from the string — even if the sensitive string was concatenated to other strings.

hideSensitive :: GopherLogStr -> GopherLogStr Source #

Replaces all chunks of the GopherLogStr that have been marked as sensitive by makeSensitive with [redacted]. Note that the chunking is dependent on the way the string was assembled by the user and the internal implementation of GopherLogStr which can lead to multiple consecutive [redacted] being returned unexpectedly. This may be improved in the future.

data GopherLogLevel Source #

Indicates the log level of a GopherLogStr to a GopherLogHandler. If you want to filter by log level you can use either the Ord or Enum instance of GopherLogLevel as the following holds:

GopherLogLevelError < GopherLogLevelWarn < GopherLogLevelInfo

Instances

Instances details
Enum GopherLogLevel Source # 
Instance details

Defined in Network.Gopher.Log

Show GopherLogLevel Source # 
Instance details

Defined in Network.Gopher.Log

Eq GopherLogLevel Source # 
Instance details

Defined in Network.Gopher.Log

Ord GopherLogLevel Source # 
Instance details

Defined in Network.Gopher.Log

ToGopherLogStr GopherLogLevel Source # 
Instance details

Defined in Network.Gopher.Log

class ToGopherLogStr a where Source #

Convert something to a GopherLogStr. In terms of performance it is best to implement a Builder for the type you are trying to render to GopherLogStr and then reuse its ToGopherLogStr instance.

class FromGopherLogStr a where Source #

Convert GopherLogStrs to other string types. Since it is used internally by GopherLogStr, it is best to use the Builder instance for performance if possible.

Networking

setupGopherSocket :: GopherConfig -> IO (Socket Inet6 Stream TCP) Source #

Auxiliary function that sets up the listening socket for runGopherManual correctly and starts to listen.

May throw a SocketException if an error occurs while setting up the socket.

Gophermaps

Helper functions for converting Gophermaps into MenuResponses. For parsing gophermap files, refer to Network.Gopher.Util.Gophermap.

gophermapToDirectoryResponse :: RawFilePath -> Gophermap -> GopherResponse Source #

Given a directory and a Gophermap contained within it, return the corresponding gopher menu response.

data GophermapEntry Source #

A gophermap entry makes all values of a gopher menu item optional except for file type and description. When converting to a GopherMenuItem, appropriate default values are used.

Constructors

GophermapEntry GopherFileType ByteString (Maybe GophermapFilePath) (Maybe ByteString) (Maybe Integer)

file type, description, path, server name, port number