usb-safe-0.3: Wrapper around the usb package adding extra type-safetySource codeContentsIndex
System.USB.Safe
MaintainerBas van Dijk <v.dijk.bas@gmail.com>
Contents
Device regions
Opening devices
Configurations
Setting configurations
Interfaces
Claiming and releasing interfaces
Alternates
Setting alternates
Endpoints
Filtering endpoints
Transfer directions
Transfer types
Endpoint I/O
Control transfers
String descriptors
USB kernel drivers
Description

This modules provides the following guarantees for working with USB devices:

  • You can't reference handles to devices that are closed. In other words: no I/O with closed handles is possible.
  • The programmer specifies the region in which devices should remain open. On exit from the region the opened devices are automatically closed.
  • You can't reference handles to configurations that have not been set.
  • You can't reference handles to interfaces that have not been claimed.
  • You can't reference handles to alternates that have not been set.
  • You can't reference endpoints that don't belong to a setted alternate.
  • You can't read from an endpoint with an Out transfer direction.
  • You can't write to an endpoint with an In transfer direction.
  • You can't read from or write to endpoints with the unsupported transfer types Control and Isochronous. Only I/O with endpoints with the Bulk and Interrupt transfer types is allowed.

This modules makes use of a technique called Lightweight monadic regions invented by Oleg Kiselyov and Chung-chieh Shan

See: http://okmij.org/ftp/Haskell/regions.html#light-weight

