hocd (empty) → 0.1.0.0
raw patch · 13 files changed
+782/−0 lines, 13 filesdep +basedep +bytestringdep +data-default-class
Dependencies added: base, bytestring, data-default-class, exceptions, hocd, hspec, mtl, network, text, transformers
Files
- CHANGELOG.md +10/−0
- LICENSE +30/−0
- README.lhs +68/−0
- README.md +68/−0
- app/Main.hs +46/−0
- hocd.cabal +81/−0
- src/HOCD.hs +65/−0
- src/HOCD/Command.hs +160/−0
- src/HOCD/Error.hs +13/−0
- src/HOCD/Monad.hs +194/−0
- src/HOCD/Types.hs +31/−0
- test/ParseSpec.hs +15/−0
- test/Spec.hs +1/−0
+ CHANGELOG.md view
@@ -0,0 +1,10 @@+# Version [0.1.0.0](https://github.com/DistRap/hocd/compare/6a16c2d...0.1.0.0) (2023-12-26)++* Initial release++---++`hocd` uses [PVP Versioning][1].++[1]: https://pvp.haskell.org+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright sorki (c) 2023++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.lhs view
@@ -0,0 +1,68 @@+[](https://github.com/DistRap/hocd/actions/workflows/ci.yaml)+[](https://hackage.haskell.org/package/hocd)+[](https://packdeps.haskellers.com/feed?needle=hocd)++# hocd++[OpenOCD] RPC service client.++[OpenOCD]: https://openocd.org/++## API++See Haddocks or [HOCD.Monad]++[HOCD.Monad]: ./src/HOCD/Monad.hs++## Example++```haskell+{-# LANGUAGE TypeApplications #-}++import Data.Word (Word32)+import HOCD++main :: IO ()+main = runOCD example >>= print++-- | For STM32G474+example+ :: MonadOCD m+ => m ([Word32], Word32)+example = do+ halt'++ -- Read RCC.CR register+ rccCr <- readMemCount @Word32 0x40021000 2++ -- Read and increment GPIOA.ODR register+ let gpioaOdr = 0x48000014+ odr <- readMem32 gpioaOdr+ writeMem gpioaOdr [odr+1]+ r <- readMem32 gpioaOdr++ pure (rccCr, r)+```++This example is runnable from git repository using:++```sh+openocd -f nucleo.cfg+cabal run hocd-readme+```++## Executable++`hocd-read-mem` can be used to read a single or multiple+addresses:++```sh+cabal run hocd-read-mem -- 0x40021000 0x48000014+```++Outputs:++```+0x40021000: 0x3030500+0x48000014: 0x9+```
+ README.md view
@@ -0,0 +1,68 @@+[](https://github.com/DistRap/hocd/actions/workflows/ci.yaml)+[](https://hackage.haskell.org/package/hocd)+[](https://packdeps.haskellers.com/feed?needle=hocd)++# hocd++[OpenOCD] RPC service client.++[OpenOCD]: https://openocd.org/++## API++See Haddocks or [HOCD.Monad]++[HOCD.Monad]: ./src/HOCD/Monad.hs++## Example++```haskell+{-# LANGUAGE TypeApplications #-}++import Data.Word (Word32)+import HOCD++main :: IO ()+main = runOCD example >>= print++-- | For STM32G474+example+ :: MonadOCD m+ => m ([Word32], Word32)+example = do+ halt'++ -- Read RCC.CR register+ rccCr <- readMemCount @Word32 0x40021000 2++ -- Read and increment GPIOA.ODR register+ let gpioaOdr = 0x48000014+ odr <- readMem32 gpioaOdr+ writeMem gpioaOdr [odr+1]+ r <- readMem32 gpioaOdr++ pure (rccCr, r)+```++This example is runnable from git repository using:++```sh+openocd -f nucleo.cfg+cabal run hocd-readme+```++## Executable++`hocd-read-mem` can be used to read a single or multiple+addresses:++```sh+cabal run hocd-read-mem -- 0x40021000 0x48000014+```++Outputs:++```+0x40021000: 0x3030500+0x48000014: 0x9+```
+ app/Main.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE LambdaCase #-}+module Main where++import qualified Control.Monad+import qualified Data.Text+import qualified Data.Text.Read+import qualified Text.Printf+import qualified System.Environment+import qualified HOCD++main :: IO ()+main = System.Environment.getArgs >>= \case+ [] -> error "No address or multiple addresses to read specified"+ [addr] -> do+ HOCD.runOCD+ $ HOCD.readMem32+ (parseMemAddr addr)+ >>= \case+ Left e -> error . show $ e+ Right v ->+ putStrLn+ $ Text.Printf.printf "0x%x" v++ addrs -> do+ HOCD.runOCD+ $ Control.Monad.forM addrs+ $ \a -> do+ let parsed = parseMemAddr a+ v <- HOCD.readMem32 parsed+ pure (parsed, v)+ >>= \case+ Left e -> error . show $ e+ Right vs ->+ Control.Monad.forM_+ vs+ $ \(a, v) ->+ putStrLn+ $ Text.Printf.printf+ "0x%x: 0x%x"+ (HOCD.unMemAddress a)+ v+ where+ parseMemAddr a =+ case Data.Text.Read.hexadecimal $ Data.Text.pack a of+ Left e -> error e+ Right (h, _) -> HOCD.memAddr h
+ hocd.cabal view
@@ -0,0 +1,81 @@+cabal-version: 2.2+name: hocd+version: 0.1.0.0+synopsis: OpenOCD Haskell interface+description: Support for OpenOCDs TCL interface+homepage: https://github.com/DistRap/hocd+license: BSD-3-Clause+license-file: LICENSE+author: sorki+maintainer: srk@48.io+copyright: 2023 sorki+category: Embedded+build-type: Simple++extra-source-files:+ LICENSE+ README.md++extra-doc-files:+ CHANGELOG.md++flag build-readme+ default:+ False+ description:+ Build README.lhs example++library+ ghc-options: -Wall+ hs-source-dirs: src+ exposed-modules: HOCD+ , HOCD.Command+ , HOCD.Error+ , HOCD.Monad+ , HOCD.Types+ build-depends: base >= 4.7 && < 5+ , bytestring+ , data-default-class+ , exceptions+ , mtl+ , network+ , transformers+ , text+ default-language: Haskell2010++executable hocd-read-mem+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , hocd+ , text+ default-language: Haskell2010++executable hocd-readme+ if !flag(build-readme)+ buildable: False+ build-depends:+ base >=4.12 && <5+ , hocd+ build-tool-depends:+ markdown-unlit:markdown-unlit+ default-language: Haskell2010+ main-is: README.lhs+ ghc-options: -pgmL markdown-unlit -Wall++test-suite hocd-tests+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: ParseSpec+ build-tool-depends:+ hspec-discover:hspec-discover+ build-depends: base >= 4.7 && < 5+ , hocd+ , hspec+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/DistRap/hocd
+ src/HOCD.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE RecordWildCards #-}++module HOCD+ ( runOCD+ , module HOCD.Error+ , module HOCD.Monad+ , module HOCD.Types+ ) where++import Control.Monad.Catch (MonadMask)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Default.Class (Default(def))++import qualified Control.Monad.Catch+import qualified Network.Socket++import HOCD.Error+import HOCD.Monad+import HOCD.Types++-- | Run OpenOCD client+-- with defaults ("127.0.0.1:6666")+runOCD+ :: ( MonadIO m+ , MonadMask m+ )+ => OCDT m a+ -> m (Either OCDError a)+runOCD = runOCDConfig def++-- | Run OpenOCD client with @OCDConfig@+-- allowing to set custom host and port+runOCDConfig+ :: ( MonadIO m+ , MonadMask m+ )+ => OCDConfig+ -> OCDT m a+ -> m (Either OCDError a)+runOCDConfig OCDConfig{..} act = do+ addrInfo <- liftIO $ Network.Socket.getAddrInfo+ (Just Network.Socket.defaultHints)+ (Just ocdHost)+ (Just $ show ocdPort)++ case addrInfo of+ (sockAddr:_) ->+ Control.Monad.Catch.bracket+ (liftIO+ $ open+ (Network.Socket.addrFamily sockAddr)+ (Network.Socket.addrAddress sockAddr)+ )+ (liftIO . Network.Socket.close)+ (\sock -> runOCDT sock act)+ _ -> pure (Left OCDError_GetAddrInfoFailed)+ where+ open sockFamily sockAddr = do+ soc <-+ Network.Socket.socket+ sockFamily+ Network.Socket.Stream+ Network.Socket.defaultProtocol+ Network.Socket.connect soc sockAddr+ pure soc
+ src/HOCD/Command.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module HOCD.Command+ ( Command(..)+ , Halt(..)+ , Capture(..)+ , ReadMemory(..)+ , WriteMemory(..)+ , subChar+ , parseMem+ ) where++import Data.Bits (FiniteBits(..))+import Data.Kind (Type)+import Data.ByteString (ByteString)+import HOCD.Error (OCDError(..))+import HOCD.Types (MemAddress(..))+import Text.Printf (PrintfArg)++import qualified Control.Monad+import qualified Data.ByteString.Char8+import qualified Data.Either+import qualified Data.List+import qualified Data.Text+import qualified Data.Text.Read+import qualified Text.Printf++class Command req where+ type Reply req :: Type++ request+ :: req+ -> ByteString++ default request+ :: Show req+ => req+ -> ByteString+ request =+ Data.ByteString.Char8.pack+ . show++ reply+ :: req+ -> ByteString+ -> Either OCDError (Reply req)++data Halt = Halt++instance Show Halt where+ show = pure "halt"++instance Command Halt where+ type Reply Halt = ByteString+ reply _ = ocdReply++data Capture a = Capture a++instance Show a => Show (Capture a) where+ show (Capture x) =+ unwords+ ["capture"+ , show $ show x -- escaping+ ]++instance (Command a, Show a) => Command (Capture a) where+ type Reply (Capture a) = ByteString+ reply _ = ocdReply++data ReadMemory a = ReadMemory+ { readMemoryAddr :: MemAddress+ , readMemoryCount :: Int+ }++instance ( FiniteBits a+ , Num a+ ) => Show (ReadMemory a) where+ show ReadMemory{..} =+ unwords+ [ "read_memory"+ , show $ unMemAddress readMemoryAddr+ , show $ finiteBitSize (0 :: a)+ , show readMemoryCount+ ]++instance ( FiniteBits a+ , Integral a+ ) => Command (ReadMemory a) where+ type Reply (ReadMemory a) = [a]+ reply _ r = ocdReply r >>= parseMem++parseMem+ :: ( FiniteBits a+ , Integral a+ )+ => ByteString+ -> Either OCDError [a]+parseMem =+ (\case+ xs | any Data.Either.isLeft xs ->+ Left (OCDError_ParseMemory $ Data.Either.lefts xs)+ xs | otherwise ->+ pure (Data.Either.rights xs)+ )+ . map+ ( either+ (Left . OCDError_CantReadHex)+ (pure . fst)+ . Data.Text.Read.hexadecimal+ . Data.Text.pack+ )+ . words+ . Data.ByteString.Char8.unpack++data WriteMemory a = WriteMemory+ { writeMemoryAddr :: MemAddress+ , writeMemoryData :: [a]+ }++instance ( FiniteBits a+ , PrintfArg a+ , Integral a+ ) => Show (WriteMemory a) where+ show WriteMemory{..} =+ unwords+ [ "write_memory"+ , show $ unMemAddress writeMemoryAddr+ , show $ finiteBitSize (0 :: a)+ , asTCLList writeMemoryData+ ]+ where+ asTCLList x =+ "{"+ <> Data.List.intercalate+ ","+ (map (formatHex @a) x)+ <> "}"+ formatHex :: PrintfArg t => t -> String+ formatHex = Text.Printf.printf "0x%x"++instance ( FiniteBits a+ , Integral a+ , PrintfArg a+ ) => Command (WriteMemory a) where+ type Reply (WriteMemory a) = ()+ reply _ = ocdReply >>= pure . Control.Monad.void++ocdReply :: ByteString -> Either OCDError ByteString+ocdReply r | Data.ByteString.Char8.last r /= subChar =+ Left $ OCDError_ReplyMissingSubOnEnd r+ocdReply r | otherwise =+ Right $ Data.ByteString.Char8.init r++subChar :: Char+subChar = '\SUB'
+ src/HOCD/Error.hs view
@@ -0,0 +1,13 @@+module HOCD.Error+ ( OCDError(..)+ ) where++import Data.ByteString (ByteString)++data OCDError+ = OCDError_ReplyMissingSubOnEnd ByteString+ | OCDError_CantReadHex String+ | OCDError_GetAddrInfoFailed+ | OCDError_ParseMemory [OCDError]+ | OCDError_ExpectedOneButGotMore+ deriving (Eq, Show)
+ src/HOCD/Monad.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeApplications #-}++module HOCD.Monad+ ( OCDT+ , runOCDT+ , MonadOCD(..)+ , halt+ , halt'+ , readMem+ , readMem32+ , readMemCount+ , writeMem+ , writeMem32+ ) where++import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)+import Control.Monad.Except (MonadError, throwError)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.Reader (MonadReader, ask)+import Control.Monad.Trans (MonadTrans, lift)+import Control.Monad.Trans.Except (ExceptT, runExceptT)+import Control.Monad.Trans.Reader (ReaderT, runReaderT)+import Data.Bits (FiniteBits(..))+import Data.ByteString (ByteString)+import Data.Word (Word32)+import HOCD.Command+ ( Command(..)+ , Capture(..)+ , Halt(..)+ , ReadMemory(..)+ , WriteMemory(..)+ , subChar+ )+import HOCD.Error (OCDError(..))+import HOCD.Types (MemAddress)+import Network.Socket (Socket)+import Text.Printf (PrintfArg)++import qualified Data.ByteString.Char8+import qualified Network.Socket.ByteString++newtype OCDT m a = OCDT+ { _unOCDT+ :: ExceptT OCDError+ (ReaderT Socket m) a+ }+ deriving+ ( Functor+ , Applicative+ , Monad+ , MonadReader Socket+ , MonadError OCDError+ , MonadCatch+ , MonadMask+ , MonadThrow+ , MonadIO+ )++instance MonadTrans OCDT where+ lift = OCDT . lift . lift++-- | Run OCDT transformer+runOCDT+ :: Monad m+ => Socket+ -> OCDT m a+ -> m (Either OCDError a)+runOCDT sock =+ (`runReaderT` sock)+ . runExceptT+ . _unOCDT++class ( MonadIO m+ , MonadError OCDError m+ ) => MonadOCD m where+ getSocket :: m Socket++instance MonadIO m => MonadOCD (OCDT m) where+ getSocket = ask++-- | Perform RPC call+rpc+ :: ( MonadOCD m+ , Command req+ )+ => req+ -> m (Reply req)+rpc cmd = do+ sock <- getSocket+ liftIO $+ Network.Socket.ByteString.sendAll+ sock+ (rpcCmd $ request cmd)+ reply cmd <$> recvTillSub sock+ >>= either throwError pure+ where+ recvTillSub s = do+ msg <-+ liftIO+ $ Network.Socket.ByteString.recv+ s+ 1024+ if Data.ByteString.Char8.last msg == subChar+ then pure msg+ else recvTillSub s >>= pure . (msg <>)++ -- | Terminate with \SUB+ rpcCmd :: ByteString -> ByteString+ rpcCmd =+ (<> Data.ByteString.Char8.singleton subChar)++-- | Halt target+halt+ :: MonadOCD m+ => m ByteString+halt = rpc $ Capture Halt++-- | Halt target, discarding reply+halt'+ :: MonadOCD m+ => m ()+halt' = halt >> pure ()++-- | Read multiple memory segments from @MemAddress@+-- according to count argument. Segment size depends+-- on passed in Word type.+readMemCount+ :: forall a m+ . ( MonadOCD m+ , FiniteBits a+ , Integral a+ )+ => MemAddress -- ^ Memory address to read from+ -> Int -- ^ Count+ -> m [a]+readMemCount ma c =+ rpc+ ReadMemory+ { readMemoryAddr = ma+ , readMemoryCount = c+ }++-- | Read single memory segment from @MemAddress@+-- Segment size depends on passed in Word type.+readMem+ :: forall a m+ . ( MonadOCD m+ , FiniteBits a+ , Integral a+ )+ => MemAddress -- ^ Memory address to read from+ -> m a+readMem ma =+ readMemCount ma 1+ >>= \case+ [one] -> pure one+ _ -> throwError OCDError_ExpectedOneButGotMore++-- | Shorthand for reading @Word32@ sized segment+readMem32+ :: MonadOCD m+ => MemAddress -- ^ Memory address to read from+ -> m Word32+readMem32 = readMem @Word32++-- | Write multiple memory segments to @MemAddress@+writeMem+ :: forall a m+ . ( MonadOCD m+ , FiniteBits a+ , PrintfArg a+ , Integral a+ )+ => MemAddress -- ^ Memory address to write to+ -> [a] -- ^ Data to write+ -> m ()+writeMem ma xs =+ rpc+ WriteMemory+ { writeMemoryAddr = ma+ , writeMemoryData = xs+ }++-- | Shorthand for writing @Word32@ sized segment+writeMem32+ :: MonadOCD m+ => MemAddress -- ^ Memory address to write to+ -> [Word32] -- ^ Data to write+ -> m ()+writeMem32 = writeMem @Word32
+ src/HOCD/Types.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module HOCD.Types+ ( MemAddress(..)+ , memAddr+ , OCDConfig(..)+ ) where++import Data.Default.Class (Default(def))+import Data.Word (Word32)++newtype MemAddress = MemAddress+ { unMemAddress :: Word32 }+ deriving (Eq, Ord, Show, Num)++-- | Shorthand constructor+memAddr :: Word32 -> MemAddress+memAddr = MemAddress++data OCDConfig = OCDConfig+ { ocdHost :: String+ , ocdPort :: Int+ } deriving (Eq, Ord, Show)++instance Default OCDConfig where+ def =+ OCDConfig+ { ocdHost = "127.0.0.1"+ , ocdPort = 6666+ }++
+ test/ParseSpec.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}++module ParseSpec where++import Data.Word (Word32)+import HOCD.Command (parseMem)+import Test.Hspec (Spec, it, shouldBe)++spec :: Spec+spec = do+ it "parses read-memory sample" $ do+ parseMem "ABCDFF 001122"+ `shouldBe`+ (Right [0xABCDFF, 0x1122 :: Word32])+
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}