implement real time encode/decode

Makefile

@@ -13,6 +13,18 @@ build-cli:
 build-gui:
 	@cabal build audiocate-gui
 
+PHONY: install-cli
+install-cli:
+	@cabal install exe:audiocate --overwrite-policy=always
+
+PHONY: install-gui
+install-gui:
+	@cabal install audiocate-gui --overwrite-policy=always
+
+install:
+	@cabal install exe:audiocate --overwrite-policy=always
+	@cabal install audiocate-gui --overwrite-policy=always
+
 benchmark-test:
 	@cabal run bench -- --svg test/output/bench_results.svg --csv test/output/bench_results.csv +RTS -T
 

app/Main.hs

@@ -30,6 +30,7 @@ import Audiocate (Command(..), run, version)
 data Opts =
   Opts
     { optVerboseFlag :: !Bool
+    , optRealTimeFlag :: !Bool
     , optCommand :: !Command
     }
 
@@ -40,8 +41,9 @@ main = do
   putStrLn $
     "\nRunning command " ++
     show (optCommand opts) ++
-    " (verbose: " ++ show (optVerboseFlag opts) ++ ")\n"
-  rc <- run (optCommand opts)
+    " (verbose: " ++ show (optVerboseFlag opts) ++ ")\n" ++
+    " (realtime: " ++ show (optRealTimeFlag opts) ++ ")\n"
+  rc <- run (optCommand opts) (optRealTimeFlag opts)
   print rc
   where
     optsParser :: ParserInfo Opts
@@ -57,6 +59,7 @@ main = do
     programOpts :: Parser Opts
     programOpts =
       Opts <$>
+      switch (long "realtime" <> help "Set for encoding/decoding in realtime") <*>
       switch (long "verbose" <> help "Set to print verbose log messages") <*>
       hsubparser
         (encodeCommand <>

audiocate.cabal

@@ -115,6 +115,7 @@ test-suite audiocate-test
       , EncodeStreamCmdSpec
       , DecodeStreamCmdSpec
       , StegoSpec
+      , RealTimeSpec
     ghc-options:
         -O -threaded -rtsopts -with-rtsopts=-N
     build-tool-depends:

gui/Main.hs

@@ -36,4 +36,4 @@ main = do
         Adw.On #activate (toggleTheme ?self args)
       ]
   putStrLn $ "Audiocate GUI v" ++ version
-  void (app.run $ Just $ progName : [])
+  void (app.run $ Just [progName])

gui/View/DecodeView.hs

@@ -157,7 +157,7 @@ onDecodeBtnClicked appState decodeView = do
                (-1)
              let s = encodeUtf8 secret
              let t :: Word64 = fromIntegral secondsValidInt
-             let stegoParams = StegoParams s t 6 LsbEncoding 123
+             let stegoParams = StegoParams s t 6 LsbEncoding 123 False
              decoder <- newDecoder stegoParams
              let wa = loadedAudioWave audio
              let frames = audioFrames wa

gui/View/EncodeView.hs

@@ -179,7 +179,7 @@ onEncodeBtnClicked appState encodeView = do
                (-1)
              let s = encodeUtf8 secret
              let t :: Word64 = fromIntegral secondsValidInt
-             let stegoParams = StegoParams s t 6 LsbEncoding 123
+             let stegoParams = StegoParams s t 6 LsbEncoding 123 False
              encoder <- newEncoder stegoParams
              let wa = loadedAudioWave audio
              let frames = audioFrames wa

lib/Audiocate.hs

@@ -10,8 +10,8 @@ module Audiocate
 import Command.Cmd (Command(..), CommandReturnCode(..), interpretCmd)
 
 -- | Runs the provided Command 
-run :: Command -> IO CommandReturnCode
-run = interpretCmd
+run :: Command -> Bool -> IO CommandReturnCode
+run cmd isRealTime = interpretCmd cmd isRealTime
 
 -- | Prints the version string
 version :: String

lib/Command/Cmd.hs