Synopsis
data DeviceRegionT s pr α
runDeviceRegionT :: MonadCatchIO pr => (forall s. DeviceRegionT s pr α) -> pr α
type TopDeviceRegion s = DeviceRegionT s IO
runTopDeviceRegion :: (forall s. TopDeviceRegion s α) -> IO α
forkTopDeviceRegion :: MonadIO pr => TopDeviceRegion s () -> DeviceRegionT s pr ThreadId
mapDeviceRegionT :: (m α -> n β) -> DeviceRegionT s m α -> DeviceRegionT s n β
liftCatch :: (pr α -> (e -> pr α) -> pr α) -> DeviceRegionT s pr α -> (e -> DeviceRegionT s pr α) -> DeviceRegionT s pr α
data DeviceHandle r
openDevice :: MonadCatchIO pr => Device -> DeviceRegionT s pr (DeviceHandle (DeviceRegionT s pr))
dupDeviceHandle :: MonadCatchIO ppr => DeviceHandle (DeviceRegionT cs (DeviceRegionT ps ppr)) -> DeviceRegionT cs (DeviceRegionT ps ppr) (DeviceHandle (DeviceRegionT ps ppr))
withDevice :: MonadCatchIO pr => Device -> (forall s. DeviceHandle (DeviceRegionT s pr) -> DeviceRegionT s pr α) -> pr α
getDevice :: DeviceHandle region -> Device
resetDevice :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> cr ()
data Config r
getConfigs :: DeviceHandle r -> [Config r]
getConfigDesc :: Config r -> ConfigDesc
dupConfig :: MonadCatchIO ppr => Config (DeviceRegionT cs (DeviceRegionT ps ppr)) -> DeviceRegionT cs (DeviceRegionT ps ppr) (Config (DeviceRegionT ps ppr))
data ConfigHandle sCfg r
data SettingAlreadySet
withConfig :: (ParentOf pr cr, MonadCatchIO cr) => Config pr -> (forall sCfg. ConfigHandle sCfg pr -> cr α) -> cr α
data NoActiveConfig
withActiveConfig :: (ParentOf pr cr, MonadCatchIO cr) => DeviceHandle pr -> (forall sCfg. ConfigHandle sCfg pr -> cr α) -> cr α
data Interface sCfg r
getInterfaces :: ConfigHandle sCfg r -> [Interface sCfg r]
getInterfaceDescs :: Interface sCfg r -> Interface
data InterfaceHandle sIntrf r
withInterface :: (ParentOf pr cr, MonadCatchIO cr) => Interface sCfg pr -> (forall sIntrf. InterfaceHandle sIntrf pr -> cr α) -> cr α
data Alternate sIntrf r
getAlternates :: InterfaceHandle sIntrf r -> [Alternate sIntrf r]
getInterfaceDesc :: Alternate sIntrf r -> InterfaceDesc
data AlternateHandle sAlt r
withAlternate :: (ParentOf pr cr, MonadCatchIO cr) => Alternate sIntrf pr -> (forall sAlt. AlternateHandle sAlt pr -> cr α) -> cr α
withActiveAlternate :: (ParentOf pr cr, MonadCatchIO cr) => InterfaceHandle sIntrf pr -> (forall sAlt. AlternateHandle sAlt pr -> cr α) -> cr α
data Endpoint sAlt r
getEndpoints :: AlternateHandle sAlt r -> [Endpoint sAlt r]
data FilteredEndpoint transDir transType sAlt r
filterEndpoints :: forall transDir transType sAlt r. (TransferDirection transDir, TransferType transType) => [Endpoint sAlt r] -> [FilteredEndpoint transDir transType sAlt r]
getEndpointDesc :: FilteredEndpoint transDir transType sAlt r -> EndpointDesc
clearHalt :: (ParentOf pr cr, MonadIO cr) => FilteredEndpoint transDir transType sAlt pr -> cr ()
data In
data Out
data Control
data Isochronous
data Bulk
data Interrupt
type ReadAction r = Timeout -> Size -> r (ByteString, Bool)
class TransferType transType => ReadEndpoint transType where
readEndpoint :: (ParentOf pr cr, MonadIO cr) => FilteredEndpoint In transType sAlt pr -> ReadAction cr
type WriteAction r = Timeout -> ByteString -> r (Size, Bool)
class TransferType transType => WriteEndpoint transType where
writeEndpoint :: (ParentOf pr cr, MonadIO cr) => FilteredEndpoint Out transType sAlt pr -> WriteAction cr
data RequestType
= Class
| Vendor
control :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> RequestType -> Recipient -> Word8 -> Word16 -> Word16 -> Timeout -> cr ()
readControl :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> RequestType -> Recipient -> Word8 -> Word16 -> Word16 -> ReadAction cr
writeControl :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> RequestType -> Recipient -> Word8 -> Word16 -> Word16 -> WriteAction cr
getLanguages :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> cr [LangId]
getStrDesc :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> StrIx -> LangId -> Size -> cr String
getStrDescFirstLang :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> StrIx -> Size -> cr String
kernelDriverActive :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> InterfaceNumber -> cr Bool
detachKernelDriver :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> InterfaceNumber -> cr ()
attachKernelDriver :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> InterfaceNumber -> cr ()
withDetachedKernelDriver :: (ParentOf pr cr, MonadCatchIO cr) => DeviceHandle pr -> InterfaceNumber -> cr α -> cr α
Device regions
data DeviceRegionT s pr α Source

A monad transformer in which Devices can be opened wich are automatically closed on exit from the region.

Note that regions can be nested. pr (for parent region) is a monad which is usually the region which is running this region. However when you are running a TopDeviceRegion the parent region will be IO.

show/hide Instances
runDeviceRegionT :: MonadCatchIO pr => (forall s. DeviceRegionT s pr α) -> pr αSource

Execute a region inside its parent region pr.

All Devices which have been opened in the given region using openDevice, and which haven't been duplicated using dupDeviceHandle, will be closed on exit from this function wether by normal termination or by raising an exception.

Also all devices which have been duplicated to this region from a child region are closed on exit if they haven't been duplicated themselves.

Note the type variable s of the region wich is only quantified over the region itself. This ensures that no values, that have a type which has s in it, can be returned from this function. (Note the similarity with the ST monad.)

DeviceHandles are parameterized by the region in which they were created. So device handles which were created by openDevice in the given region have this s in their type. This ensures that these device handles, which may have been closed on exit from this function, can't be returned by this function. This ensures you can never do any IO with closed device handles.

Note that it is possible to run a region inside another region.

