diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+ This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+ 0. Additional Definitions.
+
+ As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+ "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+ An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+ A "Combined Work" is a work produced by combining or linking an
+Application with the Library. The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+ The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+ The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+ 1. Exception to Section 3 of the GNU GPL.
+
+ You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+ 2. Conveying Modified Versions.
+
+ If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+ a) under this License, provided that you make a good faith effort to
+ ensure that, in the event an Application does not supply the
+ function or data, the facility still operates, and performs
+ whatever part of its purpose remains meaningful, or
+
+ b) under the GNU GPL, with none of the additional permissions of
+ this License applicable to that copy.
+
+ 3. Object Code Incorporating Material from Library Header Files.
+
+ The object code form of an Application may incorporate material from
+a header file that is part of the Library. You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+ a) Give prominent notice with each copy of the object code that the
+ Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the object code with a copy of the GNU GPL and this license
+ document.
+
+ 4. Combined Works.
+
+ You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+ a) Give prominent notice with each copy of the Combined Work that
+ the Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the Combined Work with a copy of the GNU GPL and this license
+ document.
+
+ c) For a Combined Work that displays copyright notices during
+ execution, include the copyright notice for the Library among
+ these notices, as well as a reference directing the user to the
+ copies of the GNU GPL and this license document.
+
+ d) Do one of the following:
+
+ 0) Convey the Minimal Corresponding Source under the terms of this
+ License, and the Corresponding Application Code in a form
+ suitable for, and under terms that permit, the user to
+ recombine or relink the Application with a modified version of
+ the Linked Version to produce a modified Combined Work, in the
+ manner specified by section 6 of the GNU GPL for conveying
+ Corresponding Source.
+
+ 1) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (a) uses at run time
+ a copy of the Library already present on the user's computer
+ system, and (b) will operate properly with a modified version
+ of the Library that is interface-compatible with the Linked
+ Version.
+
+ e) Provide Installation Information, but only if you would otherwise
+ be required to provide such information under section 6 of the
+ GNU GPL, and only to the extent that such information is
+ necessary to install and execute a modified version of the
+ Combined Work produced by recombining or relinking the
+ Application with a modified version of the Linked Version. (If
+ you use option 4d0, the Installation Information must accompany
+ the Minimal Corresponding Source and Corresponding Application
+ Code. If you use option 4d1, you must provide the Installation
+ Information in the manner specified by section 6 of the GNU GPL
+ for conveying Corresponding Source.)
+
+ 5. Combined Libraries.
+
+ You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+ a) Accompany the combined library with a copy of the same work based
+ on the Library, uncombined with any other library facilities,
+ conveyed under the terms of this License.
+
+ b) Give prominent notice with the combined library that part of it
+ is a work based on the Library, and explaining where to find the
+ accompanying uncombined form of the same work.
+
+ 6. Revised Versions of the GNU Lesser General Public License.
+
+ The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+ If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/haskoon-salvia.cabal b/haskoon-salvia.cabal
new file mode 100644
--- /dev/null
+++ b/haskoon-salvia.cabal
@@ -0,0 +1,20 @@
+Name: haskoon-salvia
+Version: 0.4.0.2
+Synopsis: Integrating HttpSpec with Haskoon
+Description: Allows to send and receive Http requests using the
+ HttpSpec specifications.
+License: LGPL
+License-file: LICENSE
+Category: Web
+Author: David Leuschner , Dirk Spoeri , Stefan Wehr
+Maintainer: David Leuschner , Dirk Spoeri , Stefan Wehr
+Build-Type: Simple
+Cabal-Version: >= 1.2
+
+Library
+ Hs-Source-Dirs: src
+ GHC-Options: -Wall -fno-warn-name-shadowing -fno-warn-orphans
+ Build-Depends: base >= 4 && < 5, HTTP, bytestring, transformers, hslogger >= 1.1.0,
+ network, haskoon,
+ salvia, salvia-protocol, fclabels, cgi, mtl, monads-fd
+ Exposed-Modules: Factis.Haskoon.WebSalvia
diff --git a/src/Factis/Haskoon/WebSalvia.hs b/src/Factis/Haskoon/WebSalvia.hs
new file mode 100644
--- /dev/null
+++ b/src/Factis/Haskoon/WebSalvia.hs
@@ -0,0 +1,207 @@
+{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeFamilies, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
+{-# LANGUAGE PackageImports #-}
+module Factis.Haskoon.WebSalvia (WebSalvia, salviaMain) where
+
+----------------------------------------
+-- STDLIB
+----------------------------------------
+import Prelude hiding ((.), id, catch)
+
+import Control.Exception (catch, SomeException)
+import Control.Category
+import Control.Monad (liftM, mplus)
+import "transformers" Control.Monad.Trans.State (StateT, evalStateT, gets, put)
+import "transformers" Control.Monad.Trans (MonadIO, liftIO, lift)
+import "transformers" Control.Monad.Trans.Error (Error, noMsg, ErrorT, runErrorT, throwError)
+import qualified "mtl" Control.Monad.Trans as MtlTrans
+import qualified "monads-fd" Control.Monad.State as TfState
+
+import Data.Maybe (fromMaybe)
+
+----------------------------------------
+-- SITE-PACKAGES
+----------------------------------------
+import System.Log.Logger (Priority(..), logM)
+
+import Factis.Haskoon.Web
+import Factis.Haskoon.WebHelper (statusCodeMessageMap)
+
+import Data.Record.Label
+
+import Network.Protocol.Http as Http hiding (server)
+import Network.Protocol.Uri as Uri hiding (host)
+
+import Network.Salvia ( start, defaultConfig, listenOn, Handler(..)
+ , hDefaultEnv, hDumpRequest, hDumpResponse)
+import Network.Salvia.Interface
+import Network.Salvia.Handler.Error
+import Network.Salvia.Handler.Cookie
+
+import Network.Socket (SockAddr(..), PortNumber, inet_addr, NameInfoFlag(..), getNameInfo, getSocketName)
+
+import qualified Network.Protocol.Cookie as Cookie
+import qualified Network.URI as Uri
+import qualified Network.CGI.Cookie as CGI
+
+instance Error () where
+ noMsg = ()
+
+newtype WebSalvia m a = WebSalvia (StateT [String] (ErrorT () m) a)
+ deriving (Monad, MonadIO)
+
+instance MtlTrans.MonadIO m => MtlTrans.MonadIO (WebSalvia m) where
+ liftIO io = WebSalvia (lift (lift (MtlTrans.liftIO io)))
+
+liftWebSalvia :: MonadIO m => m a -> WebSalvia m a
+liftWebSalvia ma = WebSalvia (lift (lift ma))
+
+getHostAndPort :: (MonadIO m, SocketM m) => Maybe String -> m (String, String)
+getHostAndPort mHostHeader =
+ do case mHostHeader of
+ Just s ->
+ let (h, p) = span (/= ':') s
+ in if null p
+ then return (h, "80")
+ else return (h, drop 1 p)
+ Nothing ->
+ do sock <- socket
+ addr <- liftIO $ getSocketName sock
+ (mhost, mport) <- liftIO $ getNameInfo [NI_NAMEREQD] True False addr
+ host <- case mhost of
+ Just h -> return h
+ Nothing -> do (mhost', _) <-
+ liftIO $ getNameInfo [NI_NUMERICHOST] False False addr
+ case mhost' of
+ Just h -> return h
+ Nothing -> return "INVALID_HOST"
+ let port = case mport of
+ Just p -> p
+ Nothing -> "80"
+ return (host, port)
+
+instance (MonadIO m,HttpM' m,BodyM Request m,SendM m,HandleQueueM m,ServerM m,AddressM' m,SocketM m)
+ => Web (WebSalvia m) where
+ type WebRes (WebSalvia m) = ()
+ -- general
+ webDocumentRoot = return "/"
+ webContainerUri =
+ do mHostHeader <- webGetHeader "Host"
+ liftWebSalvia $
+ do (_host, _port) <- getHostAndPort mHostHeader
+ return (Uri.URI "http:" (Just $ Uri.URIAuth "" _host (':' : _port)) "" "" "")
+ webRequestUri =
+ do mHostHeader <- webGetHeader "Host"
+ liftWebSalvia $
+ do _path <- request (getM (path . asUri))
+ _query <- request (getM (query . asUri))
+ _frag <- request (getM (fragment . asUri))
+ (_host, _port) <- getHostAndPort mHostHeader
+ return (Uri.URI "http:" (Just $ Uri.URIAuth "" _host (':' : _port)) _path
+ ('?' : _query) ('#':_frag))
+ webPathInfo =
+ liftWebSalvia $
+ do _path <- request (getM (path . asUri))
+ return _path
+ webMethod =
+ liftWebSalvia $
+ do _method <- request (getM method)
+ return (show _method)
+ webGetBody =
+ liftWebSalvia $
+ do b <- body forRequest
+ return b
+ webGetParams =
+ liftWebSalvia $
+ do params <- request (getM (queryParams . asUri))
+ return [(k,v) | (k, Just v) <- params]
+ webGetHeaders =
+ liftWebSalvia $
+ do _headers <- request (getM headers)
+ return (unHeaders _headers)
+ webGetCookies =
+ liftWebSalvia $
+ do res <- hCookie
+ case res of
+ Just cs -> return [(get Cookie.name c, get Cookie.value c) | c <- Cookie.toList cs]
+ Nothing -> return []
+ -- response
+ webSetStatus i mmsg =
+ liftWebSalvia $
+ do response $ status =: CustomStatus i (fromMaybe "n/a" reason)
+ return ()
+ where reason = mmsg `mplus` lookup i statusCodeMessageMap
+ webSendBSL bsl =
+ liftWebSalvia $
+ do sendBs bsl
+ return ()
+ webSetHeader name value =
+ liftWebSalvia $
+ do response $ Http.header name =: (Just value)
+ return ()
+ webFail msg =
+ do webLog "haskoon-salvia:webFail" ERROR msg
+ liftWebSalvia (hCustomError InternalServerError ("ERROR: " ++ msg))
+ WebSalvia (lift $ throwError ())
+ webSetCookie cgiCookie =
+ liftWebSalvia $
+ do port <- liftM portNum serverAddress
+ let salviaCookie = mapCgiToSalviaCookie port cgiCookie
+ hSetCookie (Cookie.fromList [salviaCookie])
+ where portNum (SockAddrInet p _) = fromIntegral p
+ portNum (SockAddrInet6 p _ _ _) = fromIntegral p
+ portNum _ = -1
+ webUnsetCookie cgiCookie =
+ liftWebSalvia $
+ do hDelCookie name
+ where name = CGI.cookieName cgiCookie
+ webGetRepls = WebSalvia (gets id)
+ webWithRepls repls (WebSalvia cont) =
+ WebSalvia $ do put repls
+ cont
+ webRunFromRq = undefined
+ webLog name prio msg = liftIO (logM name prio msg)
+
+instance ( MtlTrans.MonadIO m, MonadIO m, HttpM' m, BodyM Request m, SendM m, HandleQueueM m
+ , ServerM m,AddressM' m,SocketM m)
+ => WebIO (WebSalvia m)
+
+hHaskoon :: (MonadIO m, HttpM' m, BodyM Request m, SendM m, HandleQueueM m, ServerM m, AddressM' m)
+ => WebSalvia m (WebRes (WebSalvia m)) -> m ()
+hHaskoon (WebSalvia ma) =
+ do _ <- runErrorT (evalStateT ma [])
+ return ()
+
+mapCgiToSalviaCookie :: Int -> CGI.Cookie -> Cookie.Cookie
+mapCgiToSalviaCookie port (CGI.Cookie name value mexpires mdomain mpath secure) =
+ (Cookie.Cookie name value Nothing Nothing False mdomain
+ Nothing (fmap show mexpires) mpath [port] secure 0)
+
+
+instance MtlTrans.MonadIO (Handler p) where
+ liftIO io = Handler (TfState.StateT stfun)
+ where stfun s = do x <- io
+ return (x, s)
+
+salviaMain :: String
+ -> PortNumber
+ -> WebSalvia (Handler ()) (WebRes (WebSalvia (Handler ())))
+ -> IO ()
+salviaMain addrString port fun =
+ do addr <- inet_addr addrString
+ let myHandler =
+ hDefaultEnv $ do hDumpRequest
+ hHaskoon $ fun
+ hDumpResponse
+ let myPayload = ()
+ let myConfig = defaultConfig { listenOn = [ SockAddrInet port addr ] }
+ start myConfig (catchAllExceptions myHandler) myPayload
+ where
+ catchAllExceptions handler =
+ let fun = TfState.runStateT (unHandler handler)
+ in Handler $ TfState.StateT $ \state ->
+ do (_, state') <- fun state
+ return ((), state')
+ `catch` (\(e::SomeException) ->
+ do logM "haskoon-salvia:salviaMain" ERROR
+ ("Uncaught exception in salvia handler: " ++ show e)
+ return ((), state))