@@ -39,33 +39,33 @@ instance Show CommandReturnCode where
   show CmdFail = "Command failed."
   show _ = "Command unknown or fault"
 
-interpretCmd :: Command -> IO CommandReturnCode
-interpretCmd cmd =
+interpretCmd :: Command -> Bool -> IO CommandReturnCode
+interpretCmd cmd isRealTime =
   case cmd of
     Help -> do
       putStrLn "run Help"
       pure CmdSuccess
     (Encode secret timeRange inputFile outputFile) -> do
       let s = encodeUtf8 (T.pack secret)
       let t :: Word64 = fromIntegral timeRange
-      let stegoParams = StegoParams s t 6 LsbEncoding 0 False
+      let stegoParams = StegoParams s t 6 LsbEncoding 0 isRealTime
       runEncodeCmd stegoParams inputFile outputFile
       pure CmdSuccess
     (EncodeStream secret timeRange inputFile outputFile) -> do
       let s = encodeUtf8 (T.pack secret)
       let t :: Word64 = fromIntegral timeRange
-      let stegoParams = StegoParams s t 6 LsbEncoding 0 False
+      let stegoParams = StegoParams s t 6 LsbEncoding 0 isRealTime
       runEncodeStreamCmd False stegoParams inputFile outputFile
       pure CmdSuccess
     (Decode secret timeRange inputFile) -> do
       let s = encodeUtf8 (T.pack secret)
       let t :: Word64 = fromIntegral timeRange
-      let stegoParams = StegoParams s t 6 LsbEncoding 0 False
+      let stegoParams = StegoParams s t 6 LsbEncoding 0 isRealTime
       runDecodeCmd stegoParams inputFile
       pure CmdSuccess
     (DecodeStream secret timeRange inputFile) -> do
       let s = encodeUtf8 (T.pack secret)
       let t :: Word64 = fromIntegral timeRange
-      let stegoParams = StegoParams s t 6 LsbEncoding 0 False
+      let stegoParams = StegoParams s t 6 LsbEncoding 0 isRealTime
       runDecodeStreamCmd False stegoParams inputFile
       pure CmdSuccess

lib/Command/EncodeCmd.hs

@@ -28,12 +28,14 @@ import Stego.Encode.Encoder
   , stopEncoder
   )
 
-runEncodeCmd :: StegoParams -> FilePath -> FilePath -> IO ()
+runEncodeCmd :: StegoParams -> FilePath -> FilePath -> IO DC.DecoderResultList
 runEncodeCmd stegoParams inputFile outputFile = do
   startTime <- getCurrentTime
   audio <- runExceptT (waveAudioFromFile inputFile)
   case audio of
-    Left err -> putStrLn err
+    Left err -> do 
+      putStrLn err
+      pure []
     Right wa -> do
       let frames = audioFrames wa
       result <- doEncodeFrames stegoParams (take (length frames `div` 2) frames)
@@ -42,7 +44,8 @@ runEncodeCmd stegoParams inputFile outputFile = do
       putStrLn "\nEncode Result "
       putStrLn $ "\nTotal Frames in file: " ++ show (length $ audioFrames wa)
       let combined = result ++ result2
-      print $ DC.getResultStats combined
+      let resultStats = DC.getResultStats combined
+      print resultStats
       putStrLn $ "Writing encoded file to " ++ outputFile ++ "..."
       let wa' =
             WaveAudio
