    {-# LINE 1 "libraries\\Win32\\System\\Win32\\NamedPipes.hsc" #-}

    {-# LANGUAGE CPP                #-}
    {-# LANGUAGE BangPatterns       #-}
    {-# LANGUAGE MultiWayIf         #-}
    {-# LANGUAGE NumericUnderscores #-}

    -- | For full details on the Windows named pipes API see

    -- <https://docs.microsoft.com/en-us/windows/desktop/ipc/named-pipes>

    --

    module System.Win32.NamedPipes (

        -- * Named pipe server APIs

        createNamedPipe,
        pIPE_UNLIMITED_INSTANCES,

        -- ** Parameter types

        LPSECURITY_ATTRIBUTES,
        OpenMode,
        pIPE_ACCESS_DUPLEX,
        pIPE_ACCESS_INBOUND,
        pIPE_ACCESS_OUTBOUND,
        fILE_FLAG_OVERLAPPED,
        PipeMode,
        pIPE_TYPE_BYTE,
        pIPE_TYPE_MESSAGE,
        pIPE_READMODE_BYTE,
        pIPE_READMODE_MESSAGE,
        pIPE_WAIT,
        pIPE_NOWAIT,
        pIPE_ACCEPT_REMOTE_CLIENTS,
        pIPE_REJECT_REMOTE_CLIENTS,

        -- * Named pipe client APIs

        -- ** connect to a named pipe

        connect,

        -- ** waiting for named pipe instances

        waitNamedPipe,

        TimeOut,
        nMPWAIT_USE_DEFAULT_WAIT,
        nMPWAIT_WAIT_FOREVER,
      ) where

    import Control.Exception
    import Control.Monad (when)
    import Foreign.C.String (withCString)

    import System.Win32.Types hiding (try)
    import System.Win32.File

    -- | The named pipe open mode.

    --

    -- This must specify one of:

    --

    -- * 'pIPE_ACCESS_DUPLEX'

    -- * 'pIPE_ACCESS_INBOUND'

    -- * 'pIPE_ACCESS_OUTBOUND'

    --

    -- It may also specify:

    --

    -- * 'fILE_FLAG_WRITE_THROUGH'

    -- * 'fILE_FLAG_OVERLAPPED'

    --

    -- It may also specify any combination of:

    --

    -- * 'wRITE_DAC'

    -- * 'wRITE_OWNER'

    -- * 'aCCESS_SYSTEM_SECURITY'

    --

    type OpenMode = UINT

    pIPE_ACCESS_DUPLEX             :: OpenMode
    pIPE_ACCESS_DUPLEX :: ErrCode
    pIPE_ACCESS_DUPLEX             =  ErrCode
    3
    pIPE_ACCESS_INBOUND            :: OpenMode
    pIPE_ACCESS_INBOUND :: ErrCode
    pIPE_ACCESS_INBOUND            =  ErrCode
    1
    pIPE_ACCESS_OUTBOUND           :: OpenMode
    pIPE_ACCESS_OUTBOUND :: ErrCode
    pIPE_ACCESS_OUTBOUND           =  ErrCode
    2

    {-# LINE 83 "libraries\\Win32\\System\\Win32\\NamedPipes.hsc" #-}

    -- | The pipe mode.

    --

    -- One of the following type modes can be specified. The same type mode must be

    -- specified for each instance of the pipe.

    --

    -- * 'pIPE_TYPE_BYTE'

    -- * 'pIPE_TYPE_MESSAGE'

    --

    -- One of the following read modes can be specified. Different instances of the

    -- same pipe can specify different read modes.

    --

    -- * 'pIPE_READMODE_BYTE'

    -- * 'pIPE_READMODE_MESSAGE'

    --

    -- One of the following wait modes can be specified. Different instances of the

    -- same pipe can specify different wait modes.

    --

    -- * 'pIPE_WAIT'

    -- * 'pIPE_NOWAIT'

    --

    -- One of the following remote-client modes can be specified.  Different

    -- instances of the same pipe can specify different remote-client modes.

    --

    -- * 'pIPE_ACCEPT_REMOTE_CLIENT'

    -- * 'pIPE_REJECT_REMOTE_CLIENT'

    --

    type PipeMode = UINT

    pIPE_TYPE_BYTE                 :: PipeMode
    pIPE_TYPE_BYTE :: ErrCode
    pIPE_TYPE_BYTE                 =  ErrCode
    0
    pIPE_TYPE_MESSAGE              :: PipeMode
    pIPE_TYPE_MESSAGE :: ErrCode
    pIPE_TYPE_MESSAGE              =  ErrCode
    4
    pIPE_READMODE_BYTE             :: PipeMode
    pIPE_READMODE_BYTE :: ErrCode
    pIPE_READMODE_BYTE             =  ErrCode
    0
    pIPE_READMODE_MESSAGE          :: PipeMode
    pIPE_READMODE_MESSAGE :: ErrCode
    pIPE_READMODE_MESSAGE          =  ErrCode
    2
    pIPE_WAIT                      :: PipeMode
    pIPE_WAIT :: ErrCode
    pIPE_WAIT                      =  ErrCode
    0
    pIPE_NOWAIT                    :: PipeMode
    pIPE_NOWAIT :: ErrCode
    pIPE_NOWAIT                    =  ErrCode
    1
    pIPE_ACCEPT_REMOTE_CLIENTS     :: PipeMode
    pIPE_ACCEPT_REMOTE_CLIENTS :: ErrCode
    pIPE_ACCEPT_REMOTE_CLIENTS     =  ErrCode
    0
    pIPE_REJECT_REMOTE_CLIENTS     :: PipeMode
    pIPE_REJECT_REMOTE_CLIENTS :: ErrCode
    pIPE_REJECT_REMOTE_CLIENTS     =  ErrCode
    8

    {-# LINE 122 "libraries\\Win32\\System\\Win32\\NamedPipes.hsc" #-}

    -- | If the 'createNamedPipe' @nMaxInstances@ parameter is

    -- 'pIPE_UNLIMITED_INSTANCES', the number of pipe instances that can be created

    -- is limited only by the availability of system resources.

    pIPE_UNLIMITED_INSTANCES :: DWORD
    pIPE_UNLIMITED_INSTANCES = 255
    {-# LINE 128 "libraries\\Win32\\System\\Win32\\NamedPipes.hsc" #-}

    -- | Creates an instance of a named pipe and returns a handle for subsequent

    -- pipe operations. A named pipe server process uses this function either to

    -- create the first instance of a specific named pipe and establish its basic

    -- attributes or to create a new instance of an existing named pipe.

    --

    -- For full details see

    -- <https://docs.microsoft.com/en-us/windows/desktop/api/winbase/nf-winbase-createnamedpipea>

    --

    -- To create a named pipe which can be associate with IO completion port on

    -- needs to pass 'fILE_FLAG_OVERLAPPED' to 'OpenMode' argument,

    -- e.g.

    --

    -- >  Win32.createNamedPipe pipeName

    -- >                        (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)

    -- >                        (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)

    -- >                        pIPE_UNLIMITED_INSTANCES

    -- >                        512

    -- >                        512

    -- >                        0

    -- >                        NothinROR

    --

    --

    createNamedPipe :: String   -- ^ A unique pipe name of the form @\\.\pipe\{pipename}@

                                -- The `pipename` part of the name can include any

                                -- character other than a backslash, including

                                -- numbers and special characters. The entire pipe

                                -- name string can be up to 256 characters long.

                                -- Pipe names are not case sensitive.

                    -> OpenMode
                    -> PipeMode
                    -> DWORD    -- ^ nMaxInstances

                    -> DWORD    -- ^ nOutBufferSize

                    -> DWORD    -- ^ nInBufferSize

                    -> DWORD    -- ^ nDefaultTimeOut

                    -> Maybe LPSECURITY_ATTRIBUTES
                    -> IO HANDLE
    createNamedPipe :: String
    -> ErrCode
    -> ErrCode
    -> ErrCode
    -> ErrCode
    -> ErrCode
    -> ErrCode
    -> Maybe LPSECURITY_ATTRIBUTES
    -> IO HANDLE
    createNamedPipe String
    name ErrCode
    openMode ErrCode
    pipeMode
                    ErrCode
    nMaxInstances ErrCode
    nOutBufferSize ErrCode
    nInBufferSize
                    ErrCode
    nDefaultTimeOut Maybe LPSECURITY_ATTRIBUTES
    mb_attr =
      String -> (LPTSTR -> IO HANDLE) -> IO HANDLE
    forall a. String -> (LPTSTR -> IO a) -> IO a
    withTString String
    name ((LPTSTR -> IO HANDLE) -> IO HANDLE)
    -> (LPTSTR -> IO HANDLE) -> IO HANDLE
    forall a b. (a -> b) -> a -> b
    $ \ LPTSTR
    c_name ->
        (HANDLE -> Bool) -> String -> IO HANDLE -> IO HANDLE
    forall a. (a -> Bool) -> String -> IO a -> IO a
    failIf (HANDLE -> HANDLE -> Bool
    forall a. Eq a => a -> a -> Bool
    ==HANDLE
    iNVALID_HANDLE_VALUE) (String
    "CreateNamedPipe ('" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "')") (IO HANDLE -> IO HANDLE) -> IO HANDLE -> IO HANDLE
    forall a b. (a -> b) -> a -> b
    $
          LPTSTR
    -> ErrCode
    -> ErrCode
    -> ErrCode
    -> ErrCode
    -> ErrCode
    -> ErrCode
    -> LPSECURITY_ATTRIBUTES
    -> IO HANDLE
    c_CreateNamedPipe LPTSTR
    c_name ErrCode
    openMode ErrCode
    pipeMode
                            ErrCode
    nMaxInstances ErrCode
    nOutBufferSize ErrCode
    nInBufferSize
                            ErrCode
    nDefaultTimeOut (Maybe LPSECURITY_ATTRIBUTES -> LPSECURITY_ATTRIBUTES
    forall a. Maybe (Ptr a) -> Ptr a
    maybePtr Maybe LPSECURITY_ATTRIBUTES
    mb_attr)

    foreign import ccall unsafe "windows.h CreateNamedPipeW"
      c_CreateNamedPipe :: LPCTSTR
                        -> DWORD
                        -> DWORD
                        -> DWORD
                        -> DWORD
                        -> DWORD
                        -> DWORD
                        -> LPSECURITY_ATTRIBUTES
                        -> IO HANDLE

    -- | Timeout in milliseconds.

    --

    -- * 'nMPWAIT_USE_DEFAULT_WAIT' indicates that the timeout value passed to

    --   'createNamedPipe' should be used.

    -- * 'nMPWAIT_WAIT_FOREVER' - 'waitNamedPipe' will block forever, until a named

    --   pipe instance is available.

    --

    type TimeOut = DWORD
    nMPWAIT_USE_DEFAULT_WAIT  :: TimeOut
    nMPWAIT_USE_DEFAULT_WAIT :: ErrCode
    nMPWAIT_USE_DEFAULT_WAIT  =  ErrCode
    0
    nMPWAIT_WAIT_FOREVER      :: TimeOut
    nMPWAIT_WAIT_FOREVER :: ErrCode
    nMPWAIT_WAIT_FOREVER      =  ErrCode
    4294967295

    {-# LINE 198 "libraries\\Win32\\System\\Win32\\NamedPipes.hsc" #-}

    -- | Wait until a named pipe instance is available.  If there is no instance at

    -- hand before the timeout, it will error with 'ERROR_SEM_TIMEOUT', i.e.

    -- @invalid argument (The semaphore timeout period has expired)@

    --

    -- It returns 'True' if there is an available instance, subsequent 'createFile'

    -- might still fail, if another thread will take turn and connect before, or if

    -- the other end shuts down the name pipe.

    --

    -- It returns 'False' if timeout fired.

    --

    waitNamedPipe :: String  -- ^ pipe name

                  -> TimeOut -- ^ nTimeOut

                  -> IO Bool
    waitNamedPipe :: String -> ErrCode -> IO Bool
    waitNamedPipe String
    name ErrCode
    timeout =
        String -> (CString -> IO Bool) -> IO Bool
    forall a. String -> (CString -> IO a) -> IO a
    withCString String
    name ((CString -> IO Bool) -> IO Bool)
    -> (CString -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \ CString
    c_name -> do
          r <- CString -> ErrCode -> IO Bool
    c_WaitNamedPipe CString
    c_name ErrCode
    timeout
          e <- getLastError
          if | r                      -> pure r
             | e == eRROR_SEM_TIMEOUT -> pure False
             | otherwise              -> failWith "waitNamedPipe" e

    -- 'c_WaitNamedPipe' is a blocking call, hence the _safe_ import.

    foreign import ccall safe "windows.h WaitNamedPipeA"
      c_WaitNamedPipe :: LPCSTR -- lpNamedPipeName

                      -> DWORD  -- nTimeOut

                      -> IO BOOL

    -- | A reliable connect call, as designed in

    -- <https://docs.microsoft.com/en-us/windows/win32/ipc/named-pipe-client>

    --

    -- The arguments are passed directly to 'createFile'.

    --

    -- Note we pick the more familiar posix naming convention, do not confuse this

    -- function with 'connectNamedPipe' (which corresponds to posix 'accept')

    --

    connect :: String                      -- ^ file name

            -> AccessMode                  -- ^ dwDesiredAccess

            -> ShareMode                   -- ^ dwSharedMode

            -> Maybe LPSECURITY_ATTRIBUTES -- ^ lpSecurityAttributes

            -> CreateMode                  -- ^ dwCreationDisposition

            -> FileAttributeOrFlag         -- ^ dwFlagsAndAttributes

            -> Maybe HANDLE                -- ^ hTemplateFile

            -> IO HANDLE
    connect :: String
    -> ErrCode
    -> ErrCode
    -> Maybe LPSECURITY_ATTRIBUTES
    -> ErrCode
    -> ErrCode
    -> Maybe HANDLE
    -> IO HANDLE
    connect String
    fileName ErrCode
    dwDesiredAccess ErrCode
    dwSharedMode Maybe LPSECURITY_ATTRIBUTES
    lpSecurityAttributes ErrCode
    dwCreationDisposition ErrCode
    dwFlagsAndAttributes Maybe HANDLE
    hTemplateFile = IO HANDLE
    connectLoop
      where
        connectLoop :: IO HANDLE
    connectLoop = do
          -- `createFile` checks for `INVALID_HANDLE_VALUE` and retries if this is

          -- caused by `ERROR_SHARING_VIOLATION`.

          mh <- IO HANDLE -> IO (Either IOException HANDLE)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO HANDLE -> IO (Either IOException HANDLE))
    -> IO HANDLE -> IO (Either IOException HANDLE)
    forall a b. (a -> b) -> a -> b
    $
                  String
    -> ErrCode
    -> ErrCode
    -> Maybe LPSECURITY_ATTRIBUTES
    -> ErrCode
    -> ErrCode
    -> Maybe HANDLE
    -> IO HANDLE
    createFile String
    fileName
                             ErrCode
    dwDesiredAccess
                             ErrCode
    dwSharedMode
                             Maybe LPSECURITY_ATTRIBUTES
    lpSecurityAttributes
                             ErrCode
    dwCreationDisposition
                             ErrCode
    dwFlagsAndAttributes
                             Maybe HANDLE
    hTemplateFile
          case mh :: Either IOException HANDLE of
            Left IOException
    e -> do
              errorCode <- IO ErrCode
    getLastError
              when (errorCode /= eRROR_PIPE_BUSY)
                $ throwIO e
              -- all pipe instance were busy, wait 20s and retry; we ignore the

              -- result

              _ <- waitNamedPipe fileName 5_000
              connectLoop

            Right HANDLE
    h -> HANDLE -> IO HANDLE
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure HANDLE
    h

    -- | [ERROR_PIPE_BUSY](https://docs.microsoft.com/en-us/windows/win32/debug/system-error-codes--0-499-#ERROR_PIPE_BUSY):

    -- all pipe instances are busy.

    --

    eRROR_PIPE_BUSY :: ErrCode
    eRROR_PIPE_BUSY :: ErrCode
    eRROR_PIPE_BUSY = ErrCode
    231
    {-# LINE 275 "libraries\\Win32\\System\\Win32\\NamedPipes.hsc" #-}

    eRROR_SEM_TIMEOUT :: ErrCode
    eRROR_SEM_TIMEOUT :: ErrCode
    eRROR_SEM_TIMEOUT = ErrCode
    121
    {-# LINE 278 "libraries\\Win32\\System\\Win32\\NamedPipes.hsc" #-}