TODO: Say something more about this nesting of regions...

type TopDeviceRegion s = DeviceRegionT s IOSource
A region which has IO as its parent region which enables it to be directly executed in IO by runTopDeviceRegion or concurrently executed in another region by forkTopDeviceRegion.
runTopDeviceRegion :: (forall s. TopDeviceRegion s α) -> IO αSource

Convenience funtion for running a top-level region in IO.

Note that: runTopDeviceRegion = runDeviceRegionT

forkTopDeviceRegion :: MonadIO pr => TopDeviceRegion s () -> DeviceRegionT s pr ThreadIdSource

Return a region which executes the given top-level region in a new thread.

Note that the forked region has the same type variable s as the resulting region. This means that all DeviceHandles which can be referenced in the resulting region can also be referenced in the forked region.

mapDeviceRegionT :: (m α -> n β) -> DeviceRegionT s m α -> DeviceRegionT s n βSource
Transform the computation inside a region.
liftCatchSource
::
=> pr α -> (e -> pr α) -> pr αcatch on the argument monad.
-> DeviceRegionT s pr αComputation to attempt.
-> e -> DeviceRegionT s pr αException handler.
-> DeviceRegionT s pr α
Lift a catchError operation to the new monad.
Opening devices
data DeviceHandle r Source
A handle to an opened Device parameterized by the region r in which it was created.
openDevice :: MonadCatchIO pr => Device -> DeviceRegionT s pr (DeviceHandle (DeviceRegionT s pr))Source

Open a device in a region.

Note that the returned device handle is parameterized by the region in which it was created. This is to ensure that device handles can never escape their region and to support operations on device handles that are used in a child region of the region in which the device was created.

This is a non-blocking function; no requests are sent over the bus.

Exceptions:

  • NoMemException if there is a memory allocation failure.
  • AccessException if the user has insufficient permissions.
  • NoDeviceException if the device has been disconnected.
  • Another USBException.
dupDeviceHandleSource
:: MonadCatchIO ppr
=> DeviceHandle (DeviceRegionT cs (DeviceRegionT ps ppr))A device handle created in DeviceRegionT cs ... which must have a parent region DeviceRegionT ps ppr.
-> DeviceRegionT cs (DeviceRegionT ps ppr) (DeviceHandle (DeviceRegionT ps ppr))Yield a computation in DeviceRegionT cs that returns the duplicated device handle that can now be used in the parent region DeviceRegionT ps ppr.

Duplicate a device handle in the parent region.

For example, suppose you run the following region:

runDeviceRegionT $ do

Inside this region you run a nested child region like:

    d1hDup <- runDeviceRegionT $ do

Now in this child region you open the device d1:

        d1h <- openDevice d1

Note that d1h :: DeviceHandle (DeviceRegion cs (DeviceRegion ps ppr)) where cs is bound by the inner (child) runDeviceRegionT and ps is bound by the outer (parent) runDeviceRegionT.

Suppose you want to use the resulting device handle d1h in the parent device region. You can't simply return d1h because then the type variable cs, escapes the inner region.

However, if you duplicate the device handle you can safely return it.

        d1hDup <- dupDeviceHandle d1h
        return d1hDup

Note that d1hDup :: DeviceHandle (DeviceRegionT ps ppr)

Back in the parent region you can safely operate on d1hDup.

withDevice :: MonadCatchIO pr => Device -> (forall s. DeviceHandle (DeviceRegionT s pr) -> DeviceRegionT s pr α) -> pr αSource

A convenience function which opens the given device, applies the given function to the resulting device handle and runs the resulting region.

Note that: withDevice dev f = runDeviceRegionT $ openDevice dev >>= f

getDevice :: DeviceHandle region -> DeviceSource
Retrieve the device from the device handle.
resetDevice :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> cr ()Source

Perform a USB port reset to reinitialize a device.

The system will attempt to restore the previous configuration and alternate settings after the reset has completed.

Note the pr `ParentOf` cr which ensures that this function can be executed in any child region of the region in which the given device handle was created.

