diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,9 @@
+# STLinkUSB
+
+This package contains a Haskell driver for ST-Link USB dongles.
+My use case for this driver is the STM32-Zombie library.
+The STM32-Zombie library turns a STM32 micro-controller
+into a powerful Haskell-hackable hardware interface.
+The library is a based on information from the openocd library.
+
+## [Haddock documentation](http://hackage.haskell.org/package/STLinkUSB)
diff --git a/STLinkUSB.cabal b/STLinkUSB.cabal
new file mode 100644
--- /dev/null
+++ b/STLinkUSB.cabal
@@ -0,0 +1,41 @@
+Name:          STLinkUSB
+Version:       0.1.0
+Category:      Hardware, STM32, Microcontroller
+Synopsis:      STLink USB interface in Haskell
+Description:   This package contains a Haskell driver for ST-Link USB dongles.
+               My use case for this driver is the STM32-Zombie library.
+               The STM32-Zombie library turns a STM32 micro-controller
+               into a powerful Haskell-hackable hardware interface.
+               The library is a based on information from the openocd library.
+
+License:       BSD3
+Author:        2015-2017 Marc Fontaine <Marc.Fontaine@gmx.de>
+Stability:     Experimental
+Tested-With:   GHC == 8.2.1
+Build-Type:    Simple
+Cabal-Version: >= 1.24
+Extra-Source-Files:  README.md
+                    
+Source-Repository head
+  type:     git
+  location: git://github.com/MarcFontaine/STLinkUSB
+
+library
+  default-language  : Haskell2010
+  ghc-options       : -Wall
+  Build-depends     : base  >= 4.10 && < 5
+                    , bytestring >= 0.10 && < 0.11
+                    , usb >= 1.3 && < 1.4
+                    , vector >= 0.12 && < 0.13
+                    , binary >= 0.8 && < 0.9
+                    , transformers >= 0.5 && < 0.6
+  Exposed-modules:  STM32.STLinkUSB
+                  , STM32.STLinkUSB.Commands
+                  , STM32.STLinkUSB.Env
+                  , STM32.STLinkUSB.USBXfer
+                  , STM32.STLinkUSB.MemRW
+                  , STM32.STLinkUSB.Dongle
+                  , STM32.STLinkUSB.Test
+                  , STM32.STLinkUSB.CortexM
+                  , STM32.STLinkUSB.USBUtils
+                  , STM32.STLinkUSB.TwoBoards
diff --git a/STM32/STLinkUSB.hs b/STM32/STLinkUSB.hs
new file mode 100644
--- /dev/null
+++ b/STM32/STLinkUSB.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE RankNTypes #-}
+----------------------------------------------------------------------------
+-- |
+-- Module      :  STM32.STLinkUSB
+-- Copyright   :  (c) Marc Fontaine 2017
+-- License     :  BSD3
+-- 
+-- Maintainer  :  Marc.Fontaine@gmx.de
+-- Stability   :  experimental
+-- Portability :  GHC-only
+--
+-- This module exports a small driver for the STLink dongles. 
+-- The focus of this API is on reading and writing
+-- to the memory of and attached STM32 controller.
+-- The STM32 architecture use memory mapped IO registers to program
+-- IO ports a hardware peripherals.
+-- Therefor a STLink dongle with an attached STM32 board in combination with this
+-- library makes a nice Haskell-controlled IO extension board.
+
+
+module STM32.STLinkUSB
+(
+   test
+  ,STLT
+  ,STL
+  ,STLinkEnv
+  ,runSTLink
+  ,initDongle
+  ,resetHalt
+  ,writeDebugReg
+  ,writeMem8
+  ,writeMem32
+  ,readMem8
+  ,readMem32
+  ,LogLevel
+  ,Logger
+  ,xfer
+  )
+where
+import STM32.STLinkUSB.Env
+import STM32.STLinkUSB.USBXfer
+import STM32.STLinkUSB.MemRW
+import STM32.STLinkUSB.Dongle
+import STM32.STLinkUSB.Test
+import STM32.STLinkUSB.CortexM
diff --git a/STM32/STLinkUSB/Commands.hs b/STM32/STLinkUSB/Commands.hs
new file mode 100644
--- /dev/null
+++ b/STM32/STLinkUSB/Commands.hs
@@ -0,0 +1,207 @@
+{-# LANGUAGE RecordWildCards #-}
+----------------------------------------------------------------------------
+-- |
+-- Module      :  STM32.Commands
+-- Copyright   :  (c) Marc Fontaine 2017
+-- License     :  BSD3
+-- 
+-- Maintainer  :  Marc.Fontaine@gmx.de
+-- Stability   :  experimental
+-- Portability :  GHC-only
+--
+-- The bits, bytes and constants of the STLink protocoll.
+-- The constants have been looked up a corresponding driver that is
+-- part of the openocd library.
+-- Some parts have been added for completeness (but have not been tested so far). 
+module STM32.STLinkUSB.Commands
+where
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL (toStrict)
+import Data.Binary
+import Data.Binary.Put
+import Data.Binary.Get
+import Data.Bits
+       
+data Version = Version {
+   stlink :: Word16
+  ,jtag   :: Word16
+  ,swim   :: Word16
+  } deriving Show
+
+instance Binary Version where
+  put _ = error "Version put not implemented"
+  get = do
+    v <- getWord16be
+    let
+      stlink = (v `shiftR` 12) .&. 0x0f 
+      jtag   = (v `shiftR` 6)  .&. 0x3f 
+      swim   = v .&. 0x3f
+    return $ Version {..}
+
+-- | APIV1 is NOT supported ! Todo remove old APIV1 stuff.
+-- | todo 
+data API = APIV1 | APIV2
+  deriving (Show,Eq)
+
+type Addr = Word32
+data DebugCmd
+  = ENTER_JTAG
+  | GETSTATUS
+  | FORCEDEBUG
+  | READMEM_32BIT  Addr Word16
+  | WRITEMEM_32BIT Addr Word16
+  | RUNCORE
+  | STEPCORE
+  | READMEM_8BIT  Addr Word16
+  | WRITEMEM_8BIT Addr Word16
+  | APIV1_CLEARFP
+  | APIV1_SETWATCHPOINT
+  | ENTER_SWD
+  | EXIT
+  | READCOREID
+  | APIV1_SETFP
+  | ENTER API
+  | APIV2_READ_IDCODES
+  | RESETSYS API
+  | READREG API
+  | WRITEREG API
+  | WRITEDEBUGREG API Addr Word32
+  | APIV2_READDEBUGREG Addr
+  | READALLREGS API
+  | GETLASTRWSTATUS
+  | APIV2_DRIVE_NRST
+  | APIV2_START_TRACE_RX Word16 Word32
+  | APIV2_STOP_TRACE_RX
+  | APIV2_GET_TRACE_NB
+  | APIV2_SWD_SET_FREQ
+  | APIV2_DRIVE_NRST_LOW
+  | APIV2_DRIVE_NRST_HIGH
+  | APIV2_DRIVE_NRST_PULSE
+  deriving (Show,Eq)
+
+instance Binary DebugCmd where
+  get = error "no Binary get for debugCMD"
+  put cmd = case cmd of
+    ENTER_JTAG            -> putWord8 0x00
+    GETSTATUS             -> putWord8 0x01
+    FORCEDEBUG            -> putWord8 0x02
+    READALLREGS APIV1     -> putWord8 0x04
+    READALLREGS APIV2     -> putWord8 0x3A
+    READREG APIV1         -> putWord8 0x05
+    READREG APIV2         -> putWord8 0x33
+    WRITEREG APIV1        -> putWord8 0x06
+    WRITEREG APIV2        -> putWord8 0x34
+    READMEM_32BIT addr len
+      -> putWord8 0x07 >> putWord32le addr >> putWord16le len
+    WRITEMEM_32BIT addr len
+      -> putWord8 0x08  >> putWord32le addr >> putWord16le len
+    RUNCORE               -> putWord8 0x09
+    STEPCORE              -> putWord8 0x0a
+    APIV1_SETFP           -> putWord8 0x0b
+    READMEM_8BIT addr len
+      -> putWord8 0x0c >> putWord32le addr >> putWord16le len
+    WRITEMEM_8BIT addr len
+      -> putWord8 0x0d >> putWord32le addr >> putWord16le len
+    APIV1_CLEARFP         -> putWord8 0x0e
+    APIV1_SETWATCHPOINT   -> putWord8 0x10
+    ENTER_SWD             -> putWord8 0xa3
+    (ENTER APIV1)         -> putWord8 0x20
+    EXIT                  -> putWord8 0x21
+    READCOREID            -> putWord8 0x22
+    ENTER APIV2           -> putWord8 0x30
+    APIV2_READ_IDCODES    -> putWord8 0x31
+    (RESETSYS APIV2)      -> putWord8 0x32
+    (RESETSYS APIV1)      -> putWord8 0x03
+    (WRITEDEBUGREG APIV1 w1 w2)
+         -> putWord8 0x0f >> putWord32le w1 >> putWord32le w2
+    (WRITEDEBUGREG APIV2 w1 w2)
+         -> putWord8 0x35 >> putWord32le w1 >> putWord32le w2
+    APIV2_READDEBUGREG  w -> putWord8 0x36 >> putWord32le w
+    GETLASTRWSTATUS -> putWord8 0x3B
+    APIV2_DRIVE_NRST      -> putWord8 0x3C
+    APIV2_START_TRACE_RX  size speed
+          -> putWord8 0x40   >> putWord16le size >> putWord32le speed
+    APIV2_STOP_TRACE_RX   -> putWord8 0x41
+    APIV2_GET_TRACE_NB    -> putWord8 0x42
+    APIV2_SWD_SET_FREQ    -> putWord8 0x43
+    APIV2_DRIVE_NRST_LOW   -> putWord8 0x00
+    APIV2_DRIVE_NRST_HIGH  -> putWord8 0x01
+    APIV2_DRIVE_NRST_PULSE -> putWord8 0x02
+
+data Cmd
+  = GET_VERSION
+  | DEBUG_COMMAND DebugCmd
+  | DEBUG_COMMANDs [DebugCmd]
+  | DFU_COMMAND_EXIT
+  | SWIM_COMMAND SWIM_Cmd
+  | GET_CURRENT_MODE
+  | GET_TARGET_VOLTAGE
+  deriving Show
+
+data SWIM_Cmd = SWIM_ENTER | SWIM_EXIT
+  deriving Show
+  
+instance Binary Cmd where
+  get = error "no Binary get for debugCMD"
+  put cmd = case cmd of
+    GET_VERSION               -> putWord8 0xF1
+    DEBUG_COMMAND  c          -> putWord8 0xF2 >> put c
+    DEBUG_COMMANDs l
+      -> putWord8 0xF2 >> mapM_ put l
+    DFU_COMMAND_EXIT          -> putWord8 0xF3 >> putWord8 0x07
+    (SWIM_COMMAND SWIM_ENTER) -> putWord8 0xF4 >> putWord8 0x00
+    (SWIM_COMMAND SWIM_EXIT)  -> putWord8 0xF4 >> putWord8 0x01
+    GET_CURRENT_MODE          -> putWord8 0xF5
+    GET_TARGET_VOLTAGE        -> putWord8 0xF7
+  
+cmdToByteString :: Cmd -> BS.ByteString
+cmdToByteString cmd
+  = BS.take 16 $ BSL.toStrict $ runPut (put cmd >> padding)
+  where
+    padding = putWord64le 0 >> putWord64le 0
+
+data DevMode
+  = DEV_DFU_MODE
+  | DEV_MASS_MODE
+  | DEV_DEBUG_MODE
+  | DEV_SWIM_MODE
+  | DEV_BOOTLOADER_MODE
+  deriving (Show,Eq,Ord,Enum)
+
+data Status
+  = DEBUG_ERR_OK
+  | DEBUG_ERR_FAULT
+  | SWD_AP_WAIT
+  | SWD_AP_FAULT
+  | SWD_AP_ERROR
+  | SWD_AP_PARITY_ERROR
+  | JTAG_WRITE_ERROR
+  | JTAG_WRITE_VERIF_ERROR
+  | SWD_DP_WAIT
+  | SWD_DP_FAULT
+  | SWD_DP_ERROR
+  | SWD_DP_PARITY_ERROR
+  | SWD_AP_WDATA_ERROR
+  | SWD_AP_STICKY_ERROR
+  | SWD_AP_STICKYORUN_ERROR
+  | UnknownStatus Word8
+  deriving (Show,Eq,Ord)
+
+toStatus :: Word8 -> Status
+toStatus w = case w of
+  0x80 -> DEBUG_ERR_OK
+  0x81 -> DEBUG_ERR_FAULT
+  0x10 -> SWD_AP_WAIT
+  0x11 -> SWD_AP_FAULT
+  0x12 -> SWD_AP_ERROR
+  0x13 -> SWD_AP_PARITY_ERROR
+  0x0c -> JTAG_WRITE_ERROR
+  0x0d -> JTAG_WRITE_VERIF_ERROR
+  0x14 -> SWD_DP_WAIT
+  0x15 -> SWD_DP_FAULT
+  0x16 -> SWD_DP_ERROR
+  0x17 -> SWD_DP_PARITY_ERROR
+  0x18 -> SWD_AP_WDATA_ERROR
+  0x19 -> SWD_AP_STICKY_ERROR
+  0x1a -> SWD_AP_STICKYORUN_ERROR
+  other -> UnknownStatus other
diff --git a/STM32/STLinkUSB/CortexM.hs b/STM32/STLinkUSB/CortexM.hs
new file mode 100644
--- /dev/null
+++ b/STM32/STLinkUSB/CortexM.hs
@@ -0,0 +1,78 @@
+-- |
+-- Module      :  STM32.STLinkUSB.CortexM
+-- Copyright   :  (c) Marc Fontaine 2017
+-- License     :  BSD3
+-- 
+-- Maintainer  :  Marc.Fontaine@gmx.de
+-- Stability   :  experimental
+-- Portability :  GHC-only
+--
+-- Starting and stopping the attached CPU
+
+module STM32.STLinkUSB.CortexM
+where
+
+import Data.Word
+import Data.Bits
+import qualified Data.ByteString as BS
+import Control.Monad
+
+import STM32.STLinkUSB.Commands
+import STM32.STLinkUSB.Dongle
+import STM32.STLinkUSB.Env
+import STM32.STLinkUSB.USBXfer
+import STM32.STLinkUSB.MemRW
+  
+halt :: STL ()
+halt = do
+  debugSTL Info "halting CPU"
+  api <- asksDongleAPI              
+  case api of
+     APIV2 -> writeDebugReg _DCB_DHCSR (_DBGKEY .|. _C_HALT .|. _C_DEBUGEN)
+     APIV1 -> void $ xfer (DEBUG_COMMAND FORCEDEBUG)
+
+{-- TODO: does this work ?
+-- The intended application is to use the micro controller as an IO extension
+-- board and write to the hardware register over the SWD interface.
+-- It is essential that the micro controller cpu does not interfere,
+-- i.e. it is halted.
+-- (fancy stuff could be possible by running a custom micro controller firmware)
+-}
+resetHalt :: STL ()
+resetHalt = halt >> reset
+
+run :: STL ()
+run = do
+  debugSTL Info "starting CPU"
+  api <- asksDongleAPI              
+  case api of
+     APIV2 -> writeDebugReg _DCB_DHCSR (_DBGKEY .|. _C_DEBUGEN)
+     APIV1 -> void $ xfer (DEBUG_COMMAND RUNCORE)
+
+readCpuID :: STL BS.ByteString
+readCpuID = do
+  debugSTL Info ("trying to read CPU ID")
+  cpuID <- readMem32 _CPUID 4
+  debugSTL Info ("CPU ID : " ++ (show $ BS.unpack cpuID))
+  return cpuID
+
+_CPUID :: Word32
+_CPUID = 0xE000ED00
+
+_DCB_DHCSR :: Word32
+_DCB_DCRSR :: Word32
+_DCB_DCRDR :: Word32
+_DCB_DEMCR :: Word32
+
+_DCB_DHCSR = 0xE000EDF0
+_DCB_DCRSR = 0xE000EDF4
+_DCB_DCRDR = 0xE000EDF8
+_DCB_DEMCR = 0xE000EDFC
+
+_DBGKEY :: Word32
+_DBGKEY = 0xA05F0000
+
+_C_DEBUGEN :: Word32
+_C_DEBUGEN = 1
+_C_HALT :: Word32
+_C_HALT = 2
diff --git a/STM32/STLinkUSB/Dongle.hs b/STM32/STLinkUSB/Dongle.hs
new file mode 100644
--- /dev/null
+++ b/STM32/STLinkUSB/Dongle.hs
@@ -0,0 +1,130 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  STM32.STLinkUSB.Dongle
+-- Copyright   :  (c) Marc Fontaine 2017
+-- License     :  BSD3
+-- 
+-- Maintainer  :  Marc.Fontaine@gmx.de
+-- Stability   :  experimental
+-- Portability :  GHC-only
+--
+-- Functions for initializing, reseting and mode-change of the STLink dongle.
+
+{-# LANGUAGE RankNTypes #-}
+module STM32.STLinkUSB.Dongle
+where
+import Control.Monad
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL (fromStrict)
+import Data.Binary
+import Data.Binary.Get
+import Control.Monad.Trans.Reader
+import Control.Monad.IO.Class
+import System.USB (Status(..))
+
+import STM32.STLinkUSB.Commands
+import STM32.STLinkUSB.Env
+import STM32.STLinkUSB.USBXfer
+
+-- | Init the dongle and set debug mode.
+-- A Haskell translation of the same function in the openocd library.
+
+initDongle :: STL ()
+initDongle = do
+  debugSTL Debug "starting initDongle"
+  v <- readVersion
+  debugSTL Info ("dongle version : " ++ show v)
+  devMode <- readCurrentMode
+  case devMode of
+    DEV_DFU_MODE   -> modeLeave MODE_DFU
+    DEV_DEBUG_MODE -> modeLeave MODE_DEBUG_SWD
+    DEV_SWIM_MODE  -> modeLeave MODE_DEBUG_SWIM
+    _ -> return ()
+  _nMode <- readCurrentMode
+  when (_nMode /= DEV_DFU_MODE) $ do
+    voltage <- readVoltage
+    debugSTL Info ("dongle voltage : " ++ show voltage)
+  debugSTL Info "entering SWD Mode // connection to controller"
+  modeEnter MODE_DEBUG_SWD
+  newMode <- readCurrentMode
+  when (newMode /= DEV_DEBUG_MODE) $ do
+    let err = ("cannot set dongle mode DEV_DEBUG_MODE. Mode is : "++ show newMode)
+    debugSTL Error err                    
+    error err
+  return ()
+
+reset :: STL ()
+reset = do
+  debugSTL Info "resetting dongle"
+  api <- asks dongleAPI
+  void $ xferRetry (DEBUG_COMMAND $ RESETSYS api)
+
+readVersion :: STL Version
+readVersion = do
+  debugSTL Debug "reading dongle version"
+  msg <- xfer GET_VERSION
+  return $ decode $ BSL.fromStrict msg
+  
+readVoltage :: STL Float
+readVoltage = do
+  debugSTL Debug "reading dongle voltage"
+  msg <- xfer GET_TARGET_VOLTAGE
+  let    (a,b) = runGet ((,) <$> getWord32le <*> getWord32le) $ BSL.fromStrict msg
+  return $
+    2.4 * (realToFrac b) / (realToFrac a)
+
+readCurrentMode :: STL DevMode
+readCurrentMode = do
+  debugSTL Debug "reading dongle mode"
+  msg <- xfer GET_CURRENT_MODE
+  let mode = toEnum $ fromIntegral $ BS.head msg
+  debugSTL Debug $ "dongle mode : " ++ show mode
+  return mode
+
+data Mode
+  = MODE_DFU
+  | MODE_MASS
+  | MODE_DEBUG_JTAG
+  | MODE_DEBUG_SWD
+  | MODE_DEBUG_SWIM
+  deriving (Show,Eq,Ord,Enum)
+  
+modeEnter :: Mode ->STL ()
+modeEnter mode = do
+  api <- asks dongleAPI
+  case mode of
+    MODE_DEBUG_JTAG -> void $ xferRetry $ DEBUG_COMMANDs [ ENTER api , ENTER_JTAG ]
+    MODE_DEBUG_SWD  -> void $ xferRetry $ DEBUG_COMMANDs [ ENTER api , ENTER_SWD  ]
+    MODE_DEBUG_SWIM -> void $ xferRetry $ SWIM_COMMAND SWIM_ENTER
+    MODE_DFU   -> return ()
+    MODE_MASS  -> return ()
+
+modeLeave :: Mode -> STL ()
+modeLeave mode = do
+  case mode of
+    MODE_DEBUG_JTAG -> xferCheck $ DEBUG_COMMAND EXIT
+    MODE_DEBUG_SWD  -> xferCheck $ DEBUG_COMMAND EXIT
+    MODE_DEBUG_SWIM -> xferCheck $ SWIM_COMMAND SWIM_EXIT
+    MODE_DFU        -> xferCheck $ DFU_COMMAND_EXIT
+    _ -> return ()
+  where
+      xferCheck cmd = do
+        (_ret,err) <- xferStatus cmd
+        case err of
+           Right TimedOut  -> return () -- this is what happens : timeout
+           Right Completed -> return () -- this case was not seen
+           Left usbExcept -> do
+             let msg = "leaveMode : USB exception : " ++ show usbExcept
+             debugSTL Error msg
+             error msg
+             
+writeDebugReg :: Word32 -> Word32 -> STL()
+writeDebugReg addr val = do
+  api <- asks dongleAPI
+  void $ xfer (DEBUG_COMMAND $ WRITEDEBUGREG api addr val)
+
+dumpTrace :: STL ()
+dumpTrace = forever $ do
+   (msg,err) <- xferReadTrace
+   liftIO $ print ("trace: ",err,msg)
+
diff --git a/STM32/STLinkUSB/Env.hs b/STM32/STLinkUSB/Env.hs
new file mode 100644
--- /dev/null
+++ b/STM32/STLinkUSB/Env.hs
@@ -0,0 +1,83 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  STM32.STLinkUSB.Env
+-- Copyright   :  (c) Marc Fontaine 2017
+-- License     :  BSD3
+-- 
+-- Maintainer  :  Marc.Fontaine@gmx.de
+-- Stability   :  experimental
+-- Portability :  GHC-only
+--
+-- The STLT Monad is just a reader transformer of STLinkEnv.
+
+
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RankNTypes #-}
+
+module STM32.STLinkUSB.Env
+where
+
+import System.USB
+import Control.Monad.Trans.Reader
+import Control.Monad.IO.Class
+
+import STM32.STLinkUSB.USBUtils
+import STM32.STLinkUSB.Commands (API(..))
+
+type STLT m a = ReaderT STLinkEnv m a       
+type STL a = forall m. MonadIO m => ReaderT STLinkEnv m a
+
+runSTLink :: STLT IO a  -> IO a
+runSTLink = runSTLink' defaultDebugLogger . runReaderT
+
+runSTLink_verbose :: STLT IO a  -> IO a
+runSTLink_verbose = runSTLink' verboseDebugLogger . runReaderT
+
+runSTLink' :: Logger -> (STLinkEnv -> IO a) -> IO a
+runSTLink' logger action = do
+  usb <- findDefaultEndpoints
+  runSTLinkWith logger usb action
+
+runSTLinkWith ::
+      Logger
+   -> (Ctx, Device, EndpointAddress, EndpointAddress, EndpointAddress)
+   -> (STLinkEnv -> IO a)
+   -> IO a
+runSTLinkWith
+     debugLogger
+     (usbCtx, device, rxEndpoint, txEndpoint, traceEndpoint)
+     action
+  =  withUSB device $ \deviceHandle -> (action STLinkEnv {..})
+  where
+    dongleAPI = APIV2
+
+data STLinkEnv = STLinkEnv {
+   usbCtx :: Ctx
+  ,rxEndpoint :: EndpointAddress
+  ,txEndpoint :: EndpointAddress
+  ,traceEndpoint :: EndpointAddress
+  ,deviceHandle ::  DeviceHandle
+  ,dongleAPI  :: API
+  ,debugLogger :: Logger
+  }
+
+asksDongleAPI :: STL API
+asksDongleAPI = asks dongleAPI
+
+data LogLevel = Debug | Info | Warn | Error deriving (Show,Eq,Ord)
+type Logger = LogLevel -> String -> IO ()
+  
+debugSTL :: LogLevel -> String -> STL ()
+debugSTL ll msg = do
+  logger <- asks debugLogger
+  liftIO $ logger ll msg
+
+defaultDebugLogger :: Logger
+defaultDebugLogger logLevel msg = case logLevel of
+  Debug -> return ()
+  Info  -> return ()
+  _ -> putStrLn (show logLevel ++ " : " ++ msg )
+
+verboseDebugLogger :: Logger
+verboseDebugLogger logLevel msg
+  = putStrLn (show logLevel ++ " : " ++ msg )
diff --git a/STM32/STLinkUSB/MemRW.hs b/STM32/STLinkUSB/MemRW.hs
new file mode 100644
--- /dev/null
+++ b/STM32/STLinkUSB/MemRW.hs
@@ -0,0 +1,134 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  STM32.STLinkUSB.MemRW
+-- Copyright   :  (c) Marc Fontaine 2017
+-- License     :  BSD3
+-- 
+-- Maintainer  :  Marc.Fontaine@gmx.de
+-- Stability   :  experimental
+-- Portability :  GHC-only
+--
+-- Read and Write to the memory of an attached STM32 controller.
+
+{-# LANGUAGE RankNTypes #-}
+module STM32.STLinkUSB.MemRW
+where
+import Control.Monad
+import qualified Data.ByteString as BS
+import Data.Binary
+import Control.Monad.Trans.Reader
+
+import STM32.STLinkUSB.Commands
+import STM32.STLinkUSB.Env
+import STM32.STLinkUSB.USBXfer
+
+checkRWStatus :: STL ()
+checkRWStatus = do
+  api <- asks dongleAPI              
+  case api of
+    APIV1 -> return ()
+    APIV2 -> do
+      msg <- xfer (DEBUG_COMMAND GETLASTRWSTATUS)
+      let dongleStatus = toStatus $ BS.head msg
+      if (dongleStatus == DEBUG_ERR_OK)
+         then return ()
+         else do
+           let err = show ("checkRWStatus", dongleStatus)
+           debugSTL Error err
+           error err
+
+maxTransferBlocksize :: Word16
+maxTransferBlocksize = 64
+
+newtype TransferBlock
+  = TransferBlock {_unTransferBlock :: BS.ByteString} deriving Show
+
+unsafeToTransferBlock :: BS.ByteString -> TransferBlock
+unsafeToTransferBlock bs
+  = if len <= fromIntegral maxTransferBlocksize
+       then TransferBlock bs
+       else error msg
+  where
+    msg = "unsafeToTransferBlock :" ++ show len ++ "> maxTransferBlockSize"
+    len = BS.length bs                   
+
+newtype TransferLen = TransferLen {_unTransferLen :: Word16} deriving Show
+
+unsafeToTransferLen :: Word16 -> TransferLen
+unsafeToTransferLen len
+  = if len <= maxTransferBlocksize
+       then TransferLen len
+       else error msg
+  where
+    msg = "unsafeToTransferLen :" ++ show len ++ "> maxTransferBlocksize"
+  
+writeMem8' :: Addr -> TransferBlock -> STL ()
+writeMem8' addr (TransferBlock block) = do
+  void $ xferBulkWrite (DEBUG_COMMAND $ WRITEMEM_8BIT addr len) block
+  checkRWStatus
+  where
+    len = fromIntegral $ BS.length block
+
+writeMem32' :: Addr -> TransferBlock -> STL ()
+writeMem32' addr (TransferBlock block) = do
+  void $ xferBulkWrite (DEBUG_COMMAND $ WRITEMEM_32BIT addr len) block
+  checkRWStatus
+  where
+    len = fromIntegral $ BS.length block
+  
+readMem8' :: Addr -> TransferLen -> STL BS.ByteString
+readMem8' addr (TransferLen len) = do
+  bs <- xfer (DEBUG_COMMAND $ READMEM_8BIT addr len)
+  checkRWStatus
+  return bs
+      
+readMem32' :: Addr -> TransferLen -> STL BS.ByteString
+readMem32' addr (TransferLen len) = do
+  bs <- xfer (DEBUG_COMMAND $ READMEM_32BIT addr len)
+  checkRWStatus
+  return bs
+
+writeMem8 :: Addr -> BS.ByteString -> STL ()
+writeMem8 = writeChunks writeMem8'
+
+writeMem32 :: Addr -> BS.ByteString -> STL ()
+writeMem32 = writeChunks writeMem32'
+
+writeChunks
+  :: (Addr -> TransferBlock -> STL () ) -> Addr -> BS.ByteString -> STL ()
+writeChunks action addr bs
+  = forM_ (chunkBS addr bs) $ uncurry action
+
+
+chunkBS :: Addr -> BS.ByteString -> [(Addr,TransferBlock)]
+chunkBS addr bs
+  = if BS.length bs <= chunkSize
+       then [h]
+       else h : (chunkBS (addr + fromIntegral chunkSize)     
+                      (BS.drop chunkSize bs))
+   where
+    h = (addr, unsafeToTransferBlock $ BS.take chunkSize bs)
+    chunkSize = fromIntegral maxTransferBlocksize
+
+chunkAddr :: Addr -> Int -> [(Addr,TransferLen)]
+chunkAddr addr len
+  = if len <= chunkSize
+       then [h]
+       else h : (chunkAddr (addr + fromIntegral chunkSize)
+                      (len - chunkSize))
+   where
+    h = (addr, unsafeToTransferLen
+                    (min (fromIntegral len) (fromIntegral maxTransferBlocksize)))
+    chunkSize = fromIntegral maxTransferBlocksize
+
+readChunks
+  :: (Addr -> TransferLen -> STL BS.ByteString )
+      -> Addr -> Int -> STL BS.ByteString
+readChunks action addr len
+  = liftM BS.concat $ forM (chunkAddr addr len) $ uncurry action
+
+readMem8 :: Addr -> Int -> STL BS.ByteString
+readMem8 = readChunks readMem8'
+
+readMem32 :: Addr -> Int -> STL BS.ByteString
+readMem32 = readChunks readMem32'
diff --git a/STM32/STLinkUSB/Test.hs b/STM32/STLinkUSB/Test.hs
new file mode 100644
--- /dev/null
+++ b/STM32/STLinkUSB/Test.hs
@@ -0,0 +1,28 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  STM32.STLinkUSB.Test
+-- Copyright   :  (c) Marc Fontaine 2017
+-- License     :  BSD3
+-- 
+-- Maintainer  :  Marc.Fontaine@gmx.de
+-- Stability   :  experimental
+-- Portability :  GHC-only
+--
+-- Test the connetion to the STLink dongle
+-- and read the CPU ID of the attached controller.
+
+{-# LANGUAGE RankNTypes #-}
+module STM32.STLinkUSB.Test
+where
+
+import STM32.STLinkUSB.Env
+import STM32.STLinkUSB.Dongle
+import STM32.STLinkUSB.CortexM
+
+-- | Test the dongle and connection to the board.
+-- This test fails if no board is attached
+test :: IO ()
+test = runSTLink_verbose $ do
+  initDongle
+  _<-readCpuID
+  return ()
diff --git a/STM32/STLinkUSB/TwoBoards.hs b/STM32/STLinkUSB/TwoBoards.hs
new file mode 100644
--- /dev/null
+++ b/STM32/STLinkUSB/TwoBoards.hs
@@ -0,0 +1,106 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  STM32.STLinkUSB.TwoBoards
+-- Copyright   :  (c) Marc Fontaine 2017
+-- License     :  BSD3
+-- 
+-- Maintainer  :  Marc.Fontaine@gmx.de
+-- Stability   :  experimental
+-- Portability :  GHC-only
+--
+-- Using two Boards/Dongles in parallel.
+
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RankNTypes #-}
+
+module STM32.STLinkUSB.TwoBoards
+where
+
+import System.USB
+import Control.Monad.Trans.Reader
+import Control.Monad.IO.Class
+
+import STM32.STLinkUSB.USBUtils
+import STM32.STLinkUSB.Env
+import STM32.STLinkUSB.Commands
+import STM32.STLinkUSB.Dongle
+import STM32.STLinkUSB.CortexM
+
+type STLTT m a = ReaderT (STLinkEnv,STLinkEnv) m a
+
+runSTLinkAB :: STLTT IO a  -> IO a
+runSTLinkAB
+ = runSTLinkAB' (defaultDebugLogger, defaultDebugLogger)
+   . runReaderT
+
+runSTLinkAB_verbose :: STLTT IO a  -> IO a
+runSTLinkAB_verbose
+  = runSTLinkAB' (verboseDebugLogger, verboseDebugLogger)
+    . runReaderT
+
+runSTLinkAB' ::
+     (Logger,Logger)
+  -> ((STLinkEnv,STLinkEnv) -> IO a)
+  -> IO a
+runSTLinkAB' (loggerA,loggerB) action = do
+  ctx <- newCtx
+  setDebug ctx PrintWarnings
+  list <- findUSBDevices ctx defaultSTLProductID
+  let (deviceA,deviceB) = case list of
+          []  -> error "no STLink dongle found"
+          [_] -> error "just one STLink dongle found"
+          [a,b] -> (a,b)
+          (_:_:_:_) -> error "more two one STLink dongle found"
+  (_,_,rxA,txA,traceA) <- findEndpoints ctx deviceA
+  (_,_,rxB,txB,traceB) <- findEndpoints ctx deviceB
+  let 
+     preEnvA handleA = STLinkEnv {
+       usbCtx      = ctx
+      ,rxEndpoint  = rxA
+      ,txEndpoint  = txA
+      ,traceEndpoint = traceA
+      ,deviceHandle  = handleA
+      ,dongleAPI     = APIV2
+      ,debugLogger   = taggedLogger "A" loggerA
+      }
+     preEnvB handleB = STLinkEnv {
+       usbCtx      = ctx
+      ,rxEndpoint  = rxB
+      ,txEndpoint  = txB
+      ,traceEndpoint = traceB
+      ,deviceHandle  = handleB
+      ,dongleAPI     = APIV2
+      ,debugLogger   = taggedLogger "B" loggerB
+      }
+  runSTLinkWithAB (deviceA,deviceB) (preEnvA,preEnvB) action
+
+runSTLinkWithAB ::
+      (Device, Device)
+   -> ((DeviceHandle -> STLinkEnv), (DeviceHandle -> STLinkEnv))
+   -> ((STLinkEnv, STLinkEnv) -> IO a)
+   -> IO a
+runSTLinkWithAB (deviceA, deviceB) (preEnvA, preEnvB) action
+  =  withUSB deviceA $ \deviceHandleA ->
+      withUSB deviceB $ \deviceHandleB ->
+        (action (preEnvA deviceHandleA, preEnvB deviceHandleB))
+
+taggedLogger :: String -> Logger -> Logger
+taggedLogger tag logger loglevel msg
+  = logger loglevel (tag++":"++msg)
+
+
+boardA :: STLT IO a  -> STLTT IO a
+boardA action = do
+  env <- asks fst
+  liftIO $ (runReaderT action) env
+
+boardB :: STLT IO a  -> STLTT IO a
+boardB action = do
+  env <- asks snd
+  liftIO $ (runReaderT action) env
+
+testTwoBoards :: IO ()
+testTwoBoards = runSTLinkAB_verbose $ do
+  boardA $ initDongle
+  _<-boardA $ readCpuID
+  boardB $ initDongle
diff --git a/STM32/STLinkUSB/USBUtils.hs b/STM32/STLinkUSB/USBUtils.hs
new file mode 100644
--- /dev/null
+++ b/STM32/STLinkUSB/USBUtils.hs
@@ -0,0 +1,68 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  STM32.STLinkUSB.USBUtils
+-- Copyright   :  (c) Marc Fontaine 2017
+-- License     :  BSD3
+-- 
+-- Maintainer  :  Marc.Fontaine@gmx.de
+-- Stability   :  experimental
+-- Portability :  GHC-only
+--
+-- This module contains low-level functions for initializing the USB connection.
+-- In most setups 'STM32.STLinkUSB.Env.runSTLink' does all the work
+-- and there is no need to include this module.
+
+module STM32.STLinkUSB.USBUtils
+where
+import qualified Data.Vector as Vector
+import System.USB
+import Control.Monad
+
+findDefaultEndpoints
+  :: IO (Ctx, Device, EndpointAddress, EndpointAddress, EndpointAddress)
+findDefaultEndpoints = do
+  ctx <- newCtx
+  setDebug ctx PrintWarnings
+  list <- findUSBDevices ctx defaultSTLProductID
+  let device = case list of
+        [x] -> x
+        [] -> error "no STLink dongle found"
+        (_:_:_) -> error "more than one STLink dongle found"
+  
+  findEndpoints ctx device
+  
+findUSBDevices ::
+  Ctx -> ProductId -> IO [Device]
+findUSBDevices ctx stlProductID = do
+  devices <- fmap Vector.toList $ getDevices ctx
+  flip filterM devices $ \ device -> do
+      descr <- getDeviceDesc device
+      return (deviceProductId descr == stlProductID)
+
+defaultSTLProductID :: ProductId
+defaultSTLProductID = 0x3748
+                   
+findEndpoints ::
+     Ctx -> Device
+  -> IO (Ctx, Device, EndpointAddress, EndpointAddress, EndpointAddress)
+findEndpoints ctx device = do
+  config <- getConfigDesc device 0
+  let
+     endPoints = interfaceEndpoints
+                   $ Vector.head $ Vector.head $ configInterfaces config
+     rxEndpoint = endpointAddress $ endPoints Vector.! 0
+     txEndpoint = endpointAddress $ endPoints Vector.! 1
+     traceEndpoint = endpointAddress $ endPoints Vector.! 2
+  return (ctx, device, rxEndpoint, txEndpoint, traceEndpoint)
+
+withUSB :: Device -> (DeviceHandle -> IO a) -> IO a
+withUSB device action
+  = withDeviceHandle device $
+     \deviceHandle  -> withDetachedKernelDriver deviceHandle 0
+                         $ action deviceHandle
+
+usbReadTimeout :: Int
+usbReadTimeout = 1000
+
+usbWriteTimeout :: Int
+usbWriteTimeout = 100
diff --git a/STM32/STLinkUSB/USBXfer.hs b/STM32/STLinkUSB/USBXfer.hs
new file mode 100644
--- /dev/null
+++ b/STM32/STLinkUSB/USBXfer.hs
@@ -0,0 +1,115 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  STM32.STLinkUSB.USBXfer
+-- Copyright   :  (c) Marc Fontaine 2017
+-- License     :  BSD3
+-- 
+-- Maintainer  :  Marc.Fontaine@gmx.de
+-- Stability   :  experimental
+-- Portability :  GHC-only
+-- This module contains low-level functions for USB data transfers.
+-- Don't use theses functions directly, the prefered API is the MemRW module.
+
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RankNTypes #-}
+module STM32.STLinkUSB.USBXfer
+where
+
+import System.USB
+import Control.Monad.Trans.Reader
+import Control.Monad.IO.Class
+import Control.Concurrent (threadDelay)
+import Control.Exception (catch)
+
+import qualified Data.ByteString as BS
+
+import STM32.STLinkUSB.Commands
+import STM32.STLinkUSB.Env
+import STM32.STLinkUSB.USBUtils
+
+data XferStatus
+  = XferOK
+  | XferRetry
+  | XferDongleError
+  | XferUSBError (Either USBException System.USB.Status)
+  deriving (Show,Eq)
+
+writeBulkSTL :: Cmd -> STL (Size, System.USB.Status)
+writeBulkSTL cmd
+  = ReaderT $ \STLinkEnv {..} -> liftIO 
+    $ writeBulk deviceHandle txEndpoint (cmdToByteString cmd) usbWriteTimeout
+
+readBulkSTL :: STL (BS.ByteString, Either USBException System.USB.Status)
+readBulkSTL = ReaderT $ \STLinkEnv {..} -> do
+  let readAction = do
+        (r,s) <- readBulk deviceHandle rxEndpoint 64 usbReadTimeout
+        return (r,Right s)
+  liftIO $ catch readAction handler
+  where
+    handler e = return  (BS.empty,Left e)
+
+xferStatus :: Cmd -> STL (BS.ByteString, Either USBException System.USB.Status)
+xferStatus cmd = do
+  debugSTL Debug $ show ("xferStatus write :",cmd)
+  writeResult <- writeBulkSTL cmd
+  debugSTL Debug $ show ("xferStatus writeResult :",cmd,writeResult)
+  (retMsg,retStatus) <- readBulkSTL
+  debugSTL Debug $ show ("xferStatus readResult : ",retStatus,BS.unpack retMsg)
+  return (retMsg,retStatus)
+
+xferBulkWrite :: Cmd -> BS.ByteString -> STL ()
+xferBulkWrite cmd block = do
+  writeResult1 <- writeBulkSTL cmd
+  debugSTL Debug $ show ("xferBulkWrite : ",cmd,writeResult1)
+  writeResult2 <- ReaderT $ \STLinkEnv {..} -> do
+      liftIO $ writeBulk deviceHandle txEndpoint block usbWriteTimeout
+  debugSTL Debug $ show ("xferBulkWrite result : ",writeResult2)
+  
+xfer :: Cmd -> STL BS.ByteString
+xfer cmd = do
+  (ret,err) <- xferStatus cmd
+  case err of
+    Right Completed -> return ret
+    Right TimedOut  -> do
+      let msg = "xfer (" ++ show cmd ++ ") : timeout"
+      debugSTL Error msg
+      error msg
+    Left usbExcept -> do
+      let msg = "xfer : USB exception : " ++ show usbExcept
+      debugSTL Error msg
+      error msg
+
+-- todo xferRetry is expected to fail
+-- it should not throw an exception but return an error
+xferRetry :: Cmd -> STL BS.ByteString
+xferRetry cmd = loop 8 10000
+  where
+    exit :: Show x => x -> STL BS.ByteString
+    exit x = do
+       debugSTL Error (show x)
+       error $ show x
+       
+    loop :: Int -> Int -> STL BS.ByteString
+    loop 0 _ = exit ("xferRetry giving up after retry:", cmd)
+    loop n d = do
+       (msg,usbStatus) <- xferStatus cmd
+       case usbStatus of
+          Left err -> exit ("xferRetry usb error ",err) -- todo
+          Right Completed ->  case toStatus $ BS.head msg of
+              SWD_AP_WAIT -> retry
+              SWD_DP_WAIT -> retry
+              DEBUG_ERR_OK -> return msg
+              dongleStatus -> exit ("xferRetry dongle error ",dongleStatus)
+          Right other -> exit ("xferRetry usb error ",other)
+       where
+         retry = do
+           debugSTL Warn ("xferRetry retry after delay ("++ show cmd ++")")
+           liftIO $ threadDelay d
+           loop (n-1) (d*2)
+           
+xferReadTrace :: STL (BS.ByteString, Either USBException System.USB.Status)
+xferReadTrace = do
+  debugSTL Debug $ show "xferReadTrace"
+  (retMsg,retStatus) <- readBulkSTL
+  debugSTL Debug $ show ("xferReadTrace return : ",retStatus,BS.unpack retMsg)
+  return (retMsg,retStatus)
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain