packages feed

ficketed (empty) → 0.1.0.0

raw patch · 6 files changed

+297/−0 lines, 6 filesdep +MissingHdep +asyncdep +base

Dependencies added: MissingH, async, base, binary, blaze-html, bytestring, containers, directory, http-types, mime-types, optparse-applicative, socketed, text, wai, wai-app-static, warp

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2017 sen.cenan@gmail.com++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Main.hs view
@@ -0,0 +1,89 @@+module Main where++import Control.Applicative (optional)++import Data.Semigroup ((<>))++import qualified Options.Applicative as Opt++import Network.Socketed.Internal (withStdinPassthrough)+import Network.Socketed.Application.Ficketed (+      FicketedOptions(..), runFicketedServer+   )++import System.IO (hFlush, stdout)++params :: Opt.Parser FicketedOptions+params = FicketedOptions+   <$> optional (+         Opt.argument Opt.str+         ( Opt.help "directory to host"+         <> Opt.metavar "PATH")+      )+   <*> Opt.option Opt.auto+      ( Opt.long "port"+      <> Opt.short 'p'+      <> Opt.help "port number the server will be running on"+      <> Opt.showDefault+      <> Opt.value 3001+      <> Opt.metavar "INT" )+   <*> Opt.strOption+      ( Opt.long "bind"+      <> Opt.short 'b'+      <> Opt.help "host ip the server will be bind to"+      <> Opt.showDefault+      <> Opt.value "0.0.0.0"+      <> Opt.metavar "STRING" )+   <*> Opt.option Opt.auto+      ( Opt.long "wsport"+      <> Opt.short 'w'+      <> Opt.help "port of the socketed server"+      <> Opt.showDefault+      <> Opt.value 3000+      <> Opt.metavar "INT" )+   <*> Opt.strOption+      ( Opt.long "wsbind"+      <> Opt.short 's'+      <> Opt.help "host of the socketed server"+      <> Opt.showDefault+      <> Opt.value "0.0.0.0"+      <> Opt.metavar "STRING")+   <*> Opt.strOption+      ( Opt.long "skipedMimes"+      <> Opt.short 'x'+      <> Opt.help "skip update script for mime types listed in this list"+      <> Opt.showDefault+      <> Opt.value "text/css"+      <> Opt.metavar "COMMA SEPERATED LIST")+   <*> Opt.strOption+      ( Opt.long "extraMimes"+      <> Opt.short 'e'+      <> Opt.help "additional mime types to be subject for refreshing"+      <> Opt.showDefault+      <> Opt.value "application/json,application/x-sh"+      <> Opt.metavar "COMMA SEPERATED LIST")+   <*> Opt.strOption+      ( Opt.long "htmlMimes"+      <> Opt.short 'l'+      <> Opt.help "mime types that will not have escape html performed"+      <> Opt.showDefault+      <> Opt.value "text/html,text/javascipt"+      <> Opt.metavar "COMMA SEPERATED LIST")+   <*> Opt.strOption+      ( Opt.long "textExts"+      <> Opt.short 't'+      <> Opt.help "additional file extensions to be treated as text/plain"+      <> Opt.showDefault+      <> Opt.value "md,yaml"+      <> Opt.metavar "COMMA SEPERATED LIST")++main :: IO ()+main = putStrLn "\n" >> hFlush stdout -- kick off socketed server+      >> Opt.execParser opts >>= withStdinPassthrough . runFicketedServer+   where+      opts = Opt.info (Opt.helper <*> params)+         (+            Opt.fullDesc+            <> Opt.progDesc "ficketed"+            <> Opt.header "ficketed"+         )
+ Network/Socketed/Application/Ficketed.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Socketed.Application.Ficketed (+      FicketedOptions(..), runFicketedServer, mimeLookup+   ) where++import Data.ByteString (ByteString, isPrefixOf)+import Data.ByteString.Char8 (pack, unpack)+import Data.ByteString.Lazy (toStrict)+import Data.Binary.Builder (+      fromByteString, toLazyByteString, putStringUtf8+   )+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8)+import Data.Maybe (fromMaybe)+import Data.Map.Strict (insert)+import Data.String.Utils (split)++import Network.Mime (+      FileName, MimeType,+      defaultMimeLookup, defaultMimeMap, mimeByExt+   )+import Network.HTTP.Types (Header)++import Network.Wai (+      Middleware, Response, StreamingBody,+      mapResponseHeaders, responseToStream, responseStream, rawPathInfo+   )+import Network.Wai.Application.Static (+      defaultFileServerSettings, staticApp, ssIndices+   )+import Network.Wai.Handler.Warp (run)++import System.Directory (getCurrentDirectory)++import Text.Blaze.Html5 (text)+import Text.Blaze.Html.Renderer.String (renderHtml)++import Network.Socketed.Application.Ficketed.Internal (FicketedOptions(..))+import Network.Socketed.Application.Ficketed.Template (refreshHtml)++coerceHeaders :: Response -> Response+coerceHeaders = mapResponseHeaders (map f)+   where+      f :: Header -> Header+      f ("Content-Type", _) = ("Content-Type", "text/html")+      f h = h++rewriteHTML :: FicketedOptions -> ByteString -> StreamingBody -> StreamingBody+rewriteHTML opts path sbody send flush+   = sbody send flush+   >> send (fromByteString . pack . refreshHtml (unpack path) $ opts)+   >> flush++rewriteText :: FicketedOptions -> ByteString -> StreamingBody -> StreamingBody+rewriteText opts path sbody send flush+   = send (fromByteString "<pre>")+   >> sbody+      (send+         . putStringUtf8+         . renderHtml+         . text+         . decodeUtf8+         . toStrict+         . toLazyByteString)+      flush+   >> send (fromByteString "</pre>")+   >> send (fromByteString . pack .refreshHtml (unpack path) $ opts)+   >> flush++mimeLookup :: FicketedOptions -> FileName -> MimeType+mimeLookup opts fn = mimeByExt mimeMap (defaultMimeLookup fn) fn+   where+      f m e = insert (T.pack e) "text/plain" m+      mimeMap = foldl f defaultMimeMap $ split "," $ textExts opts++shouldRewrite :: FicketedOptions -> MimeType -> Bool+shouldRewrite (FicketedOptions _ _ _ _ _ x e _ _) m =+   ("text/" `isPrefixOf` m || m `elem` extra)+   && unpack m `notElem` skipped+      where+         skipped = split "," x+         extra = map pack $ split "," e++wrap :: FicketedOptions -> Middleware+wrap opts app req respond = app req f where+   m = mimeLookup opts . decodeUtf8 . rawPathInfo $ req+   f res =+      case () of+      _+         | shouldRewrite opts m ->+            let+               (s, hs, wb) = responseToStream . coerceHeaders $ res+               hMimes = map pack $ split "," (htmlMimes opts)+               rewrite = if m `elem` hMimes then rewriteHTML else rewriteText+            in+               wb+                  $ respond+                  . responseStream s hs+                  . rewrite opts (rawPathInfo req)+         | otherwise -> respond res++runFicketedServer :: FicketedOptions -> IO ()+runFicketedServer opts@(FicketedOptions d p _ _ _ _ _ _ _) = do+   pwd <- getCurrentDirectory+   run p+      $ wrap opts+      $ staticApp (defaultFileServerSettings $ fromMaybe pwd d) {+            ssIndices = [] -- disable auto index+         }
+ Network/Socketed/Application/Ficketed/Internal.hs view
@@ -0,0 +1,13 @@+module Network.Socketed.Application.Ficketed.Internal where++data FicketedOptions = FicketedOptions {+      dir :: Maybe String,+      port :: Int,+      host :: String,+      wsPort :: Int,+      wsHost :: String,+      skippedMimes :: String,+      extraMimes :: String,+      htmlMimes :: String,+      textExts :: String+   }
+ Network/Socketed/Application/Ficketed/Template.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE QuasiQuotes #-}++module Network.Socketed.Application.Ficketed.Template (refreshHtml) where++import Network.Socketed.Internal (showWSHost, stringQuote)+import Network.Socketed.Template (socketedScript)+import Network.Socketed.Application.Ficketed.Internal (FicketedOptions(..))++refreshHtml :: String -> FicketedOptions -> String+refreshHtml path (FicketedOptions _ _ _ wp wh _ _ _ _) = socketedScript+   (showWSHost wh wp)+   0+   (+      [stringQuote|+         function(event) {+      |]+      ++ "var path ='" ++ path ++ "';" +++      [stringQuote|+            if (event.data === path || '/' + event.data === path) {+               window.location.reload();+            }+         }+      |]+   )+   [stringQuote| function(e) { console.error(e); } |]
+ ficketed.cabal view
@@ -0,0 +1,40 @@+name: ficketed+version: 0.1.0.0++synopsis: update statically hosted file in a push stule through socketed+description: update statically hosted file in a push stule through socketed++license: MIT+license-file: LICENSE+author: sen.cenan@gmail.com+maintainer: sen.cenan@gmail.com++category: Web+build-type: Simple+cabal-version: >=1.10++executable ficketed+  main-is: Main.hs+  default-language: Haskell2010+  build-depends:+    base >=4.9 && <4.10,+    containers >= 0.5.7.1,+    async >= 2.1.1,+    binary >= 0.8.3.0,+    bytestring >= 0.10.8.1,+    directory >= 1.2.6.2,+    mime-types >= 0.1.0.7,+    text >= 1.2.2.1,+    blaze-html >= 0.9.0.1,+    http-types >= 0.9.1,+    wai >= 3.2.1.1,+    wai-app-static >= 3.1.6.1,+    warp >= 3.2.11.1,+    socketed >= 0.1.0.0,+    optparse-applicative >= 0.13.2.0,+    MissingH >= 1.4.0.1+  ghc-options: -threaded+  other-modules:+    Network.Socketed.Application.Ficketed,+    Network.Socketed.Application.Ficketed.Internal,+    Network.Socketed.Application.Ficketed.Template