{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE MultiParamTypeClasses #-}



module Language.Explorer.Tools.Protocol where

import GHC.Generics
import Data.Monoid
import Data.Aeson
import Network.HTTP.Types.Status
import Network.HTTP.Types.Header (hContentType)
import Data.Maybe
import Control.Concurrent (forkFinally)
import qualified Control.Exception as E
import Control.Monad (unless, forever, void)
import qualified Data.ByteString.Lazy as S
import qualified Data.Attoparsec.ByteString.Lazy as AB
import qualified Data.Attoparsec.ByteString.Char8 as ABC
import Network.Socket hiding (recv)
import Network.Socket.ByteString.Lazy (recv, sendAll)
import Data.Scientific
import qualified Language.Explorer.Monadic as Ex
import Control.Monad.RWS.Lazy hiding (listen)
import Control.Monad.Trans.Except
import Data.List

type ExplorerParser p m c o = (Ex.Explorer p m c o, String -> Maybe p)
type ProcessResult = Either ErrorMessage Value

type EIP p m c o = RWST (String -> Maybe p) S.ByteString (Ex.Explorer p m c o) m

class ExplorerPostValue p c o where
    postExecute :: Ex.Explorer p m c o -> Ex.Explorer p m c o -> o -> Value
    postExecute = \Explorer p m c o
_ Explorer p m c o
_ o
_ -> Value
Null
    postJump :: Ex.Explorer p m c o -> Ex.Explorer p m c o -> Value
    postJump = \Explorer p m c o
_ Explorer p m c o
_ -> Value
Null
    postRevert :: Ex.Explorer p m c o -> Ex.Explorer p m c o -> [Ex.Ref] -> Value
    postRevert = \ Explorer p m c o
_ Explorer p m c o
_ [Int]
_ -> Value
Null

data RequestMessage = RequestMessage {
    RequestMessage -> String
jsonrpc :: String,
    RequestMessage -> String
req_id :: String,
    RequestMessage -> String
method :: String,
    RequestMessage -> Maybe Value
params :: Maybe Value
} deriving (Int -> RequestMessage -> ShowS
[RequestMessage] -> ShowS
RequestMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestMessage] -> ShowS
$cshowList :: [RequestMessage] -> ShowS
show :: RequestMessage -> String
$cshow :: RequestMessage -> String
showsPrec :: Int -> RequestMessage -> ShowS
$cshowsPrec :: Int -> RequestMessage -> ShowS
Show, forall x. Rep RequestMessage x -> RequestMessage
forall x. RequestMessage -> Rep RequestMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestMessage x -> RequestMessage
$cfrom :: forall x. RequestMessage -> Rep RequestMessage x
Generic)

instance ToJSON RequestMessage where
    toEncoding :: RequestMessage -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

instance FromJSON RequestMessage where
    parseJSON :: Value -> Parser RequestMessage
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RequestMessage" forall a b. (a -> b) -> a -> b
$ \Object
v -> String -> String -> String -> Maybe Value -> RequestMessage
RequestMessage
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jsonrpc"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"

data ResponseMessage = ResponseMessage {
    ResponseMessage -> String
res_id :: String,
    ResponseMessage -> ProcessResult
body :: ProcessResult
} deriving (Int -> ResponseMessage -> ShowS
[ResponseMessage] -> ShowS
ResponseMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseMessage] -> ShowS
$cshowList :: [ResponseMessage] -> ShowS
show :: ResponseMessage -> String
$cshow :: ResponseMessage -> String
showsPrec :: Int -> ResponseMessage -> ShowS
$cshowsPrec :: Int -> ResponseMessage -> ShowS
Show)

instance ToJSON ResponseMessage where
    toJSON :: ResponseMessage -> Value
toJSON (ResponseMessage String
res_id (Left ErrorMessage
e)) = [Pair] -> Value
object [Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
res_id, Key
"error" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ErrorMessage
e]
    toJSON (ResponseMessage String
res_id (Right Value
res)) = [Pair] -> Value
object [Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
res_id, Key
"result" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
res]

    toEncoding :: ResponseMessage -> Encoding
toEncoding (ResponseMessage String
res_id (Left ErrorMessage
e)) = Series -> Encoding
pairs (Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
res_id forall a. Semigroup a => a -> a -> a
<> Key
"error" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ErrorMessage
e)
    toEncoding (ResponseMessage String
res_id (Right Value
res)) = Series -> Encoding
pairs (Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
res_id forall a. Semigroup a => a -> a -> a
<> Key
"result" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
res)


data ErrorMessage = ErrorMessage {
    ErrorMessage -> Int
code :: Int,
    ErrorMessage -> String
message :: String,
    ErrorMessage -> Maybe Value
error_data :: Maybe Value
} deriving (Int -> ErrorMessage -> ShowS
[ErrorMessage] -> ShowS
ErrorMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorMessage] -> ShowS
$cshowList :: [ErrorMessage] -> ShowS
show :: ErrorMessage -> String
$cshow :: ErrorMessage -> String
showsPrec :: Int -> ErrorMessage -> ShowS
$cshowsPrec :: Int -> ErrorMessage -> ShowS
Show, forall x. Rep ErrorMessage x -> ErrorMessage
forall x. ErrorMessage -> Rep ErrorMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorMessage x -> ErrorMessage
$cfrom :: forall x. ErrorMessage -> Rep ErrorMessage x
Generic)

instance ToJSON ErrorMessage where
    toEncoding :: ErrorMessage -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

instance FromJSON ErrorMessage
    -- No need to provide a parseJSON implementation.

