diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +The MIT License (MIT) + +Copyright (c) 2013 Andrew Gibiansky + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of +the Software, and to permit persons to whom the Software is furnished to do so, +subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS +FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR +COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/examples/basic/Main.hs b/examples/basic/Main.hs new file mode 100644 --- /dev/null +++ b/examples/basic/Main.hs @@ -0,0 +1,75 @@ +{-| +Module : Main +Description : Main module for a basic bare-minimum Jupyter kernel created using the @jupyter@ library. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX + +This module is the Main module for @kernel-basic@, a bare-minimum Jupyter kernel created using the +@jupyter@ library. It is intended to demo the bare minimum amount of code required to create a +Jupyter kernel. +-} +{-# Language OverloadedStrings #-} +module Main(main) where + +-- Imports from 'base' +import System.Environment (getArgs) +import System.Exit (exitFailure) +import System.IO (stderr) + +-- Imports from 'text' +import qualified Data.Text.IO as T + +-- Imports from 'jupyter' +import Jupyter.Install (installKernel, simpleKernelspec, InstallUser(..), InstallResult(..), + Kernelspec) +import Jupyter.Kernel (readProfile, simpleKernelInfo, serve, defaultCommHandler, + defaultClientRequestHandler) + +-- | In @main@, support two commands: +-- +-- - @kernel-basic install@: Register this kernel with Jupyter. +-- - @kernel-basic kernel $FILE@: Serve a kernel given ports in connection file $FILE. +-- +-- These are the two main functions that a kernel must support, and the installed kernelspec must +-- indicate that the client should invoke the @kernel@ command in order to launch the kernel. +main :: IO () +main = do + args <- getArgs + case args of + ["install"] -> runInstall + ["kernel", profilePath] -> runKernel profilePath + _ -> putStrLn $ "Invalid arguments: " ++ show args + +-- | Register this kernel with Jupyter. +-- +-- This eventually calls @jupyter kernelspec install@ to register the kernel, but the command +-- invocation and directory setup is handled by 'installKernel'. +runInstall :: IO () +runInstall = + installKernel InstallLocal basicKernelspec >>= handleInstallResult + where + -- A basic kernelspec with limited info. The key part of this definition is the function which + -- defines how to invoke the kernel; in this case, the kernel is invoked by calling this same + -- executable with the command-line argument "kernel", followed by a path to a connection file. + basicKernelspec :: Kernelspec + basicKernelspec = + simpleKernelspec "Basic" "basic" $ \exe connect -> [exe, "kernel", connect] + + -- Print an error message and exit with non-zero exit code if the install failed. + handleInstallResult :: InstallResult -> IO () + handleInstallResult installResult = + case installResult of + InstallSuccessful -> return () + InstallFailed reason -> do + T.hPutStrLn stderr reason + exitFailure + +-- | Run the kernel on ports determined by parsing the connection file provided. +runKernel :: FilePath -> IO () +runKernel profilePath = do + Just profile <- readProfile profilePath + serve profile defaultCommHandler $ + defaultClientRequestHandler profile $ simpleKernelInfo "Basic" diff --git a/examples/calculator/Calculator/Handler.hs b/examples/calculator/Calculator/Handler.hs new file mode 100644 --- /dev/null +++ b/examples/calculator/Calculator/Handler.hs @@ -0,0 +1,252 @@ +{-| +Module : Calculator.Handler +Description : The request handling for the calculator kernel. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX + +This module implements the main request handler ('ClientRequestHandler') for the demo Calculator +kernel that comes with the @jupyter@ package. + +The Calculator kernel implements a very simple language, represented by the following AST: + +@ +data Expr = Lit Int + | Add Expr Expr + | Multiply Expr Expr + | Subtract Expr Expr + | Divide Expr Expr + | Negate Expr + | Var Char + +data Statement = Compute [(Char, Int)] Expr + | Print Expr +@ + +Expressions in our calculator are represented by an @Expr@, and the things calculator the +calculator can do with the expressions are the constructors of @Statement@: + * @Compute@: Given a mapping from variables to values, compute and print the value of the expression. + * @Print@: Print a representation of the expression (emits both plain text and LaTeX). + +The kernel features implemented by this kernel include code execution, autocompletion of +constructor names, and inspection of constructor names. To simplify the code, parsing is omitted, +and instead the entire language syntax is simply Haskell expressions, so that we can use the +derived 'Read' parsers. + +-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +module Calculator.Handler (requestHandler) where + +-- Imports from 'base' +import Control.Concurrent (MVar, modifyMVar) +import Data.List (nub) +import Data.Monoid ((<>)) +import Text.Read (readMaybe) + +-- Imports from 'text' +import Data.Text (Text) +import qualified Data.Text as T + +-- Imports from 'jupyter' +import Jupyter.Kernel (defaultClientRequestHandler, KernelProfile, KernelCallbacks(..)) +import Jupyter.Messages (ClientRequest(..), KernelReply(..), KernelInfo(..), + LanguageInfo(..), HelpLink(..), CodeBlock(..), CodeOffset(..), + ExecutionCount, KernelOutput(..), ErrorInfo(..), displayPlain, + displayLatex, CompletionMatch(..), CursorRange(..), + pattern CompleteOk, pattern ExecuteOk, pattern InspectOk, + pattern ExecuteError) + +-- | An expression in our simple calculator language. Values are all integers, but variables are +-- represented by a single character name @Var@ constructor. +data Expr = Lit Int + | Add Expr Expr + | Multiply Expr Expr + | Subtract Expr Expr + | Divide Expr Expr + | Negate Expr + | Var Char + deriving (Eq, Ord, Show, Read) + +-- | Statements representing the things we can do with our expressions. +data Statement = Compute [(Char, Int)] Expr -- ^ Compute the value of an expression, substituting + -- variables as necessary. If variables are left over + -- after substitution, an error is raised. + | Print Expr -- ^ Print a mathematical representation of the expression. + deriving (Eq, Ord, Show, Read) + +-- | Parse a 'Statement' in our language by using its Read instance. +parse :: Text -> Maybe Statement +parse = readMaybe . T.unpack + +-- | Evaluate an expression, substituting in variables as necessary. If any variables are +-- unevaluated or division by zero occurs, yields Nothing. +eval :: [(Char, Int)] -> Expr -> Maybe Int +eval vars expr = + case expr of + Lit i -> return i + Add a b -> (+) <$> eval vars a <*> eval vars b + Multiply a b -> (*) <$> eval vars a <*> eval vars b + Subtract a b -> (-) <$> eval vars a <*> eval vars b + Divide a b -> do + denom <- eval vars b + if denom == 0 + then Nothing + else div <$> eval vars a <*> pure denom + Negate a -> negate <$> eval vars a + Var c -> lookup c vars + +-- | Print an expression as an ASCII string. +-- +-- Do not bother with clean parentheses, this is just a demo! +printText :: Expr -> String +printText expr = + case expr of + Lit i -> show i + Var c -> [c] + Negate e -> '-' : printText e + Add a b -> concat ["(", printText a, " + ", printText b, ")"] + Multiply a b -> concat ["(", printText a, " * ", printText b, ")"] + Subtract a b -> concat ["(", printText a, " - ", printText b, ")"] + Divide a b -> concat ["(", printText a, " / ", printText b, ")"] + +-- | Print an expression as a LaTeX string. +printLatex :: Expr -> String +printLatex expr = + case expr of + Lit i -> show i + Var c -> [c] + Negate e -> '-' : printLatex e + Add a b -> concat ["(", printLatex a, " + ", printLatex b, ")"] + Multiply a b -> concat ["(", printLatex a, " \\cdot ", printLatex b, ")"] + Subtract a b -> concat ["(", printLatex a, " - ", printLatex b, ")"] + Divide a b -> concat ["\\frac{", printLatex a, "}{", printLatex b, "}"] + +-- | List of symbols that should be part of autocompletions. +autocompleteSymbols :: [Text] +autocompleteSymbols = map fst tokenDocumentation + +-- | Documentation for symbols in our language, stored as an association list. +tokenDocumentation :: [(Text, Text)] +tokenDocumentation = + [ ("Lit", "Lit: Create an integer literal.") + , ("Var", "Var: Create a variable with a single character name.") + , ("Negate", "Negate: Negate an expression.") + , ("Add", "Add: Add two expressions.") + , ("Multiply", "Multiply: Multiply two expressions.") + , ("Subtract", "Subtract: Subtract one expression from another.") + , ("Divide", "Divide: Divide an expression by another.") + , ("Compute", "Compute: Given an expression and variable bindings, compute the expression value.") + , ("Print", "Print: Print an expression as text or LaTeX.") + ] + +-- | The main request handler for the Calculator kernel. +-- +-- The request handler is responsible for generating a KernelReply when given a ClientRequest, optionally +-- publishing results using the callbacks provided to it in the 'KernelCallbacks' record. +requestHandler :: KernelProfile -> MVar ExecutionCount -> KernelCallbacks -> ClientRequest -> IO KernelReply +requestHandler profile execCountVar callbacks req = + case req of + ExecuteRequest code _ -> + -- For this simple kernel, ignore the execution options, as they do not apply + -- to our simple kernel. Also, automatically increment the execution counter. + modifyMVar execCountVar $ \execCount -> do + -- Kernels are responsible for broadcasting any execution request code blocks they receive + -- to all connected frontends via kernel outputs. + sendKernelOutput callbacks $ ExecuteInputOutput execCount code + + reply <- handleExecuteRequest execCount code callbacks + return (execCount + 1, reply) + InspectRequest code offset _ -> + -- Ignore the detail level, because for this simple kernel we don't have + -- documentation of identifiers at multiple detail levels. + handleInspectRequest code offset + CompleteRequest code offset -> handleCompleteRequest code offset + other -> + -- Any unhandled messages can be handled in the default manner. + defaultClientRequestHandler profile kernelInfo callbacks other + where + -- This KernelInfo is returned by the default client request handler when it receives a + -- KernelInfoRequest message, which is usually the first message that the client sends to the + -- kernel. + kernelInfo = KernelInfo + { kernelProtocolVersion = "5.0" + , kernelBanner = "Welcome to the Haskell Calculator Test Kernel!" + , kernelImplementation = "Calculator-Kernel" + , kernelImplementationVersion = "1.0" + , kernelHelpLinks = [ HelpLink "jupyter package doc" + "http://github.com/gibiansky/jupyter-haskell" + ] + , kernelLanguageInfo = LanguageInfo + { languageName = "calculator" + , languageVersion = "1.0" + , languageMimetype = "text/plain" + , languageFileExtension = ".txt" + , languagePygmentsLexer = Nothing + , languageCodeMirrorMode = Nothing + , languageNbconvertExporter = Nothing + } + } + +-- | Given a block of code and a cursor offset in the code, tokenize the code and extract the token +-- immediately preceeding the cursor. A token is defined a contiguous set of alphanumeric +-- characters. +-- +-- >>> findPreceedingToken "xyz (Hello)" 9 == "Hell" +findPreceedingToken :: Text -> Int -> Text +findPreceedingToken code offset = + let beforeCursor = T.take offset code + allowedSymbolChars = nub $ T.unpack $ T.concat autocompleteSymbols + token = T.takeWhileEnd (`elem` allowedSymbolChars) beforeCursor + in token + +-- | Generate a 'KernelReply' for an 'ExecuteRequest', sending any necessary outputs in the process. +handleExecuteRequest :: ExecutionCount -> CodeBlock -> KernelCallbacks -> IO KernelReply +handleExecuteRequest execCount (CodeBlock code) KernelCallbacks { .. } = + case parse code of + Nothing -> do + -- Parse error! + let errMsg = "Could not parse: '" <> code <> "'" + sendKernelOutput $ DisplayDataOutput $ displayPlain errMsg + reply $ ExecuteError + ErrorInfo { errorName = "Parse Error", errorValue = errMsg, errorTraceback = [] } + Just (Compute bindings expr) -> + case eval bindings expr of + Nothing -> do + let errMsg = "Missing variable bindings in: '" <> code <> "'" + sendKernelOutput $ DisplayDataOutput $ displayPlain errMsg + reply $ ExecuteError + ErrorInfo { errorName = "Eval Error", errorValue = errMsg, errorTraceback = [] } + Just val -> do + sendKernelOutput $ DisplayDataOutput $ displayPlain $ T.pack $ show val + reply ExecuteOk + + Just (Print expr) -> do + let text = T.pack $ printText expr + latex = T.pack $ printLatex expr + sendKernelOutput $ DisplayDataOutput $ displayPlain text <> displayLatex latex + reply ExecuteOk + where + reply = return . ExecuteReply execCount + +-- | Generate a 'KernelReply' for an 'InspectRequest'. +handleInspectRequest :: CodeBlock -> CodeOffset -> IO KernelReply +handleInspectRequest (CodeBlock code) (CodeOffset offset) = + let token = findPreceedingToken code offset + in return . InspectReply . InspectOk $ displayPlain <$> lookup token tokenDocumentation + +-- | Generate autocompletions for the symbols used in our language. +-- +-- The algorithm for autocompleting is very simple: find the preceeding token by looking at which +-- characters are allowed in symbols, then search through all available symbols to find which ones +-- start with the found token. +handleCompleteRequest :: CodeBlock -> CodeOffset -> IO KernelReply +handleCompleteRequest (CodeBlock code) (CodeOffset offset) = + let token = findPreceedingToken code offset + start = offset - T.length token + completions = filter (T.isPrefixOf token) autocompleteSymbols + in return $ CompleteReply $ + CompleteOk (map CompletionMatch completions) (CursorRange start offset) mempty diff --git a/examples/calculator/Main.hs b/examples/calculator/Main.hs new file mode 100644 --- /dev/null +++ b/examples/calculator/Main.hs @@ -0,0 +1,74 @@ +{-| +Module : Main +Description : Main module for a stdin-using Jupyter kernel created using the @jupyter@ library. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX + +This module is the Main module for @kernel-calculator@, a Jupyter kernel which implements a simple +calculator language using the @jupyter@ library. It is intended to demonstrate a full yet basic kernel, +one which implements execution, inspection, completion, as well as the basic informational requests. +-} + +{-# Language OverloadedStrings #-} +module Main(main) where + +-- Imports from 'base' +import Control.Concurrent (newMVar) +import System.Environment (getArgs) +import System.Exit (exitFailure) +import System.IO (stderr) + +-- Imports from 'text' +import qualified Data.Text.IO as T + +-- Imports from 'jupyter' +import Jupyter.Install (installKernel, simpleKernelspec, InstallUser(..), InstallResult(..), + Kernelspec) +import Jupyter.Kernel (readProfile, serve, defaultCommHandler) + +-- Imports from 'kernel-calculator' +import Calculator.Handler (requestHandler) + +-- | In `main`, support two commands: +-- +-- - `kernel-calculator install`: Register this kernel with Jupyter. +-- - `kernel-calculator kernel $FILE`: Serve a kernel given ports in connection file $FILE. +main :: IO () +main = do + args <- getArgs + case args of + ["install"] -> runInstall + ["kernel", profilePath] -> runKernel profilePath + _ -> putStrLn $ "Invalid arguments: " ++ show args + +-- | Register this kernel with Jupyter. +runInstall :: IO () +runInstall = + installKernel InstallLocal calculatorKernelspec >>= handleInstallResult + where + -- A basic kernelspec with limited info. + calculatorKernelspec :: Kernelspec + calculatorKernelspec = + simpleKernelspec "Calculator" "calculator" $ \exe connect -> [exe, "kernel", connect] + + -- Print an error message and exit with non-zero exit code if the install failed. + handleInstallResult :: InstallResult -> IO () + handleInstallResult installResult = + case installResult of + InstallSuccessful -> return () + InstallFailed reason -> do + T.hPutStrLn stderr reason + exitFailure + +-- | Run the kernel on ports determined by parsing the connection file provided. +runKernel :: FilePath -> IO () +runKernel profilePath = do + Just profile <- readProfile profilePath + + -- Keep track of the current execution using an MVar. In general, kernel state (when it exists) + -- often needs to be kept in some sort of temporary mutable state. + execCountVar <- newMVar 1 + serve profile defaultCommHandler $ requestHandler profile execCountVar diff --git a/examples/client-kernel-info/Main.hs b/examples/client-kernel-info/Main.hs new file mode 100644 --- /dev/null +++ b/examples/client-kernel-info/Main.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings #-} +import Control.Monad.IO.Class (MonadIO(liftIO)) +import System.Process (spawnProcess) + +import Jupyter.Client (runClient, sendClientRequest, ClientHandlers(..), connectKernel, + defaultClientCommHandler, findKernel, writeProfile, Kernelspec(..)) +import Jupyter.Messages (ClientRequest(KernelInfoRequest), KernelReply(KernelInfoReply), + KernelRequest(InputRequest), ClientReply(InputReply)) + +main :: IO () +main = do + -- Find the kernelspec for the python 3 kernel + Just kernelspec <- findKernel "python3" + + -- Start the client connection + runClient Nothing Nothing handlers $ \profile -> do + -- Write the profile connection file to a JSON file + liftIO $ writeProfile profile "profile.json" + + -- Launch the kernel process, giving it the path to the JSON file + let command = kernelspecCommand kernelspec "" "profile.json" + _ <- liftIO $ spawnProcess (head command) (tail command) + + -- Send a kernel info request and get the reply + connection <- connectKernel + KernelInfoReply info <- sendClientRequest connection KernelInfoRequest + liftIO $ print info + +handlers :: ClientHandlers +handlers = ClientHandlers { + -- Do nothing on comm messages + commHandler = defaultClientCommHandler, + + -- Return a fake stdin string if asked for stdin + kernelRequestHandler = \_ req -> + case req of + InputRequest{} -> return $ InputReply "Fake Stdin", + + -- Do nothing on kernel outputs + kernelOutputHandler = \_ _ -> return () + } diff --git a/examples/stdin/Main.hs b/examples/stdin/Main.hs new file mode 100644 --- /dev/null +++ b/examples/stdin/Main.hs @@ -0,0 +1,100 @@ +{-| +Module : Main +Description : Main module for a basic bare-minimum Jupyter kernel created using the @jupyter@ library. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX + +This module is the Main module for @kernel-stdin@, a bare-minimum Jupyter kernel which uses the +@stdin@ channel (with 'KernelRequest's), created using the @jupyter@ library. It is intended to +demo the bare minimum amount of code required to create a Jupyter kernel which simulates using +a standard input channel. +-} + +{-# Language OverloadedStrings #-} +{-# Language PatternSynonyms #-} +module Main(main) where + +-- Imports from 'base' +import Control.Monad (when) +import System.Environment (getArgs) +import System.Exit (exitFailure) +import System.IO (stderr) + +-- Imports from 'text' +import Data.Text (Text) +import qualified Data.Text.IO as T + +-- Imports from 'jupyter' +import Jupyter.Install (installKernel, simpleKernelspec, InstallUser(..), InstallResult(..), + Kernelspec) +import Jupyter.Kernel (readProfile, simpleKernelInfo, serve, defaultCommHandler, + defaultClientRequestHandler, KernelCallbacks(..), KernelProfile, + ClientRequestHandler) +import Jupyter.Messages (KernelOutput(..), KernelReply(..), displayPlain, ClientRequest(..), + pattern ExecuteOk, CodeBlock(..), KernelRequest(..), + ClientReply(..), InputOptions(..)) + +-- | In `main`, support two commands: +-- +-- - `kernel-stdin install`: Register this kernel with Jupyter. +-- - `kernel-stdin kernel $FILE`: Serve a kernel given ports in connection file $FILE. +main :: IO () +main = do + args <- getArgs + case args of + ["install"] -> runInstall + ["kernel", profilePath] -> runKernel profilePath + _ -> putStrLn $ "Invalid arguments: " ++ show args + +-- | Register this kernel with Jupyter. +runInstall :: IO () +runInstall = + installKernel InstallLocal stdinKernelspec >>= handleInstallResult + where + -- A basic kernelspec with limited info for testing stdin. + stdinKernelspec :: Kernelspec + stdinKernelspec = + simpleKernelspec "Stdin" "stdin" $ \exe connect -> [exe, "kernel", connect] + + -- Print an error message and exit with non-zero exit code if the install failed. + handleInstallResult :: InstallResult -> IO () + handleInstallResult installResult = + case installResult of + InstallSuccessful -> return () + InstallFailed reason -> do + T.hPutStrLn stderr reason + exitFailure + +-- | Run the kernel on ports determined by parsing the connection file provided. +runKernel :: FilePath -> IO () +runKernel profilePath = do + Just profile <- readProfile profilePath + serve profile defaultCommHandler $ clientRequestHandler profile + +-- | Client request handler which acts in all ways as the default, except for execute requests, +-- it reads data from stdin and writes it back to the client as a display data message. +clientRequestHandler :: KernelProfile -> ClientRequestHandler +clientRequestHandler profile callbacks req = + case req of + ExecuteRequest (CodeBlock code) _ -> do + sendKernelOutput callbacks $ ExecuteInputOutput 1 (CodeBlock code) + echoStdin code callbacks + return $ ExecuteReply 1 ExecuteOk + _ -> defaultClientRequestHandler profile (simpleKernelInfo "Stdin") callbacks req + +-- | Read some text from the client stdin using the 'KernelCallbacks', then publish that text back +-- to the client as a 'DisplayDataOutput'. +-- +-- If the execute promppt is "password", then the input is done in password mode. +echoStdin :: Text -> KernelCallbacks -> IO () +echoStdin code callbacks = + when (code /= "skip") $ do + clientReply <- sendKernelRequest callbacks $ + InputRequest + InputOptions { inputPrompt = code, inputPassword = code == "password" } + case clientReply of + InputReply stdinText -> + sendKernelOutput callbacks $ DisplayDataOutput $ displayPlain stdinText diff --git a/jupyter.cabal b/jupyter.cabal new file mode 100644 --- /dev/null +++ b/jupyter.cabal @@ -0,0 +1,114 @@ +name: jupyter +version: 0.9.0 +synopsis: A library for creating and using Jupyter kernels. + +description: An implementation of the Jupyter messaging protocol, used to implement Jupyter kernels in Haskell or communicate with existing Jupyter kernels via the messaging protocol. +homepage: http://github.com/gibiansky/haskell-jupyter +license: MIT +license-file: LICENSE +author: Andrew Gibiansky +maintainer: andrew.gibiansky@gmail.com +category: Development +build-type: Simple +cabal-version: >=1.16 + +source-repository head + type: git + location: git://github.com/gibiansky/jupyter-haskell.git + + +library + exposed-modules: Jupyter.Kernel + Jupyter.Client + Jupyter.ZeroMQ + Jupyter.Messages + Jupyter.Messages.Internal + Jupyter.UUID + Jupyter.Install + Jupyter.Install.Internal + hs-source-dirs: src + default-language: Haskell2010 + build-depends: base >=4.6 && <5, + aeson >=0.6, + bytestring >=0.10, + cereal >=0.3, + containers >=0.5, + directory >=1.1, + temporary >=1.2, + filepath >=1.2, + process >=1.1, + mtl >=2.1, + text >=0.11, + transformers >=0.3, + unordered-containers >= 0.2.5, + uuid >=1.3, + zeromq4-haskell >=0.1, + SHA >=1.6, + monad-control >=1.0, + async >= 2.0, + exceptions >= 0.8 + +test-suite test-jupyter + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Test.hs + + other-modules: Jupyter.Test.Install + Jupyter.Test.Kernel + Jupyter.Test.ZeroMQ + Jupyter.Test.Client + Jupyter.Test.MessageExchange + Jupyter.Test.Utils + + build-depends: base >= 4 && < 5, + tasty >= 0.7, + tasty-hunit >= 0.9, + extra >= 1.1, + directory >= 1.2, + silently >= 1.2, + aeson >= 0.6, + bytestring >= 0.10, + text >= 0.11, + zeromq4-haskell >= 0.6, + transformers >= 0.3, + containers >=0.5, + process >= 1.2, + exceptions >= 0.8, + async >= 2.0, + unordered-containers >= 0.2, + jupyter + +executable kernel-basic + default-language: Haskell2010 + hs-source-dirs: examples/basic + main-is: Main.hs + build-depends: base >= 4.6, + text >= 1.2, + jupyter + +executable kernel-calculator + default-language: Haskell2010 + hs-source-dirs: examples/calculator + main-is: Main.hs + other-modules: Calculator.Handler + build-depends: base >= 4.6, + text >= 1.2, + jupyter + +executable kernel-stdin + default-language: Haskell2010 + hs-source-dirs: examples/stdin + main-is: Main.hs + build-depends: base >= 4.6, + text >= 1.2, + jupyter + +executable client-kernel-info + default-language: Haskell2010 + hs-source-dirs: examples/client-kernel-info + main-is: Main.hs + build-depends: base >= 4.6, + process >= 1.2, + transformers >= 0.3, + jupyter diff --git a/src/Jupyter/Client.hs b/src/Jupyter/Client.hs new file mode 100644 --- /dev/null +++ b/src/Jupyter/Client.hs @@ -0,0 +1,372 @@ +{-| +Module : Main +Description : Client interface for Jupyter kernels. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX + +This module provides an easy API for writing Jupyter clients. Jupyter clients (also commonly called +frontends) are programs which +communicate with Jupyter kernels, possibly starting them and then sending them requests over the +ZeroMQ-based messaging protocol. Examples of Jupyter clients include the Jupyter console, the +, and the . + +Communication with clients is done in the 'Client' monad, which is a thin wrapper over 'IO' which +maintains a small bit of required state to identify a running kernel and the sockets on which to +communicate with it. The initial state and connection information is supplied when you use 'runClient', +which requires connection information and the 'Client' action to run. + +The 'runClient' function also requires a set of 'ClientHandlers', which are callbacks that get called +when the kernel sends any sort of message to the client ('KernelRequest's, 'KernelOutput's, and 'Comm's). + +These functions can be used quite succinctly to communicate with external clients. For example, the +following code connects to an installed Python kernel (the @ipykernel@ package must be installed): + +@ +import Control.Monad.IO.Class (MonadIO(liftIO)) +import System.Process (spawnProcess) + +import "Jupyter.Client" +import "Jupyter.Messages" + +main :: IO () +main = + 'runClient' Nothing Nothing handlers $ \profile -> do + -- The `profile` provided is a generated 'KernelProfile' + -- that the client will connect to. Start an IPython kernel + -- that listens on that profile. + liftIO $ do + 'writeProfile' profile "profile.json" + 'System.Process.spawnProcess' "python" ["-m", "ipykernel", "-f", "profile.json"] + + -- Find out info about the kernel by sending it a kernel info request. + connection <- 'connectKernel' + reply <- 'sendClientRequest' connection 'KernelInfoRequest' + liftIO $ print reply + +handlers :: ClientHandlers +handlers = ClientHandlers { + -- Do nothing on comm messages + 'commHandler' = 'defaultClientCommHandler', + + -- Return a fake stdin string if asked for stdin + 'kernelRequestHandler' = \_ req -> + case req of + 'InputRequest'{} -> return $ 'InputReply' "Fake Stdin", + + -- Do nothing on kernel outputs + 'kernelOutputHandler' = \_ _ -> return () + } +@ + +A more detailed example is provided in the + +directory, and more information about the client and kernel interfaces can be found on the @jupyter@ +. +-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GADTs #-} +module Jupyter.Client ( + -- * Communicating with Clients + Client, + runClient, + connectKernel, + sendClientRequest, + sendClientComm, + ClientHandlers(..), + defaultClientCommHandler, + KernelConnection, + + -- * Writing Connection Files + writeProfile, + + -- * Locating kernels + Kernelspec(..), + findKernel, + findKernels, + ) where + +-- Imports from 'base' +import Control.Exception (bracket, catch) +import Control.Monad (forever) +import Data.Maybe (fromMaybe) + +-- Imports from 'bytestring' +import Data.ByteString (ByteString) + +-- Imports from 'async' +import Control.Concurrent.Async (async, link, link2, cancel, Async) + +-- Imports from 'mtl' +import Control.Monad.Reader (MonadReader, ReaderT, runReaderT, ask) + +-- Imports from 'transformers' +import Control.Monad.IO.Class (MonadIO(..)) + +-- Imports from 'exceptions' +import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask) + +-- Imports from 'monad-control' +import Control.Monad.Trans.Control (liftBaseWith) + +-- Imports from 'zeromq4-haskell' +import System.ZMQ4.Monadic (ZMQ) + +-- Imports from 'jupyter' +import Jupyter.Install (findKernel, findKernels, Kernelspec(..)) +import Jupyter.Messages (Comm, KernelRequest, ClientReply, KernelOutput, ClientRequest, + KernelReply) +import Jupyter.Messages.Internal (Username) +import Jupyter.ZeroMQ (ClientSockets(..), withClientSockets, sendMessage, receiveMessage, + messagingError, mkRequestHeader, KernelProfile(..), mkReplyHeader, + threadKilledHandler, writeProfile) +import qualified Jupyter.UUID as UUID + +-- | All the state required to maintain a connection to the client. +data ClientState = forall z. + ClientState + { clientSockets :: ClientSockets z -- ^ A set of sockets used to communicate with the kernel. + , clientSessionUsername :: Username -- ^ A username to use in message headers. + , clientSessionUuid :: UUID.UUID -- ^ A session UUID to use in message headers. + , clientSignatureKey :: ByteString -- ^ An HMAC signature key to hash message signature with. + , clientLiftZMQ :: forall a m. MonadIO m => ZMQ z a -> m a + -- ^ A helper function to convert from ZMQ actions to any IO monad. + } + +-- | A client action, representing a computation in which communication happens with a Jupyter +-- client. +-- +-- Use 'sendClientRequest' and 'sendClientComm' to construct 'Client' values, the 'Monad' interface to +-- manipulate them, and 'runClient' to supply all needed connection info and run the action. +newtype Client a = Client { unClient :: ReaderT ClientState IO a } + deriving (Functor, Applicative, Monad, MonadIO, MonadReader ClientState, MonadThrow, MonadCatch, MonadMask) + +-- | A connection to a kernel from a client. +-- +-- A connection can be obtained with 'connectKernel', and must be provided to +-- 'sendClientRequest' and 'sendClientComm' to communicate with a kernel. +data KernelConnection = KernelConnection + deriving (Eq, Ord) + +-- | A set of callbacks for the client. These callbacks get called when the client receives any +-- message from the kernel. +-- +-- One callback exists per message type that the clients can receive. Each callbacks can also send +-- 'Comm' messages to kernel, and receive a function of type @'Comm' -> IO ()@ that sends a single +-- 'Comm' message to the kernel. +data ClientHandlers = + ClientHandlers + { kernelRequestHandler :: (Comm -> IO ()) -> KernelRequest -> IO ClientReply + -- ^ A callback for handling 'KernelRequest's. A 'KernelRequest' is sent from a + -- kernel to just one client, and that client must generate a 'ClientReply' with + -- the corresponding constructor. + -- + -- The handler is passed a function @'Comm' -> IO ()@ which may be used to send 'Comm' messages + -- back to the client that sent the message. + , commHandler :: (Comm -> IO ()) -> Comm -> IO () + -- ^ A callback for handling 'Comm' messages from the kernel. 'Comm' messages may be handled in + -- any way, and 'defaultClientCommHandler' may be used as a 'Comm' handler that simply does nothing. + -- + -- The handler is passed a function @'Comm' -> IO ()@ which may be used to send 'Comm' messages + -- back to the client that sent the message. + , kernelOutputHandler :: (Comm -> IO ()) -> KernelOutput -> IO () + -- ^ A callback for handling 'KernelOutput's. 'KernelOutput' messages are the primary + -- way for a kernel to publish outputs, and are sent to all connected frontends. + -- + -- The handler is passed a function @'Comm' -> IO ()@ which may be used to send 'Comm' messages + -- back to the client that sent the message. + } + +-- | Run a 'Client' action in 'IO'. +-- +-- This function sets up ZeroMQ sockets on which it can connect to a kernel; if no 'KernelProfile' +-- is provided, it generates a fresh 'KernelProfile' which contains information about the ports and +-- transport protocols which it expects the kernel to connect with. It guarantees that the ports it +-- chooses are open – that is, that no kernel is currently connected to those ports. +-- +-- The generated 'KernelProfile' is passed to the user-provided @'KernelProfile' -> 'Client' a@ +-- callback, which may use functions such as 'sendClientRequest' to communicate with the kernel. If +-- the kernel sends messages to the client, they are handled with the callbacks provided in the +-- 'ClientHandlers' record. +-- +-- Most clients follow a simple pattern: +-- +-- 1. Invoke 'runClient', passing 'Nothing' for the 'KernelProfile'. This allows 'runClient' +-- to set up and choose its own ports. +-- 2. Write the connection file containing the chosen ports to a JSON file using 'writeProfile'. +-- Make sure to write it to a temporary directory, to avoid clobbering user directories with +-- connection files. +-- 3. If you do not know the command used to invoke the target kernel, use 'findKernel' to +-- find the 'Kernelspec' for the kernel you wish to launch. Then, use the 'kernelspecCommand' +-- field to generate the kernel command invocation. +-- 4. Launch the kernel using 'spawnProcess' or a similar function, providing the connection +-- file you wrote out as a command-line parameter. +-- 5. Wait for the kernel to connect to the client using 'connectKernel'. +-- 6. Use the output 'KernelConnection' from 'connectClient' to communicate with the kernel +-- using 'sendClientRequest' (and maybe 'sendClientComm'). +-- +-- A full example is provided in the +-- +-- directory. +-- +-- If any of the client handlers in the provided 'ClientHandlers' throw an exception, the client is +-- gracefully shutdown and the exception is reraised on the main 'runClient' thread. +runClient :: Maybe KernelProfile -- ^ Optionally, a 'KernelProfile' to connect to. If no + -- 'KernelProfile' is provided, one is generated on the fly. + -- However, if a 'KernelProfile' /is/ provided, and connecting to + -- the specified ports fails, an exception is thrown. + -> Maybe Username -- ^ Optionally, a username to use when sending messages to the client. + -- If no username is provided, a default one is used. + -> ClientHandlers -- ^ A record containing handlers for messages the kernel sends to the + -- client. + -> (KernelProfile -> Client a) -- ^ Provided with the 'KernelProfile' that was being used + -- (either a freshly generated one or the one passed in by + -- the user), generate a 'Client' action. This action is + -- then run, handling all the ZeroMQ communication in the + -- background. + -> IO a +runClient mProfile mUser clientHandlers client = + withClientSockets mProfile $ \profile sockets -> + liftBaseWith $ \runInBase -> do + let sessionUsername = fromMaybe "default-username" mUser + sessionUuid <- UUID.random + + -- Don't let the listenrs start immediately. If so, we can get into an ugly, ugly + -- intermediate state, where the listeners are running but their Asyncs are not linked + -- to each other *or* to the main thread. That means that sometimes, with low probability, + -- the Asyncs can get an exception thrown to them *before* they are linked, and so the + -- thread will die without killing the other thread or the main thread. This can then + -- lead to deadlocks if you expect the threads to be running. + -- + -- We avoid this but ensuring that the async threads cannot get exceptions until they + -- are linked, using an MVar for this lock. + let clientState = ClientState + { clientSockets = sockets + , clientSessionUsername = sessionUsername + , clientSessionUuid = sessionUuid + , clientSignatureKey = profileSignatureKey profile + , clientLiftZMQ = liftIO . runInBase + } + + setupListeners :: IO (Async (), Async ()) + setupListeners = do + async1 <- listenStdin clientState clientHandlers + async2 <- listenIopub clientState clientHandlers + + + -- Ensure that if any exceptions are thrown on the handler threads, + -- those exceptions are re-raised on the main thread. + link async1 + link2 async1 async2 + + return (async1, async2) + + -- Ensure that if any exceptions are thrown on the main thread, the asyncs + -- are cancelled with a ThreadKilled exception, and that if no exceptions + -- are thrown, then the threads are terminated as appropriate. + bracket setupListeners + (\(async1, async2) -> cancel async1 >> cancel async2) + (const $ runReaderT (unClient $ client profile) clientState) + + +-- | Wait for a kernel to connect to this client, and return a 'KernelConnection' once the kernel +-- has connected. +-- +-- This 'KernelConnection' must be passed to 'sendClientRequest' and 'sendClientComm' to communicate +-- with the connected kernel. +connectKernel :: Client KernelConnection +connectKernel = do + ClientState {..} <- ask + liftIO $ clientWaitForConnections clientSockets + return KernelConnection + +-- | Send a 'ClientRequest' to the kernel. Wait for the kernel to reply with a 'KernelReply', +-- blocking until it does so. +sendClientRequest :: KernelConnection -- ^ A kernel connection, produced by 'connectKernel'. + -> ClientRequest -- ^ The request to send to the connected kernel. + -> Client KernelReply +sendClientRequest KernelConnection req = do + ClientState { .. } <- ask + header <- liftIO $ mkRequestHeader clientSessionUuid clientSessionUsername req + clientLiftZMQ $ sendMessage clientSignatureKey (clientShellSocket clientSockets) header req + received <- clientLiftZMQ $ receiveMessage (clientShellSocket clientSockets) + + case received of + Left err -> + -- There's no way to recover from this, so just die. + messagingError "Jupyter.Client" $ + "Unexpected failure parsing KernelReply message: " ++ err + Right (_, message) -> return message + +-- | Send a 'Comm' message to the kernel. The kernel is not obligated to respond in any way, so do +-- not block, but return immediately upon sending the message. +sendClientComm :: KernelConnection -- ^ A kernel connection, produced by 'connectKernel'. + -> Comm -- ^ The 'Comm' message to send. + -> Client () +sendClientComm KernelConnection comm = do + ClientState { .. } <- ask + header <- liftIO $ mkRequestHeader clientSessionUuid clientSessionUsername comm + clientLiftZMQ $ sendMessage clientSignatureKey (clientShellSocket clientSockets) header comm + +-- | A default client 'Comm' handlers, which, upon receiving a 'Comm' message, does nothing. +-- +-- For use with the 'ClientHandlers' 'commHandler' field. +defaultClientCommHandler :: (Comm -> IO ()) -> Comm -> IO () +defaultClientCommHandler _ _ = return () + +-- | Spawn a new thread that forever listens on the /iopub/ socket, parsing the messages +-- as they come in and calling the appropriate callback from the 'ClientHandlers' record. +-- +-- If the thread receives a 'ThreadKilled' exception, it will die silently, without letting +-- the exception propagate. +listenIopub :: ClientState -> ClientHandlers -> IO (Async ()) +listenIopub ClientState { .. } handlers = async $ catch (forever respondIopub) threadKilledHandler + where + respondIopub = do + received <- clientLiftZMQ $ receiveMessage (clientIopubSocket clientSockets) + case received of + Left err -> + -- There's no way to recover from this, so just die. + messagingError "Jupyter.Client" $ + "Unexpected failure parsing Comm or KernelOutput message: " ++ err + Right (header, message) -> do + let sendReplyComm comm = do + commHeader <- mkReplyHeader header comm + clientLiftZMQ $ sendMessage + clientSignatureKey + (clientShellSocket clientSockets) + commHeader + comm + + case message of + Left comm -> commHandler handlers sendReplyComm comm + Right output -> kernelOutputHandler handlers sendReplyComm output + +-- | Spawn a new thread that forever listens on the /stdin/ socket, parsing the messages +-- as they come in and calling the appropriate callback from the 'ClientHandlers' record. +-- +-- If the thread receives a 'ThreadKilled' exception, it will die silently, without letting +-- the exception propagate. +listenStdin :: ClientState -> ClientHandlers -> IO (Async ()) +listenStdin ClientState{..} handlers = async $ catch (forever respondStdin) threadKilledHandler + where + respondStdin = do + received <- clientLiftZMQ $ receiveMessage (clientStdinSocket clientSockets) + case received of + Left err -> + -- There's no way to recover from this, so just die. + messagingError "Jupyter.Client" $ + "Unexpected failure parsing KernelRequest message: " ++ err + Right (header, message) -> do + let sendReplyComm comm = do + commHeader <- mkReplyHeader header comm + clientLiftZMQ $ sendMessage clientSignatureKey (clientShellSocket clientSockets) commHeader comm + reply <- kernelRequestHandler handlers sendReplyComm message + replyHeader <- mkReplyHeader header reply + clientLiftZMQ $ sendMessage clientSignatureKey (clientStdinSocket clientSockets) replyHeader reply diff --git a/src/Jupyter/Install.hs b/src/Jupyter/Install.hs new file mode 100644 --- /dev/null +++ b/src/Jupyter/Install.hs @@ -0,0 +1,56 @@ +{-| +Module : Jupyter.Install +Description : Utilities for installing Jupyter kernels. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX + +Before any Jupyter frontends (such as the notebook or console) can use a kernel, the kernel must be installed. +Traditionally, kernels are installed by defining a kernelspec and running @jupyter kernelspec install@, where a kernelspec +is defined by creating a directory with a set of predefined files that Jupyter knows how to handle, and is installed by +passing the directory to @jupyter kernelspec install@. Installed kernelspecs may be queried with @jupyter kernelspec list@. + +Instead, this module provides a few utilities for defining, installing, and locating kernelspecs. A kernelspec +can be defined by creating a value of type 'Kernelspec' and can be installed with 'installKernel'. The +installed kernelspecs may be listed or searched with 'findKernels' and 'findKernel', respectively. These utilities +are simply convenient wrappers around the @jupyter kernelspec install@ and @jupyter kernelspec list@ commands. +-} +module Jupyter.Install ( + -- * Kernelspec Definitions + Kernelspec(..), + simpleKernelspec, + + -- * Installing Jupyter Kernels + installKernel, + InstallUser(..), + InstallResult(..), + + -- * Detecting Installed Kkernels + findKernel, + findKernels, + ) where + +-- Imports from 'text' +import Data.Text (Text) + +import Jupyter.Install.Internal + +-- | Utility for creating simple kernelspecs, with all optional 'Kernelspec' fields initialized to their empty values. +-- +-- Example for Python 3: +-- >>> simpleKernelspec "Python 3" "python3" $ \exe0 connFile = ["python", "-m", "ipykernel", "-f", connFile] +simpleKernelspec :: Text -- ^ The kernel display name (see 'kernelspecDisplayName'). + -> Text -- ^ The kernel language name (see 'kernelspecLanguage'). + -> (FilePath -> FilePath -> [String]) -- ^ The kernel command line invocation (see 'kernelspecCommand'). + -> Kernelspec +simpleKernelspec displayName language command = + Kernelspec { + kernelspecDisplayName = displayName, + kernelspecLanguage = language, + kernelspecCommand = command, + kernelspecJsFile = Nothing, + kernelspecLogoFile = Nothing, + kernelspecEnv = mempty + } diff --git a/src/Jupyter/Install/Internal.hs b/src/Jupyter/Install/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Jupyter/Install/Internal.hs @@ -0,0 +1,396 @@ +{-| +Module : Jupyter.Install.Internal +Description : Utilities for installing Jupyter kernels (internal implementation). +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX + +This module exposes the internal implementation for "Jupyter.Install". +For user-facing documentation, please check out "Jupyter.Install" instead. +-} + +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +module Jupyter.Install.Internal where + +-- Imports from 'base' +import Control.Exception (Exception, IOException, catch, throwIO) +import Control.Monad (void, unless, when, foldM) +import Data.Maybe (isJust) +import System.Environment (getExecutablePath) +import System.IO (withFile, IOMode(..)) +import Text.Read (readMaybe) +import Data.Typeable (Typeable) + +#if !MIN_VERSION_base(4, 8, 0) +import Control.Applicative ((<$>), (<*>), pure) +import Data.Monoid (mempty) +#endif + +-- Imports from 'directory' +import System.Directory (findExecutable, getTemporaryDirectory, removeDirectoryRecursive, + createDirectoryIfMissing, copyFile, doesDirectoryExist, + canonicalizePath, doesFileExist) + +-- Imports from 'process' +import System.Process (readProcess) + +-- Imports from 'unordered-containers' +import qualified Data.HashMap.Lazy as HashMap +-- +-- Imports from 'containers' +import Data.Map (Map) +import qualified Data.Map as Map + +-- Imports from 'aeson' +import Data.Aeson ((.=), object, encode, eitherDecode, FromJSON(..), Value(..), (.:)) +import Data.Aeson.Types (Parser) + +-- Imports from 'bytestring' +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy.Char8 as CBS + +-- Imports from 'text' +import Data.Text (Text) +import qualified Data.Text as T + +-- | A /kernelspec/ is a description of a kernel which tells the Jupyter command-line application +-- how to install the kernel and tells the frontends how to invoke the kernel (command line flags, +-- environment, etc). +-- +-- More documentation about kernelspecs is located in the +-- . +data Kernelspec = + Kernelspec + { kernelspecDisplayName :: Text -- ^ Name for the kernel to be shown in frontends, e.g. + -- \"Haskell\". + , kernelspecLanguage :: Text -- ^ Language name for the kernel, used to refer to this kernel + -- (in command-line arguments, URLs, etc), e.g. "haskell". + , kernelspecCommand :: FilePath -> FilePath -> [String] + -- ^ How to invoke the kernel. Given the path to the currently running executable + -- and connection file, this function should return the full command to invoke the + -- kernel. For example: + -- + -- > \exe connectionFile -> [exe, "kernel", "--debug", "--connection-file", connectionFile] + , kernelspecJsFile :: Maybe FilePath -- ^ (optional) path to a Javascript file (kernel.js) + -- to provide to the Jupyter notebook. + -- This file is loaded upon notebook startup. + , kernelspecLogoFile :: Maybe FilePath -- ^ (optional) path to a 64x64 PNG file to display + -- as the kernel logo in the notebook. + , kernelspecEnv :: Map Text Text -- ^ Additional environment variables to set when invoking + -- the kernel. If no additional environment variables are + -- required, pass @'Data.Map.fromList' []@ or + -- 'Data.Monoid.mempty'. + } + +-- | Whether the installation was successful. +data InstallResult = InstallSuccessful -- ^ Kernelspec installation was successful. + | InstallFailed Text -- ^ Kernelspec installation failed, with the reason for failure provided. + deriving (Eq, Ord, Show) + +-- | Whether to install the kernel globally or just for the current user. +-- +-- This corresponds to the @--user@ flag for @jupyter kernelspec install@. +data InstallUser = InstallLocal -- ^ Install this kernel just for this user. + | InstallGlobal -- ^ Install this kernel globally. + deriving (Eq, Ord, Show) + +-- | An exception type for expected exceptions whenever the @jupyter kernelspec@ command is used. +newtype JupyterKernelspecException = JupyterKernelspecException Text + deriving (Eq, Ord, Show, Typeable) + +-- | 'JupyterKernelspecException's can be thrown when an expected failure occurs during @jupyter kernelspec@ +-- command invocation. +instance Exception JupyterKernelspecException + +-- | Version of Jupyter currently running, detected by running @jupyter --version@. +-- +-- When a version number is not present it is assumed to be zero, so 4.1 equivalent to 4.1.0. +data JupyterVersion = + JupyterVersion + { versionMajor :: Int -- ^ Major version number. + , versionMinor :: Int -- ^ Minor version number. + , versionPatch :: Int -- ^ Patch version number. + } + deriving (Eq, Ord, Show) + +-- | Convert a 'JupyterVersion' to its original displayed form. +-- +-- >>> showVersion (JupyterVersion 4 1 1) +-- "4.1.1" +showVersion :: JupyterVersion -> String +showVersion (JupyterVersion major minor patch) = + concat [show major, ".", show minor, ".", show patch] + +-- | Install a 'Kernelspec' using @jupyter kernelspec install@. +-- +-- This function expects the @jupyter@ command to be on the user's PATH, and will fail if +-- the @jupyter@ command is either unavailable or is a version incompatible with this library. +-- +-- More documentation about kernelspecs is located in the +-- +-- and by running @jupyter kernelspec install --help@. +installKernel :: InstallUser -- ^ Whether the kernel should be installed for only the current user (with @--user@) or globally + -> Kernelspec -- ^ The kernelspec to install + -> IO InstallResult -- ^ Installation result, potentially with a friendly error message +installKernel installUser kernelspec = tryInstall `catch` handleInstallFailure + where + tryInstall :: IO InstallResult + tryInstall = do + jupyterPath <- which "jupyter" + verifyJupyterCommand jupyterPath + installKernelspec installUser jupyterPath kernelspec + return InstallSuccessful + + handleInstallFailure :: JupyterKernelspecException -> IO InstallResult + handleInstallFailure (JupyterKernelspecException message) = return $ InstallFailed message + +-- | Throw a 'JupyterKernelspecException' with a given error message. +installFailed :: String -> IO a +installFailed = throwIO . JupyterKernelspecException . T.pack + +-- | Determine the absolute path to an executable on the PATH. +-- +-- Throws a 'JupyterKernelspecException' if the the executable cannot be found. +which :: FilePath -> IO FilePath +which cmd = do + mPath <- findExecutable cmd + case mPath of + Just path -> canonicalizePath path + Nothing -> + installFailed $ "Could not find '" ++ + cmd ++ + "' command on system PATH; please install it." + +-- | Verify that a proper version of Jupyter is installed. +-- +-- Throws a 'JupyterKernelspecException' if @jupyter@ is not present, is an incompatible version, or +-- otherwise cannot be used with this library. +verifyJupyterCommand :: FilePath -> IO () +verifyJupyterCommand jupyterPath = do + versionInfo <- runJupyterCommand jupyterPath ["--version"] + case parseVersion versionInfo of + Nothing -> installFailed $ "Could not parse output of 'jupyter --version': " ++ versionInfo + Just jupyterVersion -> + unless (jupyterVersionSupported jupyterVersion) $ + installFailed $ + "Invalid Jupyter version: Jupyter version 3.0 or higher required, found " + ++ showVersion jupyterVersion + +-- | Run a @jupyter@ subcommand with no standard input. +-- +-- Throws a 'JupyterKernelspecException' if the command cannot be run or returns a non-zero exit code. +runJupyterCommand :: FilePath -> [String] -> IO String +runJupyterCommand jupyterPath args = readProcess jupyterPath args "" `catch` handler + where + handler :: IOException -> IO String + handler _ = + installFailed $ + concat + [ "Could not run '" + , jupyterPath + , " " + , unwords args + , "'. " + , "Please make sure Jupyter is installed and functional." + ] + +-- | Is this Jupyter version supported? +jupyterVersionSupported :: JupyterVersion -> Bool +jupyterVersionSupported JupyterVersion{..} = versionMajor >= 3 + +-- | Given a directory, populate it with all necessary files to run @jupyter kernelspec install@. +-- +-- Currently created files include: +-- * @kernel.js@: (optional) Javascript to include in the notebook frontend. +-- * @logo-64x64.png@: (optional) Small logo PNG to include in the notebook frontend UI. +-- * @kernel.json@: (required) JSON file containing kernel invocation command and other metadata. +-- +-- The passed in directory is created and should not exist; if it already exists, it will be +-- deleted. +prepareKernelspecDirectory :: Kernelspec -> FilePath -> IO () +prepareKernelspecDirectory kernelspec dir = do + -- Make sure the directory doesn't already exist. If we didn't delete the directory, then later + -- kernelspec installs may inherit files created by previous kernelspec installs. + exists <- doesDirectoryExist dir + when exists $ removeDirectoryRecursive dir + + createDirectoryIfMissing True dir + copyKernelspecFiles kernelspec + generateKernelJSON kernelspec + + where + -- Copy files indicated by the Kernelspec data type into the directory. + copyKernelspecFiles :: Kernelspec -> IO () + copyKernelspecFiles Kernelspec { .. } = do + whenJust kernelspecJsFile $ \file -> copyFile file $ dir ++ "/kernel.js" + whenJust kernelspecLogoFile $ \file -> copyFile file $ dir ++ "/logo-64x64.png" + + -- Generate the kernel.json data structure from the Kernelspec datatype. + generateKernelJSON :: Kernelspec -> IO () + generateKernelJSON Kernelspec { .. } = do + exePath <- getExecutablePath + withFile (dir ++ "/kernel.json") WriteMode $ + flip LBS.hPutStr $ + encode $ + object + [ "argv" .= kernelspecCommand exePath "{connection_file}" + , "display_name" .= kernelspecDisplayName + , "language" .= kernelspecLanguage + , "env" .= kernelspecEnv + ] + + whenJust :: Maybe a -> (a -> IO ()) -> IO () + whenJust Nothing _ = return () + whenJust (Just a) f = f a + +-- | Install a kernelspec using @jupyter kernelspec install@. +-- +-- Throws a 'JupyterKernelspecException' on failure. +installKernelspec :: InstallUser -- ^ Whether this kernel should be installed with or without @--user@ + -> FilePath -- ^ Path to the @jupyter@ executable + -> Kernelspec -- ^ Kernelspec to install + -> IO () +installKernelspec installUser jupyterPath kernelspec = do + tempDir <- getTemporaryDirectory + let kernelspecDir = tempDir ++ "/" ++ T.unpack (kernelspecLanguage kernelspec) + prepareKernelspecDirectory kernelspec kernelspecDir + + let userFlag = + case installUser of + InstallLocal -> ["--user"] + InstallGlobal -> [] + cmd = "kernelspec" : "install" : kernelspecDir : "--replace" : userFlag + void $ runJupyterCommand jupyterPath cmd + + +-- | Parse a Jupyter version string into a list of integers. +-- +-- >>> parseVersion "4.1.3\n" +-- Just (JupyterVersion 4 1 3) +-- +-- >>> parseVersion "XYZ" +-- Nothing +-- +-- If minor or patch versions are unavailable, they are assumed to be zero: +-- +-- >>> parseVersion "4.1" +-- Just (JupyterVersion 4 1 0) +-- +-- >>> parseVersion "4" +-- Just (JupyterVersion 4 0 0) +parseVersion :: String -> Maybe JupyterVersion +parseVersion versionStr = + let versions = map (readMaybe . T.unpack) $ T.splitOn "." $ T.pack versionStr + parsed = all isJust versions + in if parsed + then case versions of + [x, y, z] -> JupyterVersion <$> x <*> y <*> z + [x, y] -> JupyterVersion <$> x <*> y <*> pure 0 + [x] -> JupyterVersion <$> x <*> pure 0 <*> pure 0 + _ -> Nothing + else Nothing + +-- | Find the kernelspec for a kernel with a given language name. +-- +-- If no such kernel exists, then 'Nothing' is returned. If an error occurs +-- while searching for Jupyter kernels, a 'JupyterKernelspecException' is thrown. +findKernel :: Text -> IO (Maybe Kernelspec) +findKernel language = do + Kernelspecs kernelspecs <- findKernelsInternal + maybe (return Nothing) + (fmap Just . checkKernelspecFiles) + (Map.lookup language kernelspecs) + +-- | Find all kernelspecs that the Jupyter installation is aware of, +-- using the @jupyter kernelspec list@ command. +-- +-- If an error occurs while searching for Jupyter kernels, a 'JupyterKernelspecException' is thrown. +findKernels :: IO [Kernelspec] +findKernels = do + Kernelspecs kernelspecs <- findKernelsInternal + mapM checkKernelspecFiles $ Map.elems kernelspecs + +-- | Get all the installed kernelspecs using @jupyter kernelspec list --json@. +-- +-- These kernelspecs must be passed through 'checkKernelspecFiles' before being returned to the +-- user. +findKernelsInternal :: IO Kernelspecs +findKernelsInternal = do + jupyterPath <- which "jupyter" + specsE <- eitherDecode . CBS.pack <$> runJupyterCommand jupyterPath + ["kernelspec", "list", "--json"] + case specsE of + Left err -> throwIO $ JupyterKernelspecException $ T.pack err + Right specs -> return specs + + +-- | Kernelspecs can refer to files such as kernel.js and logo-64x64.png. Check whether the +-- kernelspec refers to that file; if it does, check that the file exists. If the file doesn't +-- exist, then remove it from the kernelspec. +checkKernelspecFiles :: Kernelspec -> IO Kernelspec +checkKernelspecFiles spec = do + let jsFile = kernelspecJsFile spec + logoFile = kernelspecLogoFile spec + kernelspecJsFile' <- checkFile jsFile + kernelspecLogoFile' <- checkFile logoFile + return spec { kernelspecJsFile = kernelspecJsFile', kernelspecLogoFile = kernelspecLogoFile' } + + where + checkFile :: Maybe FilePath -> IO (Maybe FilePath) + checkFile Nothing = return Nothing + checkFile (Just file) = do + exists <- doesFileExist file + return $ if exists + then Just file + else Nothing + +-- | A list of kernelspecs, obtained by running @jupyter kernelspec list --json@. +-- +-- The list contains the name of the kernelspec mapped to the kernelspec itself. +newtype Kernelspecs = Kernelspecs (Map Text Kernelspec) + +-- | Parse the output of @jupyter kernelspec list --json@. +instance FromJSON Kernelspecs where + parseJSON (Object outer) = do + inner <- outer .: "kernelspecs" + case inner of + Object innerObj -> + let items = HashMap.toList innerObj + in Kernelspecs <$> foldM accumKernelspecs mempty items + _ -> fail "Expecting object inside 'kernelspecs' key" + parseJSON _ = fail "Expecting object with 'kernelspecs' key" + +-- | Collect all kernelspecs from @jupyter kernelspec list --json@ into a single map. +accumKernelspecs :: Map Text Kernelspec -- ^ Previously seen kernelspecs + -> (Text, Value) -- ^ Kernelspec name and JSON value for it + -> Parser (Map Text Kernelspec) -- ^ Map with old kernelspecs and parsed new one +accumKernelspecs prev (name, val) = do + kernelspec <- parseKernelspec val + return $ Map.insert name kernelspec prev + +-- | Parse a JSON 'Value' into a 'Kernelspec'. +parseKernelspec :: Value -> Parser Kernelspec +parseKernelspec v = + case v of + Object o -> do + dir <- o .: "resource_dir" + spec <- o .: "spec" + Kernelspec <$> spec .: "display_name" + <*> spec .: "language" + <*> (createCommand <$> spec .: "argv") + <*> pure (Just $ dir ++ "/kernel.js") + <*> pure (Just $ dir ++ "/logo-64x64.png") + <*> spec .: "env" + _ -> fail "Expecting object for kernelspec" + where + createCommand :: [Text] -> FilePath -> FilePath -> [String] + createCommand argv _ connFile = + flip map argv $ \val -> + case val of + "{connection_file}" -> connFile + _ -> T.unpack val diff --git a/src/Jupyter/Kernel.hs b/src/Jupyter/Kernel.hs new file mode 100644 --- /dev/null +++ b/src/Jupyter/Kernel.hs @@ -0,0 +1,379 @@ +{-| +Module : Jupyter.Kernel +Description : Functions for creating and serving a Jupyter kernel. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX + +The 'Jupyter.Kernel' module provides an API for quickly and easily creating Jupyter kernels. + +Jupyter kernels are programs which communicate using the +; most kernels +are language backends that allow using a particular programming language with Jupyter frontends such as +the or . + +To run a kernel, call the 'serve' function, which provides a type-safe implementation of the Jupyter +messaging spec. + +More information about the client and kernel interfaces can be found on the @jupyter@ +, and several example kernels may be found in +the directory. +-} + +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE OverloadedStrings #-} +module Jupyter.Kernel ( + -- * Serving kernels + serve, + serveDynamic, + KernelCallbacks(..), + + -- * Defining a kernel + simpleKernelInfo, + ClientRequestHandler, + defaultClientRequestHandler, + CommHandler, + defaultCommHandler, + + -- * Reading Kernel Profiles + KernelProfile(..), + readProfile, + ) where + +-- Imports from 'base' +import Control.Exception (bracket, catch, finally) +import Control.Monad (forever) +import System.Exit (exitSuccess) +import System.IO (hPutStrLn, stderr) + +-- Imports from 'bytestring' +import Data.ByteString (ByteString) + +-- Imports from 'text' +import Data.Text (Text) + +-- Imports from 'mtl' +import Control.Monad.IO.Class (MonadIO(..)) + +-- Imports from 'monad-control' +import Control.Monad.Trans.Control (liftBaseWith) + +-- Imports from 'async' +import Control.Concurrent.Async (link2, waitAny, cancel) + +-- Imports from 'zeromq4-haskell' +import System.ZMQ4.Monadic (ZMQ, Socket, Rep, Router, Pub, async, receive, send) + +-- Imports from 'jupyter' +import Jupyter.Messages (KernelOutput, Comm, ClientRequest(..), KernelReply(..), + pattern ExecuteOk, pattern InspectOk, pattern CompleteOk, + CursorRange(..), CodeComplete(..), CodeOffset(..), ConnectInfo(..), + KernelInfo(..), LanguageInfo(..), KernelOutput(..), + KernelStatus(..), KernelRequest(..), ClientReply(..)) +import Jupyter.ZeroMQ (withKernelSockets, KernelSockets(..), sendMessage, receiveMessage, + KernelProfile(..), readProfile, messagingError, mkReplyHeader, + threadKilledHandler, readProfile) + +-- | Create the simplest possible 'KernelInfo'. +-- +-- Defaults version numbers to \"0.0\", mimetype to \"text/plain\", empty banner, and a \".txt\" +-- file extension. +-- +-- Mostly intended for use in tutorials and demonstrations; if publishing production kernels, make +-- sure to use the full 'KernelInfo' constructor. +-- +-- >>> let kernelInfo = simpleKernelInfo "python3" +simpleKernelInfo :: Text -- ^ Kernel name, used for 'kernelImplementation' and 'languageName'. + -> KernelInfo +simpleKernelInfo kernelName = + KernelInfo + { kernelProtocolVersion = "5.0" + , kernelBanner = "" + , kernelImplementation = kernelName + , kernelImplementationVersion = "0.0" + , kernelHelpLinks = [] + , kernelLanguageInfo = LanguageInfo + { languageName = kernelName + , languageVersion = "0.0" + , languageMimetype = "text/plain" + , languageFileExtension = ".txt" + , languagePygmentsLexer = Nothing + , languageCodeMirrorMode = Nothing + , languageNbconvertExporter = Nothing + } + } + + +-- | The 'KernelCallbacks' data type contains callbacks that the kernel may use to communicate with +-- the client. Specifically, it can send 'KernelOutput' and 'Comm' messages using 'sendKernelOutput' +-- and 'sendComm', respectively, which are often sent to frontends in response to 'ExecuteRequest' +-- messsages. +-- +-- In addition, 'sentKernelRequest' can be used to send a 'KernelRequest' to the client, and +-- synchronously wait and receive a 'ClientReply'. +data KernelCallbacks = + KernelCallbacks + { sendKernelOutput :: KernelOutput -> IO () -- ^ Publish an output to all connected + -- frontends. This is the primary mechanism by + -- which a kernel shows output to the user. + , sendComm :: Comm -> IO () -- ^ Publish a 'Comm' message to the frontends. This allows for + -- entirely freeform back-and-forth communication between + -- frontends and kernels, avoiding the structure of the Jupyter + -- messaging protocol. This can be used for implementing custom + -- features such as support for the Jupyter notebook widgets. + , sendKernelRequest :: KernelRequest -> IO ClientReply -- ^ Send a 'KernelRequest' to the + -- client that send the first message + -- and wait for it to reply with a + -- 'ClientReply'. + } + +-- | When calling 'serve', the caller must provide a 'CommHandler'. +-- +-- The handler is used when the kernel receives a 'Comm' message from a frontend; the 'Comm' message +-- is passed to the handler, along with a set of callbacks the handler may use to send messages to +-- the client. +-- +-- Since 'Comm's are used for free-form communication outside the messaging spec, kernels should +-- ignore 'Comm' messages they do not expect. +-- +-- The 'defaultCommHandler' handler is provided for use with kernels that wish to ignore all 'Comm' +-- messages. +type CommHandler = KernelCallbacks -> Comm -> IO () + +-- | When calling 'serve', the caller must provide a 'ClientRequestHandler'. +-- +-- The handler is used when the kernel receives a 'ClientRequest' message from a frontend; the +-- 'ClientRequest' message is passed to the handler, along with a set of callbacks the handler may +-- use to send messages to the client. +-- +-- The handler must return a 'KernelReply' to be sent in response to this request. 'ClientRequest' +-- and 'KernelReply' constructors come in pairs, and the output reply constructor /must/ match the +-- input request constructor. +-- +-- Note: When the request is a 'ExecuteRequest' with the 'executeSilent' option set to @True@, the +-- 'KernelReply' will not be sent. +type ClientRequestHandler = KernelCallbacks -> ClientRequest -> IO KernelReply + +-- | Handler which ignores all 'Comm' messages sent to the kernel (and does nothing). +defaultCommHandler :: CommHandler +defaultCommHandler _ _ = return () + +-- | Handler which responds to all 'ClientRequest' messages with a default, empty reply. +defaultClientRequestHandler :: KernelProfile -- ^ The profile this kernel is running on. Used to + -- respond to 'ConnectRequest's. + -> KernelInfo -- ^ Information about this kernel. Used to respond to + -- 'KernelInfoRequest's. + -> ClientRequestHandler +defaultClientRequestHandler KernelProfile { .. } kernelInfo callbacks req = + case req of + ExecuteRequest code _ -> do + sendKernelOutput callbacks $ ExecuteInputOutput 0 code + return $ ExecuteReply 0 ExecuteOk + InspectRequest{} -> return $ InspectReply $ InspectOk Nothing + HistoryRequest{} -> return $ HistoryReply [] + CompleteRequest _ (CodeOffset offset) -> + return $ CompleteReply $ CompleteOk [] (CursorRange offset offset) mempty + IsCompleteRequest{} -> return $ IsCompleteReply CodeUnknown + CommInfoRequest{} -> return $ CommInfoReply mempty + ShutdownRequest restart -> return $ ShutdownReply restart + KernelInfoRequest{} -> return $ KernelInfoReply kernelInfo + ConnectRequest{} -> return $ ConnectReply + ConnectInfo + { connectShellPort = profileShellPort + , connectIopubPort = profileIopubPort + , connectHeartbeatPort = profileHeartbeatPort + , connectStdinPort = profileStdinPort + , connectControlPort = profileControlPort + } + +-- | Indefinitely serve a kernel on the provided ports. If the ports are not open, fails with an +-- exception. +-- +-- This starts several threads which listen and write to ZeroMQ sockets on the ports indicated in +-- the 'KernelProfile'. If an exception is raised and any of the threads die, the exception is +-- re-raised on the main thread. +-- +-- Using this function generally requires a bit of setup. The most common pattern for use is as follows: +-- +-- 1. In your kernel @Main.hs@, parse command line arguments. Some combination of arguments should include +-- a path to a connection file; this file can be read and parsed into a 'KernelProfile' with 'readProfile'. +-- (Often, the same executable will have a different mode that installs the kernel +-- using 'Jupyter.Install.installKernelspec'). +-- 2. Set up any state your kernel may need, storing it in an 'Control.Concurrent.MVar' or 'Data.IORef.IORef'. +-- 3. Define your 'CommHandler' and 'ClientRequestHandler' handlers, which read from the state and reply +-- with any necessary messages. (These handlers /may/ be called concurrently from different threads!) +-- 4. Provide the kernel profile and handlers to the 'serve' function, which blocks indefinitely. +-- +-- Example kernels may be found in the +-- directory. +serve :: KernelProfile -- ^ The kernel profile specifies how to listen for client messages (ports, + -- transport mechanism, message signing, etc). + -> CommHandler -- ^ The 'Comm' handler is called when 'Comm' messages are received from a + -- frontend. + -> ClientRequestHandler -- ^The request handler is called when 'ClientRequest' messages are + -- received from a frontend. + -> IO () +serve profile = serveInternal (Just profile) (const $ return ()) + +-- | Indefinitely serve a kernel on some ports. Ports are allocated dynamically and so, unlike +-- 'serve', 'serveDynamic' may be used when you do not know which ports are open or closed. +-- +-- The ports allocated by 'serveDynamic' are passed to the provided callback in the 'KernelProfile' +-- so that clients may connect to the served kernel. +-- +-- After the callback is run, several threads are started which listen and write to ZeroMQ sockets +-- on the allocated ports. If an exception is raised and any of the threads die, the exception is +-- re-raised on the main thread. Otherwise, this listens on the kernels indefinitely after running +-- the callback. +-- +-- This function serves as a form of inverting control over the allocated ports: usually, clients +-- will choose what ports to listen on, and provide the kernel with the ports with a connection file +-- path in the kernel command-line arguments. With this function, you can instead first start the +-- kernel, and then connect a client to the ports that the kernel chooses to bind to. +serveDynamic :: (KernelProfile -> IO ()) -- ^ This function is called with the dynamically-generated + -- kernel profile that the kernel will serve on, so that + -- clients may be notified of which ports to use to connect + -- to this kernel. The callback is called after sockets are + -- bound but before the kernel begins listening for + -- messages, so if the callback fails with an exception the + -- kernel threads are never started. + -> CommHandler -- ^ The 'Comm' handler is called when 'Comm' messages are received from + -- a frontend. + -> ClientRequestHandler -- ^The request handler is called when 'ClientRequest' messages + -- are received from a frontend. + -> IO () +serveDynamic = serveInternal Nothing + + +-- | Serve a kernel. +-- +-- If a 'KernelProfile' is provided, then open sockets bound to the specified ports; otherwise, +-- dynamically allocate ports and bind sockets to them. In both cases, the final 'KernelProfile' +-- used is passed to the provided callback, so that clients can be informed about how to connect to +-- this kernel. +-- +-- Users of the library should use 'serve' or 'serveDynamic' instead. +-- +-- After the callback is run, several threads are started which listen and write to ZeroMQ sockets +-- on the allocated ports. If an exception is raised and any of the threads die, the exception is +-- re-raised on the main thread. Otherwise, this listens on the kernels indefinitely after running +-- the callback. +serveInternal :: Maybe KernelProfile + -> (KernelProfile -> IO ()) + -> CommHandler + -> ClientRequestHandler + -> IO () +serveInternal mProfile profileHandler commHandler requestHandler = + withKernelSockets mProfile $ \profile KernelSockets { .. } -> do + -- If anything is going to be done with the profile information, do it now, after sockets have been + -- bound but before we start listening on them infinitely. + liftIO $ profileHandler profile + + let key = profileSignatureKey profile + -- Repeat an action forever. If the thread is killed with a ThreadKilled exception, + -- do not propagate the exception, but instead just let the thread die. This ensures that + -- when all the Async's are linked together, the ThreadKilled does not get propagated to the + -- main thread, which presumably is the thread that killed this action. + loop action = + async $ liftBaseWith $ \runInBase -> + catch (runInBase $ forever action) threadKilledHandler + handlers = (commHandler, requestHandler) + + -- Start all listening loops in separate threads. + let setupListeners = do + async1 <- loop $ echoHeartbeat kernelHeartbeatSocket + async2 <- loop $ serveRouter kernelControlSocket key kernelIopubSocket kernelStdinSocket handlers + async3 <- loop $ serveRouter kernelShellSocket key kernelIopubSocket kernelStdinSocket handlers + + -- Make sure that a fatal exception on any thread kills all threads. + liftIO $ link2 async1 async2 + liftIO $ link2 async2 async3 + liftIO $ link2 async3 async1 + + return [async1, async2, async3] + + -- Wait indefinitely; if any of the threads encounter a fatal exception, the fatal exception is + -- re-raised on the main thread. If the main thread dies, then the asyncs are killed via 'cancel'. + liftBaseWith $ \runInBase -> + bracket (runInBase setupListeners) + (mapM_ cancel) + (fmap snd . waitAny) + +-- | Heartbeat once. +-- +-- To heartbeat, listen for a message on the socket, and when you receive one, immediately write it +-- back to the same socket. +echoHeartbeat :: Socket z Rep -> ZMQ z () +echoHeartbeat heartbeatSocket = + receive heartbeatSocket >>= send heartbeatSocket [] + +-- | Receive and respond to a single message on the /shell/ or /control/ sockets. +serveRouter :: Socket z Router -- ^ The /shell/ or /control/ socket to listen on and write to + -> ByteString -- ^ The signature key to sign messages with + -> Socket z Pub -- ^ The /iopub/ socket to publish outputs to + -> Socket z Router -- ^ The /stdin/ socket to use to get input from the client + -> (CommHandler, ClientRequestHandler) -- ^ The handlers to use to respond to messages + -> ZMQ z () +serveRouter sock key iopub stdin handlers = + -- We use 'liftBaseWith' and the resulting 'RunInBase' from the 'MonadBaseControl' class in order to + -- hide from the kernel implementer the fact that all of this is running in the ZMQ monad. This ends + -- up being very straightforward, because the ZMQ monad is a very thin layer over IO. + liftBaseWith $ \runInBase -> do + received <- runInBase $ receiveMessage sock + case received of + Left err -> liftIO $ hPutStrLn stderr $ "Error receiving message: " ++ err + Right (header, message) -> + -- After receiving a message, create the publisher callbacks which use that message as the "parent" + -- for any responses they generate. This means that when outputs are generated in response to a + -- message, they automatically inherit that message as a parent. + let publishers = KernelCallbacks + { sendComm = runInBase . sendReplyMessage key iopub header + , sendKernelOutput = runInBase . sendReplyMessage key iopub header + , sendKernelRequest = runInBase . stdinCommunicate header + } + sendReply = runInBase . sendReplyMessage key sock header + sendReplyMessage k s parentHeader msg = do + replyHeader <- liftIO $ mkReplyHeader parentHeader msg + sendMessage k s replyHeader msg + in handleRequest sendReply publishers handlers message + where + stdinCommunicate parentHeader req = do + header <- liftIO $ mkReplyHeader parentHeader req + sendMessage key stdin header req + received <- receiveMessage stdin + case received of + Left err -> + -- There's no way to recover from this, so just die. + messagingError "Jupyter.Kernel" $ "Unexpected failure parsing ClientReply message: " ++ err + Right (_, message) -> return message + +-- | Handle a request using the appropriate handler. +-- +-- A request may either be a 'ClientRequest' or a 'Comm', which correspond to the +-- 'ClientRequestHandler' and the 'CommHandler' respectively. In the case of a 'ClientRequest', the +-- 'KernelReply' is also sent back to the frontend. +handleRequest :: (KernelReply -> IO ()) -- ^ Callback to send reply messages to the frontend + -> KernelCallbacks -- ^ Callbacks for publishing outputs to frontends + -> (CommHandler, ClientRequestHandler) -- ^ Handlers for messages from frontends + -> Either ClientRequest Comm -- ^ The received message content + -> IO () +handleRequest sendReply callbacks (commHandler, requestHandler) message = + case message of + Left clientRequest -> do + output $ KernelStatusOutput KernelBusy + finally (requestHandler callbacks clientRequest >>= sendReply) $ + case clientRequest of + ShutdownRequest restart -> do + output $ ShutdownNotificationOutput restart + output $ KernelStatusOutput KernelIdle + exitSuccess + _ -> output $ KernelStatusOutput KernelIdle + + Right comm -> commHandler callbacks comm + where + output = sendKernelOutput callbacks diff --git a/src/Jupyter/Messages.hs b/src/Jupyter/Messages.hs new file mode 100644 --- /dev/null +++ b/src/Jupyter/Messages.hs @@ -0,0 +1,1436 @@ +{-| +Module : Jupyter.Messages +Description : A type-safe specification for the Jupyter messaging specification. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX + +Jupyter kernels and clients communicate along a typed messaging protocol called the /Jupyter messaging protocol/. +The protocol defines several ZeroMQ sockets that are used for communication between the clients and the kernels, +as well as the format of the data that is sent on each of those sockets. + +To summarize briefly, the messaging protocol defines four types of communication: + +1. Client to kernel requests ('ClientRequest') and replies ('KernelReply') +2. Kernel output publication to all clients ('KernelOutput') +3. Kernel to client requests ('KernelRequest') and replies ('ClientReply') +4. Free-form "comm" messages between kernels and clients ('Comm') + +Client to kernel requests and replies are sent on two sockets called the /shell/ and /control/ sockets, but +when using the @jupyter@ package these two sockets can be treated as a single communication channel, +with the caveat that two messages may be sent at once (and thus the handlers must be thread-safe). Clients will +send a 'ClientRequest' which the kernel must respond to with a 'KernelReply'. + +During the response, kernels may want to publish results, intermediate data, or errors to the front-end(s). +This is done on the /iopub/ socket, with every published value represented via a 'KernelOutput'. Kernel +outputs are the primary mechanism for transmitting results of code evaluation to the front-ends. + +In addition to publishing outputs, kernels may request input from the clients during code evaluation using 'KernelRequest' messages, to which the clients reply with a 'ClientReply'. At the moment, the +only use for 'KernelRequest's is to request standard input from the clients, so all such messages go on the /stdin/ socket. + +Finally, kernels and frontends can create custom communication protocols using the free-form and unstructured 'Comm' +messages. A comm in Jupyter parlance is a communication channel between a kernel and a client; either one +may request to create or close a comm, and then send arbitrary JSON data along that comm. Kernels listen +for 'Comm' messages on the /shell/ socket and can send their own 'Comm' messages on the /iopub/ socket. ('Comm' messages +are not used frequently, but have been used to implement, e.g. the Jupyter widgets in +; for most use cases, it is safe to ignore them +and provide empty 'Comm' message handlers.) + +For more information, please read the +. +-} + +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +module Jupyter.Messages ( + -- * Client Requests (Shell channel) + ClientRequest(..), + CodeBlock(..), + CodeOffset(..), + ExecuteOptions(..), + defaultExecuteOptions, + DetailLevel(..), + HistoryOptions(..), + TargetName(..), + Restart(..), + HistoryAccessType(..), + HistoryRangeOptions(..), + HistorySearchOptions(..), + + -- * Kernel Replies (Shell channel) + KernelReply(..), + KernelInfo(..), + CodeMirrorMode(..), + LanguageInfo(..), + HelpLink(..), + ExecuteResult(..), + pattern ExecuteOk, + pattern ExecuteError, + pattern ExecuteAbort, + InspectResult(..), + pattern InspectOk, + pattern InspectError, + pattern InspectAbort, + CompleteResult(..), + pattern CompleteOk, + pattern CompleteError, + pattern CompleteAbort, + CompletionMatch(..), + CursorRange(..), + OperationResult(..), + HistoryItem(..), + ExecutionCount(..), + CodeComplete(..), + ConnectInfo(..), + + -- * Kernel Outputs (IOPub channel) + KernelOutput(..), + Stream(..), + DisplayData(..), + displayPlain, displayLatex, displayHtml, displayJavascript, + displaySvg, displayPng, displayJpg, + ImageDimensions(..), + MimeType(..), + ErrorInfo(..), + WaitBeforeClear(..), + KernelStatus(..), + + -- * Kernel Requests (Stdin channel) + KernelRequest(..), + InputOptions(..), + + -- * Client Replies (Stdin channel) + ClientReply(..), + + -- * Comm Messages (Shell or IOPub channel) + Comm(..), + TargetModule(..), + ) where + +-- Imports from 'base' +import Control.Applicative ((<|>)) +import Control.Monad (foldM) +import Data.Foldable (toList) +import Data.Typeable (Typeable) +import GHC.Exts (IsString) +import GHC.Generics (Generic) + +-- Imports from 'aeson' +import Data.Aeson (Value(..), Object, (.:), (.:?), (.=), object, FromJSON(..), ToJSON(..)) +import Data.Aeson.Types (Parser) + +-- Imports from 'text' +import Data.Text (Text) + +-- Imports from 'containers' +import Data.Map (Map) +import qualified Data.Map as Map + +-- Imports from 'jupyter' +import Jupyter.Messages.Internal (IsMessage(..)) +import Jupyter.UUID (UUID) +import qualified Jupyter.UUID as UUID + +-- | Most communication from a client to a kernel is initiated by the client on the /shell/ socket. +-- +-- The /shell/ socket accepts multiple incoming connections from different frontends (clients), and +-- receives requests for code execution, object information, prompts, etc. from all the connected +-- frontends. The communication on this socket is a sequence of request/reply actions from each +-- frontend and the kernel. +-- +-- The clients will send 'ClientRequest' messages to the kernel, to which the kernel must reply with +-- exactly one appropriate 'KernelReply' and, optionally, publish as many 'KernelOutput's as the +-- kernel wishes. Each 'ClientRequest' constructor corresponds to exactly one 'KernelReply' +-- constructor which should be used in the reply. +-- +-- For more information on each of these messages, view the appropriate section . +data ClientRequest = + -- | Replied to with an 'ExecuteReply'. + -- + -- This message type is used by frontends to ask the kernel to execute code on + -- behalf of the user, in a namespace reserved to the user’s variables (and thus + -- separate from the kernel’s own internal code and variables). + ExecuteRequest CodeBlock ExecuteOptions + | + -- | Replied to with an 'InspectReply'. + -- + -- Code can be inspected to show useful information to the user. It is up to + -- the kernel to decide what information should be displayed, and its + -- formatting. + -- + -- The reply is a mime-bundle, like a 'DisplayDataOutput' message, which should be a + -- formatted representation of information about the context. In the notebook, + -- this is used to show tooltips over function calls, etc. + InspectRequest CodeBlock CodeOffset DetailLevel + | + -- | Replied to with a 'HistoryReply'. + -- + -- For clients to explicitly request history from a kernel. The kernel has all + -- the actual execution history stored in a single location, so clients can + -- request it from the kernel when needed. + HistoryRequest HistoryOptions + | + -- | Replied to with a 'CompleteReply'. + -- + -- A message type for the client to request autocompletions from the kernel. + -- + -- The lexing is left to the kernel, and the only information provided is the + -- cell contents and the current cursor location in the cell. + CompleteRequest CodeBlock CodeOffset + | + -- | Replied to with a 'IsCompleteReply'. + -- + -- When the user enters a line in a console style interface, the console must + -- decide whether to immediately execute the current code, or whether to show a + -- continuation prompt for further input. + -- + -- For instance, in Python @a = 5@ would + -- be executed immediately, while for @i in range(5):@ would expect further + -- input. + -- + -- There are four possible replies (see the 'CodeComplete' data type): + -- + -- * /complete/: code is ready to be executed + -- * /incomplete/: code should prompt for another line + -- * /invalid/: code will typically be sent for execution, so that the user sees + -- the error soonest. + -- * /unknown/: if the kernel is not able to determine this. + -- + -- The frontend should also handle the kernel not replying promptly. It may + -- default to sending the code for execution, or it may implement simple + -- fallback heuristics for whether to execute the code (e.g. execute after a + -- blank line). Frontends may have ways to override this, forcing the code to be + -- sent for execution or forcing a continuation prompt. + IsCompleteRequest CodeBlock + | + -- | Replied to with a 'ConnectReply'. + -- + -- When a client connects to the request/reply socket of the kernel, it can + -- issue a connect request to get basic information about the kernel, such as + -- the ports the other ZeroMQ sockets are listening on. This allows clients to + -- only have to know about a single port (the shell channel) to connect to a + -- kernel. + -- + -- /Warning: Connect requests are deprecated in the Jupyter messaging spec./ + ConnectRequest + | + -- | Replied to with a 'CommInfoReply'. + -- + -- When a client needs the currently open @comm@s in the kernel, it can issue + -- a 'CommInfoRequest' for the currently open @comm@s. When the optional + -- 'TargetName' is specified, the 'CommInfoReply' should only contain the + -- currently open @comm@s for that target. + CommInfoRequest (Maybe TargetName) + | + -- | Replied to with a 'KernelInfoReply'. + -- + -- If a client needs to know information about the kernel, it can make a + -- 'KernelInfoRequest'. This message can be used to fetch core information of + -- the kernel, including language (e.g., Python), language version number and + -- IPython version number, and the IPython message spec version number. + KernelInfoRequest + | + -- | Replied to with a 'ShutdownReply'. + -- + -- The clients can request the kernel to shut itself down; this is used in + -- multiple cases: + -- + -- * when the user chooses to close the client application via a menu or window + -- control. + -- * when the user invokes a frontend-specific exit method (like the @quit@ magic) + -- * when the user chooses a GUI method (like the Ctrl-C + -- shortcut in the IPythonQt client) to force a kernel restart to get a clean + -- kernel without losing client-side state like history or inlined figures. + -- + -- The client sends a shutdown request to the kernel, and once it receives the + -- reply message (which is otherwise empty), it can assume that the kernel has + -- completed shutdown safely. The request can be sent on either the /control/ or + -- /shell/ sockets. Upon their own shutdown, client applications will typically + -- execute a last minute sanity check and forcefully terminate any kernel that + -- is still alive, to avoid leaving stray processes in the user’s machine. + -- + -- Kernels that receive a shutdown request will automatically shut down after + -- replying to it. + ShutdownRequest Restart + deriving (Eq, Ord, Show) + +instance IsMessage ClientRequest where + getMessageType req = + case req of + ExecuteRequest{} -> "execute_request" + InspectRequest{} -> "inspect_request" + HistoryRequest{} -> "history_request" + CompleteRequest{} -> "complete_request" + IsCompleteRequest{} -> "is_complete_request" + ConnectRequest{} -> "connect_request" + CommInfoRequest{} -> "comm_info_request" + KernelInfoRequest{} -> "kernel_info_request" + ShutdownRequest{} -> "shutdown_request" + parseMessageContent msgType = + case msgType of + "execute_request" -> Just $ \o -> + ExecuteRequest <$> o .: "code" + <*> (ExecuteOptions <$> o .: "silent" + <*> o .: "store_history" + <*> o .: "allow_stdin" + <*> o .: "stop_on_error") + "inspect_request" -> Just $ \o -> do + detailLevelNum <- o .: "detail_level" + detailLevel <- case detailLevelNum :: Int of + 0 -> return DetailLow + 1 -> return DetailHigh + _ -> fail $ "Unknown detail level in inspect_request: " ++ show detailLevelNum + InspectRequest <$> o .: "code" <*> o .: "cursor_pos" <*> pure detailLevel + + "history_request" -> Just $ \o -> + HistoryRequest <$> (HistoryOptions <$> o .: "output" + <*> o .: "raw" + <*> parseHistoryAccessType o) + "complete_request" -> Just $ \o -> CompleteRequest <$> o .: "code" <*> o .: "cursor_pos" + "is_complete_request" -> Just $ \o -> IsCompleteRequest <$> o .: "code" + "comm_info_request" -> Just $ \o -> CommInfoRequest <$> o .:? "target_name" + "shutdown_request" -> Just $ \o -> do + restart <- o .: "restart" + pure $ ShutdownRequest $ if restart + then Restart + else NoRestart + "connect_request" -> + Just $ const $ return ConnectRequest + "kernel_info_request" -> + Just $ const $ return KernelInfoRequest + _ -> Nothing + where + parseHistoryAccessType :: Object -> Parser HistoryAccessType + parseHistoryAccessType o = do + accessType <- o .: "hist_access_type" + case accessType of + "range" -> HistoryRange <$> (HistoryRangeOptions <$> o .: "session" + <*> o .: "start" + <*> o .: "stop") + "tail" -> HistoryTail <$> o .: "n" + "search" -> HistorySearch <$> (HistorySearchOptions <$> o .: "n" + <*> o .: "pattern" + <*> o .: "unique") + _ -> fail $ "Unknown history access type in hist_access_type: " ++ accessType + +instance ToJSON ClientRequest where + toJSON req = + object $ + case req of + ExecuteRequest code ExecuteOptions { .. } -> + [ "code" .= code + , "silent" .= executeSilent + , "store_history" .= executeStoreHistory + , "allow_stdin" .= executeAllowStdin + , "stop_on_error" .= executeStopOnError + , "user_expressions" .= (Map.fromList [] :: Map.Map Text ()) + ] + InspectRequest code offset detail -> + ["code" .= code, "cursor_pos" .= offset, "detail_level" .= detail] + CompleteRequest code offset -> ["code" .= code, "cursor_pos" .= offset] + HistoryRequest HistoryOptions { .. } -> + ["output" .= historyShowOutput, "raw" .= historyRaw] ++ + case historyAccessType of + HistoryRange HistoryRangeOptions { .. } -> + [ "hist_access_type" .= ("range" :: String) + , "session" .= historyRangeSession + , "start" .= historyRangeStart + , "stop" .= historyRangeStop + ] + HistoryTail n -> ["hist_access_type" .= ("tail" :: String), "n" .= n] + HistorySearch HistorySearchOptions { .. } -> + [ "hist_access_type" .= ("search" :: String) + , "n" .= historySearchCells + , "pattern" .= historySearchPattern + , "unique" .= historySearchUnique + ] + IsCompleteRequest code -> ["code" .= code] + ConnectRequest{} -> [] + CommInfoRequest targetName -> + case targetName of + Nothing -> [] + Just name -> ["target_name" .= name] + KernelInfoRequest{} -> [] + ShutdownRequest restart -> ["restart" .= restart] + + +-- | Options for executing code in the kernel. +data ExecuteOptions = + ExecuteOptions + { executeSilent :: Bool + -- ^ Whether this code should be forced to be as silent as possible. + -- + -- Kernels should avoid broadcasting on the /iopub/ channel (sending 'KernelOutput' messages) and + -- the 'ExecuteReply' message will not be sent when 'executeSilent' is @True@. In addition, kernels + -- should act as if 'executeStoreHistory' is set to @True@ whenever 'executeSilent' is @True@. + , executeStoreHistory :: Bool + -- ^ A boolean flag which, if @True@, signals the kernel to populate its history. If 'executeSilent' + -- is @True@, kernels should ignore the value of this flag and treat it as @False@. + , executeAllowStdin :: Bool + -- ^ Some frontends do not support @stdin@ requests. + -- + -- If such a frontend makes a request, it should set 'executeAllowStdin' to @False@, and any code + -- that reads from @stdin@ should crash (or, if the kernel so desires, get an empty string). + , executeStopOnError :: Bool -- ^ A boolean flag, which, if @True@, does not abort the + -- execution queue, if an exception or error is encountered. + -- This allows the queued execution of multiple + -- execute_requests, even if they generate exceptions. + } + deriving (Eq, Ord, Show) + +-- | Default set of options for an 'ExecuteRequest'. +-- +-- By default, 'executeStopOnError' and 'executeStoreHistory' are @True@, while 'executeSilent' and +-- 'executeAllowStdin' are @False@. +defaultExecuteOptions :: ExecuteOptions +defaultExecuteOptions = ExecuteOptions + { executeSilent = False + , executeStoreHistory = True + , executeAllowStdin = False + , executeStopOnError = True + } + +-- | Whether the kernel should restart after shutting down, or remain stopped. +data Restart = + -- | Restart after shutting down. + Restart + | + -- | Remain stopped after shutting down. + NoRestart + deriving (Eq, Ord, Show) + +instance ToJSON Restart where + toJSON Restart = Bool True + toJSON NoRestart = Bool False + +instance FromJSON Restart where + parseJSON (Bool True) = pure Restart + parseJSON (Bool False) = pure NoRestart + parseJSON _ = fail "Expected boolean for 'restart' field" + +-- | The target name (@target_name@) for a 'Comm'. +-- +-- The target name is, roughly, the type of the @comm@ to open. It tells the kernel or the frontend +-- (whichever receives the 'CommOpen' message) what sort of @comm@ to open and how that @comm@ +-- should behave. (The 'TargetModule' can also be optionally used in combination with a 'TargetName' +-- for this purpose; see 'CommOpen' for more info.) +newtype TargetName = TargetName Text + deriving (Eq, Ord, Show, FromJSON, ToJSON, IsString) + +-- | A block of code, represented as text. +newtype CodeBlock = CodeBlock Text + deriving (Eq, Ord, Show, FromJSON, ToJSON, IsString) + +-- | A zero-indexed offset into a block of code. +newtype CodeOffset = CodeOffset Int + deriving (Eq, Ord, Show, Num, FromJSON, ToJSON) + +-- | How much detail to show for an 'InspectRequest'. +data DetailLevel = DetailLow -- ^ Include a low level of detail. In IPython, 'DetailLow' is + -- equivalent to typing @x?@ at the prompt. + | DetailHigh -- ^ Include a high level of detail. In IPython, 'DetailHigh' is + -- equivalent to typing @x??@ at the prompt, and tries to include the + -- source code. + deriving (Eq, Ord, Show) + +instance ToJSON DetailLevel where + toJSON DetailLow = Number 0 + toJSON DetailHigh = Number 1 + +-- | What to search for in the kernel history. +data HistoryOptions = + HistoryOptions + { historyShowOutput :: Bool -- ^ If @True@, include text output in the resulting 'HistoryItem's. + , historyRaw :: Bool -- ^ If @True@, return the raw input history, else the transformed input. + , historyAccessType :: HistoryAccessType -- ^ Type of search to perform. + } + deriving (Eq, Ord, Show) + +-- | What items should be accessed in this 'HistoryRequest'. +data HistoryAccessType = HistoryRange HistoryRangeOptions -- ^ Get a range of history items. + | HistoryTail Int -- ^ Get the last /n/ cells in the history. + | HistorySearch HistorySearchOptions -- ^ Search for something in the history. + deriving (Eq, Ord, Show) + +-- | Options for retrieving a range of history cells. +data HistoryRangeOptions = + HistoryRangeOptions + { historyRangeSession :: Int -- ^ Which cell to retrieve history for. If this is negative, + -- then it counts backwards from the current session. + , historyRangeStart :: Int -- ^ Which item to start with in the selected session. + , historyRangeStop :: Int -- ^ Which item to end with in the selected session. + } + deriving (Eq, Ord, Show) + +-- | Options for retrieving history cells that match a pattern. +data HistorySearchOptions = + HistorySearchOptions + { historySearchCells :: Int -- ^ Get the last /n/ cells that match the provided pattern. + , historySearchPattern :: Text -- ^ Pattern to search for (treated literally but with @*@ + -- and @?@ as wildcards). + , historySearchUnique :: Bool -- ^ If @True@, do not include duplicated history items. + } + deriving (Eq, Ord, Show) + +-- | Clients send requests ('ClientRequest') to the kernel via the /shell/ socket, and kernels +-- generate one 'KernelReply' as a response to every 'ClientRequest'. Each type of 'ClientRequest' +-- corresponds to precisely one response type (for example, 'HistoryRequest' must be responded to +-- with a 'HistoryReply'). +data KernelReply = + -- | Reply for a 'KernelInfoRequest'. + -- + -- If a client needs to know information about the kernel, it can make a request + -- of the kernel’s information, which must be responded to with a + -- 'KernelInfoReply'. This message can be used to fetch core information of the + -- kernel, including language (e.g., Python), language version number and IPython + -- version number, and the IPython message spec version number. + KernelInfoReply KernelInfo + | + -- | Reply to an 'ExecuteRequest' message. + -- + -- The kernel should have a single, monotonically increasing counter of all + -- execution requests that are made with when @executeStoreHistory@ is @True@. + -- This counter is used to populate the @In[n]@ and @Out[n]@ prompts in the + -- frontend. The value of this counter will be returned as the 'ExecutionCount' + -- field of all 'ExecuteReply' and 'ExecuteInput' messages. + -- + -- 'ExecuteReply' does not include any output data, only a status, as the output + -- data is sent via 'DisplayDataOutput' messages on the /iopub/ channel (in + -- 'KernelOutput' messages). + ExecuteReply ExecutionCount ExecuteResult + | + -- | Reply to an 'InspectRequest'. + -- + -- Code can be inspected to show useful information to the user. It is up to the + -- kernel to decide what information should be displayed, and its formatting. + -- + -- The reply is a mime-bundle, like a 'DisplayDataOutput' message, which should be a + -- formatted representation of information about the context. In the notebook, + -- this is used to show tooltips over function calls, etc. + InspectReply InspectResult + | + -- | Reply to a 'HistoryRequest'. + -- + -- Clients can explicitly request history from a kernel. The kernel has all the + -- actual execution history stored in a single location, so clients can request it + -- from the kernel when needed. + -- + -- The 'HistoryItem's should include non-@Nothing@ 'historyItemOutput' values when + -- 'historyShowOutput' in the 'HistoryRequest' is @True@. + HistoryReply [HistoryItem] + | + -- | Reply to a 'CompleteRequest'. + -- + -- Clients can request autocompletion results from the kernel, and the kernel + -- responds with a list of matches and the selection to autocomplete. + CompleteReply CompleteResult + | + -- | Reply to a 'IsCompleteRequest'. + -- + -- Clients can request the code completeness status with a 'IsCompleteRequest'. + -- + -- For example, when the user enters a line in a console style interface, the + -- console must decide whether to immediately execute the current code, or whether + -- to show a continuation prompt for further input. + -- + -- For instance, in Python @a = + -- 5@ would be executed immediately, while @for i in range(5):@ would expect + -- further input. + IsCompleteReply CodeComplete + | + -- | Reply to a 'ConnectReply'. + -- + -- When a client connects to the request/reply socket of the kernel, it can + -- issue a 'ConnectRequest' to get basic information about the kernel, such as the + -- ports the other ZeroMQ sockets are listening on. This allows clients to only + -- have to know about a single port (the shell channel) to connect to a kernel. + -- + -- The 'ConnectReply' contains a 'ConnectInfo' with information about the ZeroMQ + -- sockets' ports used by the kernel. + ConnectReply ConnectInfo + | + -- | Reply to a 'CommInfoRequest'. + -- + -- When a client needs the currently open comms in the kernel, it can issue a + -- 'CommInfoRequest' for the currently open comms. + -- + -- The 'CommInfoReply' provides a list of currently open @comm@s with their + -- respective target names to the frontend. + CommInfoReply (Map UUID.UUID TargetName) + | + -- | Reply to a 'ShutdownRequest'. + -- + -- The client sends a shutdown request to the kernel, and once it receives the + -- reply message (which is otherwise empty), it can assume that the kernel has + -- completed shutdown safely. + -- + -- The 'ShutdownReply' allows for a safe shutdown, but, if no 'ShutdownReply' is + -- received (for example, if the kernel is deadlocked) client applications will + -- typically execute a last minute sanity check and forcefully terminate any + -- kernel that is still alive, to avoid leaving stray processes in the user’s + -- machine. + ShutdownReply Restart + deriving (Eq, Show) + +instance IsMessage KernelReply where + getMessageType reply = + case reply of + KernelInfoReply{} -> "kernel_info_reply" + ExecuteReply{} -> "execute_reply" + InspectReply{} -> "inspect_reply" + HistoryReply{} -> "history_reply" + CompleteReply{} -> "complete_reply" + IsCompleteReply{} -> "is_complete_reply" + ConnectReply{} -> "connect_reply" + CommInfoReply{} -> "comm_info_reply" + ShutdownReply{} -> "shutdown_reply" + parseMessageContent msgType = + case msgType of + "kernel_info_reply" -> Just $ \o -> + KernelInfoReply <$> (KernelInfo <$> o .: "protocol_version" + <*> o .: "banner" + <*> o .: "implementation" + <*> o .: "implementation_version" + <*> o .: "language_info" + <*> o .: "help_links") + + "execute_reply" -> Just $ \o -> + ExecuteReply <$> o .: "execution_count" <*> (ExecuteResult <$> parseResult o (pure ())) + "inspect_reply" -> Just $ \o -> + InspectReply . InspectResult <$> parseResult o + (ifM (o .: "found") (Just <$> parseDisplayData o) + (pure Nothing)) + "history_reply" -> Just $ \o -> HistoryReply <$> o .: "history" + "complete_reply" -> Just $ \o -> + CompleteReply . CompleteResult <$> parseResult o + ((,,) <$> o .: "matches" + <*> (CursorRange <$> o .: "cursor_start" + <*> o .: "cursor_end") + <*> o .: "metadata") + "is_complete_reply" -> Just $ \o -> IsCompleteReply <$> parseJSON (Object o) + "connect_reply" -> Just $ \o -> + -- The messaging spec indicates that this message uses fields named "shell_port", "iopub_port", etc, + -- but the IPython kernel sends just "shell", "iopub", etc; thus, we allow both. + ConnectReply <$> (ConnectInfo <$> (o .: "shell_port" <|> o .: "shell") + <*> (o .: "iopub_port" <|> o .: "iopub") + <*> (o .: "stdin_port" <|> o .: "stdin") + <*> (o .: "hb_port" <|> o .: "hb") + <*> (o .: "control_port" <|> o .: "control")) + "comm_info_reply" -> Just $ \o -> + CommInfoReply . Map.mapKeys UUID.uuidFromString <$> o .: "comms" + "shutdown_reply" -> Just $ \o -> ShutdownReply <$> o .: "restart" + _ -> Nothing + where + parseResult :: Object -> Parser f -> Parser (OperationResult f) + parseResult o parsed = do + status <- o .: "status" + case status :: String of + "abort" -> return OperationAbort + "ok" -> OperationOk <$> parsed + "error" -> OperationError <$> parseJSON (Object o) + _ -> fail "Expecting 'abort', 'ok', or 'error' as 'status' key" + + +ifM :: Monad m => m Bool -> m a -> m a -> m a +ifM cond thenBranch elseBranch = do + bool <- cond + if bool then thenBranch else elseBranch + + +instance ToJSON KernelReply where + toJSON reply = + object $ + case reply of + KernelInfoReply KernelInfo { .. } -> + [ "protocol_version" .= kernelProtocolVersion + , "implementation" .= kernelImplementation + , "implementation_version" .= kernelImplementationVersion + , "banner" .= kernelBanner + , "help_links" .= kernelHelpLinks + , "language_info" .= kernelLanguageInfo + ] + ExecuteReply executionCount (ExecuteResult res) -> + ("execution_count" .= executionCount) : formatResult res (const []) + CompleteReply (CompleteResult res) -> + formatResult res $ \(matches, range, metadata) -> + [ "matches" .= matches + , "cursor_start" .= cursorStart range + , "cursor_end" .= cursorEnd range + , "metadata" .= metadata + ] + InspectReply (InspectResult res) -> + formatResult res $ \mDisplayData -> case mDisplayData of + Nothing -> ("found" .= False) : mimebundleFields mempty + Just displayData -> ("found" .= True) : mimebundleFields displayData + HistoryReply historyItems -> ["history" .= historyItems] + IsCompleteReply codeComplete -> + case codeComplete of + CodeComplete -> ["status" .= ("complete" :: Text)] + CodeIncomplete indent -> ["status" .= ("incomplete" :: Text), "indent" .= indent] + CodeInvalid -> ["status" .= ("invalid" :: Text)] + CodeUnknown -> ["status" .= ("unknown" :: Text)] + ConnectReply ConnectInfo { .. } -> + [ "shell_port" .= connectShellPort + , "iopub_port" .= connectIopubPort + , "stdin_port" .= connectStdinPort + , "hb_port" .= connectHeartbeatPort + , "control_port" .= connectControlPort + ] + CommInfoReply targetNames -> + let mkTargetNameDict (TargetName name) = object ["target_name" .= name] + in ["comms" .= Map.mapKeys UUID.uuidToString (Map.map mkTargetNameDict targetNames)] + ShutdownReply restart -> ["restart" .= restart] + where + formatResult :: OperationResult f -> (f -> [(Text, Value)]) -> [(Text, Value)] + formatResult res mkFields = + case res of + OperationError err -> + [ "status" .= ("error" :: Text) + , "ename" .= errorName err + , "evalue" .= errorValue err + , "traceback" .= errorTraceback err + ] + OperationAbort -> + ["status" .= ("abort" :: Text)] + OperationOk f -> + ("status" .= ("ok" :: Text)) : mkFields f + +-- | Connection information about the ZeroMQ sockets the kernel communicates on. +data ConnectInfo = + ConnectInfo + { connectShellPort :: Int -- ^ The port the shell ROUTER socket is listening on. + , connectIopubPort :: Int -- ^ The port the PUB socket is listening on. + , connectStdinPort :: Int -- ^ The port the stdin ROUTER socket is listening on. + , connectHeartbeatPort :: Int -- ^ The port the heartbeat REP socket is listening on. + , connectControlPort :: Int -- ^ The port the control ROUTER socket is listening on. + } + deriving (Eq, Ord, Show) + +-- | A completion match, including all the text (not just the text after the cursor). +newtype CompletionMatch = CompletionMatch Text + deriving (Eq, Ord, Show, ToJSON, FromJSON, IsString) + +-- | Range (of an input cell) to replace with a completion match. +data CursorRange = + CursorRange + { cursorStart :: Int -- ^ Beginning of the range (in characters). + , cursorEnd :: Int -- ^ End of the range (in characters). + } + deriving (Eq, Ord, Show) + + +-- | One item from the kernel history, representing one single input to the kernel. An input +-- corresponds to a cell in a notebook, not a single line in a cell. +data HistoryItem = + HistoryItem + { historyItemSession :: Int -- ^ The session of this input. + , historyItemLine :: Int -- ^ The line number in the session. + , historyItemInput :: Text -- ^ The input on this line. + , historyItemOutput :: Maybe Text -- ^ Optionally, the output when this was run. + } + deriving (Eq, Ord, Show) + +instance ToJSON HistoryItem where + toJSON HistoryItem { .. } = + case historyItemOutput of + Nothing -> toJSON (historyItemSession, historyItemLine, historyItemInput) + Just output -> toJSON (historyItemSession, historyItemLine, historyItemInput, output) + +instance FromJSON HistoryItem where + parseJSON (Array vec) = + case toList vec of + [session, line, inout] -> do + (input, output) <- case inout of + String str -> pure (str, Nothing) + Array tuple -> + case toList tuple of + [String input, String txt] -> pure (input, Just txt) + [String input, Null] -> pure (input, Nothing) + _ -> fail + "Expected 2-tuple of (input, output) in history item" + _ -> fail "Expecting text (input) or 2-tuple for history item" + HistoryItem <$> parseJSON session <*> parseJSON line <*> pure input <*> pure output + _ -> fail "Expecting 3-tuple of values for history item" + parseJSON _ = fail "Expecting list for 'history' field items" + +-- | Whether a string of code is complete (no more code needs to be entered), incomplete, or unknown +-- in status. +-- +-- For example, when the user enters a line in a console style interface, the console must decide +-- whether to immediately execute the current code, or whether to show a continuation prompt for +-- further input. +-- +-- For instance, in Python @a = 5@ would be executed immediately, while @for i in +-- range(5):@ would expect further input. +data CodeComplete = + -- | The provided code is complete. Complete code is ready to be executed. + CodeComplete + | + -- | The provided code is incomplete, and the next line should be "indented" with + -- the provided text. Incomplete code should prompt for another line. + CodeIncomplete Text + | + -- | The provided code is invalid. Invalid code will typically be sent for + -- execution, so that the user sees the error soonest. + CodeInvalid + | + -- | Whether provided code is complete or not could not be determined. If the + -- code completeness is unknown, or the kernel does not reply in time, the + -- frontend may default to sending the code for execution, or use a simple + -- heuristic (execute after a blank line) . + CodeUnknown + deriving (Eq, Ord, Show) + +instance FromJSON CodeComplete where + parseJSON (Object o) = do + status <- o .: "status" + case status :: String of + "complete" -> pure CodeComplete + "incomplete" -> CodeIncomplete <$> o .: "indent" + "invalid" -> pure CodeInvalid + "unknown" -> pure CodeUnknown + _ -> fail "Expecting 'complete', 'incomplete', 'invalid', 'unknown' as code complete status" + parseJSON _ = fail "Expecting object for 'is_complete_reply' body" + +-- | The execution count, represented as an integer (number of cells evaluated up to this point). +newtype ExecutionCount = ExecutionCount Int + deriving (Eq, Ord, Show, Num, ToJSON, FromJSON) + +-- | Many operations share a similar result structure. They can: +-- +-- * complete successfully and return a result ('OperationOk') +-- * fail with an error ('OperationError') +-- * be aborted by the user ('OperationAbort') +-- +-- This data type captures this pattern, and is used in a variety of replies, such as +-- 'ExecuteResult' and 'InspectResult'. +data OperationResult f = + -- | The operation completed successfully, returning some value @f@. + OperationOk f + | + -- | The operation failed, returning error information about the failure. + OperationError ErrorInfo + | + -- | The operation was aborted by the user. + OperationAbort + deriving (Eq, Ord, Show) + +-- | Result from an 'ExecuteRequest'. +-- +-- No data is included with the result, because all execution results are published via +-- 'KernelOutput's instead. +newtype ExecuteResult = ExecuteResult (OperationResult ()) + deriving (Eq, Ord, Show) + +-- | Shorthand pattern for a successful 'ExecuteResult'. +pattern ExecuteOk = ExecuteResult (OperationOk ()) +-- +-- | Shorthand pattern for an errored 'ExecuteResult'. +pattern ExecuteError info = ExecuteResult (OperationError info) +-- +-- | Shorthand pattern for an aborted 'ExecuteResult'. +pattern ExecuteAbort = ExecuteResult OperationAbort + +-- | Result from an 'InspectRequest'. +-- +-- Result includes inspection results to show to the user (in rich 'DisplayData' format), or +-- 'Nothing' if no object was found. +newtype InspectResult = InspectResult (OperationResult (Maybe DisplayData)) + deriving (Eq, Ord, Show) + +-- | Shorthand pattern for a successful 'ExecuteResult'. +pattern InspectOk disp = InspectResult (OperationOk disp) +-- +-- | Shorthand pattern for an errored 'InspectResult'. +pattern InspectError info = InspectResult (OperationError info) +-- +-- | Shorthand pattern for an aborted 'InspectResult'. +pattern InspectAbort = InspectResult OperationAbort + +-- | Result from a 'CompleteRequest'. +-- +-- Result includes a (possibly empty) list of matches, the range of characters to replace with the +-- matches, and any associated metadata for the completions. +newtype CompleteResult = CompleteResult (OperationResult ([CompletionMatch], CursorRange, Map Text Text)) + deriving (Eq, Ord, Show) + +-- | Shorthand pattern for a successful 'ExecuteResult'. +pattern CompleteOk matches range meta = CompleteResult (OperationOk (matches, range, meta)) +-- +-- | Shorthand pattern for an errored 'CompleteResult'. +pattern CompleteError info = CompleteResult (OperationError info) +-- +-- | Shorthand pattern for an aborted 'CompleteResult'. +pattern CompleteAbort = CompleteResult OperationAbort + +-- | Error information, to be displayed to the user. +data ErrorInfo = + ErrorInfo + { errorName :: Text -- ^ Name of the error or exception. + , errorValue :: Text -- ^ Any values associated with the error or exception. + , errorTraceback :: [Text] -- ^ If possible, a traceback for the error or exception. + } + deriving (Eq, Ord, Show) + +instance FromJSON ErrorInfo where + parseJSON (Object o) = ErrorInfo <$> o .: "ename" <*> o .: "evalue" <*> o .: "traceback" + parseJSON _ = fail "Expecting object with 'ename', 'evalue', and 'traceback' fields" + +-- | Reply content for a 'KernelInfoReply', containing core information about the kernel and the +-- kernel implementation. Pieces of this information are used throughout the frontend for display +-- purposes. +-- +-- Refer to the lists of available and for those fields. +data KernelInfo = + KernelInfo + { kernelProtocolVersion :: Text + -- ^ Version of messaging protocol, usually two or three integers in the format @X.Y@ or @X.Y.Z@. + -- The first integer indicates major version. It is incremented when there is any backward + -- incompatible change. The second integer indicates minor version. It is incremented when there is + -- any backward compatible change. + , kernelBanner :: Text -- ^ A banner of information about the kernel, which may be desplayed + -- in console environments. + , kernelImplementation :: Text -- ^ The kernel implementation name (e.g. @ipython@ for the + -- IPython kernel) + , kernelImplementationVersion :: Text -- ^ Implementation version number. The version number + -- of the kernel's implementation (e.g. + -- @IPython.__version__@ for the IPython kernel) + , kernelLanguageInfo :: LanguageInfo -- ^ Information about the language of code for the + -- kernel + , kernelHelpLinks :: [HelpLink] -- ^ A list of help links. These will be displayed in the + -- help menu in the notebook UI. + } + deriving (Eq, Show) + +-- | Information about the language of code for a kernel. +data LanguageInfo = + LanguageInfo + { languageName :: Text -- ^ Name of the programming language that the kernel implements. + -- Kernel included in IPython returns @python@. + , languageVersion :: Text -- ^ Language version number. It is Python version number (e.g., + -- @2.7.3@) for the kernel included in IPython. + , languageMimetype :: Text -- ^ mimetype for script files in this language. + , languageFileExtension :: Text -- ^ Extension for script files including the dot, e.g. @.py@ + , languagePygmentsLexer :: Maybe Text -- ^ Pygments lexer, for highlighting (Only needed if + -- it differs from the 'languageName' field.) + , languageCodeMirrorMode :: Maybe CodeMirrorMode -- ^ Codemirror mode, for for highlighting in the + -- notebook. (Only needed if it differs from the + -- 'languageName' field.) + , languageNbconvertExporter :: Maybe Text -- ^ Nbconvert exporter, if notebooks written with + -- this kernel should be exported with something + -- other than the general @script@ exporter. + } + deriving (Eq, Show) + +-- | Value set in a language info object for the CodeMirror mode. +data CodeMirrorMode = NamedMode Text + -- ^ Mode described just by its name + | OptionsMode Text [(Text, Value)] + -- ^ Mode with a name and a list of extra params. + -- These parameters are interpreted by the CodeMirror library. + -- + -- For example, the 'CodeMirrorMode' that corresponds to the JSON value + -- @{"name": "mode", "key": "value"}@ would be @'OptionsMode' "mode" [("mode", String "value")]@. + deriving (Eq, Show) + +instance ToJSON LanguageInfo where + toJSON LanguageInfo { .. } = object $ + concat + [ [ "name" .= languageName + , "version" .= languageVersion + , "mimetype" .= languageMimetype + , "file_extension" .= languageFileExtension + ] + , maybe [] (\v -> ["pygments_lexer" .= v]) languagePygmentsLexer + , maybe [] (\v -> ["codemirror_mode" .= v]) languageCodeMirrorMode + , maybe [] (\v -> ["nbconvert_exporter" .= v]) languageNbconvertExporter + ] + +instance FromJSON LanguageInfo where + parseJSON (Object o) = + LanguageInfo <$> o .: "name" + <*> o .: "version" + <*> o .: "mimetype" + <*> o .: "file_extension" + <*> o .:? "pygments_lexer" + <*> o .:? "codemirror_mode" + <*> o .:? "nbconvert_exporter" + parseJSON _ = fail "Expecting object for 'language_info' field" + +instance ToJSON CodeMirrorMode where + toJSON mode = + case mode of + NamedMode name -> String name + OptionsMode name opts -> + object $ ("name" .= name) : map (uncurry (.=)) opts + +instance FromJSON CodeMirrorMode where + parseJSON (String str) = return $ NamedMode str + parseJSON (Object o) = OptionsMode <$> o .: "name" + <*> (Map.assocs . Map.delete "name" <$> parseJSON (Object o)) + parseJSON _ = fail "Expected string or object for codemirror_mode key" + +-- | A link to some help text to include in the frontend's help menu. +data HelpLink = + HelpLink + { helpLinkText :: Text -- ^ Text to show for the link. + , helpLinkURL :: Text -- ^ URL the link points to. This URL is not validated, and is used + -- directly as the link destination. + } + deriving (Eq, Ord, Show) + +instance ToJSON HelpLink where + toJSON HelpLink { .. } = + object ["text" .= helpLinkText, "url" .= helpLinkURL] + +instance FromJSON HelpLink where + parseJSON (Object o) = HelpLink <$> o .: "text" <*> o .: "url" + parseJSON _ = fail "Expected objects in 'help_links' field" + +-- | Although usually kernels respond to clients' requests, the request/reply can also go in the +-- opposite direction: from the kernel to a single frontend. The purpose of these messages (sent on +-- the /stdin/ socket) is to allow code to request input from the user (in particular reading from +-- standard input) and to have those requests fulfilled by the client. The request should be made to +-- the frontend that made the execution request that prompted the need for user input. +data KernelRequest = + -- | Request text input from standard input. + InputRequest InputOptions + deriving (Eq, Ord, Show) + +instance IsMessage KernelRequest where + getMessageType req = + case req of + InputRequest{} -> "input_request" + parseMessageContent msgType = + case msgType of + "input_request" -> Just $ \o -> InputRequest <$> (InputOptions <$> o .: "prompt" <*> o .: "password") + _ -> Nothing + +instance ToJSON KernelRequest where + toJSON req = + case req of + InputRequest InputOptions { .. } -> + object ["prompt" .= inputPrompt, "password" .= inputPassword] + +-- | Metadata for requesting input from the user. +data InputOptions = + InputOptions + { inputPrompt :: Text -- ^ Prompt for the user. + , inputPassword :: Bool -- ^ Is this prompt entering a password? On some frontends this will + -- cause + } + -- the characters to be hidden during entry. + deriving (Eq, Ord, Show) + +-- | Replies from the client to the kernel, as a result of the kernel sending a 'KernelRequest' to +-- the client. +data ClientReply = + -- | Returns the text input by the user to the frontend. + InputReply Text + deriving (Eq, Ord, Show) + +instance ToJSON ClientReply where + toJSON rep = + object $ case rep of + InputReply text -> ["value" .= text] + +instance IsMessage ClientReply where + getMessageType rep = + case rep of + InputReply{} -> "input_reply" + parseMessageContent msgType = + case msgType of + "input_reply" -> Just $ \o -> InputReply <$> o .: "value" + _ -> Nothing + +-- | During processing and code execution, the kernel publishes side effects through messages sent +-- on its /iopub/ socket. Side effects include kernel outputs and notifications, such as writing to +-- standard output or standard error, displaying rich outputs via 'DisplayDataOutput' messages, +-- updating the frontend with kernel status, etc. +-- +-- Multiple frontends may be subscribed to a single kernel, and 'KernelOutput' messages are +-- published to all frontends simultaneously. +data KernelOutput = + -- | Write text to @stdout@ ('StreamStdout') or @stderr@ ('StreamStderr'). + StreamOutput Stream Text + | + -- | Send data that should be displayed (text, html, svg, etc.) to all frontends. + -- Each message can have multiple representations of the data; it is up to the + -- frontend to decide which to use and how. A single message should contain all + -- possible representations of the same information; these representations are + -- encapsulated in the 'DisplayData' type. + -- + -- For transmitting non-textual displays, such as images, data should be base64 + -- encoded and represented as text. + DisplayDataOutput DisplayData + | + -- | Inform all frontends of the currently executing code. To let all frontends + -- know what code is being executed at any given time, these messages contain a + -- re-broadcast of the code portion of an 'ExecuteRequest', along with the + -- 'ExecutionCount'. + ExecuteInputOutput ExecutionCount CodeBlock + | + -- | Results of an execution are published as an 'ExecuteResult'. These are + -- identical to 'DisplayDataOutput' messages, with the addition of an + -- 'ExecutionCount' key. + -- + -- Results can have multiple simultaneous formats depending on its configuration. + -- A plain text representation should always be provided in the text/plain + -- mime-type ('MimePlainText'). Frontends are free to display any or all of the + -- provided representations according to their capabilities, and should ignore + -- mime-types they do not understand. + ExecuteResultOutput ExecutionCount DisplayData + | + -- | When an error occurs during code execution, a 'ExecuteErrorOutput' should be + -- published to inform all frontends of the error. + ExecuteErrorOutput ErrorInfo + | + -- | Inform the frontends of the current kernel status. This lets frontends + -- display usage stats and loading indicators to the user. + -- + -- This message type is used by frontends to monitor the status of the kernel. + -- + -- Note: 'KernelBusy' and 'KernelIdle' messages should be sent before and after + -- handling /every/ message (not just code execution!). + KernelStatusOutput KernelStatus + | + -- | This message type is used to clear the output that is visible on the + -- frontend. + -- + -- The 'WaitBeforeClear' parameter changes when the output will be cleared + -- (immediately or delayed until next output). + ClearOutput WaitBeforeClear + | + -- | Inform the frontends that the kernel is shutting down. + -- + -- This message should be broadcast whenever a 'ShutdownRequest' is received, so + -- that all frontends, not just the one that requested the shutdown, know the + -- kernel is shutting down. The 'Restart' field should match what was requested + -- in the 'ShutdownRequest'. + ShutdownNotificationOutput Restart + deriving (Eq, Ord, Show) + +instance IsMessage KernelOutput where + getMessageType msg = + case msg of + StreamOutput{} -> "stream" + DisplayDataOutput{} -> "display_data" + ExecuteInputOutput{} -> "execute_input" + ExecuteResultOutput{} -> "execute_result" + ExecuteErrorOutput{} -> "error" + KernelStatusOutput{} -> "status" + ClearOutput{} -> "clear_output" + ShutdownNotificationOutput{} -> "shutdown_reply" + parseMessageContent msgType = + case msgType of + "stream" -> Just $ \o -> StreamOutput <$> o .: "name" <*> o .: "text" + "display_data" -> Just $ \o -> DisplayDataOutput <$> parseDisplayData o + "execute_input" -> Just $ \o -> ExecuteInputOutput <$> o .: "execution_count" <*> o .: "code" + "execute_result" -> Just $ \o -> + ExecuteResultOutput <$> o .: "execution_count" <*> parseDisplayData o + "error" -> Just $ \o -> ExecuteErrorOutput <$> parseJSON (Object o) + "status" -> Just $ \o -> KernelStatusOutput <$> o .: "execution_state" + "clear_output" -> Just $ \o -> ClearOutput <$> o .: "wait" + "shutdown_reply" -> Just $ \o -> ShutdownNotificationOutput <$> o .: "restart" + _ -> Nothing + +instance ToJSON KernelOutput where + toJSON output = + object $ + case output of + StreamOutput stream text -> + ["name" .= stream, "text" .= text] + DisplayDataOutput displayData -> mimebundleFields displayData + ExecuteInputOutput executionCount code -> + ["code" .= code, "execution_count" .= executionCount] + ExecuteResultOutput executionCount displayData -> + ("execution_count" .= executionCount) : mimebundleFields displayData + ExecuteErrorOutput err -> + ["ename" .= errorName err, "evalue" .= errorValue err, "traceback" .= errorTraceback err] + KernelStatusOutput status -> + ["execution_state" .= status] + ClearOutput wait -> + ["wait" .= wait] + ShutdownNotificationOutput restart -> + ["restart" .= restart] + +-- | Output stream to write messages to. +data Stream = StreamStdout -- ^ Standard output + | StreamStderr -- ^ Standard error + deriving (Eq, Ord, Show) + +instance ToJSON Stream where + toJSON StreamStdout = "stdout" + toJSON StreamStderr = "stderr" + +instance FromJSON Stream where + parseJSON (String "stdout") = pure StreamStdout + parseJSON (String "stderr") = pure StreamStderr + parseJSON _ = fail "Expecting either 'stdout' or 'stderr' string" + +-- | Whether a 'ClearOutput' should clear the display immediately, or clear the display right before +-- the next display arrives. +-- +-- If 'ClearImmediately' is used, then the frontend may "blink", as there may be a moment after the +-- display is cleared but before a new display available, whereas 'ClearBeforeNextOutput' is meant +-- to alleviate the blinking effect. +-- +-- Used with the 'ClearOutput' kernel output message. +data WaitBeforeClear = ClearBeforeNextOutput -- ^ Clear the display area immediately. + | ClearImmediately -- ^ Clear the display area right before the next display + -- arrives. + deriving (Eq, Ord, Show) + +instance ToJSON WaitBeforeClear where + toJSON ClearBeforeNextOutput = Bool True + toJSON ClearImmediately = Bool False + +instance FromJSON WaitBeforeClear where + parseJSON (Bool True) = pure ClearBeforeNextOutput + parseJSON (Bool False) = pure ClearImmediately + parseJSON _ = fail "Expecting true or false as 'wait' field" + +-- | Status of the kernel. +-- +-- Used with 'KernelStatusOutput' messages to let the frontend know what the kernel is doing. +data KernelStatus = KernelIdle -- ^ @idle@: The kernel is available for more processing tasks. + | KernelBusy -- ^ @busy@: The kernel is currently processing and busy. + | KernelStarting -- ^ @starting@: The kernel is loading and is not yet available + -- for processing. + deriving (Eq, Ord, Show) + +instance ToJSON KernelStatus where + toJSON KernelIdle = "idle" + toJSON KernelBusy = "busy" + toJSON KernelStarting = "starting" + +instance FromJSON KernelStatus where + parseJSON (String "idle") = pure KernelIdle + parseJSON (String "busy") = pure KernelBusy + parseJSON (String "starting") = pure KernelStarting + parseJSON _ = fail "Expecting 'idle', 'busy', 'starting' as 'execution_state' field" + +-- | Target module for a 'CommOpen' message, optionally used in combination with a 'TargetName' to +-- let the receiving side of the 'CommOpen' message know how to create the @comm@. +newtype TargetModule = TargetModule Text + deriving (Eq, Ord, Show, FromJSON, ToJSON) + +-- | 'Comm' messages provide developers with an unstructured communication channel between the +-- kernel and the frontend which exists on both sides and can communicate in any direction. +-- +-- These messages are fully symmetrical - both the kernel and the frontend can send each message, +-- and no messages expect a reply. +-- +-- Every @comm@ has an ID and a target name. The code handling the message on the receiving side +-- (which may be the client or the kernel) is responsible for creating a @comm@ given the target +-- name of the @comm@ being created. +-- +-- Once a @comm@ is open with a 'CommOpen' message, the @comm@ should exist immediately on both +-- sides, until the comm is closed with a 'CommClose' message. +-- +-- For more information on @comm@ messages, read the +-- . +data Comm = + -- | A 'CommOpen' message used to request that the receiving end create a @comm@ with + -- the provided UUID and target name. + -- + -- The 'TargetName' lets the receiving end what sort of @comm@ to create; this + -- can also be refined with an optional 'TargetModule', which can select the + -- module responsible for creating this @comm@ (for languages or environments in + -- which the idea of a module is meaningful). Although such a distinction is not + -- always meaningful, the 'TargetModule' is often used to select a module (such + -- as a Python module) and the 'TargetName' is often used to select the + -- constructor or function in that module that then creates the @comm@. + -- + -- The auxiliary JSON @data@ value can contain any information the client or kernel + -- wishes to include for this @comm@ message. + CommOpen UUID Value TargetName (Maybe TargetModule) + | + -- | A 'CommClose' message destroys a @comm@, selecting it by its UUID. + -- + -- The auxiliary JSON @data@ value can contain any information the client or kernel + -- wishes to include for this @comm@ message. + CommClose UUID Value + | + -- | A 'CommMessage' message sends some JSON data to a @comm@, selecting it by its UUID. + CommMessage UUID Value + deriving (Eq, Show) + +instance IsMessage Comm where + getMessageType comm = + case comm of + CommOpen{} -> "comm_open" + CommClose{} -> "comm_close" + CommMessage{} -> "comm_msg" + parseMessageContent msgType = + case msgType of + "comm_open" -> Just $ \o -> + CommOpen <$> o .: "comm_id" <*> o .: "data" <*> o .: "target_name" <*> o .:? "target_module" + "comm_close" -> Just $ \o -> CommClose <$> o .: "comm_id" <*> o .: "data" + "comm_msg" -> Just $ \o -> CommMessage <$> o .: "comm_id" <*> o .: "data" + _ -> Nothing + + +instance ToJSON Comm where + toJSON comm = + object $ + case comm of + CommOpen uuid commData targetName mTargetModule -> + ["comm_id" .= uuid, "data" .= commData, "target_name" .= targetName] ++ + maybe [] (\targetModule -> ["target_module" .= targetModule]) mTargetModule + CommClose uuid commData -> + ["comm_id" .= uuid, "data" .= commData] + CommMessage uuid commData -> + ["comm_id" .= uuid, "data" .= commData] + +-- | A display data /mimebundle/, used to publish rich data to Jupyter frontends. +-- +-- A mimebundle contains all possible representations of an object available to the kernel in a map +-- from 'MimeType' keys to encoded data values. By sending all representations to the Jupyter +-- frontends, kernels allow the frontends to select the most appropriate representation; for +-- instance, the console frontend may prefer to use a text representation, while the notebook will +-- prefer to use an HTML or PNG representation. +-- +-- All data must be encoded into 'Text' values; for items such as images, the data must be +-- base64-encoded prior to transmission. +-- +-- In order to create the 'DisplayData' values, use the provided 'displayPlain', 'displayHtml', +-- 'displayJavascript', etc, utilities; the 'Monoid' instance can be used to combine 'DisplayData' +-- values to create values with multiple possible representations. +newtype DisplayData = DisplayData (Map MimeType Text) + deriving (Eq, Ord, Show, Typeable, Generic, Monoid) + +-- | Create a @text/plain@ 'DisplayData' bundle out of a bit of 'Text'. +displayPlain :: Text -> DisplayData +displayPlain = DisplayData . Map.singleton MimePlainText + +-- | Create a @text/html@ 'DisplayData' bundle out of a bit of 'Text'. +displayHtml :: Text -> DisplayData +displayHtml = DisplayData . Map.singleton MimeHtml + +-- | Create a @text/latex@ 'DisplayData' bundle out of a bit of 'Text'. +displayLatex :: Text -> DisplayData +displayLatex = DisplayData . Map.singleton MimeLatex + +-- | Create a @application/javascript@ 'DisplayData' bundle out of a bit of 'Text'. +displayJavascript :: Text -> DisplayData +displayJavascript = DisplayData . Map.singleton MimeJavascript + +-- | Create a @image/svg+xml@ 'DisplayData' bundle out of a bit of 'Text'. +displaySvg :: Text -> DisplayData +displaySvg = DisplayData . Map.singleton MimeSvg + +-- | Create a @image/png@ 'DisplayData' bundle out of a bit of 'Text'. +-- +-- The text should be base-64 encoded data. +displayPng :: ImageDimensions -> Text -> DisplayData +displayPng dims = DisplayData . Map.singleton (MimePng dims) + +-- | Create a @image/jpg@ 'DisplayData' bundle out of a bit of 'Text'. +-- +-- The text should be base-64 encoded data. +displayJpg :: ImageDimensions -> Text -> DisplayData +displayJpg dims = DisplayData . Map.singleton (MimeJpg dims) + +-- | Convert a 'DisplayData' to a list of JSON fields. +-- +-- This is effectively equivalent to a 'ToJSON' instance, but since 'DisplayData' fields are in +-- several messages integrated into the message fields, we provide this conversion instead. +mimebundleFields :: DisplayData -> [(Text, Value)] +mimebundleFields (DisplayData displayData) = + ["data" .= encodeDisplayData displayData, "metadata" .= encodeDisplayMetadata displayData] + where + encodeDisplayData = Map.mapKeys showMimeType + encodeDisplayMetadata = + Map.mapKeys showMimeType . Map.mapMaybeWithKey (\mime _ -> mimeTypeMetadata mime) + +-- | Parse a display data out of an object that has a data and metadata field, and +-- represents a mimebundle. +parseDisplayData :: Object -> Parser DisplayData +parseDisplayData o = do + displayData <- Map.toList <$> o .: "data" + metadata <- o .: "metadata" + DisplayData . Map.fromList <$> foldM (collectMetadata metadata) [] displayData + where + collectMetadata :: Object -> [(MimeType, Text)] -> (Text, Text) -> Parser [(MimeType, Text)] + collectMetadata metadata previous (key, value) = do + mimetype <- case key of + "text/plain" -> return MimePlainText + "text/html" -> return MimeHtml + "image/png" -> do + dims <- metadata .: "image/png" + MimePng <$> (ImageDimensions <$> dims .: "width" <*> dims .: "height") + "image/jpeg" -> do + dims <- metadata .: "image/jpeg" + MimeJpg <$> (ImageDimensions <$> dims .: "width" <*> dims .: "height") + "image/svg+xml" -> return MimeSvg + "text/latex" -> return MimeLatex + "application/javascript" -> return MimeJavascript + _ -> fail $ "Unknown mimetype: " ++ show key + return $ (mimetype, value) : previous + +-- | Dimensions of an image, to be included with the 'DisplayData' bundle in the 'MimeType'. +data ImageDimensions = + ImageDimensions + { imageWidth :: Int -- ^ Image width, in pixels. + , imageHeight :: Int -- ^ Image height, in pixels. + } + deriving (Eq, Ord, Show) + +instance ToJSON ImageDimensions where + toJSON (ImageDimensions width height) = object ["width" .= width, "height" .= height] + +-- | Mime types for the display data, with any associated metadata that the mime types may require. +data MimeType = MimePlainText -- ^ A @text/plain@ mimetype for text + | MimeHtml -- ^ A @text/html@ mimetype for HTML + | MimePng ImageDimensions -- ^ A @image/png@ mimetype for PNG images, with associated image width and height + | MimeJpg ImageDimensions -- ^ A @image/jpg@ mimetype for JPG images, with associated image width and height + | MimeSvg -- ^ A @image/svg+xml@ mimetype for SVG images + | MimeLatex -- ^ A @text/latex@ mimetype for LaTeX + | MimeJavascript -- ^ A @application/javascript@ mimetype for Javascript + deriving (Eq, Ord, Show, Typeable, Generic) + +-- | Convert a 'MimeType' into its standard string representation. +-- +-- >>> showMimeType MimePlainText +-- "text/plain" +-- +-- >>> showMimeType MimeJavascript +-- "application/javascript" +-- +-- >>> showMimeType (MimePng (ImageDimensions 100 200)) +-- "image/png" +showMimeType :: MimeType -> Text +showMimeType mime = + case mime of + MimePlainText -> "text/plain" + MimeHtml -> "text/html" + MimePng _ -> "image/png" + MimeJpg _ -> "image/jpeg" + MimeSvg -> "image/svg+xml" + MimeLatex -> "text/latex" + MimeJavascript -> "application/javascript" + +-- | Extract any metadata associated with this 'MimeType' value. +-- +-- Metadata is included with @display_data@ ('DisplayData') messages to give more information to the +-- frontends about how to display the resource. Most mime types lack any metadata, but not all; in +-- particular some image types may have image dimensions. +-- +-- >>> mimeTypeMetadata MimeHtml +-- Nothing +-- +-- >>> mimeTypeMetadata (MimePng (ImageDimensions 100 200)) +-- Object (fromList [("width", Number 100.0), ("height", Number 200.0)]) +mimeTypeMetadata :: MimeType -> Maybe Value +mimeTypeMetadata mime = + case mime of + MimePng dims -> Just $ toJSON dims + MimeJpg dims -> Just $ toJSON dims + _ -> Nothing diff --git a/src/Jupyter/Messages/Internal.hs b/src/Jupyter/Messages/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Jupyter/Messages/Internal.hs @@ -0,0 +1,121 @@ +{-| +Module : Jupyter.Messages.Internal +Description : Metadata and message headers for the Jupyter messaging protocol, used internally. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX + +This module contains type and class definitions pertaining to handling Jupyter messages +internally. The types defined here are generally useful for the @jupyter@ library +but will not be useful for users of the library. +-} + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Jupyter.Messages.Internal ( + -- * Message Metadata + MessageHeader(..), + Username(..), + MessageType(..), + IsMessage(..), + ) where + +-- Imports from 'base' +import Control.Applicative (Alternative(..)) +import GHC.Exts (IsString) + +-- Imports from 'aeson' +import Data.Aeson (FromJSON, ToJSON) +import Data.Aeson.Types (Parser, Object) + +-- Imports from 'bytestring' +import Data.ByteString (ByteString) + +-- Imports from 'text' +import Data.Text (Text) + +-- Imports from 'jupyter' +import Jupyter.UUID (UUID) + +-- | A message header with some metadata. +-- +-- The metadata has a variety of important information that pertains to the session maintained +-- between the client and the frontend. In addition to metadata, the message headers are used to +-- establish relationships between the messages: in particular, the message parent is used to +-- determine which request a reply corresponds to. +-- +-- In addition, the message type is sent as a string with the message header. +-- +-- For more information about the message headers, read the section of the Jupyter messaging +-- protocol about the +-- . +data MessageHeader = + MessageHeader + { messageIdentifiers :: [ByteString] + -- ^ The identifiers sent with the message. These identifiers come at the front of the message, and + -- are ZeroMQ routing prefix, which can be zero or more socket identities. These are used, for + -- instance, to know where to send /stdin/ requests (see the messaging spec). + , messageParent :: Maybe MessageHeader + -- ^ The parent header, if present. The parent header is used to establish relationships between + -- request and reply messages and outputs published in response to requests. + , messageMetadata :: Object + -- ^ A free-form dict of metadata. + , messageId :: UUID -- ^ A unique message UUID. + , messageSession :: UUID -- ^ A unique session UUID. + , messageUsername :: Username -- ^ The user who sent this message. + , messageType :: MessageType + -- ^ The type of this message. This is stored as a string, and determines how to parse the content + -- and what to do with the message once it is parsed. + } + deriving (Eq, Show) + +-- | A username represented as 'Text', part of the 'MessageHeader'. +newtype Username = Username Text + deriving (Eq, Ord, Show, IsString, FromJSON, ToJSON) + +-- | The type of a message, internally stored as a string. +-- +-- Examples include @execute_request@, @comm_open@, and @display_data@. +newtype MessageType = MessageType { messageTypeText :: Text } + deriving (Eq, Ord, Show, FromJSON, ToJSON, IsString) + +-- | Jupyter messages are represented as a variety of datatypes, depending on where in the messaging +-- protocol the message is used (for instance, 'Jupyter.Messages.ClientRequest' or +-- 'Jupyter.Messages.Comm'). +-- +-- Given any message, however, you need to be able to get a 'MessageType' for it, so that when +-- encoding the message onto the wire you can include the message type in the header. The +-- 'IsMessage' typeclass provides a single method, 'getMessageType', which gets the message type of +-- any Jupyter message. +class ToJSON v => IsMessage v where + -- | Get the message type for a Jupyter message. + getMessageType :: v -> MessageType + + -- | Get a parser for this message type. + -- + -- If this message type does not correspond to one of the constructors for the data type @v@, then + -- return 'Nothing'. Otherwise, return a parser that parses the message body into the given + -- datatype. + -- + -- This is a slightly unusual but necessary interface, because the message type and the message body + -- come in separate bytestrings, as they are separate blobs sent on the communication sockets. Thus, + -- we must look first at the message type, and choose the JSON parser based on the message type. + parseMessageContent :: MessageType -> Maybe (Object -> Parser v) + +-- | Provide an 'IsMessage' instance for the sum of two types which have 'IsMessage' instances. +-- +-- This is particularly useful for dealing with the /shell/ and /iopub/ socket, where kernels and +-- clients can receive different types of messages on one socket (kernels can receive 'Comm' and +-- 'ClientRequest' messages on the /shell/ socket, while clients can receive 'KernelOutput' and +-- 'Comm' messages on the /iopub/ socket). +instance (IsMessage v1, IsMessage v2) => IsMessage (Either v1 v2) where + getMessageType = either getMessageType getMessageType + parseMessageContent msgType = + fmap3 Left (parseMessageContent msgType) <|> fmap3 Right (parseMessageContent msgType) + where + -- I can't believe I get to write `fmap . fmap . fmap` and have it be meaningful. Don't think too + -- hard, just look at the type signature, which is specialized to the functors that I care about in + -- this case! (Maybe, (->) Object, and Parser, to be specific). + fmap3 :: (a -> b) -> Maybe (Object -> Parser a) -> Maybe (Object -> Parser b) + fmap3 = fmap . fmap . fmap diff --git a/src/Jupyter/UUID.hs b/src/Jupyter/UUID.hs new file mode 100644 --- /dev/null +++ b/src/Jupyter/UUID.hs @@ -0,0 +1,76 @@ +{-| +Module : Jupyter.UUID +Description : UUID generator and type. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX + +Generate, parse, and pretty print UUIDs for use with Jupyter. + +UUIDs are stored internally as just strings, rather than parsed UUIDs, because Jupyter cares about +things like dashes and capitalization -- if they are not identical to the ones Jupyter send, Jupyter +will not recognize them. Thus, we treat them as strings rather than UUIDs to be parsed to avoid +modifying them in any way. +-} +module Jupyter.UUID ( + -- * UUID data type and conversions + UUID, + uuidToString, + uuidFromString, + + -- * Generating UUIDs + random, + randoms, + ) where + +-- Imports from 'base' +import Control.Monad (mzero, replicateM) + +-- Imports from 'aeson' +import Data.Aeson + +-- Imports from 'text' +import Data.Text (pack) + +-- Imports from 'uuid' +import Data.UUID.V4 (nextRandom) + +-- | A UUID (universally unique identifier). +newtype UUID = + -- We use an internal string representation because for the purposes of Jupyter, it + -- matters whether the letters are uppercase or lowercase and whether the dashes are + -- present in the correct locations. For the purposes of new UUIDs, it does not + -- matter, but Jupyter expects UUIDs passed to kernels to be returned unchanged, so we + -- cannot actually parse them. + UUID String + deriving (Show, Read, Eq, Ord) + +-- | Convert a 'UUID' to a 'String' for transmission or display. +uuidToString :: UUID -> String +uuidToString (UUID uuid) = uuid + +-- | Convert a 'String' to a 'UUID'. +uuidFromString :: String -> UUID +uuidFromString = UUID + +-- | Generate a list of random UUIDs. +randoms :: Int -- ^ Number of UUIDs to generate. + -> IO [UUID] +randoms n = replicateM n random + +-- | Generate a single random UUID. +random :: IO UUID +random = UUID . show <$> nextRandom + +-- Allows reading and writing UUIDs as Strings in JSON. +instance FromJSON UUID where + parseJSON val@(String _) = UUID <$> parseJSON val + + -- UUIDs must be Strings. + parseJSON _ = mzero + +instance ToJSON UUID where + -- Extract the string from the UUID. + toJSON (UUID str) = String $ pack str diff --git a/src/Jupyter/ZeroMQ.hs b/src/Jupyter/ZeroMQ.hs new file mode 100644 --- /dev/null +++ b/src/Jupyter/ZeroMQ.hs @@ -0,0 +1,673 @@ +{-| +Module : Jupyter.ZeroMQ +Description : Low-level communication primitives for Jupyter's ZeroMQ channels. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX + +This is a primarily internal module; users of the @jupyter@ package do not need to import or +use functions or data types from this module. + +This module provides a low-level interface to the Jupyter ZeroMQ sockets, message encoding, and +message decoding. The primary interface consists of 'withKernelSockets' and 'withClientSockets', which +create the sets of sockets needed to serve a kernel or run a client, and 'sendMessage' and 'receiveMessage', +which, as the names may imply, send and receive messages (encoding and decoding them along the way) on the +sockets. +-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DeriveDataTypeable #-} +module Jupyter.ZeroMQ ( + -- * Opening ZeroMQ Sockets + KernelSockets(..), + withKernelSockets, + ClientSockets(..), + withClientSockets, + + -- * Kernel Profiles + KernelProfile(..), + Port, + IP, + Transport(..), + readProfile, + writeProfile, + + -- * Sending and Receiving messages + sendMessage, + receiveMessage, + mkRequestHeader, + mkReplyHeader, + + -- * Miscellaneous utilities + threadKilledHandler, + messagingError, + MessagingException(..), + ) where + +-- Imports from 'base' +import Control.Exception (throwIO, Exception, AsyncException(ThreadKilled)) +import Control.Monad (void, unless) +import Data.Char (isNumber) +import Data.Monoid ((<>)) +import Text.Read (readMaybe) +import Data.Typeable (Typeable) + +-- Imports from 'bytestring' +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as CBS +import qualified Data.ByteString.Lazy as LBS + +-- Imports from 'exceptions' +import Control.Monad.Catch (catch, finally) + +-- Imports from 'aeson' +import Data.Aeson (FromJSON(..), Value(..), (.:), ToJSON(..), encode, decode, (.=), object, + eitherDecodeStrict') +import Data.Aeson.Types (parseEither) + +-- Imports from 'mtl' +import Control.Monad.IO.Class (MonadIO(..)) + +-- Imports from 'text' +import qualified Data.Text.Encoding as T + +-- Imports from 'SHA' +import Data.Digest.Pure.SHA as SHA + +-- Imports from 'zeromq4-haskell' +import System.ZMQ4.Monadic (Socket, ZMQ, runZMQ, socket, Rep(..), Router(..), Pub(..), + Dealer(..), Req(..), Sub(..), Flag(..), send, receive, Receiver, + Sender, lastEndpoint, bind, unbind, connect, subscribe, + ZMQError, setIdentity, restrict, monitor, EventType(..), setLinger) + +-- Imports from 'jupyter' +import Jupyter.Messages.Internal (MessageHeader(..), IsMessage(..), Username(..)) +import qualified Jupyter.UUID as UUID + + +-- | Given all the bytes read from the wire, parse the Jupyter message into one of the @jupyter@ +-- package's many data types representing different types of Jupyter messages. +-- +-- Return the 'MessageHeader' along with the message itself, assuming parsing succeeds, or returns +-- an error message if it doesn't. +parseMessage :: IsMessage v + => [ByteString] -- ^ List of ZeroMQ identifiers for this message. + -> ByteString -- ^ The encoded JSON message header. + -> ByteString -- ^ The encoded JSON parent message header (or @{}@ for no parent). + -> ByteString -- ^ Any metadata associated with the message (as JSON). + -> ByteString -- ^ The contents of the message itself, encoded as JSON. + -> Either String (MessageHeader, v) +parseMessage identifiers headerData parentHeaderData metadata content = do + header <- parseHeader identifiers headerData parentHeaderData metadata + case parseMessageContent (messageType header) of + Nothing -> Left $ "Unrecognize message type: " ++ show (messageType header) + Just parser -> do + value <- eitherDecodeStrict' content + case value of + Object obj -> (header,) <$> parseEither parser obj + _ -> Left $ "Expected object when parsing message, but got: " ++ show value + +-- | Attempt to parse a message header. +parseHeader :: [ByteString] -- ^ List of ZeroMQ identifiers for this message. + -> ByteString -- ^ The encoded JSON message header. + -> ByteString -- ^ The encoded JSON parent message header (or @{}@ for no parent). + -> ByteString -- ^ Any metadata associated with the message (as JSON). + -> Either String MessageHeader +parseHeader identifiers headerData parentHeaderData metadata = do + header <- eitherDecodeStrict' headerData + + let messageIdentifiers = identifiers + messageParent <- if parentHeaderData == "{}" + then return Nothing + else Just <$> parseHeader identifiers parentHeaderData "{}" metadata + messageType <- parseEither (.: "msg_type") header + messageUsername <- parseEither (.: "username") header + messageId <- parseEither (.: "msg_id") header + messageSession <- parseEither (.: "session") header + messageMetadata <- eitherDecodeStrict' metadata + + return MessageHeader { .. } + +-- | The collection of sockets needed to communicate with Jupyter +-- kernels on the . These sockets are to be used +-- by a client communicating with a kernel. +-- +-- Roles of different sockets are described +-- . +data ClientSockets z = + ClientSockets + { clientHeartbeatSocket :: Socket z Req + -- ^ The /heartbeat/ socket, which, for functioning kernels, will echo anything sent to it immediately. + -- Clients can use this socket to check if the kernel is still alive. + , clientControlSocket :: Socket z Dealer + -- ^ The /control/ socket, optionally used to send 'ClientRequest' messages that deserve immediate + -- response (shutdown requests, etc), rather than long-running requests (execution). + , clientShellSocket :: Socket z Dealer + -- ^ The /shell/ socket, used to send the majority of 'ClientRequest' messages (introspection, + -- completion, execution, etc) and their responses. + , clientStdinSocket :: Socket z Dealer + -- ^ The /stdin/ socket, used for communication from a kernel to a single frontend; currently only + -- used for retrieving standard input from the user, hence the socket name. + , clientIopubSocket :: Socket z Sub + -- ^ The /iopub/ socket, used for receiving 'KernelOutput's from the kernel. + , clientWaitForConnections :: IO () + -- ^ A function which waits for one connection on each of the sockets, using socket monitoring. + } + +-- | The collection of sockets needed to communicate with Jupyter +-- clients on the . These sockets are to be used +-- by a kernel communicating with a client. +-- +-- Roles of different sockets are described +-- . +data KernelSockets z = + KernelSockets + { kernelHeartbeatSocket :: Socket z Rep + -- ^ The /heartbeat/ socket, which echoes anything sent to it immediately and is used by frontends + -- solely to confirm that the kernel is still alive. + , kernelControlSocket :: Socket z Router + -- ^ The /control/ socket, optionally used to send 'ClientRequest' messages that deserve immediate + -- response (shutdown requests, etc), rather than long-running requests (execution). + , kernelShellSocket :: Socket z Router + -- ^ The /shell/ socket, used to send the majority of 'ClientRequest' messages (introspection, + -- completion, execution, etc) and their responses. + , kernelStdinSocket :: Socket z Router + -- ^ The /stdin/ socket, used for communication from a kernel to a single frontend; currently only + -- used for retrieving standard input from the user, hence the socket name. + , kernelIopubSocket :: Socket z Pub + -- ^ The /iopub/ socket, used for publishing 'KernelOutput's to all frontends. + } + +-- | A TCP port, encoded as an integer. +type Port = Int + +-- | An IP address, encoded as a string. +type IP = String + +-- | The transport mechanism used to communicate with the Jupyter frontend. +data Transport = TCP -- ^ Default transport mechanism via TCP. + deriving (Eq, Ord, Show, Read) + +-- | Decode a transport mechanism from a JSON string. +instance FromJSON Transport where + parseJSON (String "tcp") = return TCP + parseJSON _ = fail "Could not parse transport, expecting string \"tcp\"" + +-- | Encode a transport mechanism as a JSON string. +instance ToJSON Transport where + toJSON TCP = "tcp" + +-- | Convert a 'Transport' to a 'String' representing the protocol, to be used as the first part of an address. +-- +-- >>> transportToProtocolString TCP == "tcp" +transportToProtocolString :: Transport -> String +transportToProtocolString TCP = "tcp" + +-- | Exception to throw when the messaging protocol is not being observed. +-- +-- See 'messagingError'. +data MessagingException = MessagingException String + deriving (Eq, Ord, Show, Typeable) + +-- | An 'Exception' instance allows 'MessagingException' to be thrown as an exception. +instance Exception MessagingException + +-- | Throw a 'MessagingException' with a descriptive error message. +-- +-- Should be used when the messaging protocol is not being properly observed or in other +-- unrecoverable situations. +messagingError :: MonadIO m + => String -- ^ Module name in which error happened. + -> String -- ^ Error message. + -> m a +messagingError moduleName msg = + liftIO $ throwIO $ MessagingException $ concat [moduleName, ": ", msg] + +-- | A kernel profile, specifying how the kernel communicates. +-- +-- The kernel profile is usually obtained by a kernel by parsing the connection file passed to it as +-- an argument as indicated by the kernelspec. +-- +-- The @profileTransport@, @profileIp@ and five profile Port fields specify the ports which the +-- kernel should bind to. These ports are usually generated fresh for every client or server started. +-- +-- @profileSignatureKey@ is used to cryptographically sign messages, so that other users on the +-- system can’t send code to run in this kernel. See the +-- +-- for the details of how this signature is calculated. +-- +-- More info on the fields of the connection file and the 'KernelProfile' is available in the +-- . +data KernelProfile = + KernelProfile + { profileIp :: IP -- ^ The IP on which to listen. + , profileTransport :: Transport -- ^ The transport mechanism. + , profileStdinPort :: Port -- ^ The stdin channel port. + , profileControlPort :: Port -- ^ The control channel port. + , profileHeartbeatPort :: Port -- ^ The heartbeat channel port. + , profileShellPort :: Port -- ^ The shell command port. + , profileIopubPort :: Port -- ^ The IOPub port. + , profileSignatureKey :: ByteString -- ^ The HMAC encryption key. + } + deriving (Eq, Ord, Show, Read) + +-- | Decode a 'KernelProfile' from a JSON object. +-- +-- This object is passed to kernels in the connection file. +instance FromJSON KernelProfile where + parseJSON (Object o) = do + -- Check that the signature scheme is as expected. + signatureScheme <- o .: "signature_scheme" + unless (signatureScheme == "hmac-sha256") $ + fail $ "Unsupported signature scheme: " ++ signatureScheme + + profileIp <- o .: "ip" + profileTransport <- o .: "transport" + profileStdinPort <- o .: "stdin_port" + profileControlPort <- o .: "control_port" + profileHeartbeatPort <- o .: "hb_port" + profileShellPort <- o .: "shell_port" + profileIopubPort <- o .: "iopub_port" + profileSignatureKey <- T.encodeUtf8 <$> o .: "key" + return KernelProfile { .. } + + parseJSON _ = fail "Expecting object for parsing KernelProfile" + +-- | Instance to decode a 'KernelProfile' from connection file contents. +instance ToJSON KernelProfile where + toJSON KernelProfile { .. } = + object + [ "ip" .= profileIp + , "transport" .= profileTransport + , "stdin_port" .= profileStdinPort + , "control_port" .= profileControlPort + , "hb_port" .= profileHeartbeatPort + , "shell_port" .= profileShellPort + , "iopub_port" .= profileIopubPort + , "key" .= T.decodeUtf8 profileSignatureKey + , "signature_scheme" .= ("hmac-sha256" :: String) + ] + +-- | Read a 'KernelProfile' from a file. This file (the connection file) should contain a +-- JSON-encoded object with all necessary fields, as described in the +-- +-- section of the Jupyter documentation. +-- +-- If the file contents cannot be parsed, 'Nothing' is returned. +readProfile :: FilePath -> IO (Maybe KernelProfile) +readProfile path = decode <$> LBS.readFile path + +-- | Write a 'KernelProfile' to a JSON file, which can be passed as the connection file to a +-- starting kernel. +writeProfile :: KernelProfile -> FilePath -> IO () +writeProfile profile path = LBS.writeFile path (encode profile) + +-- | Create and bind all ZeroMQ sockets used for serving a Jupyter kernel. Store info about the +-- created sockets in a 'KernelProfile', and then run a 'ZMQ' action, providing the used +-- 'KernelProfile' and the sockets themselves in a 'JupyterSockets' record. +withKernelSockets :: Maybe KernelProfile -- ^ Optionally, specify how the ZeroMQ sockets should be + -- opened, including the ports on which they should be + -- opened. If 'Nothing' is provided, ports are chosen + -- automatically, and a 'KernelProfile' is generated with + -- the chosen ports. + -> (forall z. KernelProfile -> KernelSockets z -> ZMQ z a) -- ^ Callback to + -- invoke with the + -- socket info and + -- ZeroMQ sockets. + -> IO a +withKernelSockets mProfile callback = runZMQ $ do + kernelHeartbeatSocket <- socket Rep + kernelControlSocket <- socket Router + kernelShellSocket <- socket Router + kernelStdinSocket <- socket Router + kernelIopubSocket <- socket Pub + + heartbeatPort <- bindSocket mProfile profileHeartbeatPort kernelHeartbeatSocket + controlPort <- bindSocket mProfile profileControlPort kernelControlSocket + shellPort <- bindSocket mProfile profileShellPort kernelShellSocket + stdinPort <- bindSocket mProfile profileStdinPort kernelStdinSocket + iopubPort <- bindSocket mProfile profileIopubPort kernelIopubSocket + + let profile = KernelProfile + { profileTransport = maybe TCP profileTransport mProfile + , profileIp = maybe "127.0.0.1" profileIp mProfile + , profileHeartbeatPort = heartbeatPort + , profileControlPort = controlPort + , profileShellPort = shellPort + , profileStdinPort = stdinPort + , profileIopubPort = iopubPort + , profileSignatureKey = maybe "" profileSignatureKey mProfile + } + + callback profile KernelSockets { .. } + +-- | Create and bind all ZeroMQ sockets used for using a Jupyter kernel from a client. Store info about the +-- created sockets in a 'KernelProfile', and then run a 'ZMQ' action, providing the used +-- 'KernelProfile' and the sockets themselves in a 'JupyterSockets' record. +withClientSockets :: Maybe KernelProfile -- ^ Optionally, specify how the ZeroMQ sockets should be + -- opened, including the ports on which they should be + -- opened. If 'Nothing' is provided, ports are chosen + -- automatically, and a 'KernelProfile' is generated with + -- the chosen ports. + -> (forall z. KernelProfile -> ClientSockets z -> ZMQ z a) -- ^ Callback to + -- invoke with the + -- socket info and + -- ZeroMQ sockets. + -> IO a +withClientSockets mProfile callback = runZMQ $ do + clientHeartbeatSocket <- socket Req + clientControlSocket <- socket Dealer + clientShellSocket <- socket Dealer + clientStdinSocket <- socket Dealer + clientIopubSocket <- socket Sub + + -- Make sure that we do not accidentally let the client run forever, + -- just because there are unsent messages. Shut it down eventually. + let linger = 300 :: Int + setLinger (restrict linger) clientHeartbeatSocket + setLinger (restrict linger) clientControlSocket + setLinger (restrict linger) clientShellSocket + setLinger (restrict linger) clientStdinSocket + setLinger (restrict linger) clientIopubSocket + + -- Set the identity of all dealer sockets to the same thing. This is really important only for the + -- stdin socket – it must have the same identity as the shell socket (see the Note in the stdin + -- section of the messaging protocol.) If we don't set the identity ourselves, then ZeroMQ will set + -- its own null-byte-prefixed identity, and the identities will be different, so the client won't be + -- able to receive the stdin messages from the kernel. + identity <- CBS.pack . UUID.uuidToString <$> liftIO UUID.random + setIdentity (restrict identity) clientShellSocket + setIdentity (restrict identity) clientStdinSocket + setIdentity (restrict identity) clientControlSocket + + -- Set up socket monitoring. When you monitor a socket, you specify the event to listen for. Then, + -- you can call the function return from 'monitor' to block until an event is received. This lets us + -- easily wait for the kernel to connect, by waiting for one accepted connection event per socket. + -- Once we receive that, we can turn off monitoring. (Passing True listens for an event; False turns + -- off monitoring.) + -- + -- You can't use 'mapM' because the sockets have different types, e.g. Socket z Req vs Socket z Dealer. + monitors <- sequence + [ monitor [ConnectedEvent] clientHeartbeatSocket + , monitor [ConnectedEvent] clientControlSocket + , monitor [ConnectedEvent] clientShellSocket + , monitor [ConnectedEvent] clientStdinSocket + , monitor [ConnectedEvent] clientIopubSocket + ] + let clientWaitForConnections = mapM_ ($ True) monitors + + heartbeatPort <- connectSocket mProfile 10730 profileHeartbeatPort clientHeartbeatSocket + controlPort <- connectSocket mProfile 11840 profileControlPort clientControlSocket + shellPort <- connectSocket mProfile 12950 profileShellPort clientShellSocket + stdinPort <- connectSocket mProfile 13160 profileStdinPort clientStdinSocket + iopubPort <- connectSocket mProfile 14270 profileIopubPort clientIopubSocket + + -- Subscribe to all topics on the iopub socket! + -- If we don't do this, then no messages get received on it. + subscribe clientIopubSocket "" + + let profile = KernelProfile + { profileTransport = maybe TCP profileTransport mProfile + , profileIp = maybe "127.0.0.1" profileIp mProfile + , profileHeartbeatPort = heartbeatPort + , profileControlPort = controlPort + , profileShellPort = shellPort + , profileStdinPort = stdinPort + , profileIopubPort = iopubPort + , profileSignatureKey = maybe "" profileSignatureKey mProfile + } + + -- Ensure that all monitors are closed after we run our action. If we don't, + -- ZMQ will not be able to shutdown because the monitor sockets linger. + finally (callback profile ClientSockets { .. }) + (liftIO $ mapM_ ($ False) monitors) + +-- | Compute the address to bind a socket to, given the 'KernelProfile', using the provided tranport +-- mechanism, IP, and port. If no 'KernelProfile' is provided (and 'Nothing' is passed), then return +-- the default address to bind to. +-- +-- This default address has no explicit port, but rather uses @*@, as in @tcp://127.0.0.1:*@, and so +-- cannot be used with ZeroMQ 'connect' (only with 'bind'). +extractAddress :: Maybe KernelProfile -- ^ Optional kernel profile to get address info from + -> (KernelProfile -> Port) -- ^ Given a kernel profile, get the port to use,e.g. + -- 'profileIopubPort' + -> String -- ^ An address string, e.g. @tcp://127.0.0.1:8283@ +extractAddress mProfile accessor = + concat + [ maybe "tcp" (transportToProtocolString . profileTransport) mProfile + , "://" + , maybe "127.0.0.1" profileIp mProfile + , ":" + , maybe "*" (show . accessor) mProfile + ] + +-- | Connect the provided socket to a port. +-- +-- The port to connect to is determined as follows: +-- +-- 1. If a 'KernelProfile' is provided, use the given @'KernelProfile' -> 'Port'@ accessor to compute +-- the port that the socket should bind to, and use it (along with the transport mechanism and IP) +-- to generate an address to connect to. If connecting to this address fails, an exception is +-- raised. +-- +-- 2. If no 'KernelProfile' is provided, attempt to bind to the provided default 'Port'. +-- +-- 3. If binding to the default 'Port' fails, increment the port by one, and try again. Repeat this +-- until either it succeeds, or until a fixed number of tries has been attempted. +-- +-- Returns the port to which the socket was connected. +connectSocket :: forall z t. Maybe KernelProfile -- ^ Optional 'KernelProfile' + -> Port -- ^ Default port to try, if no 'KernelProfile' provided + -> (KernelProfile -> Port) -- ^ Accessor function to get desired port from profile + -> Socket z t -- ^ Socket to connect + -> ZMQ z Port -- ^ Returns port to which socket connected +connectSocket mProfile startPort accessor sock = do + case mProfile of + Just _ -> connect sock (extractAddress mProfile accessor) + Nothing -> findOpenPort 100 startPort + + endpoint sock + + where + -- Try binding to a port. If it fails, try the next one (up to a fixed limit). + -- Any ZMQ error is treated as a retriable failure, regardless of the error code or message. + findOpenPort :: Int -> Int -> ZMQ z () + findOpenPort 0 _ = fail "fatal error (Jupyter.ZeroMQ): Could not find port to connect to." + findOpenPort triesLeft tryPort = + let handler :: ZMQError -> ZMQ z () + handler = const $ findOpenPort (triesLeft - 1) (tryPort + 1) + address = "tcp://127.0.0.1:" ++ show (tryPort :: Int) + in flip catch handler $ do + -- `connect` allows you to connect multiple sockets to the same port. We don't want that! So, in + -- order to find out if we have a kernel already running on the port we're about to connect to, we + -- `bind` the socket. If the bind fails, that means the port is used; if it doesn't fail, the port + -- is open, so we unbind and then connect to it. This is pretty hacky and not thread-safe, but + -- should not cause any issues in practice. + bind sock address + unbind sock address + connect sock address + + +-- | Bind a socket to a port. +-- +-- If a 'KernelProfile' is provided, then the @'KernelProfile' -> 'Port'@ accessor is used +-- to determine which port to connect to. Otherwise, some available port is chosen. The port +-- that was bound to is returned. +bindSocket :: Maybe KernelProfile -- ^ Optional kernel profile with port info + -> (KernelProfile -> Port) -- ^ Accessor for 'Port' inside the profile + -> Socket z t -- ^ Socket to 'bind' + -> ZMQ z Port -- ^ Return port socket was bound to +bindSocket mProfile accessor sock = do + bind sock (extractAddress mProfile accessor) + endpoint sock + +-- | Get the port that the socket was last bound to. +endpoint :: Socket z t -> ZMQ z Port +endpoint sock = do + endpointString <- lastEndpoint sock + case parsePort endpointString of + Nothing -> fail "fatal error (Jupyter.ZeroMQ): could not parse port as integer." + Just port -> return port + +-- | Try to parse the 'Port' from an address string along the lines of @"tcp://127.0.0.1:8829"@. +-- +-- >>> parsePort "tcp://127.0.0.1:8829" == 8829 +parsePort :: String -> Maybe Int +parsePort s = readMaybe num + where + num = reverse (takeWhile isNumber (reverse s)) + +-- | Read a client message from a ZeroMQ socket, as well as the message header that came with it. +-- Block until all data for the message has been received. +-- +-- If receiving all the data succeeds but parsing fails, return a 'String' error message. +-- +-- This message is polymorphic in its return type @v@, and so may be used to parse /any/ message +-- type. +receiveMessage :: (IsMessage v, Receiver a) => Socket z a -> ZMQ z (Either String (MessageHeader, v)) +receiveMessage sock = do + -- Read all identifiers until the identifier/message delimiter. + idents <- readUntil sock "" + + -- Ignore the signature for now. + void $ receive sock + + headerData <- receive sock + parentHeader <- receive sock + metadata <- receive sock + content <- receive sock + return $ parseMessage idents headerData parentHeader metadata content + +-- | Read data from the socket until we hit an ending string. Return all data as a list, which does +-- not include the ending string. +readUntil :: Receiver a + => Socket z a -- ^ Socket to read from + -> ByteString -- ^ Delimiter chunk + -> ZMQ z [ByteString] -- ^ Messages until (but not including) delimiter chunk +readUntil sock terminator = do + line <- receive sock + if line /= terminator + then do + remaining <- readUntil sock terminator + return $ line : remaining + else return [] + +-- | Create a new 'MessageHeader', which is suitable to be used for a request from a client to a +-- kernel. +-- +-- The main difference between 'mkRequestHeader' and 'mkReplyHeader' is that a reply header has a +-- parent header, while a request header is not triggered by another message, and so has no parent +-- header. However, since there is no parent header to inherit information from, the session UUID +-- and username must be set explicitly. +mkRequestHeader :: IsMessage v + => UUID.UUID -- ^ Session UUID for this client session + -> Username -- ^ Username to use in the header + -> v -- ^ Message for which to make header (necessary to get 'MessageType') + -> IO MessageHeader -- ^ New 'MessageHeader', with fresh randomly generated id +mkRequestHeader session username content = do + uuid <- UUID.random + return + MessageHeader + { messageIdentifiers = [] + , messageParent = Nothing + , messageMetadata = mempty + , messageId = uuid + , messageSession = session + , messageUsername = username + , messageType = getMessageType content + } + +-- | Create a new 'MessageHeader' for a message which is a reply to a previous message. +-- +-- Unlike 'mkRequestHeader', 'mkReplyHeader' requires a parent header, and so is used for replies, +-- rather than for initiating a communication. +mkReplyHeader :: IsMessage v + => MessageHeader -- ^ Header of message being replied to + -> v -- ^ Reply message for which to generate header (necessary to get 'MessageType') + -> IO MessageHeader -- ^ New 'MessageHeader', with fresh randomly generated id +mkReplyHeader parentHeader content = do + uuid <- UUID.random + return + MessageHeader + { messageIdentifiers = messageIdentifiers parentHeader + , messageParent = Just parentHeader + , messageMetadata = mempty + , messageId = uuid + , messageSession = messageSession parentHeader + , messageUsername = messageUsername parentHeader + , messageType = getMessageType content + } + + +-- | Send a Jupyter message on a socket, encoding it as described in the +-- . +sendMessage :: (IsMessage v, Sender a) + => ByteString -- ^ HMAC key used to sign the message. + -> Socket z a -- ^ Socket on which to send the message. + -> MessageHeader -- ^ Header for the message. + -> v -- ^ Data type representing the message to be send. + -> ZMQ z () +sendMessage hmacKey sock header content = do + let parentHeaderStr = maybe "{}" encodeHeader $ messageParent header + idents = messageIdentifiers header + metadata = "{}" + headerStr = encodeHeader header + contentStr = encodeStrict content + + -- Signature for the message using HMAC SHA-256. + signature = hmac $ headerStr <> parentHeaderStr <> metadata <> contentStr + + -- Send all pieces of the message. + mapM_ sendPiece idents + sendPiece "" + sendPiece signature + sendPiece headerStr + sendPiece parentHeaderStr + sendPiece metadata + + -- Conclude transmission with content. + sendLast contentStr + + where + -- Send one piece of a multipart message (with the 'SendMore' flag). + sendPiece = send sock [SendMore] + + -- Send the last piece of a multipart message. + sendLast = send sock [] + + -- Compute the HMAC SHA-256 signature of a bytestring message. + hmac :: ByteString -> ByteString + hmac = CBS.pack . SHA.showDigest . SHA.hmacSha256 (LBS.fromStrict hmacKey) . LBS.fromStrict + + -- Encode a 'MessageHeader' as a JSON ByteString. + encodeHeader :: MessageHeader -> ByteString + encodeHeader MessageHeader { .. } = + encodeStrict $ object + [ "msg_id" .= messageId + , "session" .= messageSession + , "username" .= messageUsername + , "version" .= ("5.0" :: String) + , "msg_type" .= messageType + ] + + +-- | Encode JSON to a strict bytestring. +encodeStrict :: ToJSON a => a -> ByteString +encodeStrict = LBS.toStrict . encode + +-- | Handle an 'AsyncException': if the exception is 'ThreadKilled', then do nothing, +-- otherwise, rethrow the exception. +-- +-- This helper utility exists to gracefully shutdown infinite loops in which we listen on +-- ZeroMQ sockets, and exists to stop 'ThreadKilled' exceptions from propagating back to +-- the main thread (which, presumably, is the thread that killed the thread in question). +-- +-- This is a utility provided for use with listener threads. +threadKilledHandler :: AsyncException -> IO () +threadKilledHandler ThreadKilled = return () +threadKilledHandler ex = throwIO ex diff --git a/tests/Jupyter/Test/Client.hs b/tests/Jupyter/Test/Client.hs new file mode 100644 --- /dev/null +++ b/tests/Jupyter/Test/Client.hs @@ -0,0 +1,818 @@ +{-# LANGUAGE OverloadedStrings #-} +module Jupyter.Test.Client (clientTests) where + +-- Imports from 'base' +import Control.Exception (throwIO, bracket) +import Control.Monad (forM_, void) +import Data.Monoid ((<>)) +import Control.Concurrent (threadDelay) +import Data.Maybe (isJust) + +-- Imports from 'transformers' +import Control.Monad.IO.Class (liftIO) + +-- Imports from 'tasty' +import Test.Tasty (TestTree, testGroup) + +-- Imports from 'tasty-hunit' +import Test.Tasty.HUnit (testCase, testCaseSteps, (@=?), assertBool, assertFailure) + +-- Imports from 'text' +import Data.Text (Text) +import qualified Data.Text as T + +-- Imports from 'aeson' +import Data.Aeson (ToJSON(..), object, (.=)) + +-- Imports from 'process' +import System.Process (terminateProcess, ProcessHandle) + +-- Imports from 'jupyter' +import Jupyter.Client +import Jupyter.Kernel +import Jupyter.Messages + +import Jupyter.Test.MessageExchange +import Jupyter.Test.Utils (inTempDir, shouldThrow, HandlerException(..)) + +clientTests :: TestTree +clientTests = testGroup "Client Tests" + [ testBasic + , testStdin + , testCalculator + , testClientPortsTaken + , testClient + , testHandlerExceptions + , testFindingKernelspecs + ] + +-- | Test that all the demo kernelspecs are found using the 'findKernel' and 'findKernels' commands. +-- +-- This test succeeding relies upon the kernels installing them prior to this test suite being run, +-- or running the Python test suite before this one. +testFindingKernelspecs :: TestTree +testFindingKernelspecs = testCase "Finding Kernelspecs" $ do + -- Test 'findKernels' + kernels <- findKernels + let kernelNames = map kernelspecDisplayName kernels + assertBool "Basic kernelspec not found" $ "Basic" `elem` kernelNames + assertBool "Calculator kernelspec not found" $ "Calculator" `elem` kernelNames + assertBool "Python 3 kernelspec not found" $ "Python 3" `elem` kernelNames + assertBool "Stdin kernelspec not found" $ "Stdin" `elem` kernelNames + + -- Test that a nonexistent kernel returns nothing. + kernelM <- findKernel "xyz-not-a-kernel-nope-#@" + case kernelM of + Nothing -> return () + Just _ -> assertFailure "Found a kernel that should not exist" + + -- Test 'findKernel' + let expectedKernels = [ ("basic", "basic", "Basic", False, False) + , ("stdin", "stdin", "Stdin", False, False) + , ("calculator", "calculator", "Calculator", False, False) + , ("python3", "python", "Python 3", True, False) + ] + forM_ expectedKernels $ \(name, lang, displayName, hasLogo, hasJs) -> do + Just kernel <- findKernel name + kernelspecLanguage kernel @=? lang + kernelspecDisplayName kernel @=? displayName + + -- Check that the files are not included if they don't exist. + if hasLogo + then assertBool "Logo file should be provided" $ isJust $ kernelspecLogoFile kernel + else kernelspecLogoFile kernel @=? Nothing + if hasJs + then assertBool "kernel.js file should be provided" $ isJust $ kernelspecJsFile kernel + else kernelspecJsFile kernel @=? Nothing + + assertBool "Connection file command doesn't include connection file" $ + "abcxyz" `elem` kernelspecCommand kernel "" "abcxyz" + +-- | Test that the @basic@ kernel responds to all the standard messages with empty replies. +testBasic :: TestTree +testBasic = + testMessageExchange "Basic Kernel" (commandFromKernelspec "basic") "" $ + \_ _ profile -> + [ MessageExchange + { exchangeName = "execute_request" + , exchangeRequest = ExecuteRequest "some input" defaultExecuteOptions + , exchangeReply = ExecuteReply 0 ExecuteOk + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, ExecuteInputOutput 0 "some input", kernelIdle] + } + , MessageExchange + { exchangeName = "inspect_request" + , exchangeRequest = InspectRequest "3" 1 DetailLow + , exchangeReply = InspectReply (InspectOk Nothing) + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "complete_request" + , exchangeRequest = CompleteRequest "prinx" 5 + , exchangeReply = CompleteReply $ CompleteOk [] (CursorRange 5 5) mempty + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + ] ++ defaultMessageExchange "Basic" profile + +-- | A set of default message exchanges that hold for any simple kernels. +defaultMessageExchange :: Text -> KernelProfile -> [MessageExchange] +defaultMessageExchange name profile = + [ MessageExchange + { exchangeName = "connect_request" + , exchangeRequest = ConnectRequest + , exchangeReply = ConnectReply + ConnectInfo + { connectShellPort = profileShellPort profile + , connectIopubPort = profileIopubPort profile + , connectStdinPort = profileStdinPort profile + , connectHeartbeatPort = profileHeartbeatPort profile + , connectControlPort = profileControlPort profile + } + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "kernel_info_request" + , exchangeRequest = KernelInfoRequest + , exchangeReply = KernelInfoReply $ simpleKernelInfo name + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "history_request" + , exchangeRequest = HistoryRequest $ HistoryOptions False True $ HistoryTail 3 + , exchangeReply = HistoryReply [] + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "shutdown (restart)" + , exchangeRequest = ShutdownRequest Restart + , exchangeReply = ShutdownReply Restart + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, ShutdownNotificationOutput Restart, kernelIdle] + } + ] + +-- | Test that the stdin kernel requests stdin from the client as desired. +testStdin :: TestTree +testStdin = + testMessageExchange "Stdin Kernel" (commandFromKernelspec "stdin") "skip" $ + \_ _ profile -> + [ MessageExchange + { exchangeName = "execute_request (input)" + , exchangeRequest = ExecuteRequest "prompt" + defaultExecuteOptions { executeAllowStdin = True } + , exchangeReply = ExecuteReply 1 ExecuteOk + , exchangeKernelRequests = [ (InputRequest + InputOptions + { inputPassword = False + , inputPrompt = "prompt" + }, InputReply "stdin") + ] + , exchangeComms = [] + , exchangeKernelOutputs = [ kernelBusy + , ExecuteInputOutput 1 "prompt" + , DisplayDataOutput $ displayPlain "stdin" + , kernelIdle + ] + } + , MessageExchange + { exchangeName = "execute_request (skip input)" + , exchangeRequest = ExecuteRequest "skip" + defaultExecuteOptions { executeAllowStdin = True } + , exchangeReply = ExecuteReply 1 ExecuteOk + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [ kernelBusy + , ExecuteInputOutput 1 "skip" + , kernelIdle + ] + } + , MessageExchange + { exchangeName = "execute_request (input password)" + , exchangeRequest = ExecuteRequest "password" + defaultExecuteOptions { executeAllowStdin = True } + , exchangeReply = ExecuteReply 1 ExecuteOk + , exchangeKernelRequests = [ (InputRequest + InputOptions + { inputPassword = True + , inputPrompt = "password" + }, InputReply "stdin two") + ] + , exchangeComms = [] + , exchangeKernelOutputs = [ kernelBusy + , ExecuteInputOutput 1 "password" + , DisplayDataOutput $ displayPlain "stdin two" + , kernelIdle + ] + } + ] ++ defaultMessageExchange "Stdin" profile + +-- | Test the @calculator@ kernel, which should do execution, completion, and inspection, as well +-- as all the default messages. +testCalculator :: TestTree +testCalculator = + testMessageExchange "Calculator Kernel" (commandFromKernelspec "calculator") "Lit 5" $ + \_ execCount profile -> + [ MessageExchange + { exchangeName = "connect_request" + , exchangeRequest = ConnectRequest + , exchangeReply = ConnectReply + ConnectInfo + { connectShellPort = profileShellPort profile + , connectIopubPort = profileIopubPort profile + , connectStdinPort = profileStdinPort profile + , connectHeartbeatPort = profileHeartbeatPort profile + , connectControlPort = profileControlPort profile + } + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "execute_request (compute)" + , exchangeRequest = ExecuteRequest + "Compute [('x', 3)] (Add (Divide (Lit 100) (Lit 5)) (Multiply (Lit 10) (Var 'x')))" + defaultExecuteOptions + , exchangeReply = ExecuteReply (execCount + 1) ExecuteOk + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [ kernelBusy + , ExecuteInputOutput + (execCount + 1) + "Compute [('x', 3)] (Add (Divide (Lit 100) (Lit 5)) (Multiply (Lit 10) (Var 'x')))" + , DisplayDataOutput $ displayPlain "50" + , kernelIdle + ] + } + , MessageExchange + { exchangeName = "execute_request (compute)" + , exchangeRequest = ExecuteRequest + "Print (Add (Divide (Lit 100) (Lit 5)) (Multiply (Lit 10) (Var 'x')))" + defaultExecuteOptions + , exchangeReply = ExecuteReply (execCount + 2) ExecuteOk + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [ kernelBusy + , ExecuteInputOutput + (execCount + 2) + "Print (Add (Divide (Lit 100) (Lit 5)) (Multiply (Lit 10) (Var 'x')))" + , DisplayDataOutput $ + displayPlain "((100 / 5) + (10 * x))" <> displayLatex + "(\\frac{100}{5} + (10 \\cdot x))" + , kernelIdle + ] + } + , MessageExchange + { exchangeName = "complete_request" + , exchangeRequest = CompleteRequest "Computx" 6 + , exchangeReply = CompleteReply $ CompleteOk ["Compute"] (CursorRange 0 6) mempty + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "inspect_request (low)" + , exchangeRequest = InspectRequest "Printblahblah" 5 DetailLow + , exchangeReply = InspectReply $ InspectOk $ Just $ + displayPlain "Print: Print an expression as text or LaTeX." + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "kernel_info_request" + , exchangeRequest = KernelInfoRequest + , exchangeReply = KernelInfoReply $ + KernelInfo + { kernelProtocolVersion = "5.0" + , kernelBanner = "Welcome to the Haskell Calculator Test Kernel!" + , kernelImplementation = "Calculator-Kernel" + , kernelImplementationVersion = "1.0" + , kernelLanguageInfo = LanguageInfo + { languageName = "calculator" + , languageVersion = "1.0" + , languageMimetype = "text/plain" + , languageFileExtension = ".txt" + , languagePygmentsLexer = Nothing + , languageCodeMirrorMode = Nothing + , languageNbconvertExporter = Nothing + } + , kernelHelpLinks = [ HelpLink + { helpLinkText = "jupyter package doc" + , helpLinkURL = "http://github.com/gibiansky/jupyter-haskell" + } + ] + } + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "history_request" + , exchangeRequest = HistoryRequest $ HistoryOptions False True $ HistoryTail 3 + , exchangeReply = HistoryReply [] + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "shutdown (restart)" + , exchangeRequest = ShutdownRequest Restart + , exchangeReply = ShutdownReply Restart + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, ShutdownNotificationOutput Restart, kernelIdle] + } + ] + +-- | Given the name of a kernel, find it's kernelspec and return a function which, given +-- a path to the connection file, returns the kernel command invocation. For example, +-- for the @python3@ kernel, something like the following could be the return value: +-- +-- >>> cmd <- commandFromKernelspec "python3" +-- >>> cmd "{connection_file}" == ["python", "-m", "ipykernel", "-f", "{connection_file}"] +commandFromKernelspec :: Text -> IO (FilePath -> [String]) +commandFromKernelspec name = do + kernel <- findKernel name + case kernel of + Nothing -> fail $ "Could not find kernelspec " ++ T.unpack name + Just spec -> return $ kernelspecCommand spec "" + +-- | Start the IPython kernel and return a 'ProcessHandle' for the started process. +startIPythonKernel :: KernelProfile -> IO ProcessHandle +startIPythonKernel = startKernel $ \profileFile -> ["python", "-m", "ipykernel", "-f", profileFile] + + +-- | Test that the client interface behaves as expected when the handlers throw exceptions. +-- +-- Namely, the exceptions should be reraised (once) on the main thread. +testHandlerExceptions :: TestTree +testHandlerExceptions = testCaseSteps "Client Handler Exceptions" $ \step -> do + let exception = const $ const $ throwIO HandlerException + returnStdin = const . const . return $ InputReply "<>" + handlerKernelRequestException = ClientHandlers exception defaultClientCommHandler defaultKernelOutputHandler + handlerCommException = ClientHandlers returnStdin exception defaultKernelOutputHandler + handlerKernelOutputException = ClientHandlers returnStdin defaultClientCommHandler exception + + -- ConnectRequest results in status updates, so erroring on the kernel output + -- should raise an exception in the main thread. + step "...exception on kernel output..." + raisesHandlerException $ runIPython handlerKernelOutputException $ \_ _ connection -> do + void $ sendClientRequest connection ConnectRequest + -- Since we might not get the kernel output until the connect reply, wait for + -- a while to ensure we get the kernel output before the client exits. This doesn't + -- slow down the test suite since an exception gets thrown and we exit this thread + -- without finishing the waiting. + liftIO $ threadDelay $ 1000 * 1000 + + -- ConnectRequest does not sent any stdin messages, so clients that error + -- when handling stdin messages should not crash here. + step "...no exception on kernel output..." + void $ runIPython handlerKernelRequestException $ \_ _ connection -> + sendClientRequest connection ConnectRequest + + -- This particular ExecuteRequest should reply with comm messages, and + -- so a comm handler that raises an exception should cause the main thread to crash. + step "...exception on comm..." + raisesHandlerException $ runIPython handlerCommException $ \_ _ connection -> + void $ sendClientRequest connection $ + ExecuteRequest "import ipywidgets as widgets\nwidgets.FloatSlider()" defaultExecuteOptions + + -- This particular ExecuteRequest should reply with kernel requests for stdin, and + -- so a kernel request handler that raises an exception should cause the main thread to crash. + step "...exception on stdin..." + raisesHandlerException $ runIPython handlerKernelRequestException $ \_ _ connection -> + -- If we connect too quickly the kernel sometimes misses our message, leaving us + -- in a stalled state. Wait to ensure that the kernel is ready. (We could also listen + -- on iopub for a kernel status message if we wanted to.) + void $ sendClientRequest connection $ + ExecuteRequest "print(input())" defaultExecuteOptions { executeAllowStdin = True } + + where + runIPython = runKernelAndClient startIPythonKernel + raisesHandlerException io = io `shouldThrow` [HandlerException] + +defaultKernelOutputHandler :: (Comm -> IO ()) -> KernelOutput -> IO () +defaultKernelOutputHandler _ _ = return () + +testClientPortsTaken :: TestTree +testClientPortsTaken = testCase "Client Ports Taken" $ + inTempDir $ \_ -> + runClient Nothing Nothing emptyHandler $ \profile1 -> liftIO $ + bracket (startIPythonKernel profile1) terminateProcess $ const $ + delay 500 $ runClient Nothing Nothing emptyHandler $ \profile2 -> liftIO $ + bracket (startIPythonKernel profile2) terminateProcess $ const $ + delay 500 $ runClient Nothing Nothing emptyHandler $ \profile3 -> liftIO $ do + 1 + profileShellPort profile1 @=? profileShellPort profile2 + 1 + profileHeartbeatPort profile1 @=? profileHeartbeatPort profile2 + 1 + profileControlPort profile1 @=? profileControlPort profile2 + 1 + profileStdinPort profile1 @=? profileStdinPort profile2 + 1 + profileIopubPort profile1 @=? profileIopubPort profile2 + 1 + profileShellPort profile2 @=? profileShellPort profile3 + 1 + profileHeartbeatPort profile2 @=? profileHeartbeatPort profile3 + 1 + profileControlPort profile2 @=? profileControlPort profile3 + 1 + profileStdinPort profile2 @=? profileStdinPort profile3 + 1 + profileIopubPort profile2 @=? profileIopubPort profile3 + where + emptyHandler = + ClientHandlers (const . const . return $ InputReply "") + (const . const $ return ()) + (const . const $ return ()) + delay ms act = do + threadDelay $ 1000 * ms + act + + +-- Test that messages can be sent and received on the heartbeat socket. +testClient :: TestTree +testClient = testMessageExchange + "Communicate with IPython Kernel" + (return $ \prof -> ["python", "-m", "ipykernel", "-f", prof]) + "3 + 3" $ \sessionNum execCount profile -> + [ MessageExchange + { exchangeName = "connect_request" + , exchangeRequest = ConnectRequest + , exchangeReply = ConnectReply + ConnectInfo + { connectShellPort = profileShellPort profile + , connectIopubPort = profileIopubPort profile + , connectStdinPort = profileStdinPort profile + , connectHeartbeatPort = profileHeartbeatPort profile + , connectControlPort = profileControlPort profile + } + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "execute_request (stream output)" + , exchangeRequest = ExecuteRequest "import sys\nprint(sys.version.split()[0][:3])" + defaultExecuteOptions + , exchangeReply = ExecuteReply (execCount + 1) ExecuteOk + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [ kernelBusy + , ExecuteInputOutput (execCount + 1) + "import sys\nprint(sys.version.split()[0][:3])" + , StreamOutput StreamStdout "3.5\n" + , kernelIdle + ] + } + , MessageExchange + { exchangeName = "execute_request (expr)" + , exchangeRequest = ExecuteRequest "3 + 3" defaultExecuteOptions + , exchangeReply = ExecuteReply (execCount + 2) ExecuteOk + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [ kernelBusy + , ExecuteInputOutput (execCount + 2) "3 + 3" + , ExecuteResultOutput (execCount + 2) $ displayPlain "6" + , kernelIdle + ] + } + , MessageExchange + { exchangeName = "execute_request (none)" + , exchangeRequest = ExecuteRequest "" defaultExecuteOptions + , exchangeReply = ExecuteReply (execCount + 2) ExecuteOk + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, ExecuteInputOutput (execCount + 3) "", kernelIdle] + } + , MessageExchange + { exchangeName = "execute_request (clear)" + , exchangeRequest = ExecuteRequest "from IPython.display import clear_output\nclear_output()" + defaultExecuteOptions + , exchangeReply = ExecuteReply (execCount + 3) ExecuteOk + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [ kernelBusy + , ExecuteInputOutput (execCount + 3) + "from IPython.display import clear_output\nclear_output()" + , ClearOutput ClearImmediately + , kernelIdle + ] + } + , MessageExchange + { exchangeName = "execute_request (comms)" + , exchangeRequest = ExecuteRequest "import ipywidgets as widgets\nwidgets.FloatSlider()" + defaultExecuteOptions + , exchangeReply = ExecuteReply (execCount + 4) ExecuteOk + , exchangeKernelRequests = [] + , exchangeComms = [ CommOpen + fakeUUID + (object + [ "align_items" .= str "" + , "_view_module" .= str "jupyter-js-widgets" + , "height" .= str "" + , "bottom" .= str "" + , "display" .= str "" + , "overflow_y" .= str "" + , "min_height" .= str "" + , "_view_name" .= str "LayoutView" + , "justify_content" .= str "" + , "left" .= str "" + , "min_width" .= str "" + , "overflow_x" .= str "" + , "width" .= str "" + , "margin" .= str "" + , "visibility" .= str "" + , "msg_throttle" .= toJSON (3 :: Int) + , "overflow" .= str "" + , "border" .= str "" + , "max_height" .= str "" + , "flex" .= str "" + , "flex_flow" .= str "" + , "max_width" .= str "" + , "_model_module" .= str "jupyter-js-widgets" + , "right" .= str "" + , "_model_name" .= str "LayoutModel" + , "top" .= str "" + , "align_content" .= str "" + , "align_self" .= str "" + , "padding" .= str "" + ]) + "jupyter.widget" + Nothing + , CommOpen + fakeUUID + (object + [ "max" .= toJSON (100 :: Int) + , "readout" .= True + , "background_color" .= (Nothing :: Maybe ()) + , "slider_color" .= (Nothing :: Maybe ()) + , "_view_module" .= str "jupyter-js-widgets" + , "font_family" .= str "" + , "_view_name" .= str "FloatSliderView" + , "color" .= (Nothing :: Maybe ()) + , "disabled" .= False + , "value" .= toJSON (0 :: Int) + , "visible" .= True + , "msg_throttle" .= toJSON (3 :: Int) + , "font_weight" .= str "" + , "step" .= toJSON (0.1 :: Float) + , "min" .= toJSON (0 :: Int) + , "_model_module" .= str "jupyter-js-widgets" + , "readout_format" .= str ".2f" + , "_model_name" .= str "FloatSliderModel" + , "_range" .= False + , "continuous_update" .= True + , "font_style" .= str "" + , "orientation" .= str "horizontal" + , "_dom_classes" .= ([] :: [()]) + , "description" .= str "" + , "font_size" .= str "" + ]) + "jupyter.widget" + Nothing + , CommMessage fakeUUID (object ["method" .= str "display"]) + ] + , exchangeKernelOutputs = [ kernelBusy + , ExecuteInputOutput (execCount + 4) + "import ipywidgets as widgets\nwidgets.FloatSlider()" + , StreamOutput StreamStderr $ + T.unwords + [ "Widget Javascript not detected. " + , "It may not be installed properly." + , "Did you enable the widgetsnbextension?" + , "If not, then run" + , "\"jupyter nbextension enable --py --sys-prefix widgetsnbextension\"\n" + ] + , kernelIdle + ] + } + , MessageExchange + { exchangeName = "execute_request (display)" + , exchangeRequest = ExecuteRequest "from IPython.display import *\ndisplay(HTML('Hi'))" + defaultExecuteOptions + , exchangeReply = ExecuteReply (execCount + 5) ExecuteOk + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [ kernelBusy + , ExecuteInputOutput (execCount + 5) + "from IPython.display import *\ndisplay(HTML('Hi'))" + , DisplayDataOutput $ displayPlain + "" <> displayHtml + "Hi" + , kernelIdle + ] + } + , MessageExchange + { exchangeName = "execute_request (input)" + , exchangeRequest = ExecuteRequest "x = input('Hello')\nprint(x)\nx" + defaultExecuteOptions { executeAllowStdin = True } + , exchangeReply = ExecuteReply (execCount + 6) ExecuteOk + , exchangeKernelRequests = [ (InputRequest + InputOptions { inputPassword = False, inputPrompt = "Hello" }, InputReply + "stdin") + ] + , exchangeComms = [] + , exchangeKernelOutputs = [ kernelBusy + , ExecuteInputOutput (execCount + 6) "x = input('Hello')\nprint(x)\nx" + , StreamOutput StreamStdout "stdin\n" + , ExecuteResultOutput (execCount + 6) $ displayPlain "'stdin'" + , kernelIdle + ] + } + , MessageExchange + { exchangeName = "execute_request (password)" + , exchangeRequest = ExecuteRequest "import getpass\nprint(getpass.getpass('Hello'))" + defaultExecuteOptions { executeAllowStdin = True } + , exchangeReply = ExecuteReply (execCount + 7) ExecuteOk + , exchangeKernelRequests = [ (InputRequest + InputOptions { inputPassword = True, inputPrompt = "Hello" }, InputReply + "stdin") + ] + , exchangeComms = [] + , exchangeKernelOutputs = [ kernelBusy + , ExecuteInputOutput (execCount + 7) + "import getpass\nprint(getpass.getpass('Hello'))" + , StreamOutput StreamStdout "stdin\n" + , kernelIdle + ] + } + , MessageExchange + { exchangeName = "is_complete_request (complete)" + , exchangeRequest = IsCompleteRequest "import getpass" + , exchangeReply = IsCompleteReply CodeComplete + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "is_complete_request (incomplete)" + , exchangeRequest = IsCompleteRequest "for x in [1, 2, 3]:\n" + , exchangeReply = IsCompleteReply (CodeIncomplete " ") + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "is_complete_request (invalid)" + , exchangeRequest = IsCompleteRequest "x =" + , exchangeReply = IsCompleteReply CodeInvalid + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "inspect_request (empty)" + , exchangeRequest = InspectRequest "3" 1 DetailLow + , exchangeReply = InspectReply (InspectOk Nothing) + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "inspect_request (low)" + , exchangeRequest = InspectRequest "print" 5 DetailLow + , exchangeReply = InspectReply $ InspectOk $ Just $ + displayPlain $ T.unlines + [ "\ESC[0;31mDocstring:\ESC[0m" + , "print(value, ..., sep=' ', end='\\n', file=sys.stdout, flush=False)" + , "" + , "Prints the values to a stream, or to sys.stdout by default." + , "Optional keyword arguments:" + , "file: a file-like object (stream); defaults to the current sys.stdout." + , "sep: string inserted between values, default a space." + , "end: string appended after the last value, default a newline." + , "flush: whether to forcibly flush the stream." + , "\ESC[0;31mType:\ESC[0m builtin_function_or_method" + ] + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "inspect_request (high)" + , exchangeRequest = InspectRequest "print" 5 DetailHigh + , exchangeReply = InspectReply $ InspectOk $ Just $ + displayPlain "\ESC[0;31mType:\ESC[0m builtin_function_or_method\n" + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "inspect_request (missing)" + , exchangeRequest = InspectRequest "p" 1 DetailHigh + , exchangeReply = InspectReply $ InspectOk Nothing + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "complete_request" + , exchangeRequest = CompleteRequest "prinx" 4 + , exchangeReply = CompleteReply $ CompleteOk ["print"] (CursorRange 0 4) mempty + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "complete_request (missing)" + , exchangeRequest = CompleteRequest "prinx" 5 + , exchangeReply = CompleteReply $ CompleteOk [] (CursorRange 0 5) mempty + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "history_request (tail)" + , exchangeRequest = HistoryRequest $ HistoryOptions False True $ HistoryTail 3 + , exchangeReply = HistoryReply $ + [ HistoryItem sessionNum 6 "from IPython.display import *\ndisplay(HTML('Hi'))" Nothing + , HistoryItem sessionNum 7 "x = input('Hello')\nprint(x)\nx" Nothing + , HistoryItem sessionNum 8 "import getpass\nprint(getpass.getpass('Hello'))" Nothing + ] + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "history_request (tail output)" + , exchangeRequest = HistoryRequest $ HistoryOptions True True $ HistoryTail 3 + , exchangeReply = HistoryReply $ + [ HistoryItem sessionNum 6 "from IPython.display import *\ndisplay(HTML('Hi'))" Nothing + , HistoryItem sessionNum 7 "x = input('Hello')\nprint(x)\nx" Nothing + , HistoryItem sessionNum 8 "import getpass\nprint(getpass.getpass('Hello'))" Nothing + ] + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "history_request (range)" + , exchangeRequest = HistoryRequest $ HistoryOptions False True $ + HistoryRange $ HistoryRangeOptions sessionNum 6 8 + , exchangeReply = HistoryReply $ + [ HistoryItem 0 6 "from IPython.display import *\ndisplay(HTML('Hi'))" Nothing + , HistoryItem 0 7 "x = input('Hello')\nprint(x)\nx" Nothing + ] + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "history_request (range output)" + , exchangeRequest = HistoryRequest $ HistoryOptions True True $ HistoryRange $ HistoryRangeOptions + sessionNum + 6 + 8 + , exchangeReply = HistoryReply $ + [ HistoryItem 0 6 "from IPython.display import *\ndisplay(HTML('Hi'))" Nothing + , HistoryItem 0 7 "x = input('Hello')\nprint(x)\nx" (Just "'stdin'") + ] + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "history_request (search)" + , exchangeRequest = HistoryRequest $ HistoryOptions True True $ HistorySearch $ HistorySearchOptions + 1 + "x = input('Hello')\nprint(?)\nx" + False + , exchangeReply = HistoryReply $ + [HistoryItem sessionNum 7 "x = input('Hello')\nprint(x)\nx" Nothing] + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "history_request (search output)" + , exchangeRequest = HistoryRequest $ HistoryOptions True True $ HistorySearch $ HistorySearchOptions + 1 + "x = input('Hello')\nprint(?)\nx" + False + , exchangeReply = HistoryReply $ + [HistoryItem sessionNum 7 "x = input('Hello')\nprint(x)\nx" Nothing] + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, kernelIdle] + } + , MessageExchange + { exchangeName = "shutdown (restart)" + , exchangeRequest = ShutdownRequest Restart + , exchangeReply = ShutdownReply Restart + , exchangeKernelRequests = [] + , exchangeComms = [] + , exchangeKernelOutputs = [kernelBusy, ShutdownNotificationOutput Restart, kernelIdle] + } + ] + +kernelIdle, kernelBusy :: KernelOutput +kernelIdle = KernelStatusOutput KernelIdle +kernelBusy = KernelStatusOutput KernelBusy + +str :: String -> String +str = id diff --git a/tests/Jupyter/Test/Install.hs b/tests/Jupyter/Test/Install.hs new file mode 100644 --- /dev/null +++ b/tests/Jupyter/Test/Install.hs @@ -0,0 +1,296 @@ +{-| +Module : Jupyter.Test.Install +Description : Tests for the Jupyter.Install module. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX +-} + +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} +module Jupyter.Test.Install (installTests) where + +-- Imports from 'base' +import Control.Monad (forM_) +import Data.List (isInfixOf) +import Data.Maybe (fromMaybe) +import Data.Proxy (Proxy(..)) +import System.Environment (setEnv, lookupEnv) +import System.IO (stderr, stdout) + +-- Imports from 'directory' +import System.Directory (setPermissions, getPermissions, Permissions(..), canonicalizePath, + createDirectoryIfMissing, removeFile, doesFileExist) + +-- Imports from 'bytestring' +import qualified Data.ByteString.Char8 as CBS + +-- Imports from 'aeson' +import Data.Aeson (decodeStrict, Value) + +-- Imports from 'text' +import qualified Data.Text as T + +-- Imports from 'extra' +import Control.Exception.Extra (bracket) +import System.IO.Extra (withTempDir) + +-- Imports from 'silently' +import System.IO.Silently (hCapture_) + +-- Imports from 'tasty' +import Test.Tasty (TestTree, testGroup) + +-- Imports from 'tasty-hunit' +import Test.Tasty.HUnit (testCase, (@=?), assertFailure, assertBool) + +-- Imports from 'jupyter' +import Jupyter.Install.Internal +import Jupyter.Test.Utils (shouldThrow, inTempDir) +import qualified Jupyter.Install.Internal as I + +installTests :: TestTree +installTests = testGroup "Install Tests" + [ testVersionNumberParsing + , testVersionNumberPrinting + , testFindingJupyterExecutable + , testJupyterVersionReading + , testStderrIsUntouched + , testCorrectJupyterVersionsAccepted + , testKernelspecFilesCreated + , testEndToEndInstall + ] + +-- | Test that version numbers from jupyter --version are properly parsed. +testVersionNumberParsing :: TestTree +testVersionNumberParsing = testCase "Version number parsing" $ do + Just (I.JupyterVersion 10 1 0) @=? I.parseVersion "10.1.0" + Just (I.JupyterVersion 4 1 2000) @=? I.parseVersion "4.1.2000" + Just (I.JupyterVersion 4 1 0) @=? I.parseVersion "4.1" + Just (I.JupyterVersion 4 0 0) @=? I.parseVersion "4" + Nothing @=? I.parseVersion ".xx.4" + Nothing @=? I.parseVersion "4.1.2.1.2" + +-- | Test that version numbers from jupyter --version are properly printed to the user. +testVersionNumberPrinting :: TestTree +testVersionNumberPrinting = testCase "Version number printing" $ do + parseThenShow "10.1.0" + parseThenShow "4.1.200" + parseThenShow "4.1.0" + where + parseThenShow str = + Just str @=? (I.showVersion <$> I.parseVersion str) + +-- | Set the PATH variable to a particular value during execution of an IO action. +withPath :: String -> IO a -> IO a +withPath newPath action = + bracket resetPath (setEnv "PATH") (const action) + where + resetPath = do + path <- lookupEnv "PATH" + setEnv "PATH" newPath + return $ fromMaybe "" path + + +-- | Test that `jupyter` is found by `which` if it is on the PATH, and isn't found if its not on the +-- path or isn't executable. Ensures that all returned paths are absolute and canonical. +testFindingJupyterExecutable :: TestTree +testFindingJupyterExecutable = testCase "PATH searching" $ + -- Run the entire test in a temporary directory. + inTempDir $ \tmp -> + -- Set up a PATH that has both relative and absolute paths. + withPath (".:test-path/twice:" ++ tmp ++ "/test-path-2") $ + + -- For each possible location test executable finding. + forM_ [".", "test-path/twice", "test-path-2"] $ \prefix -> do + let path = prefix ++ "/jupyter" + createDirectoryIfMissing True prefix + + -- When the file doesn't exist it should not be found. + which "jupyter" `shouldThrow` (Proxy :: Proxy JupyterKernelspecException) + + -- When the file is not executable it should not be found. + writeFile path "#!/bin/bash\ntrue" + which "jupyter" `shouldThrow` (Proxy :: Proxy JupyterKernelspecException) + + -- When the file is executable, it should be found, and be an absolute path + -- that ultimately resolves to what we expect. + setExecutable path + jupyterLoc <- which "jupyter" + expectedLoc <- canonicalizePath $ tmp ++ "/" ++ prefix ++ "/jupyter" + expectedLoc @=? jupyterLoc + + -- Clean up to avoid messing with future tests. + removeFile path + +-- | Test that the install script can parse the version numbers output by Jupyter. +testJupyterVersionReading :: TestTree +testJupyterVersionReading = testCase "jupyter --version parsing" $ + inTempDir $ \_ -> + -- Set up a jupyter executable that outputs what we expect. + withPath "." $ do + writeMockJupyter "" + setExecutable "jupyter" + path <- which "jupyter" + + -- Version too low. + writeMockJupyter "1.2.0" + verifyJupyterCommand path `shouldThrow` (Proxy :: Proxy JupyterKernelspecException) + + -- Could not parse output. + writeMockJupyter "..." + verifyJupyterCommand path `shouldThrow` (Proxy :: Proxy JupyterKernelspecException) + + writeMockJupyter "asdf" + verifyJupyterCommand path `shouldThrow` (Proxy :: Proxy JupyterKernelspecException) + + -- Works. + writeMockJupyter "3.0.0" + verifyJupyterCommand path + + writeMockJupyter "4.1.4000" + verifyJupyterCommand path + +-- | Create a mock 'jupyter' command, which always outputs a particular string to stdout and exits +-- with exit code zero. +writeMockJupyter :: String -> IO () +writeMockJupyter out = writeMockJupyter' out "" 0 + +-- | Create a mock 'jupyter' command, which outputs given strings to stdout and stderr and exits +-- with the provided exit code. +writeMockJupyter' :: String -- ^ What to output on stdout + -> String -- ^ What to output on stderr + -> Int -- ^ What exit code to exit with + -> IO () +writeMockJupyter' stdoutOut stderrOut errCode = + writeFile "jupyter" $ + unlines + [ "#!/bin/bash" + , "echo -n \"" ++ stdoutOut ++ "\"" + , "echo -n \"" ++ stderrOut ++ "\" >/dev/stderr" + , "exit " ++ show errCode + ] + +testStderrIsUntouched :: TestTree +testStderrIsUntouched = testCase "stderr is piped through" $ + inTempDir $ \_ -> + -- Set up a jupyter executable that outputs something to stderr. + withPath "." $ do + let msg = "An error" + writeMockJupyter' "Some output" msg 0 + setExecutable "jupyter" + + -- Check that stderr goes through as usual. + stderrOut <- hCapture_ [stderr] (runJupyterCommand "jupyter" []) + msg @=? stderrOut + + -- Check that stdout of the command is not output but is captured. + writeMockJupyter' "stdout" "" 0 + stdoutOut <- hCapture_ [stdout] (runJupyterCommand "jupyter" []) + "" @=? stdoutOut + +testCorrectJupyterVersionsAccepted :: TestTree +testCorrectJupyterVersionsAccepted = testCase "Correct jupyter versions accepted" $ do + assertBool "Version 3 supported" $ jupyterVersionSupported $ JupyterVersion 3 0 0 + assertBool "Version 3.1 supported" $ jupyterVersionSupported $ JupyterVersion 3 1 0 + assertBool "Version 4 supported" $ jupyterVersionSupported $ JupyterVersion 4 0 0 + assertBool "Version 10 supported" $ jupyterVersionSupported $ JupyterVersion 10 0 0 + assertBool "Version 2.3 not supported" $ not $ jupyterVersionSupported $ JupyterVersion 2 3 0 + assertBool "Version 1.0 not supported" $ not $ jupyterVersionSupported $ JupyterVersion 1 0 0 + +testKernelspecFilesCreated :: TestTree +testKernelspecFilesCreated = testCase "kernelspec files created" $ + inTempDir $ \tmp -> do + kernelspec <- createTestKernelspec tmp + + -- Test that all required files are created + withTempDir $ \kernelspecDir -> do + prepareKernelspecDirectory kernelspec kernelspecDir + assertBool "kernel.js not copied" =<< doesFileExist (kernelspecDir ++ "/kernel.js") + assertBool "logo-64x64.png not copied" =<< doesFileExist (kernelspecDir ++ "/logo-64x64.png") + assertBool "kernel.json not created" =<< doesFileExist (kernelspecDir ++ "/kernel.json") + + -- Test that the file is valid JSON and {connection_file} is present. + withTempDir $ \kernelspecDir -> do + prepareKernelspecDirectory kernelspec kernelspecDir + kernelJson <- readFile (kernelspecDir ++ "/kernel.json") + assertBool "{connection_file} not found" $ "\"{connection_file}\"" `isInfixOf` kernelJson + + case decodeStrict (CBS.pack kernelJson) :: Maybe Value of + Nothing -> assertFailure "Could not decode kernel.json file as JSON" + Just _ -> return () + + + -- Test that all previously-existing files are gone + withTempDir $ \kernelspecDir -> do + let prevFile1 = kernelspecDir ++ "/tmp.file" + prevFile2 = kernelspecDir ++ "/kernel.js" + writeFile prevFile1 "test1" + writeFile prevFile2 "test2" + + prepareKernelspecDirectory kernelspec { kernelspecJsFile = Nothing } kernelspecDir + + assertBool "previous file still exists" =<< fmap not (doesFileExist prevFile1) + assertBool "previous kernel.js file still exists" =<< fmap not (doesFileExist prevFile2) + +-- Test that end-to-end installs work as expected, and call the 'jupyter kernelspec install' +-- in the way that they are expected to. +testEndToEndInstall :: TestTree +testEndToEndInstall = testCase "installs end-to-end" $ + inTempDir $ \tmp -> do + kernelspec <- createTestKernelspec tmp + + withPath "." $ do + writeFile "jupyter" $ jupyterScript True + setExecutable "jupyter" + + result1 <- installKernel InstallLocal kernelspec + case result1 of + InstallFailed msg -> assertFailure $ "Failed to install kernelspec: " ++ T.unpack msg + _ -> return () + + writeFile "jupyter" $ jupyterScript False + result2 <- installKernel InstallGlobal kernelspec + case result2 of + InstallFailed msg -> assertFailure $ "Failed to install kernelspec: " ++ T.unpack msg + _ -> return () + where + jupyterScript user = + unlines + [ "#!/bin/bash" + , "if [[ $1 == \"--version\" ]]; then" + , "echo 4.1.0" + , "else" + , "[[ \"$1 $2 $4\" == \"kernelspec install --replace\" ]] || exit 1" + , if user + then "[[ \"$5\" == \"--user\" ]] || exit 0" + else "" + , "fi" + ] + +-- Create a kernelspec that refers to newly generated files in the provided directory. +createTestKernelspec :: String -> IO Kernelspec +createTestKernelspec tmp = do + let kernelJsFile = tmp ++ "/" ++ "kernel.js" + writeFile kernelJsFile "kernel.js" + + let kernelLogoFile = tmp ++ "/" ++ "logo-64x64.png" + writeFile kernelLogoFile "logo-64x64.png" + + return + Kernelspec + { kernelspecDisplayName = "Test" + , kernelspecLanguage = "test" + , kernelspecCommand = \exe conn -> [exe, conn, "--test"] + , kernelspecJsFile = Just kernelJsFile + , kernelspecLogoFile = Just kernelLogoFile + , kernelspecEnv = mempty + } + +-- | Make a file executable. +setExecutable :: FilePath -> IO () +setExecutable path = do + perms <- getPermissions path + setPermissions path perms { executable = True } diff --git a/tests/Jupyter/Test/Kernel.hs b/tests/Jupyter/Test/Kernel.hs new file mode 100644 --- /dev/null +++ b/tests/Jupyter/Test/Kernel.hs @@ -0,0 +1,249 @@ +{-| +Module : Jupyter.Test.Kernel +Description : Tests for the Jupyter.Kernel module. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX +-} +{-# LANGUAGE OverloadedStrings #-} +module Jupyter.Test.Kernel (kernelTests) where + +-- Imports from 'base' +import Control.Concurrent (newEmptyMVar, MVar, forkIO, putMVar, takeMVar, readMVar, + killThread) +import Control.Exception (throwIO) +import Control.Monad (forM_, void) +import Data.Proxy (Proxy(Proxy)) + +-- Imports from 'async' +import Control.Concurrent.Async (async, wait, cancel) + +-- Imports from 'transformers' +import Control.Monad.IO.Class (liftIO) + +-- Imports from 'tasty' +import Test.Tasty (TestTree, testGroup) + +-- Imports from 'tasty-hunit' +import Test.Tasty.HUnit (testCase, testCaseSteps, (@=?)) + +-- Imports from 'aeson' +import Data.Aeson (object) + +-- Imports from 'zeromq4-haskell' +import System.ZMQ4.Monadic (Req(..), Dealer(..), send, receive, runZMQ, ZMQError) + +-- Imports from 'jupyter' +import Jupyter.Client +import Jupyter.Kernel +import Jupyter.Messages +import Jupyter.Messages.Internal +import Jupyter.ZeroMQ +import qualified Jupyter.UUID as UUID + +import Jupyter.Test.Utils (connectedSocket, shouldThrow, HandlerException(..)) + +kernelTests :: TestTree +kernelTests = testGroup "Kernel Tests" + [testKernel, testKernelPortsTaken, testKernelExceptions, testKernelServeDynamic] + +-- | Test that a ZMQError is thrown if we try to serve two kernels on the same profile, because the +-- second one should fail due to the ports already being taken. +testKernelPortsTaken :: TestTree +testKernelPortsTaken = testCase "Kernel Ports Taken" $ do + profileVar <- newEmptyMVar + let reqHandler cb req = do + profile <- readMVar profileVar + defaultClientRequestHandler profile (simpleKernelInfo "Test") cb req + thread <- async $ serveDynamic (putMVar profileVar) defaultCommHandler reqHandler + profile <- readMVar profileVar + serve profile defaultCommHandler reqHandler `shouldThrow` (Proxy :: Proxy ZMQError) + cancel thread + +-- | Test that a client can connect to a kernel when the kernel is started with serveDynamic. +-- second one should fail due to the ports already being taken. +testKernelServeDynamic :: TestTree +testKernelServeDynamic = testCase "Serve Dynamic with Client" $ do + -- Set up the dynamic-ported kernel. + profileVar <- newEmptyMVar + let reqHandler cb req = do + profile <- readMVar profileVar + defaultClientRequestHandler profile (simpleKernelInfo "Test") cb req + thread <- async $ serveDynamic (putMVar profileVar) defaultCommHandler reqHandler + profile <- readMVar profileVar + + -- Connect a client to it. + runClient (Just profile) Nothing emptyHandler $ \profile' -> do + -- Ensure that the received profile is the same as assigned. + liftIO $ profile' @=? profile + + -- Do a simple back-and-forth. + connection <- connectKernel + KernelInfoReply info <- sendClientRequest connection KernelInfoRequest + liftIO $ info @=? simpleKernelInfo "Test" + + -- Kill the kernel thread. + cancel thread + where + emptyHandler = + ClientHandlers (const . const . return $ InputReply "") + (const . const $ return ()) + (const . const $ return ()) + +-- | Test the behaviour of the kernel if the kernel handlers throw exceptions. +testKernelExceptions :: TestTree +testKernelExceptions = testCaseSteps "Kernel Exceptions" $ \step -> do + profileVar <- newEmptyMVar + + let sendShellMsg msg = + runZMQ $ do + profile <- liftIO $ readMVar profileVar + shellClientSocket <- connectedSocket profile profileShellPort Dealer + header <- liftIO $ mkFreshTestHeader msg + sendMessage "" shellClientSocket header msg + + -- Test that when the client request handler throws an error, the error is + -- propagated to the main thread. + step "Testing broken request handler..." + thread1 <- async $ serveDynamic (putMVar profileVar) defaultCommHandler brokenHandler + sendShellMsg ConnectRequest + wait thread1 `shouldThrow` [HandlerException] + + -- Test that when the comm handler throws an error, the error is + -- propagated to the main thread. + step "Testing broken comm handler..." + void $ takeMVar profileVar + thread2 <- async $ serveDynamic (putMVar profileVar) brokenHandler (reqHandler profileVar) + sendShellMsg $ CommMessage (UUID.uuidFromString "test") (object []) + wait thread2 `shouldThrow` [HandlerException] + + where + reqHandler var cb req = do + profile <- readMVar var + defaultClientRequestHandler profile (simpleKernelInfo "Test") cb req + + brokenHandler _ _ = throwIO HandlerException + +-- | Test that communication on the heartbeat and shell sockets works as intended. +testKernel :: TestTree +testKernel = testCaseSteps "Simple Kernel" $ \step -> do + -- Start serving the kernel and obtain the port info so we can connect to it. + step "Starting kernel..." + profileVar <- newEmptyMVar + clientMessageVar <- newEmptyMVar + threadId <- forkIO $ serveDynamic (putMVar profileVar) defaultCommHandler (reqHandler profileVar clientMessageVar) + profile <- readMVar profileVar + + runZMQ $ do + -- Obtain the sockets + liftIO $ step "Connecting to kernel..." + heartbeatClientSocket <- connectedSocket profile profileHeartbeatPort Req + shellClientSocket <- connectedSocket profile profileShellPort Dealer + + -- Check that every message sent to the heartbeat socket is echoed back + liftIO $ step "Checking heartbeat..." + let message = "heartbeat" + send heartbeatClientSocket [] message + response <- receive heartbeatClientSocket + liftIO $ message @=? response + + -- Check that every message we sent to the shell socket is received + -- in exactly the way it was sent. + liftIO $ step "Checking client request encoding / decoding..." + forM_ clientMessages $ \msg -> do + header <- liftIO $ mkFreshTestHeader msg + sendMessage "" shellClientSocket header msg + received <- liftIO $ takeMVar clientMessageVar + liftIO $ msg @=? received + + killThread threadId + where + kernelInfo :: KernelInfo + kernelInfo = KernelInfo + { kernelProtocolVersion = "1.2.3" + , kernelBanner = "Banner" + , kernelImplementation = "kernel" + , kernelImplementationVersion = "1.0.0" + , kernelHelpLinks = [] + , kernelLanguageInfo = LanguageInfo + { languageName = "Test" + , languageVersion = "1.0.0" + , languageMimetype = "text/plain" + , languageFileExtension = ".txt" + , languagePygmentsLexer = Nothing + , languageCodeMirrorMode = Nothing + , languageNbconvertExporter = Nothing + } + } + + -- Request handler for the kernel. It responds with the default reply, but also + -- writes the client request to the provided 'MVar', so that it can be inspected + -- and compared with the client request that was actually sent. + reqHandler :: MVar KernelProfile -> MVar ClientRequest -> ClientRequestHandler + reqHandler profileVar clientMessageVar cb req = do + putMVar clientMessageVar req + profile <- readMVar profileVar + defaultClientRequestHandler profile kernelInfo cb req + + clientMessages = [ ExecuteRequest (CodeBlock "1 + 1") + ExecuteOptions + { executeSilent = False + , executeStoreHistory = True + , executeAllowStdin = False + , executeStopOnError = True + } + , InspectRequest (CodeBlock "print 'X'") 5 DetailLow + , InspectRequest (CodeBlock "print 'X'") 5 DetailHigh + , HistoryRequest + HistoryOptions + { historyShowOutput = True + , historyRaw = True + , historyAccessType = HistoryTail 3 + } + , HistoryRequest + HistoryOptions + { historyShowOutput = True + , historyRaw = True + , historyAccessType = HistoryRange + HistoryRangeOptions + { historyRangeSession = -1 + , historyRangeStart = 10 + , historyRangeStop = 100 + } + } + , HistoryRequest + HistoryOptions + { historyShowOutput = True + , historyRaw = True + , historyAccessType = HistorySearch + HistorySearchOptions + { historySearchCells = 10 + , historySearchPattern = "putStr*" + , historySearchUnique = True + } + } + , CompleteRequest (CodeBlock "putStrL + 3") 7 + , IsCompleteRequest (CodeBlock "let x = 3 in") + , ConnectRequest + , CommInfoRequest Nothing + , CommInfoRequest (Just (TargetName "comm_target")) + , KernelInfoRequest + ] + +-- | Make a new 'MessageHeader', with a random session and id. +mkFreshTestHeader :: IsMessage v => v -> IO MessageHeader +mkFreshTestHeader content = do + uuid <- UUID.random + sess <- UUID.random + return + MessageHeader + { messageIdentifiers = ["ABC", "DEF"] + , messageParent = Nothing + , messageMetadata = mempty + , messageId = uuid + , messageSession = sess + , messageUsername = "test-user" + , messageType = getMessageType content + } diff --git a/tests/Jupyter/Test/MessageExchange.hs b/tests/Jupyter/Test/MessageExchange.hs new file mode 100644 --- /dev/null +++ b/tests/Jupyter/Test/MessageExchange.hs @@ -0,0 +1,314 @@ +{-| +Module : Jupyter.Test.MessageExchange +Description : Testing infrastructure for back-and-forth communication between clients and kernels +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX + +This module serves as one mechanism of testing @jupyter@'s Client functionality, as well as kernels +included with this project. + +This module allows defining a list of 'MessageExchange' values, which indicate a complete message exchange +that should happen between a client and a kernel. The 'testMessageExchange' function then takes the list of +exchanges, runs them using the 'Client' interface, and verifies that all replies (and generated kernel +requests and outputs) match the expected ones. +-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +module Jupyter.Test.MessageExchange ( + MessageExchange(..), + startKernel, + fakeUUID, + testMessageExchange, + runKernelAndClient, + ) where + +-- Imports from 'base' +import Control.Concurrent (newMVar, swapMVar, newEmptyMVar, MVar, putMVar, takeMVar, + readMVar, modifyMVar_, threadDelay, tryTakeMVar) +import Control.Monad (forM_, unless, void) +import Data.Maybe (listToMaybe) +import System.Environment (setEnv) +import System.Timeout (timeout) + +-- Imports from 'transformers' +import Control.Monad.IO.Class (liftIO) + +-- Imports from 'exceptions' +import Control.Monad.Catch (finally) + +-- Imports from 'unordered-containers' +import qualified Data.HashMap.Strict as HashMap + +-- Imports from 'tasty' +import Test.Tasty (TestTree) + +-- Imports from 'tasty-hunit' +import Test.Tasty.HUnit (testCaseSteps, (@=?), assertFailure) + +-- Imports from 'aeson' +import Data.Aeson.Types (Value(..)) + +-- Imports from 'process' +import System.Process (spawnProcess, terminateProcess, ProcessHandle, getProcessExitCode) + +-- Imports from 'jupyter' +import Jupyter.Client +import Jupyter.Kernel +import Jupyter.Messages +import qualified Jupyter.UUID as UUID + +import Jupyter.Test.Utils (inTempDir) + +-- | A data type representing an exchange of messages between a client and a kernel. +-- +-- Given a list of 'MessageExchange's, this module can run the communication and check that all +-- requests, outputs, and replies match what was specified. +-- +-- This currently does not support sending 'Comm' messages as part of the exchange, but does support +-- receiving them. +data MessageExchange = + MessageExchange + { exchangeName :: String + -- ^ Name for the message exchange (to show in errors and test outputs) + , exchangeRequest :: ClientRequest + -- ^ The 'ClientRequest' that initiates the exchange + , exchangeReply :: KernelReply + -- ^ The 'KernelReply' that is returned + , exchangeKernelRequests :: [(KernelRequest, ClientReply)] + -- ^ The 'KernelRequest's that are sent to the client, with a reply for each one + , exchangeComms :: [Comm] + -- ^ The 'Comm' messages that are sent to the client + , exchangeKernelOutputs :: [KernelOutput] + -- ^ The 'KernelOutput' messages that are sent to the client + } + deriving (Eq, Show) + +-- | Start an external-process kernel. +-- +-- First, write the provided profile to a randomly named JSON file. Then, pass the path to this +-- connection file to the provided function, which should return the command that should be used to +-- start the kernel. Return the 'ProcessHandle' for the kernel process. +-- +-- For example, given a profile @kernelProfile@, the IPython kernel would be started as +-- +-- > startKernel (\connFile -> ["python", "-m", "ipykernel", "-f", connFile]) kernelProfile +-- +-- It is recommended that this be run in a temporary directory that is deleted afterward, so that +-- this does not litter the user's path with JSON connection files. +startKernel :: (FilePath -> [String]) -- ^ Function to generate kernel command given JSON connection + -- file + -> KernelProfile -- ^ Kernel profile to write to the connection file + -> IO ProcessHandle -- ^ Handle to the spawned kernel process +startKernel mkCmd profile = do + -- Write a randomly-named profile JSON file. These are randomly named to avoid the possibility of + -- accidentally passing an old connection file to a newly spawned kernel. + uuid <- UUID.uuidToString <$> UUID.random + let filename = "profile-" ++ uuid ++ ".json" + writeProfile profile filename + + -- Set JPY_PARENT_PID to shut up the kernel about its Ctrl-C behaviour (this is mostly for the + -- IPython kernel). + setEnv "JPY_PARENT_PID" "-1" + + -- Start the kernel, and then give it a bit of time to start. If we don't give it some time to + -- start, then it is possible for it to miss our first message. In that case, this test suite just + -- spins forever... + case mkCmd filename of + [] -> fail "Jupyter.Test.Client.startKernel: Expected command with at the executable name" + cmd:args -> spawnProcess cmd args + +-- | Run a kernel and a client connected to that kernel (in a temporary directory). +-- +-- This function starts a client, uses the generated kernel profile to start an external kernel +-- process, connects to that kernel and communicates with it as indicated by a 'Client' action, and +-- then ensures that the external process is shutdown before exiting. +runKernelAndClient :: (KernelProfile -> IO ProcessHandle) -- ^ Function to start external kernel + -> ClientHandlers -- ^ Client handlers for messages received from the kernel + -> (KernelProfile -> ProcessHandle -> KernelConnection -> Client a) -- ^ Client action to run + -> IO a +runKernelAndClient start handlers action = + inTempDir $ \_ -> runClient Nothing Nothing handlers $ \profile -> do + proc <- liftIO $ start profile + finally (connectKernel >>= action profile proc) $ liftIO $ terminateProcess proc + +-- | Use the 'MessageExchange' data type to generate a test case for a test suite. +-- +-- The generated test suite starts a kernel, acquires some basic information about it, sets up a +-- client that talks to the kernel, and plays through the 'MessageExchange's provided by the user. +-- All interactions between the client and the kernel are recorded and verified against the +-- 'MessageExchange's. +testMessageExchange :: String -- ^ Name for the test case + -> IO (FilePath -> [String]) + -- ^ IO action that generates a function, which, if given the path to the + -- connection file, returns the full command to run. This is allowed to be + -- dynamically generated so that it can use 'findKernel' to locate external + -- kernels Jupyter knows about. + -> CodeBlock + -- ^ A valid block of code accepted by the kernel, used to establish + -- the execution counter and session number. + -> (Int -> ExecutionCount -> KernelProfile -> [MessageExchange]) + -- ^ A function to generate the all desired message exchanges, given the + -- session number in progress (for history requests), the previous execution + -- request, and the profile that was connected to. + -> TestTree +testMessageExchange name mkKernelCommand validCode mkMessageExchanges = testCaseSteps name $ \step -> do + -- All communication from kernel to client is recorded in MVars. Allocate those MVars + -- and create the handlers that write to those MVars. + kernelOutputsVar <- newMVar [] + commsVar <- newEmptyMVar + kernelRequestsVar <- newEmptyMVar + clientRepliesVar <- newMVar [] + let clientHandlers = ClientHandlers (exchangeKernelRequestHandler clientRepliesVar kernelRequestsVar) + (exchangeCommHandler commsVar) + (exchangeKernelOutputHandler kernelOutputsVar) + + mk <- mkKernelCommand + runKernelAndClient (startKernel mk) clientHandlers $ \profile proc connection -> do + -- Wait for the kernel to initialize. We know that the kernel is done initializing when it sends its + -- first response; however, sometimes we also get a "starting" status. Since later on we check for + -- equality of kernel outputs, we want to get rid of this timing inconsistencey immediately by just + -- doing on preparation message. + liftIO $ step "Waiting for kernel to start..." + void $ sendClientRequest connection ConnectRequest + liftIO $ do + waitForKernelIdle kernelOutputsVar + void $ swapMVar kernelOutputsVar [] + + -- Acquire the current session number. Without this, we can't accurately test the history replies, + -- since they contain the session numbers. To acquire the session number, send an execute request followed + -- by a history request. + execReply <- sendClientRequest connection $ ExecuteRequest validCode defaultExecuteOptions + execCount <- case execReply of + ExecuteReply count _ -> return count + _ -> fail "Expected ExecuteReply for ExecuteRequest" + liftIO $ do + waitForKernelIdle kernelOutputsVar + void $ swapMVar kernelOutputsVar [] + + histReply <- sendClientRequest connection $ HistoryRequest $ HistoryOptions False True $ HistoryTail 1 + sessionNum <- case histReply of + HistoryReply items -> return $ maybe 1 historyItemSession (listToMaybe items) + _ -> fail "Expected HistoryReply for HistoryRequest" + liftIO $ waitForKernelIdle kernelOutputsVar + void $ liftIO $ takeMVar kernelOutputsVar + + liftIO $ step "Checking messages exchanges..." + forM_ (mkMessageExchanges sessionNum execCount profile) $ \MessageExchange{..} -> do + liftIO $ do + step $ "\t..." ++ exchangeName + putMVar kernelOutputsVar [] + putMVar commsVar [] + putMVar kernelRequestsVar [] + + void $ tryTakeMVar clientRepliesVar + putMVar clientRepliesVar exchangeKernelRequests + + reply <- sendClientRequest connection exchangeRequest + + liftIO $ do + waitForKernelIdle kernelOutputsVar + exchangeReply @=? reply + + receivedComms <- takeMVar commsVar + exchangeComms @=? reverse receivedComms + + receivedKernelRequests <- takeMVar kernelRequestsVar + map fst exchangeKernelRequests @=? reverse receivedKernelRequests + + receivedOutputs <- takeMVar kernelOutputsVar + exchangeKernelOutputs @=? reverse receivedOutputs + + -- In the case of message exchanges that end in a shutdown message, the kernel is + -- responsible for shutting itself down after it sends the shutdown reply. Test that + -- this happens, and fail if the kernel process hasn't terminated after some time. + case exchangeReply of + ShutdownReply{} -> do + threadDelay $ 500 * 1000 + exitCodeM <- getProcessExitCode proc + case exitCodeM of + Nothing -> assertFailure "Kernel did not shut down after shutdown request" + _ -> return () + _ -> return () + +-- | Wait for the kernel to send a 'KernelIdle' status update. +-- +-- This function polls the given 'MVar', waiting for the contained list to have a 'KernelIdle' +-- status update. If this doesn't happen within a fixed but long timeout (1 second or so), an +-- exception is raised, as it is likely indicative of a deadlock. +waitForKernelIdle :: MVar [KernelOutput] -> IO () +waitForKernelIdle var = do + res <- timeout 1000000 wait + case res of + Just _ -> return () + Nothing -> fail "Timed out in waitForKernelIdle: deadlock?" + + where + -- Poll the MVar until it has the KernelIdle in it. + wait = do + outputs <- readMVar var + unless (KernelStatusOutput KernelIdle `elem` outputs) $ do + threadDelay 100000 + waitForKernelIdle var + +-- | A fake UUID that replaces all UUIDs in 'Comm' messages. +-- +-- This is necessary because kernels generate UUIDs randomly, so we cannot use equality to test +-- them, unless we replace all UUIDs with fake ones. This is the fake UUID that UUIDs from the +-- kernels get replaced with. +fakeUUID :: UUID.UUID +fakeUUID = UUID.uuidFromString "fake" + +-- | A handler for the 'kernelRequestHandler' field of 'ClientHandlers'. +-- +-- This handler listens for kernel requests, and, upon a kernel request, stores it in a list in an +-- MVar, and then looks up a response to this kernel request and replies with it. +-- +-- This allows for scripted interactions between clients and kernels to include /stdin/ channel requests. +exchangeKernelRequestHandler :: MVar [(KernelRequest, ClientReply)] + -- ^ Variable holding request / response pairs; response is looked up here. + -> MVar [KernelRequest] + -- ^ Variable to store the received kernel request in. + -> (Comm -> IO ()) + -- ^ (unused) callback to send 'Comm' messages to the kernel + -> KernelRequest + -- ^ Received kernel request + -> IO ClientReply +exchangeKernelRequestHandler repliesVar var _ req = do + modifyMVar_ var $ return . (req :) + replies <- readMVar repliesVar + case lookup req replies of + Just reply -> return reply + Nothing -> fail "Could not find appropriate client reply" + + +-- | A handler for the 'commHandler' field of 'ClientHandlers'. +-- +-- This handler listens for comm messages and stores them into a mutable variable. All 'Comm' +-- messages have a UUID, which is replaced by 'fakeUUID'. In addition, any known fields that are +-- non-deterministic are dropped from the data. (For instance, 'layout' is dropped from IPython +-- widget messages.) +-- +-- This function is not meant to be incredibly reusable. +exchangeCommHandler :: MVar [Comm] -> (Comm -> IO ()) -> Comm -> IO () +exchangeCommHandler var _ comm = modifyMVar_ var $ return . (comm' :) + where + comm' = + case comm of + CommOpen _ val b c -> CommOpen fakeUUID (dropJSONKey "layout" val) b c + CommClose _ a -> CommClose fakeUUID a + CommMessage _ a -> CommMessage fakeUUID a + + dropJSONKey key val = + case val of + Object o -> Object (HashMap.delete key o) + other -> other + +-- | A handler for the 'kernelOutputHandler' field of 'ClientHandlers'. +-- +-- This handler listens for 'KernelOutput' messages and stores them into a mutable variable. +exchangeKernelOutputHandler :: MVar [KernelOutput] -> (Comm -> IO ()) -> KernelOutput -> IO () +exchangeKernelOutputHandler var _ out = + modifyMVar_ var $ return . (out :) diff --git a/tests/Jupyter/Test/Utils.hs b/tests/Jupyter/Test/Utils.hs new file mode 100644 --- /dev/null +++ b/tests/Jupyter/Test/Utils.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Jupyter.Test.Utils where + +-- Imports from 'base' +import Control.Exception (catch, Exception) + +-- Imports from 'tasty-hunit +import Test.Tasty.HUnit (assertFailure) + +-- Imports from 'extra' +import System.IO.Extra (withTempDir) +import System.Directory.Extra (withCurrentDirectory) + +-- Imports from 'zeromq4-haskell' +import System.ZMQ4.Monadic (socket, connect, ZMQ, Socket, SocketType) + +-- Imports from 'jupyter' +import Jupyter.ZeroMQ (KernelProfile, Port) + +-- | Create a temporary directory and execute an action with that temporary directory as the working +-- directory. This is not threadsafe, since working directories are global values. +inTempDir :: (FilePath -> IO a) -> IO a +inTempDir action = withTempDir $ \tmp -> withCurrentDirectory tmp (action tmp) + +-- | Check that an IO action throws an exception of the expected type. +shouldThrow :: forall a proxy e. Exception e => IO a -> proxy e -> IO () +shouldThrow action _ = + catch (action >> assertFailure "Did not throw expected exception") handler + where + handler :: e -> IO () + handler _ = return () + +-- | Create and connect a socket to a port, obtained by applying an accessor to a 'KernelProfile'. +connectedSocket :: SocketType s + => KernelProfile -- ^ Profile to get port from + -> (KernelProfile -> Port) -- ^ Accessor to get port from profile + -> s -- ^ Socket type to create, e.g. 'Rep' + -> ZMQ z (Socket z s) -- ^ Returns connected ZeroMQ socket +connectedSocket profile accessor socketType = do + sock <- socket socketType + connect sock $ "tcp://127.0.0.1:" ++ show (accessor profile) + return sock + +-- | An exception type to be thrown during tests. +data HandlerException = HandlerException | HandlerExceptionWithMessage String + deriving (Eq, Ord, Show) + +-- | Make 'HandlerException' an instance of 'Exception' so it can be thrown +instance Exception HandlerException diff --git a/tests/Jupyter/Test/ZeroMQ.hs b/tests/Jupyter/Test/ZeroMQ.hs new file mode 100644 --- /dev/null +++ b/tests/Jupyter/Test/ZeroMQ.hs @@ -0,0 +1,63 @@ +{-| +Module : Jupyter.Test.ZeroMQ +Description : Miscellaneous tests for Jupyter.ZeroMQ. +Copyright : (c) Andrew Gibiansky, 2016 +License : MIT +Maintainer : andrew.gibiansky@gmail.com +Stability : stable +Portability : POSIX +-} +{-# LANGUAGE OverloadedStrings #-} +module Jupyter.Test.ZeroMQ (zmqTests) where + +-- Imports from 'transformers' +import Control.Monad.IO.Class (liftIO) + +-- Imports from 'tasty' +import Test.Tasty (TestTree, testGroup) + +-- Imports from 'tasty-hunit' +import Test.Tasty.HUnit (testCase, (@=?)) + +-- Imports from 'zeromq4-haskell' +import System.ZMQ4.Monadic (Req(..), send, receive) + +-- Imports from 'jupyter' +import Jupyter.ZeroMQ + +import Jupyter.Test.Utils (inTempDir, connectedSocket) + +zmqTests :: TestTree +zmqTests = testGroup "ZeroMQ Tests" [testHeartbeatSocket, testReadProfile] + +-- Test that messages can be sent and received on the heartbeat socket. +testHeartbeatSocket :: TestTree +testHeartbeatSocket = testCase "Heartbeat Socket" $ + withKernelSockets Nothing $ \profile socks -> do + heartbeatClientSocket <- connectedSocket profile profileHeartbeatPort Req + + let message = "heartbeat" + send heartbeatClientSocket [] message + received <- receive (kernelHeartbeatSocket socks) + liftIO $ message @=? received + +-- Test that kernel profile encoding and decoding works as expected. +testReadProfile :: TestTree +testReadProfile = testCase "Reading profile file" $ + inTempDir $ \_ -> do + let filename = "profile.json" + writeProfile testProfile filename + profile <- readProfile filename + Just testProfile @=? profile + where + testProfile = + KernelProfile + { profileIp = "127.0.0.1" + , profileTransport = TCP + , profileStdinPort = 3982 + , profileControlPort = 3983 + , profileHeartbeatPort = 3984 + , profileShellPort = 3945 + , profileIopubPort = 3942 + , profileSignatureKey = "" + } diff --git a/tests/Test.hs b/tests/Test.hs new file mode 100644 --- /dev/null +++ b/tests/Test.hs @@ -0,0 +1,16 @@ +module Main (main) where + +-- Imports from 'tasty' +import Test.Tasty (defaultMain, testGroup) + +-- Imports from 'jupyter' +import Jupyter.Test.Client (clientTests) +import Jupyter.Test.Install (installTests) +import Jupyter.Test.Kernel (kernelTests) +import Jupyter.Test.ZeroMQ (zmqTests) + +-- | Run all Haskell tests for the @jupyter@ package. +main :: IO () +main = + defaultMain $ + testGroup "Tests" [installTests, zmqTests, kernelTests, clientTests]