@@ -55,11 +58,14 @@ runEncodeCmd stegoParams inputFile outputFile = do
               }
       write <- runExceptT (waveAudioToFile outputFile wa')
       case write of
-        Left err -> putStrLn err
+        Left err -> do 
+          putStrLn err
+          pure []
         Right _ -> do
           endTime <- getCurrentTime
           putStrLn $
             "Completed encode in " <> show (diffUTCTime endTime startTime)
+          pure combined
 
 doEncodeFrames :: StegoParams -> Frames -> IO DC.DecoderResultList
 doEncodeFrames stegoParams frames = do

lib/Stego/Common.hs

@@ -1,42 +1,46 @@
 -- | Holds common types and functions for supporting the
 -- audio steganography modules.
-module Stego.Common (
-  EncodingType (..),
-  DecodingType (..),
-  StegoParams (..),
-  TotpPayload,
-  TimestampPayload,
-  DecodedPayload,
-  DecodedFrame,
-  Payload,
-  Secret,
-  calculateTotp,
-  checkTotp,
-  utcTimeToWord64,
-  word64ToUtcTime,
-  readBinWord64,
-  readBinWord32,
-  getEncodingType,
-  shouldSkipFrame,
-)
-where
-
-import Data.ByteString qualified as BS
+module Stego.Common
+  ( EncodingType(..)
+  , DecodingType(..)
+  , StegoParams(..)
+  , TotpPayload
+  , TimestampPayload
+  , DecodedPayload
+  , DecodedFrame
+  , Payload
+  , Secret
+  , calculateTotp
+  , checkTotp
+  , utcTimeToWord64
+  , word64ToUtcTime
+  , readBinWord64
+  , readBinWord32
+  , getEncodingType
+  , shouldSkipFrame
+  , getIsRealTime
+  ) where
+
+import qualified Data.ByteString as BS
 import Data.Int (Int16, Int32)
-import Data.OTP (HashAlgorithm (..), totp, totpCheck)
-import Data.Time.Clock (UTCTime (..))
+import Data.OTP (HashAlgorithm(..), totp, totpCheck)
+import Data.Time.Clock (UTCTime(..))
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
 import Data.Word (Word32, Word64, Word8)
 import Numeric (readBin)
 
 import Data.Audio.Wave (Frame)
 
 -- | Supported encoding types
-data EncodingType = LsbEncoding | EchoHideEncoding
+data EncodingType
+  = LsbEncoding
+  | EchoHideEncoding
   deriving (Show, Eq)
 
 -- | Supported decoding types
-data DecodingType = LsbDecoding | EchoHideDecoding
+data DecodingType
+  = LsbDecoding
+  | EchoHideDecoding
   deriving (Show, Eq)
 
 -- | The secret key used to calculate TOTP result
@@ -58,14 +62,19 @@ type DecodedPayload = (Word64, TotpPayload)
 type DecodedFrame = (Int, [Int16], DecodedPayload)
 
 -- | StegoParams instance used to capture parameters
-data StegoParams = StegoParams Secret Word64 Word8 EncodingType Payload Bool
+data StegoParams =
+  StegoParams Secret Word64 Word8 EncodingType Payload Bool
   deriving (Show, Eq)
 
 -- | Extracts the EncodingType of provided StegoParams
 getEncodingType :: StegoParams -> EncodingType
 getEncodingType (StegoParams _ _ _ LsbEncoding _ _) = LsbEncoding
 getEncodingType _ = EchoHideEncoding
 
+-- | Extracts the boolean stegoParam indicating if the stego is real-time or not
+getIsRealTime :: StegoParams -> Bool
+getIsRealTime (StegoParams _ _ _ _ _ x) = x
+
 -- | Calculates a TOTP value for the StegoParams at the provided UTCTime
 calculateTotp :: StegoParams -> UTCTime -> TotpPayload
 calculateTotp (StegoParams secret range numDigits _ _ _) time =
@@ -97,4 +106,5 @@ readBinWord32 = fst . head . readBin
 -- suitable for encoding/decoding. This is mostly done by assessing if the
 -- targeted bits are too quiet / low in energy.
 shouldSkipFrame :: Frame -> Bool
-shouldSkipFrame (_, f) = realToFrac (sum (map abs (take 128 f))) < (1E-3 :: Double)
+shouldSkipFrame (_, f) =
+  realToFrac (sum (map abs (take 128 f))) < (1E-3 :: Double)

lib/Stego/Decode/Decoder.hs

@@ -12,7 +12,7 @@ module Stego.Decode.Decoder
   , getResultStats
   , getResultFrames
   , decodeFrame'
-  , Decoder (..)
+  , Decoder(..)
   ) where
 
 import Control.Concurrent (forkIO)
