echo server example

cabal.project

@@ -1,6 +1,7 @@
 packages:
   argo/
   python/
+  file-echo-api/
   cryptol-remote-api/
   saw-remote-api/
   tasty-script-exitcode/

file-echo-api/CHANGELOG.md

@@ -0,0 +1,7 @@
+# Revision history for file-echo-api
+
+## 0.1.0.0 -- 2020-10-09
+
+* First version. Released on an unsuspecting world. A simple echo server which
+  can load files on disk and send their contents (all or a portion) back
+  to the client.

file-echo-api/README.rst

@@ -0,0 +1,48 @@
+``file-echo-api``
+=================
+
+A simple example usage of Argo: a JSON-RPC "file echo server" which can load files on disk and send their contents back to the client.
+
+Commands
+--------------------------
+
+* ``load``
+
+  * Loads a file into the echo server's memory.  
+  * Parameters
+
+    * ``file path : String``
+
+      * File path describing which file to load.
+
+* ``clear``
+
+  * Clears any loaded file from the server's memory.
+  * No parameters
+
+Queries
+-------------------------
+
+* ``show``
+
+  * Returns the contents of the last loaded file.
+
+  * No required parameters
+  * Optional parameters
+
+    * ``start : Integer``
+
+      * Character index in loaded file to begin showing from, default value ``0``.
+
+    * ``end : Integer``
+
+      * Character index to show up until (but not including), default value is the character length of the currently loaded file minus the ``start`` parameter's value.
+
+
+Files
+-----
+
+* ``src/FileEchoServer.hs`` implements the internals of the server.
+* ``file-echo-api/Main.hs`` defines an Argo executable leveraging the definitions from ``FileEchoServer.hs``.
+* ``test/Test.hs`` a Haskell test runner which executes the python script ``file-echo-tests.py``.
+* ``test-scripts/file-echo-tests.py`` is a python script which leverages the ``argo`` python library to test the file echo server.

file-echo-api/file-echo-api.cabal

@@ -0,0 +1,71 @@
+cabal-version:       2.4
+name:                file-echo-api
+version:             0.1.0.0
+license:             BSD-3-Clause
+license-file:        LICENSE
+author:              Andrew Kent
+maintainer:          [email protected]
+category:            Language
+extra-source-files:  CHANGELOG.md
+data-files:          test-scripts/**/*.py
+                     test-scripts/**/*.txt
+
+common warnings
+  ghc-options:
+    -Weverything
+    -Wno-missing-exported-signatures
+    -Wno-missing-import-lists
+    -Wno-missed-specialisations
+    -Wno-all-missed-specialisations
+    -Wno-unsafe
+    -Wno-safe
+    -Wno-missing-local-signatures
+    -Wno-monomorphism-restriction
+    -Wno-implicit-prelude
+
+common deps
+  build-depends:
+    base                 >=4.11.1.0 && <4.15,
+    argo,
+    aeson                >= 1.4.2,
+    base64-bytestring    >= 1.0,
+    bytestring           ^>= 0.10.8,
+    containers           >=0.5.11 && <0.7,
+    directory            ^>= 1.3.1,
+    filepath             ^>= 1.4,
+    lens                 >= 4.17 && < 4.20,
+    scientific           ^>= 0.3,
+    text                 ^>= 1.2.3,
+    unordered-containers ^>= 0.2,
+    vector               ^>= 0.12,
+
+  default-language:    Haskell2010
+
+library
+  import:              deps, warnings
+  hs-source-dirs:      src
+
+  exposed-modules:
+    FileEchoServer
+
+executable file-echo-api
+  import:              deps, warnings
+  main-is:             Main.hs
+  hs-source-dirs:      file-echo-api
+
+  build-depends:
+    file-echo-api
+
+test-suite test-file-echo-api
+  import:              deps, warnings
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Test.hs
+  other-modules:       Paths_file_echo_api
+  build-depends:
+    argo-python,
+    file-echo-api,
+    quickcheck-instances ^>= 0.3.19,
+    tasty                 >= 1.2.1,
+    tasty-quickcheck     ^>= 0.10,
+    tasty-script-exitcode

file-echo-api/file-echo-api/Main.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Main ( main ) where
+
+import qualified Data.Aeson as JSON
+import           Data.ByteString ( ByteString )
+import Data.Text (Text)
+
+import qualified Argo as Argo
+import Argo.DefaultMain ( defaultMain )
+
+
+import qualified FileEchoServer as FES
+
+main :: IO ()
+main =
+  do theApp <- Argo.mkApp mkInitState serverMethods
+     defaultMain description theApp
+
+description :: String
+description =
+  "An RPC server for loading and printing files."
+
+mkInitState :: (FilePath -> IO ByteString) -> IO FES.ServerState 
+mkInitState = const $ FES.initialState
+
+serverMethods :: [(Text, Argo.MethodType, JSON.Value -> Argo.Method FES.ServerState JSON.Value)]
+serverMethods =
+  [ ("load",           Argo.Command,   Argo.method FES.loadCmd)
+  , ("clear",          Argo.Command,   Argo.method FES.clearCmd)
+  , ("show",           Argo.Query,     Argo.method FES.showCmd)
+  ]

