n2o (empty) → 0.11.0

raw patch · 8 files changed

+294/−0 lines, 8 filesdep +basedep +bertdep +binarysetup-changed

Dependencies added: base, bert, binary, bytestring, containers, hspec, n2o, text

Files

LICENSE +30/−0
README.md +0/−0
Setup.hs +2/−0
n2o.cabal +50/−0
src/Network/N2O.hs +30/−0
src/Network/N2O/Core.hs +83/−0
src/Network/N2O/Types.hs +91/−0
test/Spec.hs +8/−0

+ 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.cabal view

@@ -0,0 +1,50 @@+name:           n2o
+version:        0.11.0
+description:    Embeddable Application Protocol Loop
+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:       Abstract Protocol Loop
+
+source-repository head
+  type: git
+  location: https://github.com/xafizoff/n2o
+
+library
+  exposed-modules:
+                  Network.N2O
+                , Network.N2O.Types
+                , Network.N2O.Core
+  other-modules:
+      Paths_n2o
+  hs-source-dirs:
+      src
+  build-depends: base >= 4.7 && < 5
+               , text >= 1.2
+               , bytestring >=0.9
+               , binary >=0.5
+               , containers >= 0.5
+  default-language: Haskell2010
+
+test-suite n2o-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_n2o
+  hs-source-dirs:
+      test
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+                base >=4.7 && < 5
+              , n2o
+              , bert
+              , hspec
+  default-language: Haskell2010

+ src/Network/N2O.hs view

