basic CMD interpreter and structure

app/Main.hs

@@ -1,8 +1,13 @@
 module Main (main) where
 
-import qualified Audiocate (start)
+import Audiocate (run, Command(..), CommandReturnCode (..))
 
 main :: IO ()
 main = do
-  Audiocate.start
+  rc <- run (Encode "hello123" 5 "test/corpus/sample1.wav" "test/output/sample1_cmd.wav")
+  if rc == CmdSuccess then do
+    rc2 <- run (Decode "hello123" 5 "test/output/sample1_cmd.wav")
+    print rc2
+  else
+    print rc
 

audiocate.cabal

@@ -46,6 +46,9 @@ library
       , Stego.Encode.Encoder
       , Stego.Decode.LSB
       , Stego.Decode.Decoder
+      , Command.Cmd
+      , Command.DecodeCmd
+      , Command.EncodeCmd
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:

lib/Audiocate.hs

@@ -1,130 +1,10 @@
-module Audiocate (start) where
+module Audiocate (
+ run,
+ Command(..),
+ CommandReturnCode(..),
+ ) where
 
-import Control.Concurrent (forkIO)
-import Control.Concurrent.STM (atomically, newEmptyTMVarIO, putTMVar, readTChan, takeTMVar)
-import Control.Monad (void)
-import Control.Monad.Except (runExceptT)
-import Data.Audio.Wave (WaveAudio (..), waveAudioFromFile, waveAudioToFile, Frames)
-import Data.Text qualified as T
-import Data.Text.Encoding (encodeUtf8)
-import Data.Time.Clock (getCurrentTime, diffUTCTime)
-import Stego.Common (EncodingType (LsbEncoding), StegoParams (StegoParams))
-import Stego.Decode.Decoder qualified as DC
-import Stego.Encode.Encoder (EncoderResult (..), enqueueFrame, getResultChannel, newEncoder, stopEncoder)
-import Data.List (sort)
-import Stego.Decode.Decoder (DecoderResultList)
+import Command.Cmd (interpretCmd, Command(..), CommandReturnCode(..))
 