-- instance Except ErrorMessage 
-- where
--     noMsg = ErrorMessage { code = 0, message = "", error_data = Nothing}
--     strMsg msg = ErrorMessage {code = 0, message = msg, error_data = Nothing }

data JumpParams = JumpParams {
    JumpParams -> Int
jump_ref :: Int
}

instance FromJSON JumpParams where
    parseJSON :: Value -> Parser JumpParams
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JumpParams" forall a b. (a -> b) -> a -> b
$ \Object
v -> Int -> JumpParams
JumpParams
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reference"

data JumpResult = JumpResult {
    JumpResult -> Value
jump_post :: Value
}

instance ToJSON JumpResult where 
    toJSON :: JumpResult -> Value
toJSON JumpResult
res = [Pair] -> Value
object [Key
"post" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= JumpResult -> Value
jump_post JumpResult
res]

data ExecuteParams = ExecuteParams {
    ExecuteParams -> String
program :: String
} deriving (Int -> ExecuteParams -> ShowS
[ExecuteParams] -> ShowS
ExecuteParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecuteParams] -> ShowS
$cshowList :: [ExecuteParams] -> ShowS
show :: ExecuteParams -> String
$cshow :: ExecuteParams -> String
showsPrec :: Int -> ExecuteParams -> ShowS
$cshowsPrec :: Int -> ExecuteParams -> ShowS
Show, forall x. Rep ExecuteParams x -> ExecuteParams
forall x. ExecuteParams -> Rep ExecuteParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExecuteParams x -> ExecuteParams
$cfrom :: forall x. ExecuteParams -> Rep ExecuteParams x
Generic)

instance FromJSON ExecuteParams

data ExecuteResult = ExecuteResult {
    ExecuteResult -> Int
exec_ref :: Int,
    ExecuteResult -> Value
exec_out :: Value,
    ExecuteResult -> Value
exec_post :: Value
}

instance ToJSON ExecuteResult where
    toJSON :: ExecuteResult -> Value
toJSON (ExecuteResult Int
ref Value
out Value
post) = [Pair] -> Value
object [Key
"reference" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
ref, Key
"output" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
out, Key
"post" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
post]

    toEncoding :: ExecuteResult -> Encoding
toEncoding (ExecuteResult Int
ref Value
out Value
post) = Series -> Encoding
pairs (Key
"reference" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
ref forall a. Semigroup a => a -> a -> a
<> Key
"output" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
out forall a. Semigroup a => a -> a -> a
<> Key
"post" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
post)

data RevertParams = RevertParams {
    RevertParams -> Int
revert_ref :: Int
}

instance FromJSON RevertParams where
    parseJSON :: Value -> Parser RevertParams
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RevertParams" forall a b. (a -> b) -> a -> b
$ \Object
v -> Int -> RevertParams
RevertParams
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reference"

data RevertResult = RevertResult {
    RevertResult -> [Int]
revert_deleted :: [Ex.Ref],
    RevertResult -> Value
post_revert :: Value
}

instance ToJSON RevertResult where 
    toJSON :: RevertResult -> Value
toJSON RevertResult
res = [Pair] -> Value
object [Key
"deleted" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RevertResult -> [Int]
revert_deleted RevertResult
res, Key
"post" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RevertResult -> Value
post_revert RevertResult
res]

data DerefParams = DerefParams {
    DerefParams -> Int
deref_ref :: Int
}

instance FromJSON DerefParams where
    parseJSON :: Value -> Parser DerefParams
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DerefParams" forall a b. (a -> b) -> a -> b
$ \Object
v -> Int -> DerefParams
DerefParams
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reference"


data TraceParams = TraceParams {
    TraceParams -> Int
reference :: Int
} deriving (forall x. Rep TraceParams x -> TraceParams
forall x. TraceParams -> Rep TraceParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TraceParams x -> TraceParams
$cfrom :: forall x. TraceParams -> Rep TraceParams x
Generic)

instance FromJSON TraceParams


data Edge = Edge {
    Edge -> Int
source :: Int,
    Edge -> Int
target :: Int,
    Edge -> EdgeLabel
label  :: EdgeLabel
} deriving (forall x. Rep Edge x -> Edge
forall x. Edge -> Rep Edge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Edge x -> Edge
$cfrom :: forall x. Edge -> Rep Edge x
Generic)

instance ToJSON Edge where
    toEncoding :: Edge -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions


data EdgeLabel = EdgeLabel {
    EdgeLabel -> Value
program :: Value,
    EdgeLabel -> Value
mval :: Value
} deriving (forall x. Rep EdgeLabel x -> EdgeLabel
forall x. EdgeLabel -> Rep EdgeLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EdgeLabel x -> EdgeLabel
$cfrom :: forall x. EdgeLabel -> Rep EdgeLabel x
Generic)

instance ToJSON EdgeLabel where
    toEncoding :: EdgeLabel -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions


data ExecutionTree = ExecutionTree {
    ExecutionTree -> Int
current :: Int,
    ExecutionTree -> [Int]
references :: [Int],
    ExecutionTree -> [Edge]
edges :: [Edge]
} deriving (forall x. Rep ExecutionTree x -> ExecutionTree
forall x. ExecutionTree -> Rep ExecutionTree x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExecutionTree x -> ExecutionTree
$cfrom :: forall x. ExecutionTree -> Rep ExecutionTree x
Generic)

instance ToJSON ExecutionTree where
    toEncoding :: ExecutionTree -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

data PathParams = PathParams {
    PathParams -> Int
source :: Int,
    PathParams -> Int
target :: Int
} deriving (forall x. Rep PathParams x -> PathParams
forall x. PathParams -> Rep PathParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PathParams x -> PathParams
$cfrom :: forall x. PathParams -> Rep PathParams x
Generic)

