Stability | experimental |
---|---|
Portability | POSIX |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
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 = caserequestSelector
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
:
FileResponse
: file type agnostic file response, takes aByteString
to support both text and binary files.MenuResponse
: a gopher menu (“directory listing”) consisting of a list ofGopherMenuItem
sErrorResponse
: gopher way to show an error (e. g. if a file is not found). AnErrorResponse
results in a menu response with a single entry.
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
- runGopher :: GopherConfig -> (GopherRequest -> IOGopherResponse) -> IO ()
- runGopherPure :: GopherConfig -> (GopherRequest -> GopherResponse) -> IO ()
- runGopherManual :: IO (SocketInet6StreamTCP) -> IO () -> (SocketInet6StreamTCP -> IO ()) -> GopherConfig -> (GopherRequest -> IOGopherResponse) -> IO ()
- dataGopherConfig = GopherConfig {}
- defaultConfig :: GopherConfig
- dataGopherRequest = GopherRequest {}
- dataGopherResponse
- dataGopherMenuItem = ItemGopherFileTypeByteStringByteString (MaybeByteString) (MaybeInteger)
- dataGopherFileType
- typeGopherLogHandler = GopherLogLevel -> GopherLogStr -> IO ()
- dataGopherLogStr
- makeSensitive :: GopherLogStr -> GopherLogStr
- hideSensitive :: GopherLogStr -> GopherLogStr
- dataGopherLogLevel
- classToGopherLogStr a where
- toGopherLogStr :: a -> GopherLogStr
- classFromGopherLogStr a where
- fromGopherLogStr :: GopherLogStr -> a
- setupGopherSocket :: GopherConfig -> IO (SocketInet6StreamTCP)
- gophermapToDirectoryResponse :: RawFilePath -> Gophermap -> GopherResponse
- typeGophermap = [GophermapEntry]
- dataGophermapEntry = GophermapEntryGopherFileTypeByteString (MaybeGophermapFilePath) (MaybeByteString) (MaybeInteger)
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 -> IOGopherResponse) -> 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#
Arguments
:: IO (SocketInet6StreamTCP) | action to set up listening socket |
-> IO () | ready action called after startup |
-> (SocketInet6StreamTCP -> IO ()) | socket clean up action |
-> GopherConfig | server config |
-> (GopherRequest -> IOGopherResponse) | 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.
Necessary information to handle gopher requests
Constructors
GopherConfig | |
Fields
|
defaultConfig :: GopherConfigSource#
Default GopherConfig
describing a server on localhost:70
with no registered log handler.
Requests
Constructors
GopherRequest | |
Fields
|
Instances
ShowGopherRequestSource# | |
Defined in Network.Gopher Methods showsPrec :: Int -> GopherRequest -> ShowS# show :: GopherRequest -> String# showList :: [GopherRequest] -> ShowS# | |
EqGopherRequestSource# | |
Defined in Network.Gopher Methods (==) :: GopherRequest -> GopherRequest -> Bool# (/=) :: GopherRequest -> GopherRequest -> Bool# |
Responses
Constructors
MenuResponse [GopherMenuItem] | gopher menu, wrapper around a list of |
FileResponseByteString | return the given |
ErrorResponseByteString | gopher menu containing a single error with the given |
Instances
ShowGopherResponseSource# | |
Defined in Network.Gopher.Types Methods showsPrec :: Int -> GopherResponse -> ShowS# show :: GopherResponse -> String# showList :: [GopherResponse] -> ShowS# | |
EqGopherResponseSource# | |
Defined in Network.Gopher.Types Methods (==) :: GopherResponse -> GopherResponse -> Bool# (/=) :: GopherResponse -> GopherResponse -> Bool# |
entry in a gopher menu
Constructors
ItemGopherFileTypeByteStringByteString (MaybeByteString) (MaybeInteger) | file type, menu text, selector, server name (optional), port (optional). None of the given |
Instances
ShowGopherMenuItemSource# | |
Defined in Network.Gopher.Types Methods showsPrec :: Int -> GopherMenuItem -> ShowS# show :: GopherMenuItem -> String# showList :: [GopherMenuItem] -> ShowS# | |
EqGopherMenuItemSource# | |
Defined in Network.Gopher.Types Methods (==) :: GopherMenuItem -> GopherMenuItem -> Bool# (/=) :: GopherMenuItem -> GopherMenuItem -> Bool# |
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 |
Instances
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]"
typeGopherLogHandler = 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.
UTF-8 encoded string which may have parts of it marked as sensitive (see makeSensitive
). Use its ToGopherLogStr
, Semigroup
and IsString
instances to construct GopherLogStr
s and FromGopherLogStr
to convert to the commonly used Haskell string types.
Instances
IsStringGopherLogStrSource# | |
Defined in Network.Gopher.Log Methods fromString :: String -> GopherLogStr# | |
MonoidGopherLogStrSource# | |
Defined in Network.Gopher.Log Methods mappend :: GopherLogStr -> GopherLogStr -> GopherLogStr# mconcat :: [GopherLogStr] -> GopherLogStr# | |
SemigroupGopherLogStrSource# | |
Defined in Network.Gopher.Log Methods (<>) :: GopherLogStr -> GopherLogStr -> GopherLogStr# sconcat :: NonEmptyGopherLogStr -> GopherLogStr# stimes :: Integral b => b -> GopherLogStr -> GopherLogStr# | |
ShowGopherLogStrSource# | |
Defined in Network.Gopher.Log Methods showsPrec :: Int -> GopherLogStr -> ShowS# show :: GopherLogStr -> String# showList :: [GopherLogStr] -> ShowS# | |
FromGopherLogStrGopherLogStrSource# | |
Defined in Network.Gopher.Log Methods | |
ToGopherLogStrGopherLogStrSource# | |
Defined in Network.Gopher.Log Methods |
makeSensitive :: GopherLogStr -> GopherLogStrSource#
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 -> GopherLogStrSource#
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.
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
Constructors
GopherLogLevelError | |
GopherLogLevelWarn | |
GopherLogLevelInfo |
Instances
classToGopherLogStr a whereSource#
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.
Methods
toGopherLogStr :: a -> GopherLogStrSource#
Instances
ToGopherLogStrBuilderSource# | |
Defined in Network.Gopher.Log Methods | |
ToGopherLogStrByteStringSource# | |
Defined in Network.Gopher.Log Methods | |
ToGopherLogStrByteStringSource# | |
Defined in Network.Gopher.Log Methods | |
ToGopherLogStrGopherLogLevelSource# | |
Defined in Network.Gopher.Log Methods | |
ToGopherLogStrGopherLogStrSource# | |
Defined in Network.Gopher.Log Methods | |
ToGopherLogStr (SocketAddressInet6)Source# | |
Defined in Network.Gopher.Log Methods | |
ToGopherLogStr [Char]Source# | |
Defined in Network.Gopher.Log Methods toGopherLogStr :: [Char] -> GopherLogStrSource# |
classFromGopherLogStr a whereSource#
Convert GopherLogStr
s to other string types. Since it is used internally by GopherLogStr
, it is best to use the Builder
instance for performance if possible.
Methods
fromGopherLogStr :: GopherLogStr -> a Source#
Instances
FromGopherLogStrBuilderSource# | |
Defined in Network.Gopher.Log Methods | |
FromGopherLogStrByteStringSource# | |
Defined in Network.Gopher.Log Methods | |
FromGopherLogStrByteStringSource# | |
Defined in Network.Gopher.Log Methods | |
FromGopherLogStrGopherLogStrSource# | |
Defined in Network.Gopher.Log Methods | |
FromGopherLogStrTextSource# | |
Defined in Network.Gopher.Log Methods | |
FromGopherLogStrTextSource# | |
Defined in Network.Gopher.Log Methods | |
FromGopherLogStr [Char]Source# | |
Defined in Network.Gopher.Log Methods fromGopherLogStr :: GopherLogStr -> [Char] Source# |
Networking
setupGopherSocket :: GopherConfig -> IO (SocketInet6StreamTCP) 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 Gophermap
s into MenuResponse
s. For parsing gophermap files, refer to Network.Gopher.Util.Gophermap.
gophermapToDirectoryResponse :: RawFilePath -> Gophermap -> GopherResponseSource#
Given a directory and a Gophermap contained within it, return the corresponding gopher menu response.
typeGophermap = [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
GophermapEntryGopherFileTypeByteString (MaybeGophermapFilePath) (MaybeByteString) (MaybeInteger) | file type, description, path, server name, port number |
Instances
ShowGophermapEntrySource# | |
Defined in Network.Gopher.Util.Gophermap Methods showsPrec :: Int -> GophermapEntry -> ShowS# show :: GophermapEntry -> String# showList :: [GophermapEntry] -> ShowS# | |
EqGophermapEntrySource# | |
Defined in Network.Gopher.Util.Gophermap Methods (==) :: GophermapEntry -> GophermapEntry -> Bool# (/=) :: GophermapEntry -> GophermapEntry -> Bool# |