From 1edc7f0996901ec49c24eafd8526e5255959f225 Mon Sep 17 00:00:00 2001 From: Eric Conlon <37287+ejconlon@users.noreply.github.com> Date: Wed, 24 Jan 2024 18:48:36 -0800 Subject: [PATCH] etc --- minipat-dirt/src/Minipat/Dirt/Prelude.hs | 46 ++++++++++++++++-------- 1 file changed, 31 insertions(+), 15 deletions(-) diff --git a/minipat-dirt/src/Minipat/Dirt/Prelude.hs b/minipat-dirt/src/Minipat/Dirt/Prelude.hs index c77a866..6f1ea61 100644 --- a/minipat-dirt/src/Minipat/Dirt/Prelude.hs +++ b/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,27 +33,42 @@ 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 @@ -61,12 +76,13 @@ 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 ()