instance FromJSON PathParams

parseErrorCode :: Int
parseErrorCode = -Int
32700
invalidRequestCode :: Integer
invalidRequestCode = -Integer
32600
methodNotFoundCode :: Int
methodNotFoundCode = -Int
32601
invalidParamsCode :: Int
invalidParamsCode = -Int
32602
internalErrorCode :: Integer
internalErrorCode = -Integer
32603

referenceNotInTreeCode :: Int
referenceNotInTreeCode = Int
1
referenceRevertInvalidCode :: Int
referenceRevertInvalidCode = Int
2
programParseErrorCode :: Int
programParseErrorCode = Int
3
pathNonExistingCode :: Int
pathNonExistingCode = Int
4



parseError :: ErrorMessage
parseError :: ErrorMessage
parseError = ErrorMessage {
    $sel:code:ErrorMessage :: Int
code = Int
parseErrorCode,
    $sel:message:ErrorMessage :: String
message = String
"Parse error",
    $sel:error_data:ErrorMessage :: Maybe Value
error_data = forall a. Maybe a
Nothing
}

methodNotFound :: ErrorMessage
methodNotFound :: ErrorMessage
methodNotFound = ErrorMessage {
    $sel:code:ErrorMessage :: Int
code = Int
methodNotFoundCode,
    $sel:message:ErrorMessage :: String
message = String
"Method not found",
    $sel:error_data:ErrorMessage :: Maybe Value
error_data = forall a. Maybe a
Nothing
}

invalidParams :: ErrorMessage
invalidParams :: ErrorMessage
invalidParams = ErrorMessage {
    $sel:code:ErrorMessage :: Int
code = Int
invalidParamsCode,
    $sel:message:ErrorMessage :: String
message = String
"Invalid method parameter(s)",
    $sel:error_data:ErrorMessage :: Maybe Value
error_data = forall a. Maybe a
Nothing
}

ensureParameter :: Monad m => Maybe Value -> ExceptT ErrorMessage (EIP p m c o) Value
ensureParameter :: forall (m :: * -> *) p c o.
Monad m =>
Maybe Value -> ExceptT ErrorMessage (EIP p m c o) Value
ensureParameter Maybe Value
Nothing = forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrorMessage
invalidParams
ensureParameter (Just Value
v) = forall (m :: * -> *) a. Monad m => a -> m a
return Value
v

fromResult :: Monad m => Result a -> Value -> ExceptT ErrorMessage (EIP p m c o) Value
fromResult :: forall (m :: * -> *) a p c o.
Monad m =>
Result a -> Value -> ExceptT ErrorMessage (EIP p m c o) Value
fromResult Result a
res Value
onSuccess = case Result a
res of
    (Error String
e) -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrorMessage
invalidParams
    (Success a
v) -> forall (m :: * -> *) a. Monad m => a -> m a
return Value
onSuccess

