From 2e9ebc0e64ef2febb61669a8fdec3e84dd4b0c63 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 23 Apr 2023 20:22:28 +0200
Subject: Add network namespace in constructor of corresponding type

---
 src/Network/Ip.hs | 24 +++++++++++++++++++-----
 1 file changed, 19 insertions(+), 5 deletions(-)

(limited to 'src/Network/Ip.hs')

diff --git a/src/Network/Ip.hs b/src/Network/Ip.hs
index 7488829..1365f66 100644
--- a/src/Network/Ip.hs
+++ b/src/Network/Ip.hs
@@ -10,12 +10,17 @@ module Network.Ip (
     ipSubnet,
     lanSubnet,
 
-    NetworkNamespace(..),
+    NetworkNamespace,
     HasNetns(..),
+    addNetworkNamespace,
     textNetnsName,
     callOn,
 ) where
 
+import Control.Concurrent.STM
+
+import Control.Monad.Writer
+
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Word
@@ -51,14 +56,23 @@ lanSubnet :: IpPrefix -> IpPrefix
 lanSubnet (IpPrefix prefix) = IpPrefix (take 3 $ prefix ++ repeat 0)
 
 
-newtype NetworkNamespace = NetworkNamespace Text
+newtype NetworkNamespace = NetworkNamespace
+    { netnsName :: Text
+    }
     deriving (Eq, Ord)
 
-class HasNetns a where netnsName :: a -> NetworkNamespace
+class HasNetns a where getNetns :: a -> NetworkNamespace
+
+addNetworkNamespace :: Text -> WriterT [IO ()] STM NetworkNamespace
+addNetworkNamespace name = do
+    tell $ (:[]) $ callCommand $ T.unpack $ "ip netns add \"" <> name <> "\""
+    return $ NetworkNamespace
+        { netnsName = name
+        }
 
 textNetnsName :: NetworkNamespace -> Text
-textNetnsName (NetworkNamespace name) = name
+textNetnsName = netnsName
 
 callOn :: HasNetns a => a -> Text -> IO ()
 callOn n cmd = callCommand $ T.unpack $ "ip netns exec \"" <> ns <> "\" " <> cmd
-    where NetworkNamespace ns = netnsName n
+    where NetworkNamespace ns = getNetns n
-- 
cgit v1.2.3