packages feed

n2o-protocols (empty) → 0.11.0

raw patch · 8 files changed

+190/−0 lines, 8 filesdep +basedep +base64-bytestringdep +bertsetup-changed

Dependencies added: base, base64-bytestring, bert, binary, bytestring, containers, n2o, nitro

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Marat Khafizov (c) 2018
+
+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 Marat Khafizov 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.
+ README.md view
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

+ n2o-protocols.cabal view
@@ -0,0 +1,38 @@+name:           n2o-protocols
+version:        0.11.0
+description:    N2O Protocols: Interfaces and Implementations
+homepage:       https://github.com/xafizoff/n2o#readme
+bug-reports:    https://github.com/xafizoff/n2o/issues
+author:         Marat Khafizov
+maintainer:     xafizoff@gmail.com
+copyright:      2018 Marat Khafizov (c)
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+cabal-version:  >= 1.10
+extra-source-files:  README.md
+category:       Network, N2O, Web
+synopsis:       N2O Protocols Starter Pack
+
+source-repository head
+  type: git
+  location: https://github.com/xafizoff/n2o
+
+library
+  exposed-modules: Network.N2O.Protocols
+                 , Network.N2O.Protocols.Types
+                 , Network.N2O.Protocols.Nitro
+                 , Network.N2O.Protocols.Client
+  other-modules:
+      Paths_n2o_protocols
+  hs-source-dirs:
+      src
+  build-depends: base >= 4.7 && < 5
+               , n2o == 0.11.0
+               , nitro == 0.11.0
+               , bytestring >= 0.10
+               , binary >= 0.5
+               , bert >= 1.2
+               , containers >= 0.5
+               , base64-bytestring >= 1.0
+  default-language: Haskell2010

+ src/Network/N2O/Protocols.hs view
@@ -0,0 +1,35 @@+{-|
+Module      : Network.N2O.Protocols
+Description : N2O Protocols Starter
+Copyright   : (c) Marat Khafizov, 2018
+License     : BSD-3
+Maintainer  : xafizoff@gmail.com
+Stability   : experimental
+Portability : not portable
+
+N2O Protocol definitions and implementations, compatible with 
+the [Erlang version of the N2O](https://github.com/synrc/n2o)
+
+For more infomation please check out the [manual](https://haskell.n2o.space/man/protocols.htm)
+
+-}
+module Network.N2O.Protocols
+ ( module Proto
+ , module Network.N2O.Protocols.Nitro
+-- , module Network.N2O.Protocols.Client
+ , createCx) where
+
+import Network.N2O.Types as Types
+import Network.N2O.Protocols.Types as Proto
+import Network.N2O.Core
+import Network.N2O.Nitro
+import Network.N2O.Protocols.Nitro
+
+-- | Create context with specified @router@ middleware
+createCx router = mkCx
+  { cxMiddleware = [router]
+  , cxProtos = [nitroProto]
+  , cxDePickle = defDePickle
+  , cxPickle = defPickle
+  }
+

+ src/Network/N2O/Protocols/Client.hs view
@@ -0,0 +1,2 @@+module Network.N2O.Protocols.Client where
+

+ src/Network/N2O/Protocols/Nitro.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE ScopedTypeVariables #-}
+module Network.N2O.Protocols.Nitro where
+
+import Control.Monad (forM_)
+import qualified Data.Map.Strict as M
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString as BS
+import qualified Data.Binary as B
+import qualified Data.ByteString.Lazy.Char8 as CL8
+import Data.IORef
+import Data.BERT
+import Network.N2O.Core
+import Network.N2O.Types as Types
+import Network.N2O.Nitro
+import Network.N2O.Protocols.Types as Proto
+
+nitroProto :: (Show a, B.Binary a) => Proto N2OProto a
+nitroProto = Proto { protoInfo = nitroInfo }
+
+nitroInfo :: (Show a, B.Binary a) => N2OProto a -> N2O N2OProto a (Result (N2OProto a))
+nitroInfo message = do
+  ref <- ask
+  cx@Context {cxHandler = handle, cxDePickle = dePickle} <- lift $ readIORef ref
+  lift $ putStrLn ("NITRO : " ++ show message)
+  case message of
+    msg@(N2ONitro (Proto.Init pid)) -> do
+      handle Types.Init
+      actions <- getActions
+      rendered <- renderActions' actions
+      return $ Reply (reply rendered)
+    msg@(N2ONitro (Pickle _source pickled linked)) -> do
+      forM_ (M.toList linked) (uncurry put)
+      case dePickle pickled of
+        Just x -> do
+          handle (Message x)
+          actions <- getActions
+          rendered <- renderActions' actions
+          return $ Reply (reply rendered)
+        _ -> return Unknown
+    msg@(N2ONitro Done) -> do
+      handle Terminate
+      return Empty
+  where
+    reply bs = Io bs L.empty
+    renderActions' actions =
+      case actions of
+        [] -> return L.empty
+        actions -> do
+          putActions []
+          first <- renderActions actions
+          actions2 <- getActions
+          second <- renderActions actions2
+          putActions []
+          return $ first <> CL8.pack ";" <> second

+ src/Network/N2O/Protocols/Types.hs view
@@ -0,0 +1,29 @@+module Network.N2O.Protocols.Types where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as L+import qualified Data.Map.Strict as M++-- | Top level sum of protocols
+data N2OProto a+  = N2ONitro (Nitro a)+  | N2OClient (Client a)+  | Io L.ByteString+       L.ByteString+  | Nop+  deriving (Show)++-- | Client protocol message type
+data Client a+  = Cli a+  | Srv a+  deriving (Show)++-- | Nitro protocol message type
+data Nitro a+  = Init L.ByteString+  | Pickle { pickleSource :: L.ByteString+           , picklePickled :: L.ByteString+           , pickleLinked :: M.Map BS.ByteString L.ByteString }+  | Done+  deriving (Show)