jump :: (Monad m, ExplorerPostValue p c o) => Value -> ExceptT ErrorMessage (EIP p m c o) Value
jump :: forall (m :: * -> *) p c o.
(Monad m, ExplorerPostValue p c o) =>
Value -> ExceptT ErrorMessage (EIP p m c o) Value
jump Value
v = case (forall a. FromJSON a => Value -> Result a
fromJSON Value
v) :: Result JumpParams of
    (Error String
e) -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrorMessage
invalidParams
    (Success JumpParams
v') -> do
        Explorer p m c o
ex <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => m s
get
        case forall p (m :: * -> *) c o.
Int -> Explorer p m c o -> Maybe (Explorer p m c o)
Ex.jump (JumpParams -> Int
jump_ref JumpParams
v') Explorer p m c o
ex of
            Just Explorer p m c o
ex' -> do
                forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Explorer p m c o
ex'
                forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> JumpResult
JumpResult forall a b. (a -> b) -> a -> b
$ forall p c o (m :: * -> *).
ExplorerPostValue p c o =>
Explorer p m c o -> Explorer p m c o -> Value
postJump Explorer p m c o
ex Explorer p m c o
ex'
            Maybe (Explorer p m c o)
Nothing -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrorMessage { $sel:code:ErrorMessage :: Int
code = Int
referenceNotInTreeCode, $sel:message:ErrorMessage :: String
message = String
"", $sel:error_data:ErrorMessage :: Maybe Value
error_data = forall a. Maybe a
Nothing }

execute :: (Eq o, Monoid o, ToJSON o, Eq p, ExplorerPostValue p c o) => Value -> ExceptT ErrorMessage (EIP p IO c o) Value
execute :: forall o p c.
(Eq o, Monoid o, ToJSON o, Eq p, ExplorerPostValue p c o) =>
Value -> ExceptT ErrorMessage (EIP p IO c o) Value
execute Value
v = case (forall a. FromJSON a => Value -> Result a
fromJSON Value
v) :: Result ExecuteParams of
    (Error String
e) -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrorMessage
invalidParams
    (Success ExecuteParams
v') -> do
        String -> Maybe p
parser <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *). MonadReader r m => m r
ask
        let pl :: Maybe p
pl = String -> Maybe p
parser forall a b. (a -> b) -> a -> b
$ ExecuteParams -> String
program (ExecuteParams
v' :: ExecuteParams)
        case Maybe p
pl of
            Just p
prog -> do
                Explorer p IO c o
ex <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => m s
get
                (Explorer p IO c o
ex', o
output) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall p (m :: * -> *) c o.
Language p m c o =>
p -> Explorer p m c o -> m (Explorer p m c o, o)
Ex.execute p
prog Explorer p IO c o
ex
                forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => s -> m ()
put Explorer p IO c o
ex'
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ ExecuteResult { $sel:exec_ref:ExecuteResult :: Int
exec_ref = forall programs (m :: * -> *) configs output.
Explorer programs m configs output -> Int
Ex.currRef Explorer p IO c o
ex', $sel:exec_out:ExecuteResult :: Value
exec_out = forall a. ToJSON a => a -> Value
toJSON o
output, $sel:exec_post:ExecuteResult :: Value
exec_post = forall p c o (m :: * -> *).
ExplorerPostValue p c o =>
Explorer p m c o -> Explorer p m c o -> o -> Value
postExecute Explorer p IO c o
ex Explorer p IO c o
ex' o
output }
            Maybe p
Nothing -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrorMessage { $sel:code:ErrorMessage :: Int
code = Int
programParseErrorCode, $sel:message:ErrorMessage :: String
message = String
"", $sel:error_data:ErrorMessage :: Maybe Value
error_data = forall a. Maybe a
Nothing }

allRefs :: Ex.Explorer p IO c o -> [(Ex.Ref, c)]
allRefs :: forall p c o. Explorer p IO c o -> [(Int, c)]
allRefs Explorer p IO c o
ex = [(Int, c)]
refs
    where
        ((Int, c)
_, [(Int, c)]
refs, [((Int, c), (p, o), (Int, c))]
_) = forall p (m :: * -> *) c o.
Explorer p m c o
-> ((Int, c), [(Int, c)], [((Int, c), (p, o), (Int, c))])
Ex.executionGraph Explorer p IO c o
ex


revert :: (Eq o, Monoid o, Eq p, ExplorerPostValue p c o) => Value -> ExceptT ErrorMessage (EIP p IO c o) Value
revert :: forall o p c.
(Eq o, Monoid o, Eq p, ExplorerPostValue p c o) =>
Value -> ExceptT ErrorMessage (EIP p IO c o) Value
revert Value
v = case (forall a. FromJSON a => Value -> Result a
fromJSON Value
v) :: Result RevertParams of
    (Error String
e) -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrorMessage
invalidParams
    (Success RevertParams
v) -> do
        Explorer p IO c o
ex <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => m s
get
        case forall p (m :: * -> *) c o.
Int -> Explorer p m c o -> Maybe (Explorer p m c o)
Ex.revert (RevertParams -> Int
revert_ref RevertParams
v) Explorer p IO c o
ex of
            Just Explorer p IO c o
ex' -> do
                forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => s -> m ()
put Explorer p IO c o
ex'
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ RevertResult { $sel:revert_deleted:RevertResult :: [Int]
revert_deleted = [Int]
deleted, $sel:post_revert:RevertResult :: Value
post_revert = forall p c o (m :: * -> *).
ExplorerPostValue p c o =>
Explorer p m c o -> Explorer p m c o -> [Int] -> Value
postRevert Explorer p IO c o
ex Explorer p IO c o
ex' [Int]
deleted}
                where 
                    refs :: [Int]
refs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall p c o. Explorer p IO c o -> [(Int, c)]
allRefs Explorer p IO c o
ex)
                    refs' :: [Int]
refs' = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall p c o. Explorer p IO c o -> [(Int, c)]
allRefs Explorer p IO c o
ex')
                    deleted :: [Int]
deleted = ([Int]
refs forall a. Eq a => [a] -> [a] -> [a]
\\ [Int]
refs')
            Maybe (Explorer p IO c o)
Nothing -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrorMessage { $sel:code:ErrorMessage :: Int
code = Int
referenceRevertInvalidCode, $sel:message:ErrorMessage :: String
message = String
"", $sel:error_data:ErrorMessage :: Maybe Value
error_data = forall a. Maybe a
Nothing }

deref :: (Eq o, Monoid o, Eq p, ToJSON c) => Value -> ExceptT ErrorMessage (EIP p IO c o) Value
deref :: forall o p c.
(Eq o, Monoid o, Eq p, ToJSON c) =>
Value -> ExceptT ErrorMessage (EIP p IO c o) Value
deref Value
v = case (forall a. FromJSON a => Value -> Result a
fromJSON Value
v) :: Result DerefParams of
    (Error String
e) -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrorMessage
invalidParams
    (Success DerefParams
v) -> do
        Explorer p IO c o
ex <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => m s
get
        case forall p (m :: * -> *) c o. Explorer p m c o -> Int -> Maybe c
Ex.deref Explorer p IO c o
ex (DerefParams -> Int
deref_ref DerefParams
v) of
            (Just c
conf) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON c
conf
            Maybe c
Nothing -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrorMessage { $sel:code:ErrorMessage :: Int
code = Int
referenceNotInTreeCode, $sel:message:ErrorMessage :: String
message = String
"", $sel:error_data:ErrorMessage :: Maybe Value
error_data = forall a. Maybe a
Nothing}

executionTree :: (ToJSON o, ToJSON p) => ExceptT ErrorMessage (EIP p IO c o) Value
executionTree :: forall o p c.
(ToJSON o, ToJSON p) =>
ExceptT ErrorMessage (EIP p IO c o) Value
executionTree = do
    Explorer p IO c o
ex <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => m s
get
    let ((Int, c)
curr, [(Int, c)]
nodes, [((Int, c), (p, o), (Int, c))]
edges) = forall p (m :: * -> *) c o.
Explorer p m c o
-> ((Int, c), [(Int, c)], [((Int, c), (p, o), (Int, c))])
Ex.executionGraph Explorer p IO c o
ex
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ ExecutionTree 
        { $sel:current:ExecutionTree :: Int
current = forall a b. (a, b) -> a
fst (Int, c)
curr
        , $sel:references:ExecutionTree :: [Int]
references = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, c)]
nodes
        , $sel:edges:ExecutionTree :: [Edge]
edges = forall a b. (a -> b) -> [a] -> [b]
map (\((Int, c)
s, (p
p, o
o), (Int, c)
t) -> Edge { $sel:source:Edge :: Int
source = forall a b. (a, b) -> a
fst (Int, c)
s
        , $sel:label:Edge :: EdgeLabel
label = EdgeLabel { $sel:program:EdgeLabel :: Value
program = forall a. ToJSON a => a -> Value
toJSON p
p, $sel:mval:EdgeLabel :: Value
mval = forall a. ToJSON a => a -> Value
toJSON o
o}
        , $sel:target:Edge :: Int
target = forall a b. (a, b) -> a
fst (Int, c)
t} ) [((Int, c), (p, o), (Int, c))]
edges}

getCurrentReference :: ExceptT ErrorMessage (EIP p IO c o) Value
getCurrentReference :: forall p c o. ExceptT ErrorMessage (EIP p IO c o) Value
getCurrentReference = do
    Explorer p IO c o
ex <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => m s
get
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall programs (m :: * -> *) configs output.
Explorer programs m configs output -> Int
Ex.currRef Explorer p IO c o
ex

getAllReferences :: ExceptT ErrorMessage (EIP p IO c o) Value
getAllReferences :: forall p c o. ExceptT ErrorMessage (EIP p IO c o) Value
getAllReferences = do
    Explorer p IO c o
ex <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => m s
get
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall p c o. Explorer p IO c o -> [(Int, c)]
allRefs Explorer p IO c o
ex)