You can only reset a device when all computations passed to withConfig or withActiveConfig have been terminated. If you call resetDevice and such a computation is still running a SettingAlreadySet exception is thrown.

If the reset fails, the descriptors change, or the previous state cannot be restored, the device will appear to be disconnected and reconnected. This means that the device handle is no longer valid (you should close it) and rediscover the device. A NotFoundException is raised to indicate that this is the case.

TODO: Think about how to handle the implications of the the previous paragraph!

This is a blocking function which usually incurs a noticeable delay.

Exceptions:

Configurations
data Config r Source
A supported configuration of a Device parameterized by the region r in which it was created.
getConfigs :: DeviceHandle r -> [Config r]Source

Retrieve the supported configurations from the device handle.

Note that the configuration is parameterized by the same region r in which the device handle was created. This ensures you can never use a configuration outside that region.

getConfigDesc :: Config r -> ConfigDescSource
Retrieve the configuration descriptor from the given configuration.
dupConfigSource
:: MonadCatchIO ppr
=> Config (DeviceRegionT cs (DeviceRegionT ps ppr))A configuration created in DeviceRegionT cs ... which must have a parent region DeviceRegionT ps ppr.
-> DeviceRegionT cs (DeviceRegionT ps ppr) (Config (DeviceRegionT ps ppr))Yield a computation in DeviceRegionT cs that returns the duplicated configuration that can now be used in the parent region DeviceRegionT ps ppr.

Duplicate a configuration in the parent region.

Also see: dupDeviceHandle.

Setting configurations
data ConfigHandle sCfg r Source

A handle to an active Config parameterized by the region r in which it was created.

You get a handle to a configuration using withConfig or withActiveConfig. The type variable sCfg is used to ensure that you can't return this handle from these functions.

data SettingAlreadySet Source

This exception can be thrown in:

to indicate that the device was already configured with a setting.

show/hide Instances
withConfig :: (ParentOf pr cr, MonadCatchIO cr) => Config pr -> (forall sCfg. ConfigHandle sCfg pr -> cr α) -> cr αSource

Set the active configuration for a device and then apply the given function to the resulting configuration handle.

USB devices support multiple configurations of which only one can be active at any given time. When a configuration is set using withConfig or withActiveConfig no threads can set a new configuration until the computation passed to these functions terminates. If you do try to set one a SettingAlreadySet exception will be thrown.

The operating system may or may not have already set an active configuration on the device. It is up to your application to ensure the correct configuration is selected before you attempt to claim interfaces and perform other operations. If you want to use the current active configuration use withActiveConfig.

If you call this function on a device already configured with the selected configuration, then this function will act as a lightweight device reset: it will issue a SET_CONFIGURATION request using the current configuration, causing most USB-related device state to be reset (altsetting reset to zero, endpoint halts cleared, toggles reset).

You cannot change/reset configuration if other applications or drivers have claimed interfaces.

This is a blocking function.

Exceptions:

  • BusyException if interfaces are currently claimed.
  • NoDeviceException if the device has been disconnected
  • SettingAlreadySet if a configuration has already been set using withConfig or withActiveConfig.
  • Another USBException.
data NoActiveConfig Source
This exception can be thrown in withActiveConfig to indicate that the device is currently not configured.
show/hide Instances
withActiveConfig :: (ParentOf pr cr, MonadCatchIO cr) => DeviceHandle pr -> (forall sCfg. ConfigHandle sCfg pr -> cr α) -> cr αSource

Apply the given function to the configuration handle of the current active configuration of the given device handle.

This function needs to determine the current active configuration. This information may be cached by the operating system. If it isn't cached this function will block while a control transfer is submitted to retrieve the information.

TODO: I'm not yet sure if this is the best way of handling already configured devices. So this may change in the future!

Exceptions:

Interfaces
data Interface sCfg r Source
A supported interface of a Config parameterized by the region r in which it was created and the sCfg of the configuration it is derived from.
getInterfaces :: ConfigHandle sCfg r -> [Interface sCfg r]Source

