{- |
Copyright: 2006, Bjorn Bringert
Copyright: 2009, Henning Thielemann
-}
module Network.MoHWS.Server.Context where

import qualified Network.MoHWS.Server.Options as Options
import qualified Network.MoHWS.Server.Request as ServerRequest
import qualified Network.MoHWS.Configuration as Config
import qualified Network.MoHWS.Logger.Access as AccessLogger
import qualified Network.MoHWS.Logger.Error as ErrorLogger
import qualified Network.MoHWS.HTTP.MimeType as MimeType
import qualified Network.MoHWS.HTTP.Response as Response

import Network.BSD (HostEntry, )
import System.Time (TimeDiff, )


-- * ServerContext

data T ext = Cons
   {
      T ext -> T
options :: Options.T,
      T ext -> T ext
config :: Config.T ext,
      T ext -> HostEntry
hostName :: HostEntry,
      T ext -> Dictionary
mimeTypes :: MimeType.Dictionary,
      T ext -> Handle
errorLogger :: ErrorLogger.Handle,
      T ext -> [Handle]
accessLoggers :: [AccessLogger.Handle]
   }

instance Functor T where
   fmap :: (a -> b) -> T a -> T b
fmap a -> b
f T a
st = Cons :: forall ext.
T
-> T ext -> HostEntry -> Dictionary -> Handle -> [Handle] -> T ext
Cons {
      options :: T
options = T a -> T
forall ext. T ext -> T
options T a
st,
      config :: T b
config = (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (T a -> T b) -> T a -> T b
forall a b. (a -> b) -> a -> b
$ T a -> T a
forall ext. T ext -> T ext
config T a
st,
      hostName :: HostEntry
hostName = T a -> HostEntry
forall ext. T ext -> HostEntry
hostName T a
st,
      mimeTypes :: Dictionary
mimeTypes = T a -> Dictionary
forall ext. T ext -> Dictionary
mimeTypes T a
st,
      errorLogger :: Handle
errorLogger = T a -> Handle
forall ext. T ext -> Handle
errorLogger T a
st,
      accessLoggers :: [Handle]
accessLoggers = T a -> [Handle]
forall ext. T ext -> [Handle]
accessLoggers T a
st
   }


-- * MIME types

getMimeType :: T ext -> FilePath -> String
getMimeType :: T ext -> FilePath -> FilePath
getMimeType T ext
st FilePath
filename =
   let def :: FilePath
def = T ext -> FilePath
forall ext. T ext -> FilePath
Config.defaultType (T ext -> T ext
forall ext. T ext -> T ext
config T ext
st)
   in  FilePath -> (T -> FilePath) -> Maybe T -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
def T -> FilePath
forall a. Show a => a -> FilePath
show (Dictionary -> FilePath -> Maybe T
MimeType.fromFileName (T ext -> Dictionary
forall ext. T ext -> Dictionary
mimeTypes T ext
st) FilePath
filename)

-- * Logging

instance ErrorLogger.HasHandle (T ext) where
   getHandle :: T ext -> Handle
getHandle = T ext -> Handle
forall ext. T ext -> Handle
errorLogger

logAccess :: T ext -> ServerRequest.T body -> Response.T body -> TimeDiff -> IO ()
logAccess :: T ext -> T body -> T body -> TimeDiff -> IO ()
logAccess T ext
st T body
req T body
resp TimeDiff
delay =
    do Request
msg <- T body -> T body -> HostEntry -> TimeDiff -> IO Request
forall body.
T body -> T body -> HostEntry -> TimeDiff -> IO Request
AccessLogger.mkRequest T body
req T body
resp (T ext -> HostEntry
forall ext. T ext -> HostEntry
hostName T ext
st) TimeDiff
delay
       (Handle -> IO ()) -> [Handle] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Handle
l -> Handle -> Request -> IO ()
AccessLogger.log Handle
l Request
msg) (T ext -> [Handle]
forall ext. T ext -> [Handle]
accessLoggers T ext
st)