summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-04-23 20:22:28 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2023-04-23 20:27:15 +0200
commit2e9ebc0e64ef2febb61669a8fdec3e84dd4b0c63 (patch)
tree2b46c44f81f3f1477ff548d0b93d2d9183fc2a19 /src/Network
parent7153a26626498d9790ddf73f6a275cc93f847c66 (diff)
Add network namespace in constructor of corresponding type
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/Ip.hs24
1 files changed, 19 insertions, 5 deletions
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