packages feed

fxpak 0.0.1 → 0.1.0

raw patch · 6 files changed

+526/−521 lines, 6 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

- FXPak: AddressGet :: Int -> Int -> AddressGet
- FXPak: AddressSet :: Int -> Int -> AddressSet
- FXPak: ClearX :: Flag
- FXPak: Data64Bytes :: Flag
- FXPak: NoResponse :: Flag
- FXPak: OnlyReset :: Flag
- FXPak: SetX :: Flag
- FXPak: SkipReset :: Flag
- FXPak: StreamBurst :: Flag
- FXPak: [Boot] :: Opcode (Opcode' 'Boot)
- FXPak: [Config] :: Context (Context' 'Config)
- FXPak: [Delete] :: Opcode (Opcode' 'Delete)
- FXPak: [File] :: Context (Context' 'File)
- FXPak: [GetBytes2] :: AddressGet -> AddressGet -> Arguments (Arguments' ('GetBytes2 (a :: (AddressGet, AddressGet))))
- FXPak: [GetBytes3] :: AddressGet -> AddressGet -> AddressGet -> Arguments (Arguments' ('GetBytes3 (a :: (AddressGet, AddressGet, AddressGet))))
- FXPak: [GetBytes4] :: AddressGet -> AddressGet -> AddressGet -> AddressGet -> Arguments (Arguments' ('GetBytes4 (a :: (AddressGet, AddressGet, AddressGet, AddressGet))))
- FXPak: [GetBytes] :: AddressGet -> Arguments (Arguments' ('GetBytes (a :: AddressGet)))
- FXPak: [Get] :: Opcode (Opcode' 'Get)
- FXPak: [Info] :: Opcode (Opcode' 'Info)
- FXPak: [List] :: Opcode (Opcode' 'List)
- FXPak: [MSU] :: Context (Context' 'MSU)
- FXPak: [MenuReset] :: Opcode (Opcode' 'MenuReset)
- FXPak: [Mkdir] :: Opcode (Opcode' 'Mkdir)
- FXPak: [Move] :: Opcode (Opcode' 'Move)
- FXPak: [None] :: Arguments (Arguments' 'None)
- FXPak: [PathContents] :: FilePath -> ByteString -> Arguments (Arguments' ('PathContents (a :: FilePath) (b :: ByteString)))
- FXPak: [PathRename] :: FilePath -> FilePath -> Arguments (Arguments' ('PathRename (a :: FilePath) a))
- FXPak: [Path] :: FilePath -> Arguments (Arguments' ('Path (a :: FilePath)))
- FXPak: [PowerCycle] :: Opcode (Opcode' 'PowerCycle)
- FXPak: [Put] :: Opcode (Opcode' 'Put)
- FXPak: [Reset] :: Opcode (Opcode' 'Reset)
- FXPak: [Response] :: Opcode (Opcode' 'Response)
- FXPak: [SNES] :: Context (Context' 'SNES)
- FXPak: [SetByte2] :: AddressSet -> AddressSet -> Arguments (Arguments' ('SetByte2 (a :: (AddressSet, AddressSet))))
- FXPak: [SetByte3] :: AddressSet -> AddressSet -> AddressSet -> Arguments (Arguments' ('SetByte3 (a :: (AddressSet, AddressSet, AddressSet))))
- FXPak: [SetByte4] :: AddressSet -> AddressSet -> AddressSet -> AddressSet -> Arguments (Arguments' ('SetByte4 (a :: (AddressSet, AddressSet, AddressSet, AddressSet))))
- FXPak: [SetByte] :: AddressSet -> Arguments (Arguments' ('SetByte (a :: AddressSet)))
- FXPak: [Stream] :: Opcode (Opcode' 'Stream)
- FXPak: [Time] :: Opcode (Opcode' 'Time)
- FXPak: [VGet] :: Opcode (Opcode' 'VGet)
- FXPak: [VPut] :: Opcode (Opcode' 'VPut)
- FXPak: [dataLength] :: AddressGet -> Int
- FXPak: [start] :: AddressGet -> Int
- FXPak: [target] :: AddressSet -> Int
- FXPak: [value] :: AddressSet -> Int
- FXPak: data AddressGet
- FXPak: data AddressSet
- FXPak: data Arguments a
- FXPak: data Context c
- FXPak: data Flag
- FXPak: data Opcode o
- FXPak: open :: FilePath -> IO FXPak
- FXPak: packet :: ValidPacket c o a ~ 'True => Context (Context' c) -> Opcode (Opcode' o) -> Flags -> Arguments (Arguments' a) -> Packet
- FXPak: send :: FXPak -> Packet -> IO (Maybe ByteString)
- FXPak: type FXPak = SerialPort
- FXPak: type Flags = Flags
- FXPak: type Packet = Packet
+ System.Hardware.FXPak: AddressGet :: Int -> Int -> AddressGet
+ System.Hardware.FXPak: AddressSet :: Int -> Int -> AddressSet
+ System.Hardware.FXPak: ClearX :: Flag
+ System.Hardware.FXPak: Data64Bytes :: Flag
+ System.Hardware.FXPak: NoResponse :: Flag
+ System.Hardware.FXPak: OnlyReset :: Flag
+ System.Hardware.FXPak: SetX :: Flag
+ System.Hardware.FXPak: SkipReset :: Flag
+ System.Hardware.FXPak: StreamBurst :: Flag
+ System.Hardware.FXPak: [Boot] :: Opcode (Opcode' 'Boot)
+ System.Hardware.FXPak: [Config] :: Context (Context' 'Config)
+ System.Hardware.FXPak: [Delete] :: Opcode (Opcode' 'Delete)
+ System.Hardware.FXPak: [File] :: Context (Context' 'File)
+ System.Hardware.FXPak: [GetBytes2] :: AddressGet -> AddressGet -> Arguments (Arguments' ('GetBytes2 (a :: (AddressGet, AddressGet))))
+ System.Hardware.FXPak: [GetBytes3] :: AddressGet -> AddressGet -> AddressGet -> Arguments (Arguments' ('GetBytes3 (a :: (AddressGet, AddressGet, AddressGet))))
+ System.Hardware.FXPak: [GetBytes4] :: AddressGet -> AddressGet -> AddressGet -> AddressGet -> Arguments (Arguments' ('GetBytes4 (a :: (AddressGet, AddressGet, AddressGet, AddressGet))))
+ System.Hardware.FXPak: [GetBytes] :: AddressGet -> Arguments (Arguments' ('GetBytes (a :: AddressGet)))
+ System.Hardware.FXPak: [Get] :: Opcode (Opcode' 'Get)
+ System.Hardware.FXPak: [Info] :: Opcode (Opcode' 'Info)
+ System.Hardware.FXPak: [List] :: Opcode (Opcode' 'List)
+ System.Hardware.FXPak: [MSU] :: Context (Context' 'MSU)
+ System.Hardware.FXPak: [MenuReset] :: Opcode (Opcode' 'MenuReset)
+ System.Hardware.FXPak: [Mkdir] :: Opcode (Opcode' 'Mkdir)
+ System.Hardware.FXPak: [Move] :: Opcode (Opcode' 'Move)
+ System.Hardware.FXPak: [None] :: Arguments (Arguments' 'None)
+ System.Hardware.FXPak: [PathContents] :: FilePath -> ByteString -> Arguments (Arguments' ('PathContents (a :: FilePath) (b :: ByteString)))
+ System.Hardware.FXPak: [PathRename] :: FilePath -> FilePath -> Arguments (Arguments' ('PathRename (a :: FilePath) a))
+ System.Hardware.FXPak: [Path] :: FilePath -> Arguments (Arguments' ('Path (a :: FilePath)))
+ System.Hardware.FXPak: [PowerCycle] :: Opcode (Opcode' 'PowerCycle)
+ System.Hardware.FXPak: [Put] :: Opcode (Opcode' 'Put)
+ System.Hardware.FXPak: [Reset] :: Opcode (Opcode' 'Reset)
+ System.Hardware.FXPak: [Response] :: Opcode (Opcode' 'Response)
+ System.Hardware.FXPak: [SNES] :: Context (Context' 'SNES)
+ System.Hardware.FXPak: [SetByte2] :: AddressSet -> AddressSet -> Arguments (Arguments' ('SetByte2 (a :: (AddressSet, AddressSet))))
+ System.Hardware.FXPak: [SetByte3] :: AddressSet -> AddressSet -> AddressSet -> Arguments (Arguments' ('SetByte3 (a :: (AddressSet, AddressSet, AddressSet))))
+ System.Hardware.FXPak: [SetByte4] :: AddressSet -> AddressSet -> AddressSet -> AddressSet -> Arguments (Arguments' ('SetByte4 (a :: (AddressSet, AddressSet, AddressSet, AddressSet))))
+ System.Hardware.FXPak: [SetByte] :: AddressSet -> Arguments (Arguments' ('SetByte (a :: AddressSet)))
+ System.Hardware.FXPak: [Stream] :: Opcode (Opcode' 'Stream)
+ System.Hardware.FXPak: [Time] :: Opcode (Opcode' 'Time)
+ System.Hardware.FXPak: [VGet] :: Opcode (Opcode' 'VGet)
+ System.Hardware.FXPak: [VPut] :: Opcode (Opcode' 'VPut)
+ System.Hardware.FXPak: [dataLength] :: AddressGet -> Int
+ System.Hardware.FXPak: [start] :: AddressGet -> Int
+ System.Hardware.FXPak: [target] :: AddressSet -> Int
+ System.Hardware.FXPak: [value] :: AddressSet -> Int
+ System.Hardware.FXPak: data AddressGet
+ System.Hardware.FXPak: data AddressSet
+ System.Hardware.FXPak: data Arguments a
+ System.Hardware.FXPak: data Context c
+ System.Hardware.FXPak: data Flag
+ System.Hardware.FXPak: data Opcode o
+ System.Hardware.FXPak: open :: FilePath -> IO FXPak
+ System.Hardware.FXPak: packet :: ValidPacket c o a ~ 'True => Context (Context' c) -> Opcode (Opcode' o) -> Flags -> Arguments (Arguments' a) -> Packet
+ System.Hardware.FXPak: send :: FXPak -> Packet -> IO (Maybe ByteString)
+ System.Hardware.FXPak: type FXPak = SerialPort
+ System.Hardware.FXPak: type Flags = Flags
+ System.Hardware.FXPak: type Packet = Packet

