servant-jsonrpc-server (empty) → 1.0.0

raw patch · 4 files changed

+106/−0 lines, 4 filesdep +aesondep +basedep +mtlsetup-changed

Dependencies added: aeson, base, mtl, servant, servant-jsonrpc, servant-server

Files

• Setup.hs +2/−0
• changelog.md +3/−0
• servant-jsonrpc-server.cabal +36/−0
• src/Servant/Server/JsonRpc.hs +65/−0

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

@@ -0,0 +1,3 @@+# 1.0.0++First release

@@ -0,0 +1,36 @@+cabal-version:       2.4++name:                servant-jsonrpc-server+version:             1.0.0+author:              Ian Shipman <ics@gambolingpangolin.com>+maintainer:          Ian Shipman <ics@gambolingpangolin.com>++synopsis:            JSON-RPC servant servers+description:+    Use this package to define a servant server which exposes JSON-RPC over HTTP endpoints.++homepage:            https://github.com/GambolingPangolin/servant-jsonrpc+license:             ISC+category:            Web+build-type:          Simple++extra-source-files:  changelog.md++source-repository head+  type:     git+  location: https://github.com/GambolingPangolin/servant-jsonrpc.git++library+  default-language:    Haskell2010+  hs-source-dirs:      src++  exposed-modules:+    Servant.Server.JsonRpc++  build-depends:+      aeson                 >= 1.3          && < 2.0+    , base                  >= 4.11         && < 4.13+    , mtl                   >= 2.2          && < 2.3+    , servant               >= 0.14         && < 0.17+    , servant-jsonrpc       >= 1.0          && < 1.1+    , servant-server        >= 0.14         && < 0.17

@@ -0,0 +1,65 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module: Servant.Server.JsonRpc+--+-- This module provides support for writing handlers for JSON-RPC endpoints+--+-- > type Mul = JsonRpcEndpoint "mul" (Int, Int) String Int+-- > mulHandler :: (Int, Int) -> Handler (Either (JsonRpcErr String) Int)+-- > mulHandler = _+-- >+-- > server :: Application+-- > server = serve (Proxy @Mul) mulHandler+module Servant.Server.JsonRpc+    ( module Servant.JsonRpc+    ) where+++import           Control.Monad.Error.Class (throwError)+import           Data.Aeson                (FromJSON, ToJSON)+import           Data.Proxy                (Proxy (..))+import           GHC.TypeLits              (KnownSymbol)+import           Servant.API               (NoContent)+import           Servant.Server            (HasServer (..), err400)++import           Servant.JsonRpc++instance (KnownSymbol method, FromJSON p, ToJSON e, ToJSON r)+    => HasServer (JsonRpc method p e r) context where++    type ServerT (JsonRpc method p e r) m = p -> m (Either (JsonRpcErr e) r)++    route _ cx = route endpoint cx . fmap f+        where+        f x (Request _ p (Just ix)) = g ix <$> x p+        f _ _                       = throwError err400+        g ix (Right r) = Result ix r+        g ix (Left e)  = Errors (Just ix) e++        endpoint = Proxy @(JsonRpcEndpoint (JsonRpc method p e r))++    hoistServerWithContext _ _ f x p = f $ x p+++instance (KnownSymbol method, FromJSON p)+    => HasServer (JsonRpcNotification method p) context where++    type ServerT (JsonRpcNotification method p) m = p -> m NoContent++    route _ cx = route endpoint cx . fmap f+        where+        f x (Request _ p _) = x p+        endpoint = Proxy @(JsonRpcEndpoint (JsonRpcNotification method p))++    hoistServerWithContext _ _ f x p = f $ x p