getTrace :: (ToJSON p, ToJSON o) => Maybe Value -> ExceptT ErrorMessage (EIP p IO c o) Value
getTrace :: forall p o c.
(ToJSON p, ToJSON o) =>
Maybe Value -> ExceptT ErrorMessage (EIP p IO c o) Value
getTrace (Just Value
r) = case (forall a. FromJSON a => Value -> Result a
fromJSON Value
r) :: Result TraceParams of
    (Error String
e) -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrorMessage
invalidParams
    (Success TraceParams
v) -> do
        Explorer p IO c o
ex <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => m s
get
        let path :: [((Int, c), (p, o), (Int, c))]
path = forall p (m :: * -> *) c o.
Explorer p m c o -> Int -> Int -> [((Int, c), (p, o), (Int, c))]
Ex.getPathFromTo Explorer p IO c o
ex Int
1 (TraceParams -> Int
reference (TraceParams
v :: TraceParams)) -- Fix hardcode 1(it's initialRef).
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\((Int, c)
s, (p
p, o
o), (Int, c)
t) -> Edge { $sel:source:Edge :: Int
source = forall a b. (a, b) -> a
fst (Int, c)
s, $sel:target:Edge :: Int
target = forall a b. (a, b) -> a
fst (Int, c)
t, $sel:label:Edge :: EdgeLabel
label = EdgeLabel { $sel:program:EdgeLabel :: Value
program = forall a. ToJSON a => a -> Value
toJSON p
p, $sel:mval:EdgeLabel :: Value
mval = forall a. ToJSON a => a -> Value
toJSON o
o} }) [((Int, c), (p, o), (Int, c))]
path
getTrace Maybe Value
Nothing = do
    Explorer p IO c o
ex <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => m s
get
    let trace :: [((Int, c), (p, o), (Int, c))]
trace = forall p (m :: * -> *) c o.
Explorer p m c o -> [((Int, c), (p, o), (Int, c))]
Ex.getTrace Explorer p IO c o
ex
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\((Int, c)
s, (p
p, o
o), (Int, c)
t) -> Edge { $sel:source:Edge :: Int
source = forall a b. (a, b) -> a
fst (Int, c)
s, $sel:target:Edge :: Int
target = forall a b. (a, b) -> a
fst (Int, c)
t, $sel:label:Edge :: EdgeLabel
label = EdgeLabel { $sel:program:EdgeLabel :: Value
program = forall a. ToJSON a => a -> Value
toJSON p
p, $sel:mval:EdgeLabel :: Value
mval = forall a. ToJSON a => a -> Value
toJSON o
o} }) [((Int, c), (p, o), (Int, c))]
trace

getPath :: (ToJSON o, ToJSON p) => Value -> ExceptT ErrorMessage (EIP p IO c o) Value
getPath :: forall o p c.
(ToJSON o, ToJSON p) =>
Value -> ExceptT ErrorMessage (EIP p IO c o) Value
getPath Value
val = case (forall a. FromJSON a => Value -> Result a
fromJSON Value
val) :: Result PathParams of
    (Error String
e) -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrorMessage { $sel:code:ErrorMessage :: Int
code = Int
pathNonExistingCode, $sel:message:ErrorMessage :: String
message = String
"", $sel:error_data:ErrorMessage :: Maybe Value
error_data = forall a. Maybe a
Nothing}
    (Success PathParams
v) -> do
        Explorer p IO c o
ex <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => m s
get
        let path :: [((Int, c), (p, o), (Int, c))]