-doEncodeFrames :: StegoParams -> Frames -> IO DecoderResultList
-doEncodeFrames stegoParams frames = do
-  encoder <- newEncoder stegoParams
-  resC <- getResultChannel encoder
-  printChan <- getResultChannel encoder
-  decoder <- DC.newDecoder stegoParams
-  void $ DC.mapDecoderOpQToResultChan decoder resC
-  resD <- DC.getResultChannel decoder
-  x <- newEmptyTMVarIO
-  void $ forkIO $ loopDc resD [] (length frames) x
-  void $ forkIO $ printLoop printChan 0 (length frames)
-
-  mapM_ (enqueueFrame encoder) frames
-  t <- stopEncoder encoder
-  void $ atomically $ takeTMVar t
-  atomically $ takeTMVar x
- where
-  loopDc resD fs total t = do
-    res <- atomically $ readTChan resD
-    case res of
-      DC.StoppingDecoder -> do
-        void $ atomically $ putTMVar t fs
-      f -> do
-        loopDc resD (f : fs) total t
-  printLoop c fs totalFs = do
-    res <- atomically $ readTChan c
-    case res of
-      StoppingEncoder -> do 
-        pure ()
-      _ -> do
-        printLoop c (fs + 1) totalFs
-
-doDecodeWaveAudio :: StegoParams -> WaveAudio -> IO DC.DecoderResultList
-doDecodeWaveAudio stegoParams waveAudio = do
-  decoder <- DC.newDecoder stegoParams
-  resD <- DC.getResultChannel decoder
-  m <- newEmptyTMVarIO
-  void $ forkIO $ decodeLoop resD [] m
-  let frames = audioFrames waveAudio
-  mapM_ (DC.enqueueFrame decoder) frames
-  _ <- DC.stopDecoder decoder
-  atomically $ takeTMVar m
- where
-  decodeLoop channel fs resultVar = do
-    res <- atomically $ readTChan channel
-    case res of
-      DC.StoppingDecoder -> do
-        atomically $ putTMVar resultVar (sort fs)
-        pure ()
-      f -> do
-        decodeLoop channel (f : fs) resultVar
-
-start :: IO ()
-start = do
-  let inputFile = "test/corpus/sample2.wav"
-  let outputFile = "test/output/sample2_out.wav"
-  let secret = encodeUtf8 (T.pack "Sef7Kp%IU{T&In-=t'up/V2NwiY7,4Ds")
-  let stegoParams = StegoParams secret 5 6 LsbEncoding 123
-  doEncodeFile stegoParams inputFile outputFile
-  doDecodeFile stegoParams outputFile
-
-doDecodeFile :: StegoParams -> FilePath -> IO ()
-doDecodeFile stegoParams inputFile = do
-  startTime <- getCurrentTime
-  putStrLn $ "Reading audio file " ++ inputFile ++ "..." 
-  audio <- runExceptT (waveAudioFromFile inputFile)
-  case audio of
-    Left err -> putStrLn err
-    Right wa -> do
-      readTime <- getCurrentTime
-      putStrLn $ "Read file in " <> show (diffUTCTime readTime startTime)
-      putStrLn ""
-      print wa
-      result <- doDecodeWaveAudio stegoParams wa
-      putStrLn "\nDecode Result "
-      print $ DC.getResultStats result
-      endTime <- getCurrentTime
-      putStrLn $ "Completed decode in " <> show (diffUTCTime endTime startTime)
-
-doEncodeFile :: StegoParams -> FilePath -> FilePath -> IO ()
-doEncodeFile stegoParams inputFile outputFile = do
-  startTime <- getCurrentTime
-  putStrLn $ "Reading audio file " ++ inputFile ++ "..." 
-  audio <- runExceptT (waveAudioFromFile inputFile)
-  case audio of
-    Left err -> putStrLn err
-    Right wa -> do
-      readTime <- getCurrentTime
-      putStrLn $ "Read file in " <> show (diffUTCTime readTime startTime)
-      putStrLn ""
-      print wa
-      let frames = audioFrames wa
-      result <- doEncodeFrames stegoParams (take (length frames `div` 2) frames)
-      result2 <- doEncodeFrames stegoParams (drop (length frames `div` 2) frames)
-      putStrLn "\nEncode Result "
-      putStrLn $ "\nTotal Frames in file: " ++ show (length $ audioFrames wa)
-      let combined = result ++ result2
-      print $ DC.getResultStats combined
-      putStrLn $ "Writing encoded file " ++ outputFile ++ "..."
-      let wa' =
-            WaveAudio
-              { srcFile = outputFile
-              , bitSize = 16
-              , rate = rate wa
-              , channels = channels wa
-              , audioFrames = []
-              , samples = concatMap snd (sort $ DC.getResultFrames combined)
-              }
-      write <- runExceptT (waveAudioToFile outputFile wa')
-      case write of
-        Left err -> putStrLn err
-        Right _ -> do
-          endTime <- getCurrentTime
-          putStrLn $ "Completed encode in " <> show (diffUTCTime endTime startTime)
+run :: Command -> IO CommandReturnCode
+run = interpretCmd

lib/Command/Cmd.hs

@@ -0,0 +1,44 @@
+module Command.Cmd (
+ Command (..),
+ CommandReturnCode (..),
+ interpretCmd,
+) where
+
+import Command.EncodeCmd (runEncodeCmd)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Stego.Common (StegoParams(..), EncodingType (LsbEncoding))
+import Data.Word (Word64)
+import Command.DecodeCmd (runDecodeCmd)
+
+data Command
+  = Help
+  | Encode String Word64 FilePath FilePath
+  | Decode String Word64 FilePath
+  deriving (Show)
+
+data CommandReturnCode
+  = CmdSuccess
+  | CmdFail
+  | CmdUnknown
+  deriving (Show, Eq)
+
+
+interpretCmd :: Command -> IO CommandReturnCode
+interpretCmd cmd =
+  case cmd of
+    Help -> do 
+      putStrLn "run Help"
+      pure CmdSuccess
+    (Encode secret timeRange inputFile outputFile) -> do 
+      let s = encodeUtf8 (T.pack secret)
+      let stegoParams = StegoParams s timeRange 6 LsbEncoding 123
+      runEncodeCmd stegoParams inputFile outputFile
+      pure CmdSuccess
+    (Decode secret timeRange inputFile) -> do
+      let s = encodeUtf8 (T.pack secret)
+      let stegoParams = StegoParams s timeRange 6 LsbEncoding 123
+      runDecodeCmd stegoParams inputFile
+      pure CmdSuccess
+
+

lib/Command/DecodeCmd.hs

@@ -0,0 +1,52 @@
+module Command.DecodeCmd (
+ runDecodeCmd,
+) where
+
+import Stego.Common (StegoParams(..))
+import Data.Audio.Wave (WaveAudio (..), waveAudioFromFile)
+import Stego.Decode.Decoder (DecoderResultList, DecoderResult (StoppingDecoder), getResultStats, newDecoder, getResultChannel, enqueueFrame, stopDecoder)
+import Data.Time (getCurrentTime, diffUTCTime)
+import Control.Monad.Except (runExceptT)
+import Control.Concurrent.STM (newEmptyTMVarIO, atomically, takeTMVar, readTChan, putTMVar)
+import Control.Monad ( void )
+import Data.List (sort)
+import Control.Concurrent (forkIO)
+
+runDecodeCmd :: StegoParams -> FilePath -> IO ()
+runDecodeCmd stegoParams inputFile = do
+  startTime <- getCurrentTime
+  putStrLn $ "Reading audio file " ++ inputFile ++ "..." 
+  audio <- runExceptT (waveAudioFromFile inputFile)
+  case audio of
+    Left err -> putStrLn err
+    Right wa -> do
+      readTime <- getCurrentTime
+      putStrLn $ "Read file in " <> show (diffUTCTime readTime startTime)
+      putStrLn ""
+      print wa
+      result <- doDecodeWaveAudio stegoParams wa
+      putStrLn "\nDecode Result "
+      print $ getResultStats result
+      endTime <- getCurrentTime
+      putStrLn $ "Completed decode in " <> show (diffUTCTime endTime startTime)
+
+doDecodeWaveAudio :: StegoParams -> WaveAudio -> IO DecoderResultList
+doDecodeWaveAudio stegoParams waveAudio = do
+  decoder <- newDecoder stegoParams
+  resD <- getResultChannel decoder
+  m <- newEmptyTMVarIO
+  void $ forkIO $ decodeLoop resD [] m
+  let frames = audioFrames waveAudio
+  mapM_ (enqueueFrame decoder) frames
+  _ <- stopDecoder decoder
+  atomically $ takeTMVar m
+ where
+  decodeLoop channel fs resultVar = do
+    res <- atomically $ readTChan channel
+    case res of
+      StoppingDecoder -> do
+        atomically $ putTMVar resultVar (sort fs)
+        pure ()
+      f -> do
+        decodeLoop channel (f : fs) resultVar
+

lib/Command/EncodeCmd.hs

@@ -0,0 +1,84 @@
+module Command.EncodeCmd (
+  runEncodeCmd
+) where
+
+import Stego.Common
+import qualified Stego.Decode.Decoder as DC
+import Data.Audio.Wave (WaveAudio(..), Frames, waveAudioToFile, waveAudioFromFile)
+import Stego.Encode.Encoder (EncoderResult(..), newEncoder, getResultChannel, enqueueFrame, stopEncoder)
+import Control.Monad (void)
+import Control.Concurrent.STM (newEmptyTMVarIO, takeTMVar, readTChan, putTMVar)
+import Control.Concurrent (forkIO)
+import Control.Monad.STM (atomically)
+import Data.Time (getCurrentTime, diffUTCTime)
+import Control.Monad.Except (runExceptT)
+import Data.List (sort)
+
+
+runEncodeCmd :: StegoParams -> FilePath -> FilePath -> IO ()
+runEncodeCmd stegoParams inputFile outputFile = do
+  startTime <- getCurrentTime
+  putStrLn $ "Reading audio file " ++ inputFile ++ "..." 
+  audio <- runExceptT (waveAudioFromFile inputFile)
+  case audio of
+    Left err -> putStrLn err
+    Right wa -> do
+      readTime <- getCurrentTime
+      putStrLn $ "Read file in " <> show (diffUTCTime readTime startTime)
+      putStrLn ""
+      print wa
+      let frames = audioFrames wa
+      result <- doEncodeFrames stegoParams (take (length frames `div` 2) frames)
+      result2 <- doEncodeFrames stegoParams (drop (length frames `div` 2) frames)
+      putStrLn "\nEncode Result "
+      putStrLn $ "\nTotal Frames in file: " ++ show (length $ audioFrames wa)
+      let combined = result ++ result2
+      print $ DC.getResultStats combined
+      putStrLn $ "Writing encoded file " ++ outputFile ++ "..."
+      let wa' =
+            WaveAudio
+              { srcFile = outputFile
+              , bitSize = bitSize wa
+              , rate = rate wa
+              , channels = channels wa
+              , audioFrames = []
+              , samples = concatMap snd (sort $ DC.getResultFrames combined)
+              }
+      write <- runExceptT (waveAudioToFile outputFile wa')
+      case write of
+        Left err -> putStrLn err
+        Right _ -> do
+          endTime <- getCurrentTime
+          putStrLn $ "Completed encode in " <> show (diffUTCTime endTime startTime)
+
+doEncodeFrames :: StegoParams -> Frames -> IO DC.DecoderResultList
+doEncodeFrames stegoParams frames = do
+  encoder <- newEncoder stegoParams
+  resC <- getResultChannel encoder
+  printChan <- getResultChannel encoder
+  decoder <- DC.newDecoder stegoParams
+  void $ DC.mapDecoderOpQToResultChan decoder resC
+  resD <- DC.getResultChannel decoder
+  x <- newEmptyTMVarIO
+  void $ forkIO $ decoderResultLoop resD [] (length frames) x
+  void $ forkIO $ printLoop printChan (0 :: Int) (length frames)
+
+  mapM_ (enqueueFrame encoder) frames
+  t <- stopEncoder encoder
+  void $ atomically $ takeTMVar t
+  atomically $ takeTMVar x
+ where
+  decoderResultLoop resD fs total t = do
+    res <- atomically $ readTChan resD
+    case res of
+      DC.StoppingDecoder -> do
+        void $ atomically $ putTMVar t fs
+      f -> do
+        decoderResultLoop resD (f : fs) total t
+  printLoop c fs totalFs = do
+    res <- atomically $ readTChan c
+    case res of
+      StoppingEncoder -> do 
+        pure ()
+      _ -> do
+        printLoop c (fs + 1) totalFs

lib/Stego/Common.hs

@@ -23,7 +23,7 @@ module Stego.Common (
 )
 where
 
-import Data.Audio.Wave (Frame)
+import Data.Audio.Wave (Frame, Frames)
 import Data.ByteString qualified as BS
 import Data.Int (Int16, Int32)
 import Data.OTP (HashAlgorithm (..), totp, totpCheck)