Retrieve the supported interfaces from the configuration handle.

Note that the interface is parameterized by the same type variables as the configuration handle. This ensures you can never use an interface outside the scope of the function passed to withConfig or withActiveConfig.

getInterfaceDescs :: Interface sCfg r -> InterfaceSource

Retrieve the alternate interface descriptors of the interface.

Note that: type Interface = [InterfaceDesc].

Claiming and releasing interfaces
data InterfaceHandle sIntrf r Source

A handle to a claimed Interface parameterized with the region r in which it was created.

You get a handle to an interface using withInterface. The type variable sIntrf is used to ensure that you can't return this handle from this function.

withInterface :: (ParentOf pr cr, MonadCatchIO cr) => Interface sCfg pr -> (forall sIntrf. InterfaceHandle sIntrf pr -> cr α) -> cr αSource

Claim the given interface, then apply the given function to the resulting interface handle and finally release the interface on exit from the function wether by normal termination or by raising an exception.

Note that it is allowed to claim an already-claimed interface.

Claiming of interfaces is a purely logical operation; it does not cause any requests to be sent over the bus. Interface claiming is used to instruct the underlying operating system that your application wishes to take ownership of the interface.

This is a non-blocking function.

Exceptions:

  • BusyException if the interface is already claimed.
  • NoDeviceException if the device has been disconnected.
  • Another USBException.
Alternates
data Alternate sIntrf r Source
A supported Interface alternate setting parameterized by the region r in which it was created and the sIntrf of the interface it is derived from.
getAlternates :: InterfaceHandle sIntrf r -> [Alternate sIntrf r]Source

Retrieve the supported alternate settings from the interface handle.

Note that the alternate setting is parameterized by the same type variables as the interface handle. This ensures you can never use an alternate setting outside the scope of the function passed to withInterface.

getInterfaceDesc :: Alternate sIntrf r -> InterfaceDescSource
Retrieve the interface descriptor of this alternate setting.
Setting alternates
data AlternateHandle sAlt r Source

A handle to a setted alternate setting parameterized by the region r in which it was created.

You get a handle to an alternate using withAlternate or withActiveAlternate. The type variable sAlt is used to ensure that you can't return this handle from these functions.

withAlternate :: (ParentOf pr cr, MonadCatchIO cr) => Alternate sIntrf pr -> (forall sAlt. AlternateHandle sAlt pr -> cr α) -> cr αSource

Activate an alternate setting for an interface and then apply the given function to the resulting alternate handle.

Simillary to configurations, interfaces support multiple alternate settings of which only one can be active at any given time. When an alternate is set using withAlternate or withActiveAlternate no threads can set a new alternate until the computation passed to these functions terminates. If you do try to set one a SettingAlreadySet exception will be thrown.

The operating system may already have set an alternate for the interface. If you want to use this current active alternate use withActiveAlternate.

This is a blocking function.

Exceptions:

withActiveAlternate :: (ParentOf pr cr, MonadCatchIO cr) => InterfaceHandle sIntrf pr -> (forall sAlt. AlternateHandle sAlt pr -> cr α) -> cr αSource

Apply the given function to the alternate handle of the current active alternate of the give interface handle.

To determine the current active alternate this function will block while a control transfer is submitted to retrieve the information.

TODO: I'm not yet sure if this is the best way of handling already configured devices. So this may change in the future!

Exceptions:

Endpoints
data Endpoint sAlt r Source
A supported endpoint from an Alternate parameterized by the region r in which it was created and the sAlt of the alternate it is derived from.
getEndpoints :: AlternateHandle sAlt r -> [Endpoint sAlt r]Source

Retrieve the supported endpoints from the alternate handle.

Note that the endpoint is parameterized by the same type variables as the alternate handle. This ensures you can never use an endpoint outside the scope of the function passed to withAlternate or withActiveAlternate.

Filtering endpoints
data FilteredEndpoint transDir transType sAlt r Source