@@ -0,0 +1,30 @@+{-|
+Module      : Network.N2O
+Description : Core of the N2O Framework
+Copyright   : (c) Marat Khafizov, 2018
+License     : BSD-3
+Maintainer  : xafizoff@gmail.com
+Stability   : experimental
+Portability : not portable
+
+This module defines basic types and functions for the N2O Framework.
+
+One of the trickiest part of the client-server applications is the communication
+protocol between client and server. This package aims to provide scalable application
+level infrastructure for protocols and services.
+
+Logically, this package consists of two parts:
+
+  * the 'N2O' monad for local state management;
+  * the 'protoRun' function, that allows to perform abstract protocol loop.
+
+For basic usage see [N2O sample app](https://github.com/xafizoff/n2o/tree/master/samples)
+
+-}
+module Network.N2O
+ ( module Network.N2O.Types
+ , module Network.N2O.Core
+ ) where
+
+import Network.N2O.Types
+import Network.N2O.Core

+ src/Network/N2O/Core.hs view

@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
+{-|
+Module      : Network.N2O.Core
+Description : Core functions
+Copyright   : (c) Marat Khafizov, 2018
+License     : BSD 3-Clause
+Maintainer  : xafizoff@gmail.com
+Stability   : experimental
+Portability : not portable
+
+Core functions
+
+-}
+module Network.N2O.Core (lift, ask, put, get, mkCx, mkReq, protoRun) where
+
+import Data.IORef
+import qualified Data.Map.Strict as M
+import qualified Data.Binary as B
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.Text.Lazy as TL
+import Control.Exception (SomeException)
+import Network.N2O.Types
+import Data.Map.Strict (insert, (!?))
+
+-- | 'Context' constructor
+mkCx = Context
+  { cxReq = undefined
+  , cxHandler = undefined
+  , cxMiddleware = []
+  , cxDePickle = undefined
+  , cxPickle = undefined
+  , cxProtos = []
+  , cxState = M.empty
+  }
+
+-- | 'Req' constructor
+mkReq = Req { reqPath = "/", reqMeth = "GET", reqVers = "HTTP/1.1", reqHead = [] }
+
+-- | NO-OP result
+nop :: Result a
+nop = Empty
+
+-- | N2O protocol loop
+protoRun :: f a -> [Proto f a] -> N2O f a (Result (f a))
+protoRun = loop []
+  where
+    loop _ _ [] = return nop
+    loop acc msg (proto:protos) = do
+      res <- protoInfo proto msg
+      case res of
+        Unknown -> loop acc msg protos
+        Empty -> return Empty
+        Reply msg1 -> return $ Reply msg1
+        a -> loop (a : acc) msg protos
+
+-- | Lift underlying monad to the N2O monad
+lift :: m a -> N2OT state m a
+lift m = N2OT (const m)
+
+-- | Get current state (env)
+ask :: (Monad m) => N2OT state m state
+ask = N2OT return
+
+getContext = do
+  ref <- ask
+  lift $ readIORef ref
+
+-- | Put data to the local state
+put :: (B.Binary bin) => BS.ByteString -> bin -> N2O f a ()
+put k v = do
+  state <- ask
+  lift $ modifyIORef state (\cx@Context{cxState=m} -> cx{cxState=insert k (B.encode v) m})
+
+-- | Get data from the local state
+get :: (B.Binary bin) => BS.ByteString -> N2O f a (Maybe bin)
+get k = do
+  state <- N2OT return
+  cx <- lift $ readIORef state
+  let mp = cxState cx
+  case mp !? k of
+    Just v -> return $ Just (B.decode v)
+    _ -> return Nothing

+ src/Network/N2O/Types.hs view

@@ -0,0 +1,91 @@+{-# LANGUAGE KindSignatures #-}++{-|
+Module      : Network.N2O.Types
+Description : Basic types
+Copyright   : (c) Marat Khafizov, 2018
+License     : BSD-3
+Maintainer  : xafizoff@gmail.com
+Stability   : experimental
+Portability : not portable
+
+Basic types
+
+-}+module Network.N2O.Types where++import qualified Data.Binary as B+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import Data.IORef+import Data.Map.Strict (Map, (!?), insert)+import qualified Data.Text.Lazy as TL++-- | An HTTP header
+type Header = (BS.ByteString, BS.ByteString)++-- | An HTTP request
+data Req = Req+  { reqPath :: BS.ByteString+  , reqMeth :: BS.ByteString+  , reqVers :: BS.ByteString+  , reqHead :: [Header]+  }++-- | The N2O context data type
+-- This is the key data type of the N2O. @(f :: * -> *)@ - type constructor
+-- for the protocol handler's input type. @(a :: *)@ - base type for the
+-- event handler's input type. I.e. @(f a)@ gives input type for the
+-- protocol handler. @(Event a)@ gives input type for the event handler.
+data Context (f :: * -> *) a = Context+  { cxHandler :: Event a -> N2O f a (Result a)+  , cxReq :: Req+  , cxMiddleware :: [Context f a -> Context f a]+  , cxProtos :: [Proto f a]+  , cxDePickle :: BL.ByteString -> Maybe a+  , cxPickle :: a -> BL.ByteString+  , cxState :: Map BS.ByteString BL.ByteString+  }++-- | Result of the message processing
+data Result a+  = Reply a+  | Ok+  | Unknown+  | Empty+  deriving (Show, Eq)++-- | N2O protocol handler
+newtype Proto f a = Proto+  { protoInfo :: f a -> N2O f a (Result (f a))+  }++-- | Event data type
+data Event a+  = Init+  | Message a+  | Terminate++-- | Local mutable state
+type State f a = IORef (Context f a)++-- | 'N2OT' over 'IO' with 'N2OState' as env
+type N2O f a = N2OT (State f a) IO++-- | Reader monad transformer
+newtype N2OT state m a = N2OT+  { runN2O :: state -> m a+  }++instance Functor m => Functor (N2OT state m) where+  fmap f (N2OT g) = N2OT (fmap f . g)++instance Applicative m => Applicative (N2OT state m) where+  pure = N2OT . const . pure+  (N2OT f) <*> (N2OT g) = N2OT $ \state -> f state <*> g state++instance Monad m => Monad (N2OT state m) where+  m >>= k =+    N2OT $ \state -> do+      a <- runN2O m state+      runN2O (k a) state

+ test/Spec.hs view

@@ -0,0 +1,8 @@+{-# LANGUAGE OverloadedStrings #-}
+
+import Test.Hspec
+import Network.N2O.Core
+import Data.BERT
+
+main :: IO ()
+main = return ()