path = forall p (m :: * -> *) c o.
Explorer p m c o -> Int -> Int -> [((Int, c), (p, o), (Int, c))]
Ex.getPathFromTo Explorer p IO c o
ex (PathParams -> Int
source (PathParams
v :: PathParams)) (PathParams -> Int
target (PathParams
v :: PathParams))
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\((Int, c)
s, (p
p, o
o), (Int, c)
t) -> Edge { $sel:source:Edge :: Int
source = forall a b. (a, b) -> a
fst (Int, c)
s, $sel:target:Edge :: Int
target = forall a b. (a, b) -> a
fst (Int, c)
t, $sel:label:Edge :: EdgeLabel
label = EdgeLabel { $sel:program:EdgeLabel :: Value
program = forall a. ToJSON a => a -> Value
toJSON p
p, $sel:mval:EdgeLabel :: Value
mval = forall a. ToJSON a => a -> Value
toJSON o
o} }) [((Int, c), (p, o), (Int, c))]
path

getLeaves :: ExceptT ErrorMessage (EIP p IO c o) Value
getLeaves :: forall p c o. ExceptT ErrorMessage (EIP p IO c o) Value
getLeaves = do
    Explorer p IO c o
ex <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => m s
get
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall p (m :: * -> *) c o. Explorer p m c o -> [(Int, c)]
Ex.leaves Explorer p IO c o
ex)

methodDispatch :: (Eq o, Monoid o, ToJSON o, ToJSON p, Eq p, ToJSON c, ExplorerPostValue p c o) => String -> Maybe Value -> ExceptT ErrorMessage (EIP p IO c o) Value
methodDispatch :: forall o p c.
(Eq o, Monoid o, ToJSON o, ToJSON p, Eq p, ToJSON c,
 ExplorerPostValue p c o) =>
String -> Maybe Value -> ExceptT ErrorMessage (EIP p IO c o) Value
methodDispatch String
"jump" Maybe Value
mval = forall (m :: * -> *) p c o.
Monad m =>
Maybe Value -> ExceptT ErrorMessage (EIP p m c o) Value
ensureParameter Maybe Value
mval forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) p c o.
(Monad m, ExplorerPostValue p c o) =>
Value -> ExceptT ErrorMessage (EIP p m c o) Value
jump
methodDispatch String
"execute" Maybe Value
mval = forall (m :: * -> *) p c o.
Monad m =>
Maybe Value -> ExceptT ErrorMessage (EIP p m c o) Value
ensureParameter Maybe Value
mval forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall o p c.
(Eq o, Monoid o, ToJSON o, Eq p, ExplorerPostValue p c o) =>
Value -> ExceptT ErrorMessage (EIP p IO c o) Value
execute
methodDispatch String
"revert" Maybe Value
mval = forall (m :: * -> *) p c o.
Monad m =>
Maybe Value -> ExceptT ErrorMessage (EIP p m c o) Value
ensureParameter Maybe Value
mval forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall o p c.
(Eq o, Monoid o, Eq p, ExplorerPostValue p c o) =>
Value -> ExceptT ErrorMessage (EIP p IO c o) Value
revert
methodDispatch String
"deref" Maybe Value
mval = forall (m :: * -> *) p c o.
Monad m =>
Maybe Value -> ExceptT ErrorMessage (EIP p m c o) Value
ensureParameter Maybe Value
mval forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall o p c.
(Eq o, Monoid o, Eq p, ToJSON c) =>
Value -> ExceptT ErrorMessage (EIP p IO c o) Value
deref
methodDispatch String
"getTrace" Maybe Value
mval = forall p o c.
(ToJSON p, ToJSON o) =>
Maybe Value -> ExceptT ErrorMessage (EIP p IO c o) Value
getTrace Maybe Value
mval
methodDispatch String
"getPath" Maybe Value
mval = forall (m :: * -> *) p c o.
Monad m =>
Maybe Value -> ExceptT ErrorMessage (EIP p m c o) Value
ensureParameter Maybe Value
mval forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall o p c.
(ToJSON o, ToJSON p) =>
Value -> ExceptT ErrorMessage (EIP p IO c o) Value
getPath
methodDispatch String
"getExecutionTree" Maybe Value
_ = forall o p c.
(ToJSON o, ToJSON p) =>
ExceptT ErrorMessage (EIP p IO c o) Value
executionTree
methodDispatch String
"getCurrentReference" Maybe Value
_ = forall p c o. ExceptT ErrorMessage (EIP p IO c o) Value
getCurrentReference
methodDispatch String
"getAllReferences" Maybe Value
_ = forall p c o. ExceptT ErrorMessage (EIP p IO c o) Value
getAllReferences
methodDispatch String
"getLeaves" Maybe Value
_ = forall p c o. ExceptT ErrorMessage (EIP p IO c o) Value
getLeaves
methodDispatch String
_ Maybe Value
_ = forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrorMessage
methodNotFound

handleRequest :: (Eq o, Monoid o, ToJSON o, ToJSON o, ToJSON p, Eq p, ToJSON c, ExplorerPostValue p c o) => Maybe RequestMessage -> EIP p IO c o ResponseMessage
handleRequest :: forall o p c.
(Eq o, Monoid o, ToJSON o, ToJSON o, ToJSON p, Eq p, ToJSON c,
 ExplorerPostValue p c o) =>
Maybe RequestMessage -> EIP p IO c o ResponseMessage
handleRequest (Just RequestMessage
msg) = do
    ProcessResult
res <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall o p c.
(Eq o, Monoid o, ToJSON o, ToJSON p, Eq p, ToJSON c,
 ExplorerPostValue p c o) =>
String -> Maybe Value -> ExceptT ErrorMessage (EIP p IO c o) Value
methodDispatch (RequestMessage -> String
method RequestMessage
msg) (RequestMessage -> Maybe Value
params RequestMessage
msg)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ResponseMessage { $sel:res_id:ResponseMessage :: String
res_id = RequestMessage -> String
req_id RequestMessage
msg, $sel:body:ResponseMessage :: ProcessResult
body = ProcessResult
res }
handleRequest Maybe RequestMessage
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ResponseMessage { $sel:res_id:ResponseMessage :: String
res_id = String
"0", $sel:body:ResponseMessage :: ProcessResult
body = forall a b. a -> Either a b
Left ErrorMessage
parseError { $sel:message:ErrorMessage :: String
message = String
"NOthing" }}


