packages feed

jupyter (empty) → 0.9.0

raw patch · 23 files changed

+5993/−0 lines, 23 filesdep +SHAdep +aesondep +asyncsetup-changed

Dependencies added: SHA, aeson, async, base, bytestring, cereal, containers, directory, exceptions, extra, filepath, jupyter, monad-control, mtl, process, silently, tasty, tasty-hunit, temporary, text, transformers, unordered-containers, uuid, zeromq4-haskell

Files

+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,3 @@+import           Distribution.Simple++main = defaultMain
+ examples/basic/Main.hs view
@@ -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"
+ examples/calculator/Calculator/Handler.hs view
@@ -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
+ examples/calculator/Main.hs view
@@ -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
+ examples/client-kernel-info/Main.hs view
@@ -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 ()+  }
+ examples/stdin/Main.hs view
@@ -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
+ jupyter.cabal view
@@ -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
+ src/Jupyter/Client.hs view
@@ -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+<http://jupyter.org/qtconsole/stable/ QtConsole>, and the <Notebook http://jupyter.org/>.++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+<https://github.com/gibiansky/jupyter-haskell/tree/master/examples/client-kernel-info examples/client-kernel-info>+directory, and more information about the client and kernel interfaces can be found on the @jupyter@+<https://github.com/gibiansky/jupyter-haskell README>.+-}+{-# 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+-- <https://github.com/gibiansky/jupyter-haskell/tree/master/examples/client-kernel-info examples/client-kernel-info>+-- 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
+ src/Jupyter/Install.hs view
@@ -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+      }
+ src/Jupyter/Install/Internal.hs view
@@ -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+-- <http://jupyter-client.readthedocs.io/en/latest/kernels.html#kernelspecs official documentation>.+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+-- <http://jupyter-client.readthedocs.io/en/latest/kernels.html#kernelspecs Jupyter documentation>+-- 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
+ src/Jupyter/Kernel.hs view
@@ -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+<https://jupyter-client.readthedocs.io/en/latest/messaging.html Jupyter messaging spec>; most kernels+are language backends that allow using a particular programming language with Jupyter frontends such as+the <http://jupyter.org/ notebook> or <http://jupyter.org/qtconsole/stable/ QtConsole>.++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@+<https://github.com/gibiansky/jupyter-haskell README>, and several example kernels may be found in +the <https://github.com/gibiansky/jupyter-haskell/tree/master/examples examples> 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+-- <https://github.com/gibiansky/jupyter-haskell/tree/master/examples examples> 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
+ src/Jupyter/Messages.hs view
@@ -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+<https://github.com/ipython/ipywidgets ipywidgets>; for most use cases, it is safe to ignore them+and provide empty 'Comm' message handlers.)++For more information, please read the+<https://jupyter-client.readthedocs.io/en/latest/messaging.html full Jupyter messaging specification>.+-}++{-# 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 <https://jupyter-client.readthedocs.io/en/latest/messaging.html#messages-on-the-shell-router-dealer-sockets of the Jupyter messaging spec>.+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 <http://pygments.org/docs/lexers/ Pygments lexers> and <http://codemirror.net/mode/index.html Codemirror modes> 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+-- <https://jupyter-client.readthedocs.io/en/latest/messaging.html#custom-messages section in the Jupyter messaging spec>.+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
+ src/Jupyter/Messages/Internal.hs view
@@ -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+-- <https://jupyter-client.readthedocs.io/en/latest/messaging.html#the-wire-protocol wire protocol>.+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
+ src/Jupyter/UUID.hs view
@@ -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
+ src/Jupyter/ZeroMQ.hs view
@@ -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 <http://zeromq.org/ ZeroMQ> sockets needed to communicate with Jupyter+-- kernels on the <https://jupyter- Jupyter messaging wire protocol>. These sockets are to be used+-- by a client communicating with a kernel.+--+-- Roles of different sockets are described+-- <https://jupyter-client.readthedocs.io/en/latest/messaging.html#introduction here>.+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 <http://zeromq.org/ ZeroMQ> sockets needed to communicate with Jupyter+-- clients on the <https://jupyter- Jupyter messaging wire protocol>. These sockets are to be used+-- by a kernel communicating with a client.+--+-- Roles of different sockets are described+-- <https://jupyter-client.readthedocs.io/en/latest/messaging.html#introduction here>.+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+-- <http://jupyter-client.readthedocs.io/en/latest/messaging.html#wire-protocol wire protocol documentation>+-- 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+-- <http://jupyter-client.readthedocs.io/en/latest/kernels.html#connection-files respective Jupyter documentation>.+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+-- <https://jupyter-client.readthedocs.io/en/latest/kernels.html#connection-files connection files>+-- 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 "<IDS|MSG>"++  -- 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+-- <http://jupyter-client.readthedocs.io/en/latest/messaging.html#wire-protocol wire protocol documentation>.+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 "<IDS|MSG>"+  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
+ tests/Jupyter/Test/Client.hs view
@@ -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('<b>Hi</b>'))"+                          defaultExecuteOptions+    , exchangeReply = ExecuteReply (execCount + 5) ExecuteOk+    , exchangeKernelRequests = []+    , exchangeComms = []+    , exchangeKernelOutputs = [ kernelBusy+                              , ExecuteInputOutput (execCount + 5)+                                  "from IPython.display import *\ndisplay(HTML('<b>Hi</b>'))"+                              , DisplayDataOutput $ displayPlain+                                                      "<IPython.core.display.HTML object>" <> displayHtml+                                                                                                "<b>Hi</b>"+                              , 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('<b>Hi</b>'))" 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('<b>Hi</b>'))" 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('<b>Hi</b>'))" 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('<b>Hi</b>'))" 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
+ tests/Jupyter/Test/Install.hs view
@@ -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 }
+ tests/Jupyter/Test/Kernel.hs view
@@ -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+      }
+ tests/Jupyter/Test/MessageExchange.hs view
@@ -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 :)
+ tests/Jupyter/Test/Utils.hs view
@@ -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
+ tests/Jupyter/Test/ZeroMQ.hs view
@@ -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 = ""+         }
+ tests/Test.hs view
@@ -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]