eros-http (empty) → 0.5.0.0

raw patch · 5 files changed

+204/−0 lines, 5 filesdep +aesondep +basedep +blaze-htmlsetup-changed

Dependencies added: aeson, base, blaze-html, bytestring, eros, http-types, markdown, text, wai, wai-responsible, warp

Files

• LICENSE +30/−0
• README.md +49/−0
• Setup.hs +2/−0
• eros-http.cabal +43/−0
• src/Main.hs +80/−0

@@ -0,0 +1,30 @@+Copyright (c) 2014, Peter Harpending++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Peter Harpending nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,49 @@+# eros-http++This is an HTTP front-end to the+[Eros library](https://github.com/pharpend/eros). Eros is a text censorship+library, that I wrote.++# Usage++If the server receives a GET request, it returns an HTML representation of this+file.++It takes an input string via POST, and returns some data in JSON mapping each+phraselist to the score for the input string. The JSON is compressed.++I fed the server the GPL, here are the results, which have been prettified, and+alphabetized by key.++```json+{+  "chat": 0,+  "conspiracy": 0,+  "drug-advocacy": 0,+  "forums": 0,+  "gambling": 0,+  "games": 0,+  "gore": 0,+  "id-theft": 0,+  "illegal-drugs": 0,+  "intolerance": 0,+  "legal-drugs": 0,+  "malware": 0,+  "music": 0,+  "news": 0,+  "nudism": 0,+  "peer2peer": 0,+  "personals": 0,+  "pornography": 20,+  "proxies": 0,+  "secret-societies": 0,+  "self-labeling": 0,+  "sport": 30,+  "translation": 0,+  "upstream-filter": 0,+  "violence": 0,+  "warez-hacking": 0,+  "weapons": 0,+  "webmail": 0+}+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,43 @@+-- Initial eros-http.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                eros-http+version:             0.5.0.0+synopsis:            JSON HTTP interface to Eros.+description:         +  This is a small program that runs an HTTP server.+homepage:            https://eros.rockywestlabs.com/+license:             BSD3+license-file:        LICENSE+author:              Peter Harpending+maintainer:          Peter Harpending <pharpend2@gmail.com>+copyright:           2014, Peter Harpending+category:            Text+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10+data-files:+  README.md++executable eros-http+  main-is:             Main.hs+  other-modules:       Paths_eros_http+  -- other-extensions:    +  build-depends:+      aeson           >=0.7   && <0.8+    , base            >=4.7   && <4.8+    , blaze-html      >=0.7   && <0.8+    , bytestring      >=0.10  && <0.11+    , eros            >=0.5.3 && <0.6+    , http-types      >=0.8   && <0.9+    , markdown        >=0.1   && <0.2+    , text            >=1.1   && <1.2+    , wai             >=3.0   && <3.1+    , wai-responsible >=0.0   && <0.1+    , warp            >=3.0   && <3.1+  hs-source-dirs:      src/+  default-language:    Haskell2010+  ghc-options:+    -O2+    -Wall+    -fno-warn-orphans

@@ -0,0 +1,80 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module       : Main+-- Description  : Runs the Eros HTTP server.+-- Copyright    : 2014, Peter Harpending.+-- License      : BSD3+-- Maintainer   : Peter Harpending <pharpend2@gmail.com>+-- Stability    : experimental+-- Portability  : archlinux+--++module Main where++import           Control.Applicative+import           Data.Aeson+import qualified Data.ByteString.Lazy as Bl+import qualified Data.Text      as Ts+import qualified Data.Text.Lazy as Tl+import           Data.Text.Lazy.Encoding+import           Network.HTTP.Types+import           Network.Wai+import           Network.Wai.Handler.Warp+import qualified Paths_eros_http as Peh+import           Text.Blaze.Html.Renderer.Text+import           Text.Eros+import           Text.Markdown++-- |Run everything+main :: IO ()+main = do+    phraseMaps <- mapM getListPair erosLists+    readmePath <- Peh.getDataFileName "README.md"+    readmeBs   <- Bl.readFile readmePath+    let readmeText = decodeUtf8 readmeBs+        readmeHtml = renderHtml $ markdown def readmeText+        app req recieveResponse = recieveResponse =<< runRequest req phraseMaps readmeHtml+    run 8000 app+  where++    getListPair :: ErosList -> IO (ErosList, PhraseMap)+    getListPair list = do+      phraseMap <- readPhraseMap list+      return (list, phraseMap)++-- |Take the request, generate a response+runRequest :: Request -> [(ErosList, PhraseMap)] -> Tl.Text -> IO Response+runRequest req pmaps readmeText = do+      case requestMethod req of+        "GET" -> do+          return $ htmlResponse $ encodeUtf8 readmeText+        "POST" -> do+          serverInput <- decodeUtf8 <$> Bl.fromStrict <$> requestBody req+          jsonResponse <$> runInput serverInput pmaps+        _ -> do+           errorResponse405 "Method not supported"+    where+      jsonResponse :: Bl.ByteString -> Response+      jsonResponse = responseLBS status200 [(hContentType, "application/json")]+      htmlResponse :: Bl.ByteString -> Response+      htmlResponse = responseLBS status200 [(hContentType, "text/html")]+      errorResponse405 :: Bl.ByteString -> IO Response+      errorResponse405 = return . responseLBS status405 [(hContentType, "text/plain")]++runInput :: Message -> [(ErosList, PhraseMap)] -> IO Bl.ByteString+runInput txt listsMaps = return lsEncoded+  where lsEncoded      = encode listScoreAlist+        listScoreAlist = object [nom .= tx | (nom, tx) <- zip listNames scores]+        listNames      = map probably lists+        scores         = map (messageScore txt) maps+        lists          = [v | (v, _) <- listsMaps]+        maps           = [m | (_, m) <- listsMaps]++probably :: ErosList -> Ts.Text+probably el =+  case erosNameByList el of+    Just s -> Tl.toStrict s+    -- No idea how we would get here, but nonetheless, we're doing+    -- a table lookup, so things can go wrong.+    Nothing -> "unknown"