diff --git a/System/USB/Internal.hs b/System/USB/Internal.hs --- a/System/USB/Internal.hs +++ b/System/USB/Internal.hs @@ -50,13 +50,13 @@ import Data.Eq.Unicode ( (≢), (≡) ) -- from bytestring: -import qualified Data.ByteString as B ( ByteString, packCStringLen ) +import qualified Data.ByteString as B ( ByteString, packCStringLen, drop ) import qualified Data.ByteString.Internal as BI ( createAndTrim, createAndTrim' ) import qualified Data.ByteString.Unsafe as BU ( unsafeUseAsCStringLen ) -- from text: -import qualified Data.Text.Foreign as T ( fromPtr ) -import qualified Data.Text as T ( unpack ) +import qualified Data.Text as T ( unpack ) +import qualified Data.Text.Encoding as TE ( decodeUtf16LE ) -- from bindings-libusb: import Bindings.Libusb @@ -1071,71 +1071,61 @@ -- ** String descriptors -------------------------------------------------------------------------------- +-- | The size in number of bytes of the header of string descriptors +strDescHeaderSize ∷ Size +strDescHeaderSize = 2 + {-| Retrieve a list of supported languages. This function may throw 'USBException's. -} getLanguages ∷ DeviceHandle → IO [LangId] -getLanguages devHndl = getStrDescUnmarshal devHndl 0 0 maxNrOfLangIds unmarshal - where - unmarshal strPtr strSize = map unmarshalLangId <$> peekArray strSize strPtr - maxNrOfLangIds = 148 -- Based on the number of language identifiers in: - -- http://www.usb.org/developers/docs/USB_LANGIDs.pdf - -{-| Retrieve a string descriptor from a device. +getLanguages devHndl = allocaArray maxSize $ \dataPtr → do + reportedSize ← write dataPtr -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. + let strSize = (reportedSize - strDescHeaderSize) `div` 2 + strPtr = castPtr $ dataPtr `plusPtr` strDescHeaderSize -This function may throw 'USBException's. --} -getStrDesc ∷ DeviceHandle - → StrIx -- ^ Should not be 0! - → LangId -- ^ Make sure this language is supported by the device - -- (See: 'getLanguages'). - → Int -- ^ Maximum number of characters in the requested string. - -- An 'IOException' will be thrown when the requested - -- string is larger than this number. - → IO String -getStrDesc devHndl strIx langId nrOfChars = assert (strIx ≢ 0) $ - getStrDescUnmarshal devHndl strIx (marshalLangId langId) nrOfChars unmarshal + map unmarshalLangId <$> peekArray strSize strPtr where - unmarshal strPtr strSize = T.unpack <$> T.fromPtr strPtr strSize - -getStrDescUnmarshal ∷ DeviceHandle - → StrIx - → Word16 - → Int - → (Ptr Word16 → Int → IO α) - → IO α -getStrDescUnmarshal devHndl strIx langId nrOfWords unmarshal = do - let maxSize = headerSize + nrOfWords * 2 - headerSize = 2 - allocaArray maxSize $ \dataPtr → do - actualSize ← checkUSBException $ c'libusb_get_string_descriptor - (getDevHndlPtr devHndl) - strIx - langId - dataPtr - (fromIntegral maxSize) - when (actualSize < headerSize) $ - throwIO $ IOException "Incomplete header" + maxSize = 255 -- Some devices choke on size > 255 + write = putStrDesc devHndl 0 0 maxSize - reportedSize ← peek dataPtr +{-| @putStrDesc devHndl strIx langId maxSize dataPtr@ retrieves the +string descriptor @strIx@ in the language @langId@ from the @devHndl@ +and writes at most @maxSize@ bytes from that string descriptor to the +location that @dataPtr@ points to. So ensure there is at least space +for @maxSize@ bytes there. Next, the header of the string descriptor +is checked for correctness. If it's incorrect an 'IOException' is +thrown. Finally, the size reported in the header is returned. +-} +putStrDesc ∷ DeviceHandle + → StrIx + → Word16 + → Size + → Ptr CUChar + → IO Size +putStrDesc devHndl strIx langId maxSize dataPtr = do + actualSize ← checkUSBException $ c'libusb_get_string_descriptor + (getDevHndlPtr devHndl) + strIx + langId + dataPtr + (fromIntegral maxSize) + when (actualSize < strDescHeaderSize) $ + throwIO $ IOException "Incomplete header" - when (reportedSize > fromIntegral actualSize) $ - throwIO $ IOException "Not enough space to hold data" + reportedSize ← peek dataPtr - descType ← peekElemOff dataPtr 1 + when (reportedSize > fromIntegral actualSize) $ + throwIO $ IOException "Not enough space to hold data" - when (descType ≢ c'LIBUSB_DT_STRING) $ - throwIO $ IOException "Invalid header" + descType ← peekElemOff dataPtr 1 - let strPtr = castPtr $ dataPtr `plusPtr` headerSize - strSize = (fromIntegral reportedSize - headerSize) `div` 2 + when (descType ≢ c'LIBUSB_DT_STRING) $ + throwIO $ IOException "Invalid header" - unmarshal strPtr strSize + return $ fromIntegral reportedSize {-| The language ID consists of the primary language identifier and the sublanguage identififier as described in: @@ -1163,6 +1153,28 @@ -- Can be retrieved by all the *StrIx functions. type StrIx = Word8 +{-| 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 'USBException's. +-} +getStrDesc ∷ DeviceHandle + → StrIx + → LangId + → Int -- ^ Maximum number of characters in the requested string. An + -- 'IOException' will be thrown when the requested string is + -- larger than this number. + → IO String +getStrDesc devHndl strIx langId nrOfChars = assert (strIx ≢ 0) $ + fmap decode $ BI.createAndTrim size $ write ∘ castPtr + where + write = putStrDesc devHndl strIx (marshalLangId langId) size + size = strDescHeaderSize + 2 * nrOfChars -- characters are 2 bytes + decode = T.unpack ∘ TE.decodeUtf16LE ∘ B.drop strDescHeaderSize + {-| Retrieve a string descriptor from a device using the first supported language. @@ -1173,11 +1185,10 @@ This function may throw 'USBException's. -} getStrDescFirstLang ∷ DeviceHandle - → StrIx -- ^ Should not be 0! - -- If so, an 'InvalidParamException' will be thrown. - → Int -- ^ Maximum number of characters in the requested - -- string. An 'IOException' will be thrown when the - -- requested string is larger than this number. + → StrIx + → Int -- ^ Maximum number of characters in the requested + -- string. An 'IOException' will be thrown when the + -- requested string is larger than this number. → IO String getStrDescFirstLang devHndl strIx nrOfChars = do langIds ← getLanguages devHndl diff --git a/usb.cabal b/usb.cabal --- a/usb.cabal +++ b/usb.cabal @@ -1,5 +1,5 @@ name: usb -version: 0.6 +version: 0.6.0.1 cabal-version: >=1.6 build-type: Custom license: BSD3