file-echo-api/src/FileEchoServer.hs

@@ -0,0 +1,120 @@
+{-# LANGUAGE OverloadedStrings #-}
+module FileEchoServer ( module FileEchoServer ) where
+
+import qualified Argo as Argo
+import           Control.Monad.IO.Class ( liftIO )
+import qualified Data.Aeson as JSON
+import           Data.Aeson ( (.:), (.:?), (.=), (.!=) )
+import           Data.ByteString ( ByteString )
+import qualified Data.ByteString.Char8 as Char8
+import qualified Data.Text as T
+import qualified System.Directory as Dir
+
+newtype FileContents = FileContents String
+
+data ServerState = ServerState 
+  { loadedFile :: Maybe FilePath
+  -- ^ Loaded file (if any).
+  , fileContents :: FileContents
+  -- ^ Current file contents, or "" if one has not been loaded yet.
+  }
+
+initialState :: IO ServerState
+initialState = pure $ ServerState Nothing (FileContents "")
+
+newtype ServerErr = ServerErr String
+newtype ServerRes a = ServerRes (Either ServerErr (a,FileContents))
+newtype ServerCmd a = 
+  ServerCmd (((FilePath -> IO ByteString), FileContents) -> IO (ServerRes a))
+
+
+------------------------------------------------------------------------
+-- Command Execution
+
+runServerCmd :: ServerCmd a -> Argo.Method ServerState a
+runServerCmd (ServerCmd cmd) =
+    do s <- Argo.getState
+       reader <- Argo.getFileReader
+       out <- liftIO $ cmd (reader, fileContents s)
+       case out of
+         ServerRes (Left (ServerErr message)) ->
+           Argo.raise $ Argo.makeJSONRPCException
+            11000 "File Server exception"
+            (Just (JSON.object ["error" .= message]))
+         ServerRes (Right (x, newFileContents)) ->
+           do Argo.setState (s { fileContents = newFileContents})
+              return x
+
+
+------------------------------------------------------------------------
+-- Errors
+
+fileNotFound :: FilePath -> Argo.JSONRPCException
+fileNotFound fp =
+  Argo.makeJSONRPCException
+    20051 (T.pack ("File doesn't exist: " <> fp))
+    (Just (JSON.object ["path" .= fp]))
+
+------------------------------------------------------------------------
+-- Load Command
+
+data LoadParams = LoadParams FilePath
+
+instance JSON.FromJSON LoadParams where
+  parseJSON =
+    JSON.withObject "params for \"load\"" $
+    \o -> LoadParams <$> o .: "file path"
+
+loadCmd :: LoadParams -> Argo.Method ServerState ()
+loadCmd (LoadParams file) =
+  do exists <- liftIO $ Dir.doesFileExist file
+     if exists
+     then do getFileContents <- Argo.getFileReader
+             contents <- liftIO $ getFileContents file
+             Argo.setState $ ServerState 
+              { loadedFile = Just file
+              , fileContents = FileContents $ Char8.unpack contents
+              }
+     else Argo.raise (fileNotFound file)
+
+
+------------------------------------------------------------------------
+-- Clear Command
+
+data ClearParams = ClearParams
+
+instance JSON.FromJSON ClearParams where
+  parseJSON =
+    JSON.withObject "params for \"show\"" $
+    \o -> pure ClearParams
+
+clearCmd :: ClearParams -> Argo.Method ServerState ()
+clearCmd _ =
+  do Argo.setState $ ServerState
+      { loadedFile = Nothing
+      , fileContents = FileContents ""
+      }
+
+-- Substring ------------------------------------------------------------
+
+data ShowParams = ShowParams
+  { showStart :: Int
+    -- ^ Inclusive start index in contents.
+  , showEnd :: Maybe Int
+  -- ^ Exclusive end index in contents.
+  }
+
+instance JSON.FromJSON ShowParams where
+  parseJSON =
+    JSON.withObject "params for \"show\"" $
+    \o -> do start <- o .:? "start" .!= 0
+             end <- o   .:? "end"
+             pure $ ShowParams start end
+
+showCmd :: ShowParams -> Argo.Method ServerState JSON.Value
+showCmd (ShowParams start end) =
+  do (FileContents contents) <-  fileContents <$> Argo.getState
+     let len = case end of
+                Nothing -> length contents
+                Just idx -> idx - start 
+     pure (JSON.object [ "value" .= (JSON.String $ T.pack $ take len $ drop start contents)])