Files

CHANGELOG.md view
@@ -5,3 +5,8 @@ * Pre-release work uploaded to github   - Able to encode most packet types   - Enforces packet constraints at the type level++## 0.1.0 -- 2021-04-06++* Moved module under System.Hardware+* Bumped version dependencies
fxpak.cabal view
@@ -1,5 +1,5 @@ name:                fxpak-version:             0.0.1+version:             0.1.0 synopsis:            Interface to the FXPak/FXPak Pro USB interface description:         Wraps Serial interaction with FXPak/FXPak Pro devices homepage:            https://github.com/wuest/fxpak@@ -19,9 +19,9 @@   default-language: Haskell2010   hs-source-dirs:   src -  exposed-modules:    FXPak-  other-modules:      FXPak.Internal+  exposed-modules:    System.Hardware.FXPak+  other-modules:      System.Hardware.FXPak.Internal -  build-depends:      base       >= 4.9  && < 4.15+  build-depends:      base       >= 4.9  && < 4.16                     , serialport >= 0.5  && < 0.6                     , bytestring >= 0.11 && < 0.12
− src/FXPak.hs
@@ -1,287 +0,0 @@-{-# language DataKinds         #-}-{-# language GADTs             #-}-{-# language KindSignatures    #-}-{-# language OverloadedStrings #-}-{-# language ViewPatterns      #-}-{- |-Module      :  FXPak-Copyright   :  (c) Christina Wuest 2021-License     :  BSD-style--Maintainer  :  tina@wuest.me-Stability   :  experimental-Portability :  non-portable--Interface to working with the FXPak/FXPak Pro flash cart devices for the-SNES/Super Famicom--}--module FXPak ( FXPak-             , Packet, Opcode(..), Context(..), Arguments(..)-             , FI.AddressGet(..), FI.AddressSet(..)-             , FI.Flag(..), Flags-             , open, packet, send-             ) where--import Prelude--import qualified System.Hardware.Serialport as Serial-import qualified Data.ByteString.Char8 as BS--import Control.Monad.IO.Class ( liftIO )-import Data.Bits ( (.&.), shiftR )-import Data.Char ( chr, ord )--import qualified FXPak.Internal as FI---- | An FXPak device (which is exposed as a serial device)-type FXPak = Serial.SerialPort---- | A packet representing a single complete to send to the FXPak-type Packet = FI.Packet---- | Represents an address to fetch memory from and a length to read-type AddressGet = FI.AddressGet---- | Represents a value and the address to which it should be written-type AddressSet = FI.AddressSet---- | The context in which a packet's command operates-data Context c where-    -- | In the File mode, files can be managed directly, and booted-    File   :: Context (FI.Context' 'FI.File)-    -- | In the SNES context, bytes can be written to and read from memory, and-    -- all system commands (e.g. reset, powercycle, reset to menu, system info,-    -- and stream data) are passed through-    SNES   :: Context (FI.Context' 'FI.SNES)-    MSU    :: Context (FI.Context' 'FI.MSU)-    Config :: Context (FI.Context' 'FI.Config)---- | The Opcode representing the command to perform-data Opcode o where-    -- | Depending on context, either return the contents of a given file, or-    -- read memory-    Get        :: Opcode (FI.Opcode' 'FI.Get)-    -- | Depending on context, either allow the upload of a file, or write bytes-    -- to memory-    Put        :: Opcode (FI.Opcode' 'FI.Put)-    -- | Retrieve from 1-4 regions of memory-    VGet       :: Opcode (FI.Opcode' 'FI.VGet)-    -- | Write from 1-4 bytes to memory-    VPut       :: Opcode (FI.Opcode' 'FI.VPut)-    -- | List files in a given directory-    List       :: Opcode (FI.Opcode' 'FI.List)-    -- | Make a given directory on the FXPak's filesystem-    Mkdir      :: Opcode (FI.Opcode' 'FI.Mkdir)-    -- | Delete a given path on the FXPak's filesystem-    Delete     :: Opcode (FI.Opcode' 'FI.Delete)-    -- | Move a given path on the FXPak's filesystem to a new location-    Move       :: Opcode (FI.Opcode' 'FI.Move)-    -- | Reset the SNES/SFC-    Reset      :: Opcode (FI.Opcode' 'FI.Reset)-    -- | Boot a given file-    Boot       :: Opcode (FI.Opcode' 'FI.Boot)-    -- | Reset the SNES/SFC-    PowerCycle :: Opcode (FI.Opcode' 'FI.PowerCycle)-    -- | Return information about the running FXPak-    Info       :: Opcode (FI.Opcode' 'FI.Info)-    -- | Reset the SNES/SFC, returning to the FXPak's main menu-    MenuReset  :: Opcode (FI.Opcode' 'FI.MenuReset)-    Stream     :: Opcode (FI.Opcode' 'FI.Stream)-    Time       :: Opcode (FI.Opcode' 'FI.Time)-    -- | Indicates a response packet-    Response   :: Opcode (FI.Opcode' 'FI.Response)---- | Arguments indicating the desired action taken by a given operation-data Arguments a where-    -- | No arguments - valid only with the Reset, MenuReset, Info, Stream, and-    -- PowerCycle opcodes-    None         :: Arguments (FI.Arguments' 'FI.None)-    -- | Path to a given object - valid for Get, List, Mkdir, Delete, and Boot-    -- in the File context-    Path         :: FilePath -> Arguments (FI.Arguments' ('FI.Path (a :: FilePath)))-    -- | Path with an accompanying ByteString - valid only for Put in the File-    -- context-    PathContents :: FilePath -> BS.ByteString -> Arguments (FI.Arguments' ('FI.PathContents (a :: FilePath) (b :: BS.ByteString)))-    -- | Source and destination paths - valid only for Move in the File context-    PathRename   :: FilePath -> FilePath -> Arguments (FI.Arguments' ('FI.PathRename (a :: FilePath) a))-    -- | An address and length of data to be read for non-File context Get and-    -- VGet opcodes-    GetBytes     :: AddressGet -> Arguments (FI.Arguments' ('FI.GetBytes (a :: AddressGet)))-    -- | Two address/length pairs to be read for non-File context VGet-    GetBytes2    :: AddressGet -> AddressGet -> Arguments (FI.Arguments' ('FI.GetBytes2 (a :: (AddressGet, AddressGet))))-    -- | Three address/length pairs to be read for non-File context VGet-    GetBytes3    :: AddressGet -> AddressGet -> AddressGet -> Arguments (FI.Arguments' ('FI.GetBytes3 (a :: (AddressGet, AddressGet, AddressGet))))-    -- | Four address/length pairs to be read for non-File context VGet-    GetBytes4    :: AddressGet -> AddressGet -> AddressGet -> AddressGet -> Arguments (FI.Arguments' ('FI.GetBytes4 (a :: (AddressGet, AddressGet, AddressGet, AddressGet))))-    -- | A target address and byte to be written for non-File context Put and-    -- VPut opcodes-    SetByte      :: AddressSet -> Arguments (FI.Arguments' ('FI.SetByte (a :: AddressSet)))-    -- | Two address/data pairs to be written for non-File context VPut-    SetByte2     :: AddressSet -> AddressSet -> Arguments (FI.Arguments' ('FI.SetByte2 (a :: (AddressSet, AddressSet))))-    -- | Three address/data pairs to be written for non-File context VPut-    SetByte3     :: AddressSet -> AddressSet -> AddressSet -> Arguments (FI.Arguments' ('FI.SetByte3 (a :: (AddressSet, AddressSet, AddressSet))))-    -- | Four address/data pairs to be written for non-File context VPut-    SetByte4     :: AddressSet -> AddressSet -> AddressSet -> AddressSet -> Arguments (FI.Arguments' ('FI.SetByte4 (a :: (AddressSet, AddressSet, AddressSet, AddressSet))))---- | List of Flags to be encoded for a given packet-type Flags = FI.Flags---- | Given a Context (wrapping the internal type-safe Context' construct),--- produce the internal construct for the purposes of packet construction-context :: Context (FI.Context' c) -> FI.Context' c-context File   = FI.File'-context SNES   = FI.SNES'-context MSU    = FI.MSU'-context Config = FI.Config'---- | Given an Opcode (wrapping the internal type-safe Opcode' construct),--- produce the internal construct for the purposes of packet construction-opcode :: Opcode (FI.Opcode' o) -> FI.Opcode' o-opcode Get        = FI.Get'-opcode Put        = FI.Put'-opcode VGet       = FI.VGet'-opcode VPut       = FI.VPut'-opcode List       = FI.List'-opcode Mkdir      = FI.Mkdir'-opcode Delete     = FI.Delete'-opcode Move       = FI.Move'-opcode Reset      = FI.Reset'-opcode Boot       = FI.Boot'-opcode PowerCycle = FI.PowerCycle'-opcode Info       = FI.Info'-opcode MenuReset  = FI.MenuReset'-opcode Stream     = FI.Stream'-opcode Time       = FI.Time'-opcode Response   = FI.Response'---- | Given an Arguments datum (wrapping the internal type-safe Arguments'--- construct), -- produce the internal construct for the purposes of packet--- construction-arguments :: Arguments (FI.Arguments' a) -> FI.Arguments' a-arguments None                = FI.None'-arguments (Path a)            = FI.Path' a-arguments (PathContents a b)  = FI.PathContents' a b-arguments (PathRename a b)    = FI.PathRename' a b-arguments (GetBytes a)        = FI.GetBytes' a-arguments (GetBytes2 a b)     = FI.GetBytes2' a b-arguments (GetBytes3 a b c)   = FI.GetBytes3' a b c-arguments (GetBytes4 a b c d) = FI.GetBytes4' a b c d-arguments (SetByte a)         = FI.SetByte' a-arguments (SetByte2 a b)      = FI.SetByte2' a b-arguments (SetByte3 a b c)    = FI.SetByte3' a b c-arguments (SetByte4 a b c d)  = FI.SetByte4' a b c d---- | Open a given serial device as an FXPak-open :: FilePath -> IO FXPak-open = flip Serial.openSerial Serial.defaultSerialSettings---- | Encode a packet to send to an FXPak, preventing encoding of invalid packets-packet :: (FI.ValidPacket c o a ~ 'True) => Context (FI.Context' c) -> Opcode (FI.Opcode' o) -> Flags -> Arguments (FI.Arguments' a) -> Packet-packet (context -> c) (opcode -> o) flags (arguments -> a) = FI.packet c o flags a---- | Sends a given packet to an FXPak device, returning a ByteString if a--- response is expected-send :: FXPak -> Packet -> IO (Maybe BS.ByteString)-send dev dat = do-    _ <- Serial.send dev $ pack dat-    let (FI.Packet _ _ flags _) = dat-    if elem FI.NoResponse flags-        then return Nothing-        else do-            resp <- liftIO $ readSerial 512 dev []-            let resp' = BS.unpack resp in-                if (take 5 resp') /= ['U', 'S', 'B', 'A', '\x0F']-                    then return Nothing-                    else fetch dev $ fmap ord $ drop 255 $ resp'---- | Read a number of bytes from the FXPak designated by a string fro--- a string read from the serial device-fetch :: FXPak -> [Int] -> IO (Maybe BS.ByteString)-fetch _ []         = return Nothing-fetch _ (0:_)      = return Nothing-fetch dev (size:_) = Just <$> readSerial size dev []---- | Convert a Packet to a ByteString ready to be sent to the FXPak device,--- enforcing the appropriate packet size-pack :: Packet -> BS.ByteString-pack (FI.Packet o c f a) =-    let op = chr $ fromEnum o-        ctx = chr $ fromEnum c-        flags = chr $ FI.fromFlags f-    -- "USBA" string is taken from the original usb2snesw application-    in pack' (elem FI.Data64Bytes f) o a ['U', 'S', 'B', 'A', op, ctx, flags]---- | Select the appropriate size pack function given the opcode and flags given-pack' :: Bool -> FI.Opcode -> FI.Arguments -> [Char] -> BS.ByteString-pack' True  _       = pack64-pack' False FI.VPut = pack64-pack' False FI.VGet = pack64-pack' False _       = pack512---- | Given a set of GetBytes/SetByte arguments and packet header, generate a 64--- byte packet--- Note: 64 byte packets can only be generated for the VGet/VPut opcodes, and--- therefore any non-GetBytes/SetByte operations are considered undefined in--- this context-pack64 :: FI.Arguments -> String -> BS.ByteString-pack64 (FI.GetBytes addrGet) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressGet addrGet) ++ (nulls 24)-pack64 (FI.GetBytes2 (addrGet, addrGet2)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressGet addrGet) ++ (fromAddressGet addrGet2) ++ (nulls 16)-pack64 (FI.GetBytes3 (addrGet, addrGet2, addrGet3)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressGet addrGet) ++ (fromAddressGet addrGet2) ++ (fromAddressGet addrGet3) ++ (nulls 8)-pack64 (FI.GetBytes4 (addrGet, addrGet2, addrGet3, addrGet4)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressGet addrGet) ++ (fromAddressGet addrGet2) ++ (fromAddressGet addrGet3) ++ (fromAddressGet addrGet4)-pack64 (FI.SetByte addrSet) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressSet addrSet) ++ (nulls 24)-pack64 (FI.SetByte2 (addrSet, addrSet2)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressSet addrSet) ++ (fromAddressSet addrSet2) ++ (nulls 16)-pack64 (FI.SetByte3 (addrSet, addrSet2, addrSet3)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressSet addrSet) ++ (fromAddressSet addrSet2) ++ (fromAddressSet addrSet3) ++ (nulls 8)-pack64 (FI.SetByte4 (addrSet, addrSet2, addrSet3, addrSet4)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressSet addrSet) ++ (fromAddressSet addrSet2) ++ (fromAddressSet addrSet3) ++ (fromAddressSet addrSet4)-pack64 _ _ = undefined---- | Given a set of arguments and packet header, generate a 512 byte packet--- Note: VGet/VPut-specific arguments (GetBytes2+/SetByte2+) are considered--- undefined in this context, as VGet/VPut must use 64-byte packet-pack512 :: FI.Arguments -> String -> BS.ByteString-pack512 FI.None tmp = BS.pack $ tmp ++ (nulls 505)-pack512 (FI.Path p) tmp =-    let p' = take 255 p-    in BS.pack $ tmp ++ (nulls 249) ++ p' ++ (nulls (256 - (length p')))-pack512 (FI.PathRename s d) tmp =-    let s' = take 255 s-        d' = take 248 d-    in BS.pack $ tmp ++ d' ++ (nulls (249 - (length d'))) ++ s' ++ (nulls (256 - (length s')))-pack512 (FI.GetBytes addrGet) tmp = BS.pack $ tmp ++ (nulls 245) ++ (fromAddressGet addrGet) ++ (nulls 252)-pack512 (FI.SetByte addrSet) tmp = BS.pack $ tmp ++ (nulls 245) ++ (fromAddressSet addrSet) ++ (nulls 252)-pack512 _ _ = undefined---- | Generate an 8 byte string from an AddressGet-fromAddressGet :: AddressGet -> String-fromAddressGet ag =-    let validSize = chr $ (0xFF .&.) $ FI.dataLength ag-        addr = FI.start ag-        addrhi = chr $ 0xFF .&. (shiftR addr 16)-        addrmid = chr $ 0xFF .&. (shiftR addr 8)-        addrlow = chr $ 0xFF .&. addr-    in (nulls 3) ++ [validSize, chr 0x00, addrhi, addrmid, addrlow]---- | Generate an 8 byte string from an AddressSet-fromAddressSet :: AddressSet -> String-fromAddressSet as =-    let addr = FI.target as-        byte = chr $ (0xFF .&.) $ FI.value as-        addrhi = chr $ 0xFF .&. (shiftR 16 addr)-        addrmid = chr $ 0xFF .&. (shiftR 8 addr)-        addrlow = chr $ 0xFF .&. addr-    in (nulls 3) ++ [byte, chr 0x00, addrhi, addrmid, addrlow]---- | Convenience function to generate arbitrary length string of NUL bytes-nulls :: Int -> String-nulls x = take x $ fmap chr $ repeat 0x00---- | Read a given number of bytes from the FXPak-readSerial :: Int -> FXPak -> [BS.ByteString] -> IO BS.ByteString-readSerial size dev bufs =-    let currSize = sum $ fmap BS.length bufs-    in-        if currSize >= size-           then return $ foldl BS.append "" $ reverse bufs-           else do-               dat <- Serial.recv dev $ size - currSize-               readSerial size dev $ dat:bufs
− src/FXPak/Internal.hs
@@ -1,230 +0,0 @@-{-# language DataKinds    #-}-{-# language GADTs        #-}-{-# language TypeFamilies #-}-{-# language ViewPatterns #-}-{- |-Module      :  FXPak.Internal-Copyright   :  (c) Christina Wuest 2021-License     :  BSD-style--Maintainer  :  tina@wuest.me-Stability   :  experimental-Portability :  non-portable--Internals for FXPak - ensures only valid packets can be encoded.--}--module FXPak.Internal where--import Prelude--import qualified Data.ByteString.Char8 as BS--import Data.Bits ( (.|.), shiftL )---- | Flags to be encoded as a 1-byte bit map--- Note: No checking of flag validity is done in the original usb2snesw software--- and as such research into which combinations produce expected results is--- still underway-data Flag = SkipReset | OnlyReset | ClearX | SetX | StreamBurst | NoResponse | Data64Bytes deriving ( Eq, Show, Enum, Bounded )---- | List of Flag data--- Note: Since this will be reduced to a single bit map, flag duplication is not--- considered invalid-type Flags = [Flag]---- | Given a list of Flags, produce the bit map expected by the FXPak-fromFlags :: Flags -> Int-fromFlags = (foldl (.|.) 0) . (fmap $ (shiftL 1) . fromEnum)----- | The context in which a packet's command operates-data Context = File | SNES | MSU | Config deriving ( Eq, Show, Enum, Bounded )-data Context' (c :: Context) where-    -- | File contexts involve manipulation of the FXPak's filesystem, including-    -- booting files directly-    File'   :: Context' 'File-    -- | SNES contexts involve the system's memory, allowing reading and writing-    -- of RAM-    SNES'   :: Context' 'SNES-    MSU'    :: Context' 'MSU-    Config' :: Context' 'Config---- | View Pattern to extract a Context from its wrapping Context'-context :: Context' c -> Context-context File'   = File-context SNES'   = SNES-context MSU'    = MSU-context Config' = Config---- | Represents the operation to be performed by the FXPak-data Opcode = Get | Put | VGet | VPut-            | List | Mkdir | Delete | Move-            | Reset | Boot | PowerCycle | Info | MenuReset | Stream | Time-            | Response-            deriving ( Eq, Show, Enum, Bounded )-data Opcode' (o :: Opcode) where-    -- | Get the contents of a file or target memory-    Get'        :: Opcode' 'Get-    -- | Write a file to the filesystem or a byte to memory-    Put'        :: Opcode' 'Put-    -- | Read and return between 1 and 4 regions of memory-    VGet'       :: Opcode' 'VGet-    -- | Write between 1 and 4 bytes to system memory-    VPut'       :: Opcode' 'VPut-    -- | List files at a given path-    List'       :: Opcode' 'List-    -- | Make a new directory at the given path-    Mkdir'      :: Opcode' 'Mkdir-    -- | Delete a node in the FXPak's filesystem-    Delete'     :: Opcode' 'Delete-    -- | Move a node in the FXPak's filesystem from one location to another-    Move'       :: Opcode' 'Move-    -- | Reset the SNES/SFC-    Reset'      :: Opcode' 'Reset-    -- | Boot a file at the target location-    Boot'       :: Opcode' 'Boot-    -- | Reset the SNES/SFC-    PowerCycle' :: Opcode' 'PowerCycle-    -- | Return information about the running FXPak-    Info'       :: Opcode' 'Info-    -- | Reset the SNES/SFC, returning to the FXPak's main menu-    MenuReset'  :: Opcode' 'MenuReset-    Stream'     :: Opcode' 'Stream-    Time'       :: Opcode' 'Time-    -- | Indicates a response packet-    -- A user should never set this for an outgoing packet.-    Response'   :: Opcode' 'Response---- | View Pattern to extract a Opcode from its wrapping Opcode'-opcode :: Opcode' o -> Opcode-opcode Get'        = Get-opcode Put'        = Put-opcode VGet'       = VGet-opcode VPut'       = VPut-opcode List'       = List-opcode Mkdir'      = Mkdir-opcode Delete'     = Delete-opcode Move'       = Move-opcode Reset'      = Reset-opcode Boot'       = Boot-opcode PowerCycle' = PowerCycle-opcode Info'       = Info-opcode MenuReset'  = MenuReset-opcode Stream'     = Stream-opcode Time'       = Time-opcode Response'   = Response---- | Represents an address to fetch memory from and a length to read-data AddressGet = AddressGet { start      :: Int-                             , dataLength :: Int-                             } deriving ( Show )---- | Represents a value and the address to which it should be written-data AddressSet = AddressSet { target :: Int-                             , value  :: Int-                             } deriving ( Show )---- | Arguments indicating the desired action taken by a given operation-data Arguments = None-               | Path FilePath-               | PathContents FilePath BS.ByteString-               | PathRename FilePath FilePath-               | GetBytes AddressGet-               | GetBytes2 (AddressGet, AddressGet)-               | GetBytes3 (AddressGet, AddressGet, AddressGet)-               | GetBytes4 (AddressGet, AddressGet, AddressGet, AddressGet)-               | SetByte AddressSet-               | SetByte2 (AddressSet, AddressSet)-               | SetByte3 (AddressSet, AddressSet, AddressSet)-               | SetByte4 (AddressSet, AddressSet, AddressSet, AddressSet)-               deriving ( Show )-data Arguments' (a :: Arguments) where-    -- | No arguments - valid only with the Reset, MenuReset, Info, Stream, and-    -- PowerCycle opcodes-    None' :: Arguments' 'None-    -- | Path to a given object - valid for Get, List, Mkdir, Delete, and Boot-    -- in the File context-    Path' :: FilePath -> Arguments' ('Path (a :: FilePath))-    -- | Path with an accompanying ByteString - valid only for Put in the File-    -- context-    PathContents' :: FilePath -> BS.ByteString -> Arguments' ('PathContents (a :: FilePath) (b :: BS.ByteString))-    -- | Source and destination paths - valid only for Move in the File context-    PathRename' :: FilePath -> FilePath -> Arguments' ('PathRename (a :: FilePath) a)-    -- | An address and length of data to be read for non-File context Get and-    -- VGet opcodes-    GetBytes' :: AddressGet -> Arguments' ('GetBytes (a :: AddressGet))-    -- | Two address/length pairs to be read for non-File context VGet-    GetBytes2' :: AddressGet -> AddressGet -> Arguments' ('GetBytes2 (a :: (AddressGet, AddressGet)))-    -- | Three address/length pairs to be read for non-File context VGet-    GetBytes3' :: AddressGet -> AddressGet -> AddressGet -> Arguments' ('GetBytes3 (a :: (AddressGet, AddressGet, AddressGet)))-    -- | Four address/length pairs to be read for non-File context VGet-    GetBytes4' :: AddressGet -> AddressGet -> AddressGet -> AddressGet -> Arguments' ('GetBytes4 (a :: (AddressGet, AddressGet, AddressGet, AddressGet)))-    -- | A target address and byte to be written for non-File context Put and-    -- VPut opcodes-    SetByte' :: AddressSet -> Arguments' ('SetByte (a :: AddressSet))-    -- | Two address/data pairs to be written for non-File context VPut-    SetByte2' :: AddressSet -> AddressSet -> Arguments' ('SetByte2 (a :: (AddressSet, AddressSet)))-    -- | Three address/data pairs to be written for non-File context VPut-    SetByte3' :: AddressSet -> AddressSet -> AddressSet -> Arguments' ('SetByte3 (a :: (AddressSet, AddressSet, AddressSet)))-    -- | Four address/data pairs to be written for non-File context VPut-    SetByte4' :: AddressSet -> AddressSet -> AddressSet -> AddressSet -> Arguments' ('SetByte4 (a :: (AddressSet, AddressSet, AddressSet, AddressSet)))---- | View Pattern to extract an Arguments datum from its wrapping Arguments'-arguments :: Arguments' a -> Arguments-arguments None' = None-arguments (Path' a) = Path a-arguments (PathContents' a b) = PathContents a b-arguments (PathRename' a b) = PathRename a b-arguments (GetBytes' a) = GetBytes a-arguments (GetBytes2' a b) = GetBytes2 (a, b)-arguments (GetBytes3' a b c) = GetBytes3 (a, b, c)-arguments (GetBytes4' a b c d) = GetBytes4 (a, b, c, d)-arguments (SetByte' a) = SetByte a-arguments (SetByte2' a b) = SetByte2 (a, b)-arguments (SetByte3' a b c) = SetByte3 (a, b, c)-arguments (SetByte4' a b c d) = SetByte4 (a, b, c, d)---- | ValidPacket allows a constraint to be added to functions which would create--- Packet data, guaranteeing that they are only able to generate packets--- conforming to the expected specifications of the FXPak-type family ValidPacket (c :: Context) (o :: Opcode) (a :: Arguments) :: Bool where-    ValidPacket 'File 'Get ('Path _) = 'True-    ValidPacket 'File 'Put ('PathContents _ _) = 'True-    ValidPacket 'File 'List ('Path _) = 'True-    ValidPacket 'File 'Mkdir ('Path _) = 'True-    ValidPacket 'File 'Delete ('Path _) = 'True-    ValidPacket 'File 'Move ('PathRename _ _) = 'True-    ValidPacket 'File 'Boot ('Path _) = 'True--    ValidPacket 'File 'Get _ = 'False-    ValidPacket 'File 'Put _ = 'False-    ValidPacket 'File 'VGet _ = 'False-    ValidPacket 'File 'VPut _ = 'False--    ValidPacket _ 'Get ('GetBytes _) = 'True-    ValidPacket _ 'Put ('SetByte _) = 'True-    ValidPacket _ 'VGet ('GetBytes _) = 'True-    ValidPacket _ 'VGet ('GetBytes2 _) = 'True-    ValidPacket _ 'VGet ('GetBytes3 _) = 'True-    ValidPacket _ 'VGet ('GetBytes4 _) = 'True-    ValidPacket _ 'VPut ('SetByte _) = 'True-    ValidPacket _ 'VPut ('SetByte2 _) = 'True-    ValidPacket _ 'VPut ('SetByte3 _) = 'True-    ValidPacket _ 'VPut ('SetByte4 _) = 'True--    ValidPacket _ 'Reset 'None = 'True-    ValidPacket _ 'MenuReset 'None = 'True-    ValidPacket _ 'Info 'None = 'True-    ValidPacket _ 'Stream 'None = 'True-    ValidPacket _ 'PowerCycle 'None = 'True--    ValidPacket _ _ _ = 'False---- | Represents a Packet to be sent to the FXPak-data Packet = Packet Opcode Context Flags Arguments deriving ( Show )---- | Smart Constructor for a Packet, guaranteeing validity via the ValidPacket--- constraint-packet :: (ValidPacket c o a ~ 'True) => (Context' c) -> (Opcode' o) -> Flags -> (Arguments' a) -> Packet-packet (context -> c) (opcode -> o) flags (arguments -> a) = Packet o c flags a
+ src/System/Hardware/FXPak.hs view
@@ -0,0 +1,287 @@+{-# language DataKinds         #-}+{-# language GADTs             #-}+{-# language KindSignatures    #-}+{-# language OverloadedStrings #-}+{-# language ViewPatterns      #-}+{- |+Module      :  System.Hardware.FXPak+Copyright   :  (c) Christina Wuest 2021+License     :  BSD-style++Maintainer  :  tina@wuest.me+Stability   :  experimental+Portability :  non-portable++Interface to working with the FXPak/FXPak Pro flash cart devices for the+SNES/Super Famicom+-}++module System.Hardware.FXPak ( FXPak+                             , Packet, Opcode(..), Context(..), Arguments(..)+                             , FI.AddressGet(..), FI.AddressSet(..)+                             , FI.Flag(..), Flags+                             , open, packet, send+                             ) where++import Prelude++import qualified System.Hardware.Serialport as Serial+import qualified Data.ByteString.Char8 as BS++import Control.Monad.IO.Class ( liftIO )+import Data.Bits ( (.&.), shiftR )+import Data.Char ( chr, ord )++import qualified System.Hardware.FXPak.Internal as FI++-- | An FXPak device (which is exposed as a serial device)+type FXPak = Serial.SerialPort++-- | A packet representing a single complete to send to the FXPak+type Packet = FI.Packet++-- | Represents an address to fetch memory from and a length to read+type AddressGet = FI.AddressGet++-- | Represents a value and the address to which it should be written+type AddressSet = FI.AddressSet++-- | The context in which a packet's command operates+data Context c where+    -- | In the File mode, files can be managed directly, and booted+    File   :: Context (FI.Context' 'FI.File)+    -- | In the SNES context, bytes can be written to and read from memory, and+    -- all system commands (e.g. reset, powercycle, reset to menu, system info,+    -- and stream data) are passed through+    SNES   :: Context (FI.Context' 'FI.SNES)+    MSU    :: Context (FI.Context' 'FI.MSU)+    Config :: Context (FI.Context' 'FI.Config)++-- | The Opcode representing the command to perform+data Opcode o where+    -- | Depending on context, either return the contents of a given file, or+    -- read memory+    Get        :: Opcode (FI.Opcode' 'FI.Get)+    -- | Depending on context, either allow the upload of a file, or write bytes+    -- to memory+    Put        :: Opcode (FI.Opcode' 'FI.Put)+    -- | Retrieve from 1-4 regions of memory+    VGet       :: Opcode (FI.Opcode' 'FI.VGet)+    -- | Write from 1-4 bytes to memory+    VPut       :: Opcode (FI.Opcode' 'FI.VPut)+    -- | List files in a given directory+    List       :: Opcode (FI.Opcode' 'FI.List)+    -- | Make a given directory on the FXPak's filesystem+    Mkdir      :: Opcode (FI.Opcode' 'FI.Mkdir)+    -- | Delete a given path on the FXPak's filesystem+    Delete     :: Opcode (FI.Opcode' 'FI.Delete)+    -- | Move a given path on the FXPak's filesystem to a new location+    Move       :: Opcode (FI.Opcode' 'FI.Move)+    -- | Reset the SNES/SFC+    Reset      :: Opcode (FI.Opcode' 'FI.Reset)+    -- | Boot a given file+    Boot       :: Opcode (FI.Opcode' 'FI.Boot)+    -- | Reset the SNES/SFC+    PowerCycle :: Opcode (FI.Opcode' 'FI.PowerCycle)+    -- | Return information about the running FXPak+    Info       :: Opcode (FI.Opcode' 'FI.Info)+    -- | Reset the SNES/SFC, returning to the FXPak's main menu+    MenuReset  :: Opcode (FI.Opcode' 'FI.MenuReset)+    Stream     :: Opcode (FI.Opcode' 'FI.Stream)+    Time       :: Opcode (FI.Opcode' 'FI.Time)+    -- | Indicates a response packet+    Response   :: Opcode (FI.Opcode' 'FI.Response)++-- | Arguments indicating the desired action taken by a given operation+data Arguments a where+    -- | No arguments - valid only with the Reset, MenuReset, Info, Stream, and+    -- PowerCycle opcodes+    None         :: Arguments (FI.Arguments' 'FI.None)+    -- | Path to a given object - valid for Get, List, Mkdir, Delete, and Boot+    -- in the File context+    Path         :: FilePath -> Arguments (FI.Arguments' ('FI.Path (a :: FilePath)))+    -- | Path with an accompanying ByteString - valid only for Put in the File+    -- context+    PathContents :: FilePath -> BS.ByteString -> Arguments (FI.Arguments' ('FI.PathContents (a :: FilePath) (b :: BS.ByteString)))+    -- | Source and destination paths - valid only for Move in the File context+    PathRename   :: FilePath -> FilePath -> Arguments (FI.Arguments' ('FI.PathRename (a :: FilePath) a))+    -- | An address and length of data to be read for non-File context Get and+    -- VGet opcodes+    GetBytes     :: AddressGet -> Arguments (FI.Arguments' ('FI.GetBytes (a :: AddressGet)))+    -- | Two address/length pairs to be read for non-File context VGet+    GetBytes2    :: AddressGet -> AddressGet -> Arguments (FI.Arguments' ('FI.GetBytes2 (a :: (AddressGet, AddressGet))))+    -- | Three address/length pairs to be read for non-File context VGet+    GetBytes3    :: AddressGet -> AddressGet -> AddressGet -> Arguments (FI.Arguments' ('FI.GetBytes3 (a :: (AddressGet, AddressGet, AddressGet))))+    -- | Four address/length pairs to be read for non-File context VGet+    GetBytes4    :: AddressGet -> AddressGet -> AddressGet -> AddressGet -> Arguments (FI.Arguments' ('FI.GetBytes4 (a :: (AddressGet, AddressGet, AddressGet, AddressGet))))+    -- | A target address and byte to be written for non-File context Put and+    -- VPut opcodes+    SetByte      :: AddressSet -> Arguments (FI.Arguments' ('FI.SetByte (a :: AddressSet)))+    -- | Two address/data pairs to be written for non-File context VPut+    SetByte2     :: AddressSet -> AddressSet -> Arguments (FI.Arguments' ('FI.SetByte2 (a :: (AddressSet, AddressSet))))+    -- | Three address/data pairs to be written for non-File context VPut+    SetByte3     :: AddressSet -> AddressSet -> AddressSet -> Arguments (FI.Arguments' ('FI.SetByte3 (a :: (AddressSet, AddressSet, AddressSet))))+    -- | Four address/data pairs to be written for non-File context VPut+    SetByte4     :: AddressSet -> AddressSet -> AddressSet -> AddressSet -> Arguments (FI.Arguments' ('FI.SetByte4 (a :: (AddressSet, AddressSet, AddressSet, AddressSet))))++-- | List of Flags to be encoded for a given packet+type Flags = FI.Flags++-- | Given a Context (wrapping the internal type-safe Context' construct),+-- produce the internal construct for the purposes of packet construction+context :: Context (FI.Context' c) -> FI.Context' c+context File   = FI.File'+context SNES   = FI.SNES'+context MSU    = FI.MSU'+context Config = FI.Config'++-- | Given an Opcode (wrapping the internal type-safe Opcode' construct),+-- produce the internal construct for the purposes of packet construction+opcode :: Opcode (FI.Opcode' o) -> FI.Opcode' o+opcode Get        = FI.Get'+opcode Put        = FI.Put'+opcode VGet       = FI.VGet'+opcode VPut       = FI.VPut'+opcode List       = FI.List'+opcode Mkdir      = FI.Mkdir'+opcode Delete     = FI.Delete'+opcode Move       = FI.Move'+opcode Reset      = FI.Reset'+opcode Boot       = FI.Boot'+opcode PowerCycle = FI.PowerCycle'+opcode Info       = FI.Info'+opcode MenuReset  = FI.MenuReset'+opcode Stream     = FI.Stream'+opcode Time       = FI.Time'+opcode Response   = FI.Response'++-- | Given an Arguments datum (wrapping the internal type-safe Arguments'+-- construct), -- produce the internal construct for the purposes of packet+-- construction+arguments :: Arguments (FI.Arguments' a) -> FI.Arguments' a+arguments None                = FI.None'+arguments (Path a)            = FI.Path' a+arguments (PathContents a b)  = FI.PathContents' a b+arguments (PathRename a b)    = FI.PathRename' a b+arguments (GetBytes a)        = FI.GetBytes' a+arguments (GetBytes2 a b)     = FI.GetBytes2' a b+arguments (GetBytes3 a b c)   = FI.GetBytes3' a b c+arguments (GetBytes4 a b c d) = FI.GetBytes4' a b c d+arguments (SetByte a)         = FI.SetByte' a+arguments (SetByte2 a b)      = FI.SetByte2' a b+arguments (SetByte3 a b c)    = FI.SetByte3' a b c+arguments (SetByte4 a b c d)  = FI.SetByte4' a b c d++-- | Open a given serial device as an FXPak+open :: FilePath -> IO FXPak+open = flip Serial.openSerial Serial.defaultSerialSettings++-- | Encode a packet to send to an FXPak, preventing encoding of invalid packets+packet :: (FI.ValidPacket c o a ~ 'True) => Context (FI.Context' c) -> Opcode (FI.Opcode' o) -> Flags -> Arguments (FI.Arguments' a) -> Packet+packet (context -> c) (opcode -> o) flags (arguments -> a) = FI.packet c o flags a++-- | Sends a given packet to an FXPak device, returning a ByteString if a+-- response is expected+send :: FXPak -> Packet -> IO (Maybe BS.ByteString)+send dev dat = do+    _ <- Serial.send dev $ pack dat+    let (FI.Packet _ _ flags _) = dat+    if elem FI.NoResponse flags+        then return Nothing+        else do+            resp <- liftIO $ readSerial 512 dev []+            let resp' = BS.unpack resp in+                if (take 5 resp') /= ['U', 'S', 'B', 'A', '\x0F']+                    then return Nothing+                    else fetch dev $ fmap ord $ drop 255 $ resp'++-- | Read a number of bytes from the FXPak designated by a string fro+-- a string read from the serial device+fetch :: FXPak -> [Int] -> IO (Maybe BS.ByteString)+fetch _ []         = return Nothing+fetch _ (0:_)      = return Nothing+fetch dev (size:_) = Just <$> readSerial size dev []++-- | Convert a Packet to a ByteString ready to be sent to the FXPak device,+-- enforcing the appropriate packet size+pack :: Packet -> BS.ByteString+pack (FI.Packet o c f a) =+    let op = chr $ fromEnum o+        ctx = chr $ fromEnum c+        flags = chr $ FI.fromFlags f+    -- "USBA" string is taken from the original usb2snesw application+    in pack' (elem FI.Data64Bytes f) o a ['U', 'S', 'B', 'A', op, ctx, flags]++-- | Select the appropriate size pack function given the opcode and flags given+pack' :: Bool -> FI.Opcode -> FI.Arguments -> [Char] -> BS.ByteString+pack' True  _       = pack64+pack' False FI.VPut = pack64+pack' False FI.VGet = pack64+pack' False _       = pack512++-- | Given a set of GetBytes/SetByte arguments and packet header, generate a 64+-- byte packet+-- Note: 64 byte packets can only be generated for the VGet/VPut opcodes, and+-- therefore any non-GetBytes/SetByte operations are considered undefined in+-- this context+pack64 :: FI.Arguments -> String -> BS.ByteString+pack64 (FI.GetBytes addrGet) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressGet addrGet) ++ (nulls 24)+pack64 (FI.GetBytes2 (addrGet, addrGet2)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressGet addrGet) ++ (fromAddressGet addrGet2) ++ (nulls 16)+pack64 (FI.GetBytes3 (addrGet, addrGet2, addrGet3)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressGet addrGet) ++ (fromAddressGet addrGet2) ++ (fromAddressGet addrGet3) ++ (nulls 8)+pack64 (FI.GetBytes4 (addrGet, addrGet2, addrGet3, addrGet4)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressGet addrGet) ++ (fromAddressGet addrGet2) ++ (fromAddressGet addrGet3) ++ (fromAddressGet addrGet4)+pack64 (FI.SetByte addrSet) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressSet addrSet) ++ (nulls 24)+pack64 (FI.SetByte2 (addrSet, addrSet2)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressSet addrSet) ++ (fromAddressSet addrSet2) ++ (nulls 16)+pack64 (FI.SetByte3 (addrSet, addrSet2, addrSet3)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressSet addrSet) ++ (fromAddressSet addrSet2) ++ (fromAddressSet addrSet3) ++ (nulls 8)+pack64 (FI.SetByte4 (addrSet, addrSet2, addrSet3, addrSet4)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressSet addrSet) ++ (fromAddressSet addrSet2) ++ (fromAddressSet addrSet3) ++ (fromAddressSet addrSet4)+pack64 _ _ = undefined++-- | Given a set of arguments and packet header, generate a 512 byte packet+-- Note: VGet/VPut-specific arguments (GetBytes2+/SetByte2+) are considered+-- undefined in this context, as VGet/VPut must use 64-byte packet+pack512 :: FI.Arguments -> String -> BS.ByteString+pack512 FI.None tmp = BS.pack $ tmp ++ (nulls 505)+pack512 (FI.Path p) tmp =+    let p' = take 255 p+    in BS.pack $ tmp ++ (nulls 249) ++ p' ++ (nulls (256 - (length p')))+pack512 (FI.PathRename s d) tmp =+    let s' = take 255 s+        d' = take 248 d+    in BS.pack $ tmp ++ d' ++ (nulls (249 - (length d'))) ++ s' ++ (nulls (256 - (length s')))+pack512 (FI.GetBytes addrGet) tmp = BS.pack $ tmp ++ (nulls 245) ++ (fromAddressGet addrGet) ++ (nulls 252)+pack512 (FI.SetByte addrSet) tmp = BS.pack $ tmp ++ (nulls 245) ++ (fromAddressSet addrSet) ++ (nulls 252)+pack512 _ _ = undefined++-- | Generate an 8 byte string from an AddressGet+fromAddressGet :: AddressGet -> String+fromAddressGet ag =+    let validSize = chr $ (0xFF .&.) $ FI.dataLength ag+        addr = FI.start ag+        addrhi = chr $ 0xFF .&. (shiftR addr 16)+        addrmid = chr $ 0xFF .&. (shiftR addr 8)+        addrlow = chr $ 0xFF .&. addr+    in (nulls 3) ++ [validSize, chr 0x00, addrhi, addrmid, addrlow]++-- | Generate an 8 byte string from an AddressSet+fromAddressSet :: AddressSet -> String+fromAddressSet as =+    let addr = FI.target as+        byte = chr $ (0xFF .&.) $ FI.value as+        addrhi = chr $ 0xFF .&. (shiftR 16 addr)+        addrmid = chr $ 0xFF .&. (shiftR 8 addr)+        addrlow = chr $ 0xFF .&. addr+    in (nulls 3) ++ [byte, chr 0x00, addrhi, addrmid, addrlow]++-- | Convenience function to generate arbitrary length string of NUL bytes+nulls :: Int -> String+nulls x = take x $ fmap chr $ repeat 0x00++-- | Read a given number of bytes from the FXPak+readSerial :: Int -> FXPak -> [BS.ByteString] -> IO BS.ByteString+readSerial size dev bufs =+    let currSize = sum $ fmap BS.length bufs+    in+        if currSize >= size+           then return $ foldl BS.append "" $ reverse bufs+           else do+               dat <- Serial.recv dev $ size - currSize+               readSerial size dev $ dat:bufs
+ src/System/Hardware/FXPak/Internal.hs view
@@ -0,0 +1,230 @@+{-# language DataKinds    #-}+{-# language GADTs        #-}+{-# language TypeFamilies #-}+{-# language ViewPatterns #-}+{- |+Module      :  System.Hardware.FXPak.Internal+Copyright   :  (c) Christina Wuest 2021+License     :  BSD-style++Maintainer  :  tina@wuest.me+Stability   :  experimental+Portability :  non-portable++Internals for FXPak - ensures only valid packets can be encoded.+-}++module System.Hardware.FXPak.Internal where++import Prelude++import qualified Data.ByteString.Char8 as BS++import Data.Bits ( (.|.), shiftL )++-- | Flags to be encoded as a 1-byte bit map+-- Note: No checking of flag validity is done in the original usb2snesw software+-- and as such research into which combinations produce expected results is+-- still underway+data Flag = SkipReset | OnlyReset | ClearX | SetX | StreamBurst | NoResponse | Data64Bytes deriving ( Eq, Show, Enum, Bounded )++-- | List of Flag data+-- Note: Since this will be reduced to a single bit map, flag duplication is not+-- considered invalid+type Flags = [Flag]++-- | Given a list of Flags, produce the bit map expected by the FXPak+fromFlags :: Flags -> Int+fromFlags = (foldl (.|.) 0) . (fmap $ (shiftL 1) . fromEnum)+++-- | The context in which a packet's command operates+data Context = File | SNES | MSU | Config deriving ( Eq, Show, Enum, Bounded )+data Context' (c :: Context) where+    -- | File contexts involve manipulation of the FXPak's filesystem, including+    -- booting files directly+    File'   :: Context' 'File+    -- | SNES contexts involve the system's memory, allowing reading and writing+    -- of RAM+    SNES'   :: Context' 'SNES+    MSU'    :: Context' 'MSU+    Config' :: Context' 'Config++-- | View Pattern to extract a Context from its wrapping Context'+context :: Context' c -> Context+context File'   = File+context SNES'   = SNES+context MSU'    = MSU+context Config' = Config++-- | Represents the operation to be performed by the FXPak+data Opcode = Get | Put | VGet | VPut+            | List | Mkdir | Delete | Move+            | Reset | Boot | PowerCycle | Info | MenuReset | Stream | Time+            | Response+            deriving ( Eq, Show, Enum, Bounded )+data Opcode' (o :: Opcode) where+    -- | Get the contents of a file or target memory+    Get'        :: Opcode' 'Get+    -- | Write a file to the filesystem or a byte to memory+    Put'        :: Opcode' 'Put+    -- | Read and return between 1 and 4 regions of memory+    VGet'       :: Opcode' 'VGet+    -- | Write between 1 and 4 bytes to system memory+    VPut'       :: Opcode' 'VPut+    -- | List files at a given path+    List'       :: Opcode' 'List+    -- | Make a new directory at the given path+    Mkdir'      :: Opcode' 'Mkdir+    -- | Delete a node in the FXPak's filesystem+    Delete'     :: Opcode' 'Delete+    -- | Move a node in the FXPak's filesystem from one location to another+    Move'       :: Opcode' 'Move+    -- | Reset the SNES/SFC+    Reset'      :: Opcode' 'Reset+    -- | Boot a file at the target location+    Boot'       :: Opcode' 'Boot+    -- | Reset the SNES/SFC+    PowerCycle' :: Opcode' 'PowerCycle+    -- | Return information about the running FXPak+    Info'       :: Opcode' 'Info+    -- | Reset the SNES/SFC, returning to the FXPak's main menu+    MenuReset'  :: Opcode' 'MenuReset+    Stream'     :: Opcode' 'Stream+    Time'       :: Opcode' 'Time+    -- | Indicates a response packet+    -- A user should never set this for an outgoing packet.+    Response'   :: Opcode' 'Response++-- | View Pattern to extract a Opcode from its wrapping Opcode'+opcode :: Opcode' o -> Opcode+opcode Get'        = Get+opcode Put'        = Put+opcode VGet'       = VGet+opcode VPut'       = VPut+opcode List'       = List+opcode Mkdir'      = Mkdir+opcode Delete'     = Delete+opcode Move'       = Move+opcode Reset'      = Reset+opcode Boot'       = Boot+opcode PowerCycle' = PowerCycle+opcode Info'       = Info+opcode MenuReset'  = MenuReset+opcode Stream'     = Stream+opcode Time'       = Time+opcode Response'   = Response++-- | Represents an address to fetch memory from and a length to read+data AddressGet = AddressGet { start      :: Int+                             , dataLength :: Int+                             } deriving ( Show )++-- | Represents a value and the address to which it should be written+data AddressSet = AddressSet { target :: Int+                             , value  :: Int+                             } deriving ( Show )++-- | Arguments indicating the desired action taken by a given operation+data Arguments = None+               | Path FilePath+               | PathContents FilePath BS.ByteString+               | PathRename FilePath FilePath+               | GetBytes AddressGet+               | GetBytes2 (AddressGet, AddressGet)+               | GetBytes3 (AddressGet, AddressGet, AddressGet)+               | GetBytes4 (AddressGet, AddressGet, AddressGet, AddressGet)+               | SetByte AddressSet+               | SetByte2 (AddressSet, AddressSet)+               | SetByte3 (AddressSet, AddressSet, AddressSet)+               | SetByte4 (AddressSet, AddressSet, AddressSet, AddressSet)+               deriving ( Show )+data Arguments' (a :: Arguments) where+    -- | No arguments - valid only with the Reset, MenuReset, Info, Stream, and+    -- PowerCycle opcodes+    None' :: Arguments' 'None+    -- | Path to a given object - valid for Get, List, Mkdir, Delete, and Boot+    -- in the File context+    Path' :: FilePath -> Arguments' ('Path (a :: FilePath))+    -- | Path with an accompanying ByteString - valid only for Put in the File+    -- context+    PathContents' :: FilePath -> BS.ByteString -> Arguments' ('PathContents (a :: FilePath) (b :: BS.ByteString))+    -- | Source and destination paths - valid only for Move in the File context+    PathRename' :: FilePath -> FilePath -> Arguments' ('PathRename (a :: FilePath) a)+    -- | An address and length of data to be read for non-File context Get and+    -- VGet opcodes+    GetBytes' :: AddressGet -> Arguments' ('GetBytes (a :: AddressGet))+    -- | Two address/length pairs to be read for non-File context VGet+    GetBytes2' :: AddressGet -> AddressGet -> Arguments' ('GetBytes2 (a :: (AddressGet, AddressGet)))+    -- | Three address/length pairs to be read for non-File context VGet+    GetBytes3' :: AddressGet -> AddressGet -> AddressGet -> Arguments' ('GetBytes3 (a :: (AddressGet, AddressGet, AddressGet)))+    -- | Four address/length pairs to be read for non-File context VGet+    GetBytes4' :: AddressGet -> AddressGet -> AddressGet -> AddressGet -> Arguments' ('GetBytes4 (a :: (AddressGet, AddressGet, AddressGet, AddressGet)))+    -- | A target address and byte to be written for non-File context Put and+    -- VPut opcodes+    SetByte' :: AddressSet -> Arguments' ('SetByte (a :: AddressSet))+    -- | Two address/data pairs to be written for non-File context VPut+    SetByte2' :: AddressSet -> AddressSet -> Arguments' ('SetByte2 (a :: (AddressSet, AddressSet)))+    -- | Three address/data pairs to be written for non-File context VPut+    SetByte3' :: AddressSet -> AddressSet -> AddressSet -> Arguments' ('SetByte3 (a :: (AddressSet, AddressSet, AddressSet)))+    -- | Four address/data pairs to be written for non-File context VPut+    SetByte4' :: AddressSet -> AddressSet -> AddressSet -> AddressSet -> Arguments' ('SetByte4 (a :: (AddressSet, AddressSet, AddressSet, AddressSet)))++-- | View Pattern to extract an Arguments datum from its wrapping Arguments'+arguments :: Arguments' a -> Arguments+arguments None' = None+arguments (Path' a) = Path a+arguments (PathContents' a b) = PathContents a b+arguments (PathRename' a b) = PathRename a b+arguments (GetBytes' a) = GetBytes a+arguments (GetBytes2' a b) = GetBytes2 (a, b)+arguments (GetBytes3' a b c) = GetBytes3 (a, b, c)+arguments (GetBytes4' a b c d) = GetBytes4 (a, b, c, d)+arguments (SetByte' a) = SetByte a+arguments (SetByte2' a b) = SetByte2 (a, b)+arguments (SetByte3' a b c) = SetByte3 (a, b, c)+arguments (SetByte4' a b c d) = SetByte4 (a, b, c, d)++-- | ValidPacket allows a constraint to be added to functions which would create+-- Packet data, guaranteeing that they are only able to generate packets+-- conforming to the expected specifications of the FXPak+type family ValidPacket (c :: Context) (o :: Opcode) (a :: Arguments) :: Bool where+    ValidPacket 'File 'Get ('Path _) = 'True+    ValidPacket 'File 'Put ('PathContents _ _) = 'True+    ValidPacket 'File 'List ('Path _) = 'True+    ValidPacket 'File 'Mkdir ('Path _) = 'True+    ValidPacket 'File 'Delete ('Path _) = 'True+    ValidPacket 'File 'Move ('PathRename _ _) = 'True+    ValidPacket 'File 'Boot ('Path _) = 'True++    ValidPacket 'File 'Get _ = 'False+    ValidPacket 'File 'Put _ = 'False+    ValidPacket 'File 'VGet _ = 'False+    ValidPacket 'File 'VPut _ = 'False++    ValidPacket _ 'Get ('GetBytes _) = 'True+    ValidPacket _ 'Put ('SetByte _) = 'True+    ValidPacket _ 'VGet ('GetBytes _) = 'True+    ValidPacket _ 'VGet ('GetBytes2 _) = 'True+    ValidPacket _ 'VGet ('GetBytes3 _) = 'True+    ValidPacket _ 'VGet ('GetBytes4 _) = 'True+    ValidPacket _ 'VPut ('SetByte _) = 'True+    ValidPacket _ 'VPut ('SetByte2 _) = 'True+    ValidPacket _ 'VPut ('SetByte3 _) = 'True+    ValidPacket _ 'VPut ('SetByte4 _) = 'True++    ValidPacket _ 'Reset 'None = 'True+    ValidPacket _ 'MenuReset 'None = 'True+    ValidPacket _ 'Info 'None = 'True+    ValidPacket _ 'Stream 'None = 'True+    ValidPacket _ 'PowerCycle 'None = 'True++    ValidPacket _ _ _ = 'False++-- | Represents a Packet to be sent to the FXPak+data Packet = Packet Opcode Context Flags Arguments deriving ( Show )++-- | Smart Constructor for a Packet, guaranteeing validity via the ValidPacket+-- constraint+packet :: (ValidPacket c o a ~ 'True) => (Context' c) -> (Opcode' o) -> Flags -> (Arguments' a) -> Packet+packet (context -> c) (opcode -> o) flags (arguments -> a) = Packet o c flags a