I/O operations on endpoints are type-safe. You can only read from an endpoint with an In transfer direction and you can only write to an endpoint with an Out transfer direction.

Reading and writing also have different implementations for the different endpoint transfer types like: Bulk and Interrupt. I/O with endpoints of other transfer types like Control and Isochronous is not possible.

This type lifts the transfer direction and transfer type information to the type-level so that I/O operations like readEndpoint and writeEndpoint can specify which endpoints they support.

The reason it is called a FilteredEndpoint is that to create it you have to filter a list of Endpoints with filterEndpoints.

filterEndpoints :: forall transDir transType sAlt r. (TransferDirection transDir, TransferType transType) => [Endpoint sAlt r] -> [FilteredEndpoint transDir transType sAlt r]Source
The Endpoint type is not rich enough to encode the transfer direction and transfer type. In order to introduce this type information we have to filter the list of endpoints and get back a list of filtered endpoints which have the specified transfer direction and transfer type and also expres this information in their type.
getEndpointDesc :: FilteredEndpoint transDir transType sAlt r -> EndpointDescSource
Retrieve the endpoint descriptor from the given endpoint handle.
clearHalt :: (ParentOf pr cr, MonadIO cr) => FilteredEndpoint transDir transType sAlt pr -> cr ()Source

Clear the halt/stall condition for an endpoint.

Endpoints with halt status are unable to receive or transmit data until the halt condition is stalled.

You should cancel all pending transfers before attempting to clear the halt condition.

This is a blocking function.

Exceptions:

  • NoDeviceException if the device has been disconnected.
  • Another USBException.
Transfer directions
data In Source
In transfer direction (device -> host) used for reading.
show/hide Instances
TransferDirection In
data Out Source
Out transfer direction (host -> device) used for writing.
show/hide Instances
TransferDirection Out
Transfer types
data Control Source
Control endpoints don't support read and write operations.
show/hide Instances
TransferType Control
data Isochronous Source
Isochronous endpoints don't support read and write operations.
show/hide Instances
TransferType Isochronous
data Bulk Source
Bulk endpoints support read and write operations.
show/hide Instances
data Interrupt Source
Interrupt endpoints support read and write operations.
show/hide Instances
Endpoint I/O
type ReadAction r = Timeout -> Size -> r (ByteString, Bool)Source

Handy type synonym for read transfers.

A ReadAction is a function which takes a timeout and a size which defines how many bytes to read. The function returns an action which, when executed, performs the actual read and returns the bytestring that was read paired with an indication if the transfer timed out.

class TransferType transType => ReadEndpoint transType whereSource

Class of transfer types that support reading.

(Only Bulk and Interrupt transfer types are supported.)

Methods
readEndpoint :: (ParentOf pr cr, MonadIO cr) => FilteredEndpoint In transType sAlt pr -> ReadAction crSource
Read bytes from an In endpoint.
show/hide Instances
type WriteAction r = Timeout -> ByteString -> r (Size, Bool)Source

Handy type synonym for write transfers.

A WriteAction is a function which takes a timeout and the bytestring to write. The function returns an action which, when exectued, returns the number of bytes that were actually written paired with an indication if the transfer timed out.

class TransferType transType => WriteEndpoint transType whereSource

Class of transfer types that support writing

(Only Bulk and Interrupt transfer types are supported.)

Methods
writeEndpoint :: (ParentOf pr cr, MonadIO cr) => FilteredEndpoint Out transType sAlt pr -> WriteAction crSource
Write bytes to an Out endpoint.
show/hide Instances
Control transfers
data RequestType Source
Control transfers can have three request types: Standard, Class and Vendor. We disallow Standard requests however because with them you can destroy the safety guarantees that this module provides.
Constructors
Class
Vendor
controlSource
:: (ParentOf pr cr, MonadIO cr)
=> DeviceHandle prA handle for the device to communicate with.
-> RequestTypeThe type of request.
-> RecipientThe recipient of the request.
-> Word8Request.
-> Word16Value.
-> Word16Index.
-> TimeoutTimeout (in milliseconds) that this function should wait before giving up due to no response being received. For no timeout, use value 0.
-> cr ()

