etc

minipat-dirt/src/Minipat/Dirt/Prelude.hs

@@ -1,9 +1,10 @@
 module Minipat.Dirt.Prelude where
 
 import Control.Exception (throwIO)
+import Control.Monad.IO.Class (liftIO)
 import Data.Ratio ((%))
 import Data.IORef (IORef, newIORef)
-import Dahdit.Network (Conn (..), HostPort (..), udpClientConn, runEncoder, runDecoder)
+import Dahdit.Network (Conn (..), HostPort (..), udpServerConn, runEncoder, runDecoder)
 import Network.Socket qualified as NS
 import Data.Acquire (Acquire)
 import Dahdit.Midi.Osc (Packet)
@@ -12,18 +13,17 @@ import Minipat.Dirt.Ref qualified as R
 import Minipat.Dirt.Osc qualified as O
 import Nanotime (PosixTime, TimeDelta, currentTime, timeDeltaFromFracSecs)
 
--- private con
-data Dirt = Dirt !NS.SockAddr !(Conn ())
-
 data Env = Env
-  { envDirtHp :: !HostPort
+  { envTargetHp :: !HostPort
+  , envListenHp :: !HostPort
   , envCps :: !Rational
   , envOscTimeout :: !TimeDelta
   } deriving stock (Eq, Ord, Show)
 
 defaultEnv :: Env
 defaultEnv = Env
-  { envDirtHp = HostPort (Just "127.0.0.1") 57120
+  { envTargetHp = HostPort (Just "127.0.0.1") 57120
+  , envListenHp = HostPort (Just "127.0.0.1") 57129
   , envCps = 1 % 2 -- 120 bpm, 4 bpc
   , envOscTimeout = timeDeltaFromFracSecs @Double 0.1
   }
@@ -33,40 +33,56 @@ data Clock = Clock
   , clCps :: !Rational
   } deriving stock (Eq, Ord, Show)
 
+data OscConn = OscConn
+  { ocTargetAddr :: !NS.SockAddr
+  , ocListenConn :: !(Conn NS.SockAddr)
+  }
+
 data St = St
   { stEnv :: !Env
   , stRel :: !ReleaseVar
   , stClock :: !(IORef Clock)
-  , stDirt :: !(Ref Dirt)
+  , stConn :: !(Ref OscConn)
   }
 
--- private
-acqDirt :: HostPort -> Acquire Dirt
-acqDirt = fmap (uncurry Dirt) . udpClientConn Nothing
+-- TODO export this from dahdit-network
+resolveAddr :: HostPort -> IO NS.SockAddr
+resolveAddr hp@(HostPort host port) = do
+  infos <- NS.getAddrInfo Nothing host (Just (show port))
+  case infos of
+    [] -> fail ("Could not resolve address: " ++ show hp)
+    info : _ -> pure (NS.addrAddress info)
+
+acqConn :: Env -> Acquire OscConn
+acqConn (Env targetHp listenHp _ _) = do
+  targetAddr <- liftIO (resolveAddr targetHp)
+  conn <- udpServerConn Nothing listenHp
+  pure (OscConn targetAddr conn)
 
 initSt :: Env -> IO St
 initSt env = do
   rv <- R.releaseVarCreate
-  ref <- R.refCreate rv (acqDirt (envDirtHp env))
+  ref <- R.refCreate rv (acqConn env)
   now <- currentTime
   cv <- newIORef (Clock now (envCps env))
   pure (St env rv cv ref)
 
 reinitSt :: St -> IO ()
-reinitSt st = R.refReplace (stDirt st) (acqDirt (envDirtHp (stEnv st)))
+reinitSt st = R.refReplace (stConn st) (acqConn (stEnv st))
 
 cleanupSt :: St -> IO ()
 cleanupSt = R.releaseVarCleanup . stRel
 
 sendHandshake :: St -> IO ()
 sendHandshake (St _ _ _ ref) = R.refUse ref $ \case
   Nothing -> error "Not connected"
-  Just (Dirt _ (Conn _ enc)) -> do runEncoder enc () O.handshakePkt
+  Just (OscConn targetAddr (Conn _ enc)) -> do
+    runEncoder enc targetAddr O.handshakePkt
 
 listen :: St -> IO (Maybe Packet)
-listen (St (Env _ _ _timeout) _ _ ref) = R.refUse ref $ \case
+listen (St (Env _ _ _ _timeout) _ _ ref) = R.refUse ref $ \case
   Nothing -> error "Not connected"
-  Just (Dirt _ (Conn dec _)) ->
+  Just (OscConn _ (Conn dec _)) ->
     runDecoder dec >>= either throwIO pure . snd
 
 test :: IO ()