handleRequest' :: (Eq o, Monoid o, ToJSON o, Eq p, ToJSON p, ToJSON c, ExplorerPostValue p c o) => S.ByteString -> EIP p IO c o ResponseMessage
handleRequest' :: forall o p c.
(Eq o, Monoid o, ToJSON o, Eq p, ToJSON p, ToJSON c,
 ExplorerPostValue p c o) =>
ByteString -> EIP p IO c o ResponseMessage
handleRequest' ByteString
body =
    case forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
body of
        (Just Maybe RequestMessage
m) -> forall o p c.
(Eq o, Monoid o, ToJSON o, ToJSON o, ToJSON p, Eq p, ToJSON c,
 ExplorerPostValue p c o) =>
Maybe RequestMessage -> EIP p IO c o ResponseMessage
handleRequest Maybe RequestMessage
m
        Maybe (Maybe RequestMessage)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ResponseMessage
invalidHeader

invalidHeader :: ResponseMessage
invalidHeader :: ResponseMessage
invalidHeader = ResponseMessage { $sel:res_id:ResponseMessage :: String
res_id = String
"0", $sel:body:ResponseMessage :: ProcessResult
body = forall a b. a -> Either a b
Left ErrorMessage
parseError {$sel:message:ErrorMessage :: String
message = String
"Headeer"} }

parseHeader :: AB.Parser (Int, String)
parseHeader :: Parser (Int, String)
parseHeader = do
    ByteString -> Parser ByteString
AB.string ByteString
"Content-Length:"
    forall (f :: * -> *) a. Alternative f => f a -> f ()
AB.skipMany (Char -> Parser Char
ABC.char Char
' ')
    Scientific
res <- Parser Scientific
ABC.scientific
    forall (f :: * -> *) a. Alternative f => f a -> f ()
AB.skipMany (Char -> Parser Char
ABC.char Char
' ')
    Char -> Parser Char
ABC.char Char
'\r'
    Char -> Parser Char
ABC.char Char
'\n'
    ByteString -> Parser ByteString
ABC.string ByteString
"Content-Type:"
    forall (f :: * -> *) a. Alternative f => f a -> f ()
AB.skipMany (Char -> Parser Char
ABC.char Char
' ')
    String
typ <- forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
AB.manyTill Parser Char
ABC.letter_ascii (Char -> Parser Char
ABC.char Char
'\r')
    forall (f :: * -> *) a. Alternative f => f a -> f ()
AB.skipMany (Char -> Parser Char
ABC.char Char
' ')
    Char -> Parser Char
ABC.char Char
'\n'
    Char -> Parser Char
ABC.char Char
'\r'
    Char -> Parser Char
ABC.char Char
'\n'
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ ((forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
res) :: Maybe Int), String
typ)


intProg :: Int -> Int -> IO (Maybe Int, ())
intProg :: Int -> Int -> IO (Maybe Int, ())
intProg Int
x Int
y = do
    String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
y
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Int
x, ())

intParse :: String -> Maybe Int
intParse :: String -> Maybe Int
intParse String
_ = forall a. a -> Maybe a
Just Int
1

-- TODO: Handle incorrect request.
-- TODO: Send correct error messages.
serve :: (Eq o, Monoid o, ToJSON o, Eq p, ToJSON p, ToJSON c, ExplorerPostValue p c o) => String -> Ex.Explorer p IO c o -> (String -> Maybe p) -> IO ()
serve :: forall o p c.
(Eq o, Monoid o, ToJSON o, Eq p, ToJSON p, ToJSON c,
 ExplorerPostValue p c o) =>
String -> Explorer p IO c o -> (String -> Maybe p) -> IO ()
serve String
port Explorer p IO c o
ex String -> Maybe p
parser = forall a. IO a -> IO a
withSocketsDo forall a b. (a -> b) -> a -> b
$ do
    AddrInfo
addr <- String -> IO AddrInfo
resolve String
port
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (AddrInfo -> IO Socket
open AddrInfo
addr) Socket -> IO ()
close forall {b}. Socket -> IO b
loop
  where
    resolve :: String -> IO AddrInfo
resolve String
port = do
        let hints :: AddrInfo
hints = AddrInfo
defaultHints {
                addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_PASSIVE]
              , addrSocketType :: SocketType
addrSocketType = SocketType
Stream
              }
        AddrInfo
addr:[AddrInfo]
_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo (forall a. a -> Maybe a
Just AddrInfo
hints) forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
port)
        forall (m :: * -> *) a. Monad m => a -> m a
return AddrInfo
addr
    open :: AddrInfo -> IO Socket
open AddrInfo
addr = do
        Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
addr) (AddrInfo -> SocketType
addrSocketType AddrInfo
addr) (AddrInfo -> ProtocolNumber
addrProtocol AddrInfo
addr)
        Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
ReuseAddr Int
1
        Socket -> SockAddr -> IO ()
bind Socket
sock (AddrInfo -> SockAddr
addrAddress AddrInfo
addr)
        -- If the prefork technique is not used,
        -- set CloseOnExec for the security reasons.
        ProtocolNumber
fd <- Socket -> IO ProtocolNumber
fdSocket Socket
sock
        ProtocolNumber -> IO ()
setCloseOnExecIfNeeded ProtocolNumber
fd
        Socket -> Int -> IO ()
listen Socket
sock Int
10
        forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock
    loop :: Socket -> IO b