@@ -36,6 +36,7 @@ import Data.Audio.Wave (Frame, Frames)
 import Data.List (foldl')
 import Text.Printf (printf)
 
+import Data.Time (getCurrentTime)
 import Stego.Common
   ( DecodedFrame
   , EncodingType(..)
@@ -201,11 +202,21 @@ decodeFrame' stegoParams frame
 runDecoder :: Decoder -> IO ()
 runDecoder dec = loop
   where
-    toResult frame Nothing = SkippedFrame frame
-    toResult _ (Just (i, samples, (time, payload))) =
-      DecodedFrameR
-        (i, samples, (time, payload))
-        (checkTotp (stegoParams dec) (word64ToUtcTime time) payload)
+    toResult frame Nothing = pure $ SkippedFrame frame
+    toResult _ (Just (i, samples, (time, payload)))
+    -- check if this is set to use real-time
+     = do
+      if time == 0
+        then do
+          time' <- getCurrentTime
+          pure $
+            DecodedFrameR
+              (i, samples, (time, payload))
+              (checkTotp (stegoParams dec) time' payload)
+        else pure $
+             DecodedFrameR
+               (i, samples, (time, payload))
+               (checkTotp (stegoParams dec) (word64ToUtcTime time) payload)
     loop = do
       op <- atomically $ readTQueue (opQ dec)
       case op of
@@ -217,7 +228,8 @@ runDecoder dec = loop
               loop
             else do
               let decoded = decodeFrame' (stegoParams dec) f
-              atomically $ writeTChan (resultChan dec) (toResult f decoded)
+              result <- toResult f decoded
+              atomically $ writeTChan (resultChan dec) result
               loop
         (StopDecoder m) -> do
           atomically $ do

lib/Stego/Encode/Encoder.hs

@@ -36,6 +36,7 @@ import Stego.Common
   , StegoParams(..)
   , calculateTotp
   , getEncodingType
+  , getIsRealTime
   , shouldSkipFrame
   , utcTimeToWord64
   )
@@ -110,27 +111,31 @@ encodeFrame' stegoParams time frame
     Stego.Encode.LSB.encodeFrame time64 totp frame
   | otherwise = undefined
   where
-    time64 = utcTimeToWord64 time
+    time64 =
+      if getIsRealTime stegoParams
+        then 0
+        else utcTimeToWord64 time
     totp = calculateTotp stegoParams time
 
 -- | The main run loop function for running an Encoder
 runEncoder :: Encoder -> IO ()
 runEncoder enc = loop
- where
-  loop = do
-    op <- atomically $ readTQueue (encoderOpQ enc)
-    case op of
-      (EncodeFrame (i, f)) -> do
-        time <- getCurrentTime
-        let shouldSkip = shouldSkipFrame (i, f)
-        if shouldSkip
-          then do
-            atomically $ writeTChan (resultChan enc) (SkippedFrame (i, f))
-            loop
-          else do
-            let encoded = encodeFrame' (stegoParams enc) time (i, f)
-            atomically $ writeTChan (resultChan enc) (EncodedFrame encoded)
-            loop
-      (StopEncoder m) -> atomically $ do
-        writeTChan (resultChan enc) StoppingEncoder
-        putTMVar m ()
+  where
+    loop = do
+      op <- atomically $ readTQueue (encoderOpQ enc)
+      case op of
+        (EncodeFrame (i, f)) -> do
+          time <- getCurrentTime
+          let shouldSkip = shouldSkipFrame (i, f)
+          if shouldSkip
+            then do
+              atomically $ writeTChan (resultChan enc) (SkippedFrame (i, f))
+              loop
+            else do
+              let encoded = encodeFrame' (stegoParams enc) time (i, f)
+              atomically $ writeTChan (resultChan enc) (EncodedFrame encoded)
+              loop
+        (StopEncoder m) ->
+          atomically $ do
+            writeTChan (resultChan enc) StoppingEncoder
+            putTMVar m ()