Perform a USB control request that does not transfer data.

The value and index values should be given in host-endian byte order.

Exceptions:

  • TimeoutException if the transfer timed out.
  • PipeException if the control request was not supported by the device
  • NoDeviceException if the device has been disconnected.
  • Another USBException.
readControlSource
:: (ParentOf pr cr, MonadIO cr)
=> DeviceHandle prA handle for the device to communicate with.
-> RequestTypeThe type of request.
-> RecipientThe recipient of the request.
-> Word8Request.
-> Word16Value.
-> Word16Index.
-> ReadAction cr

Perform a USB control read.

The value and index values should be given in host-endian byte order.

Exceptions:

  • PipeException if the control request was not supported by the device
  • NoDeviceException if the device has been disconnected.
  • Another USBException.
writeControlSource
:: (ParentOf pr cr, MonadIO cr)
=> DeviceHandle prA handle for the device to communicate with.
-> RequestTypeThe type of request.
-> RecipientThe recipient of the request.
-> Word8Request.
-> Word16Value.
-> Word16Index.
-> WriteAction cr

Perform a USB control write.

The value and index values should be given in host-endian byte order.

Exceptions:

  • PipeException if the control request was not supported by the device
  • NoDeviceException if the device has been disconnected.
  • Another USBException.
String descriptors
getLanguages :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> cr [LangId]Source

Retrieve a list of supported languages.

This function may throw USBExceptions.

getStrDesc :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> StrIx -> LangId -> Size -> cr StringSource

Retrieve a string descriptor from a device.

This is a convenience function which formulates the appropriate control message to retrieve the descriptor. The string returned is Unicode, as detailed in the USB specifications.

This function may throw USBExceptions.

TODO: The following can be made more type-safe!

When I call getStrDesc I would like the type system to guarantee that the given StrIx and LangId actually belong to the given DeviceHandle. In other words I would like to get a type error when they are some arbitrary number or come from another device.

getStrDescFirstLang :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> StrIx -> Size -> cr StringSource

Retrieve a string descriptor from a device using the first supported language.

This is a convenience function which formulates the appropriate control message to retrieve the descriptor. The string returned is Unicode, as detailed in the USB specifications.

This function may throw USBExceptions.

USB kernel drivers
kernelDriverActive :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> InterfaceNumber -> cr BoolSource

Determine if a kernel driver is active on an interface.

If a kernel driver is active, you cannot claim the interface, and libusb will be unable to perform I/O.

Exceptions:

  • NoDeviceException if the device has been disconnected.
  • Another USBException.
detachKernelDriver :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> InterfaceNumber -> cr ()Source

Detach a kernel driver from an interface.

If successful, you will then be able to claim the interface and perform I/O.

Exceptions:

  • NotFoundException if no kernel driver was active.
  • InvalidParamException if the interface does not exist.
  • NoDeviceException if the device has been disconnected.
  • Another USBException.
attachKernelDriver :: (ParentOf pr cr, MonadIO cr) => DeviceHandle pr -> InterfaceNumber -> cr ()Source

Re-attach an interface's kernel driver, which was previously detached using detachKernelDriver.

Exceptions:

  • NotFoundException if no kernel driver was active.
  • InvalidParamException if the interface does not exist.
  • NoDeviceException if the device has been disconnected.
  • BusyException if the driver cannot be attached because the interface is claimed by a program or driver.
  • Another USBException.
withDetachedKernelDriver :: (ParentOf pr cr, MonadCatchIO cr) => DeviceHandle pr -> InterfaceNumber -> cr α -> cr αSource

If a kernel driver is active on the specified interface the driver is detached and the given action is executed. If the action terminates, whether by normal termination or by raising an exception, the kernel driver is attached again. If a kernel driver is not active on the specified interface the action is just executed.

Exceptions:

  • NoDeviceException if the device has been disconnected.
  • Another USBException.
Produced by Haddock version 2.4.2