sdffg

hq-sample.cabal

@@ -17,10 +17,15 @@ extra-source-files:
 library
   exposed-modules:
       API.Server
+      Data.Model.AudioRequest
+      Data.Model.TrackRequest
       Data.Persist.Tap
       Data.Persist.TapTrans
+      Data.State.Queue
       Data.State.Track
       Data.Types
+      Data.Util.TrackIdGen
+      Domain.AudioRequest
       Domain.Sample
       Env.Cache
       Env.Persist.Tap
@@ -48,6 +53,7 @@ library
       FlexibleInstances
       UndecidableInstances
       ScopedTypeVariables
+      DuplicateRecordFields
   build-depends:
       aeson
     , async
@@ -55,6 +61,7 @@ library
     , bytestring
     , conferer
     , containers
+    , cryptohash-sha256
     , data-default <0.8.0
     , data-default-class <0.2
     , directory
@@ -64,6 +71,7 @@ library
     , mongoDB
     , mtl
     , optics
+    , random
     , resource-pool
     , servant
     , servant-server
@@ -96,6 +104,7 @@ executable hq-sample
       FlexibleInstances
       UndecidableInstances
       ScopedTypeVariables
+      DuplicateRecordFields
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       aeson
@@ -104,6 +113,7 @@ executable hq-sample
     , bytestring
     , conferer
     , containers
+    , cryptohash-sha256
     , data-default <0.8.0
     , data-default-class <0.2
     , directory
@@ -114,6 +124,7 @@ executable hq-sample
     , mongoDB
     , mtl
     , optics
+    , random
     , resource-pool
     , servant
     , servant-server
@@ -148,6 +159,7 @@ test-suite hq-sample-test
       FlexibleInstances
       UndecidableInstances
       ScopedTypeVariables
+      DuplicateRecordFields
   build-tool-depends:
       hspec-discover:hspec-discover
   build-depends:
@@ -157,6 +169,7 @@ test-suite hq-sample-test
     , bytestring
     , conferer
     , containers
+    , cryptohash-sha256
     , data-default <0.8.0
     , data-default-class <0.2
     , directory
@@ -170,6 +183,7 @@ test-suite hq-sample-test
     , mongoDB
     , mtl
     , optics
+    , random
     , resource-pool
     , servant
     , servant-server

package.yaml

@@ -20,6 +20,7 @@ default-extensions:
   - FlexibleInstances
   - UndecidableInstances
   - ScopedTypeVariables
+  - DuplicateRecordFields
 
 dependencies:
   - base
@@ -53,6 +54,9 @@ dependencies:
   - data-default-class < 0.2
   - data-default < 0.8.0
 
+  - random
+  - cryptohash-sha256
+
 library:
   source-dirs: src
   dependencies:

src/Data/Model/AudioRequest.hs

@@ -0,0 +1,16 @@
+module Data.Model.AudioRequest where
+
+import Data.Persist.Tap (TapId)
+import Data.State.Queue (QueueId)
+import Data.Text (Text)
+import Data.Types
+import GHC.Generics (Generic)
+
+data AudioRequest = AudioRequest
+    { tapId :: TapId
+    , queueId :: QueueId
+    , trackContent :: TrackContent
+    , trackParameters :: TrackParameters
+    , volume :: Volume
+    }
+    deriving (Show, Eq, Generic)

src/Data/Model/TrackRequest.hs

@@ -0,0 +1,27 @@
+module Data.Model.TrackRequest where
+
+import Data.Persist.Tap (TapId)
+import Data.State.Track (TrackId)
+import Data.Text (Text)
+import Data.Types (TrackContent, TrackParameters, Volume)
+import GHC.Generics (Generic)
+
+newtype TrackToken = TrackToken Text
+    deriving (Show, Eq, Generic)
+
+data TrackRequestMeta = TrackRequestMeta
+    { tapId :: TapId
+    , trackId :: TrackId
+    , trackToken :: TrackToken
+    , volume :: Volume
+    }
+    deriving (Show, Eq, Generic)
+
+data TrackRequest = TrackRequest
+    { tapId :: TapId
+    , trackId :: TrackId
+    , trackToken :: TrackToken
+    , parameters :: TrackParameters
+    , content :: TrackContent
+    }
+    deriving (Show, Eq, Generic)

src/Data/State/Queue.hs

@@ -0,0 +1,7 @@
+module Data.State.Queue where
+
+import Data.Text (Text)
+import GHC.Generics (Generic)
+
+newtype QueueId = QueueId Text
+    deriving (Show, Eq, Generic)

src/Data/State/Track.hs

@@ -1,12 +1,13 @@
 module Data.State.Track where
 
 import Data.Aeson (FromJSON, ToJSON)
+import Data.Text (Text)
 import Data.Word (Word64)
 import GHC.Generics (Generic)
 
-newtype TrackId = TrackId Word64
+newtype TrackId = TrackId Text
     deriving stock (Show, Eq, Ord, Generic)
     deriving newtype (ToJSON, FromJSON)
 
-data Track = Track {trackId :: TrackId}
+newtype Track = Track {trackId :: TrackId}
     deriving (Show, Eq, Ord, Generic)

src/Data/Types.hs

@@ -1,4 +1,4 @@
-module Data.Types (UserId (..)) where
+module Data.Types (UserId (..), Volume (..), TrackContent (..), TrackParameters (..)) where
 
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -8,6 +8,15 @@ import Serialize.Str
 newtype UserId = Discord Text
     deriving (Show, Eq, Generic)
 
+newtype Volume = Volume Integer
+    deriving (Show, Eq, Generic)
+
+newtype TrackContent = TrackContent Text
+    deriving (Show, Eq, Generic)
+
+newtype TrackParameters = TrackParameters Text
+    deriving (Show, Eq, Generic)
+
 instance StrTrans UserId where
     toStr userId = case userId of
         Discord discordId -> "d:" <> discordId

src/Data/Util/TrackIdGen.hs

@@ -0,0 +1,32 @@
+module Data.Util.TrackIdGen (generateTrackId, generateTrackToken) where
+
+import Control.Monad (replicateM)
+import Data.Model.TrackRequest (HashedTrackToken, TrackToken (TrackToken))
+import Data.State.Track (TrackId (TrackId))
+import Data.Text (Text)
+import qualified Data.Text as T
+import System.Random (randomRIO)
+
+trackIdLen :: Int
+trackIdLen = 32
+
+tokenLen :: Int
+tokenLen = 32
+
+alphanumericChars :: [Char]
+alphanumericChars = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9']
+
+generateAlphanumeric :: Int -> IO Text
+generateAlphanumeric len = do
+    let charCount = length alphanumericChars
+
+    randomIndices <- replicateM len $ randomRIO (0, charCount - 1)
+    let randomString = (alphanumericChars !!) <$> randomIndices
+
+    return $ T.pack randomString
+
+generateTrackId :: IO TrackId
+generateTrackId = TrackId <$> generateAlphanumeric trackIdLen
+
+generateTrackToken :: IO TrackToken
+generateTrackToken = TrackToken <$> generateAlphanumeric tokenLen

src/Domain/AudioRequest.hs

@@ -0,0 +1,13 @@
+module Domain.AudioRequest where
+
+import Data.Model.AudioRequest (AudioRequest)
+import Data.State.Track (TrackId)
+import Data.Util.TrackIdGen (generateTrackId, generateTrackToken)
+import Infrastructure.App (AppM)
+
+processAudioRequest :: AudioRequest -> AppM TrackId
+processAudioRequest = do
+    trackId <- generateTrackId
+    trackToken <- generateTrackToken
+
+-- TODO