loop Socket
sock = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
        (Socket
conn, SockAddr
peer) <- Socket -> IO (Socket, SockAddr)
accept Socket
sock
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Connection from " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SockAddr
peer
        forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally (forall {o} {p} {c}.
(Monoid o, Eq o, Eq p, ToJSON o, ToJSON p, ToJSON c,
 ExplorerPostValue p c o) =>
Explorer p IO c o -> (String -> Maybe p) -> Socket -> IO ()
talk Explorer p IO c o
ex String -> Maybe p
parser Socket
conn) (\Either SomeException ()
_ -> Socket -> IO ()
close Socket
conn)
    talk :: Explorer p IO c o -> (String -> Maybe p) -> Socket -> IO ()
talk Explorer p IO c o
ex String -> Maybe p
parser Socket
conn = do
        String -> IO ()
putStrLn String
"Hello receiving"
        ByteString
msg <- Socket -> Int64 -> IO ByteString
recv Socket
conn Int64
1024
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
S.null ByteString
msg) forall a b. (a -> b) -> a -> b
$ do
            Explorer p IO c o
ex' <- forall {o} {p} {c}.
(Monoid o, Eq o, Eq p, ToJSON o, ToJSON p, ToJSON c,
 ExplorerPostValue p c o) =>
Explorer p IO c o
-> (String -> Maybe p)
-> Socket
-> ByteString
-> IO (Explorer p IO c o)
acceptCommand Explorer p IO c o
ex String -> Maybe p
parser Socket
conn ByteString
msg
            Explorer p IO c o -> (String -> Maybe p) -> Socket -> IO ()
talk Explorer p IO c o
ex' String -> Maybe p
parser Socket
conn

acceptCommand :: Explorer p IO c o
-> (String -> Maybe p)
-> Socket
-> ByteString
-> IO (Explorer p IO c o)
acceptCommand Explorer p IO c o
ex String -> Maybe p
parser Socket
conn ByteString
command = do
    let res :: Result (Int, String)
res = forall a. Parser a -> ByteString -> Result a
AB.parse Parser (Int, String)
parseHeader ByteString
command
    String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Result (Int, String)
res
    (Maybe (ResponseMessage, Explorer p IO c o, ByteString)
result, ByteString
toParse) <- case Result (Int, String)
res of
        (AB.Done ByteString
rem (Int
val, String
_)) -> do
            case ByteString -> Int64
S.length ByteString
rem forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val) of
                Bool
True -> do
                    ByteString
msg <- Socket -> Int64 -> IO ByteString
recv Socket
conn Int64
1024
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, ByteString -> ByteString -> ByteString
S.append ByteString
command ByteString
msg)
                Bool
False -> do
                    let command :: ByteString
command = Int64 -> ByteString -> ByteString
S.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val) ByteString
rem
                    String -> IO ()
putStrLn String
"-------------------------"
                    String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ByteString
command
                    String -> IO ()
putStrLn String
"-------------------------"
                    (ResponseMessage, Explorer p IO c o, ByteString)
out <- forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST (forall o p c.
(Eq o, Monoid o, ToJSON o, Eq p, ToJSON p, ToJSON c,
 ExplorerPostValue p c o) =>
ByteString -> EIP p IO c o ResponseMessage
handleRequest' ByteString
command) String -> Maybe p
parser Explorer p IO c o
ex
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (ResponseMessage, Explorer p IO c o, ByteString)
out, Int64 -> ByteString -> ByteString
S.drop (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val) ByteString
rem)
        (AB.Fail ByteString
_ [String]
_ String
"not enough input") -> do
            ByteString
msg <- Socket -> Int64 -> IO ByteString
recv Socket
conn Int64
1024
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, ByteString -> ByteString -> ByteString
S.append ByteString
command ByteString
msg)
        Result (Int, String)
_ ->  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (ResponseMessage
invalidHeader, Explorer p IO c o
ex, ByteString
""), ByteString
"")
    case Maybe (ResponseMessage, Explorer p IO c o, ByteString)
result of
        Maybe (ResponseMessage, Explorer p IO c o, ByteString)
Nothing -> if ByteString
toParse forall a. Eq a => a -> a -> Bool
== ByteString
"" then forall (m :: * -> *) a. Monad m => a -> m a
return Explorer p IO c o
ex else Explorer p IO c o
-> (String -> Maybe p)
-> Socket
-> ByteString
-> IO (Explorer p IO c o)
acceptCommand Explorer p IO c o
ex String -> Maybe p
parser Socket
conn ByteString
toParse
        Just (ResponseMessage
resp, Explorer p IO c o
ex', ByteString
log) -> do
            let encoded_resp :: ByteString
encoded_resp = forall a. ToJSON a => a -> ByteString
encode ResponseMessage
resp
            let full_resp :: ByteString
full_resp = [ByteString] -> ByteString
S.concat [ByteString
"Content-Length:", forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
S.length ByteString
encoded_resp, ByteString
"\r\nContent-Type: jrpcei\r\n\r\n", ByteString
encoded_resp]
            Socket -> ByteString -> IO ()
sendAll Socket
conn ByteString
full_resp
            String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ByteString
full_resp
            String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ByteString
toParse
            if ByteString
toParse forall a. Eq a => a -> a -> Bool
== ByteString
"" then forall (m :: * -> *) a. Monad m => a -> m a
return Explorer p IO c o
ex' else Explorer p IO c o
-> (String -> Maybe p)
-> Socket
-> ByteString
-> IO (Explorer p IO c o)
acceptCommand Explorer p IO c o
ex' String -> Maybe p
parser Socket
conn ByteString
toParse