1 files changed, 90 insertions, 0 deletions
diff --git a/src/Network/WireGuard/Foreign/In6Addr.hsc b/src/Network/WireGuard/Foreign/In6Addr.hsc
new file mode 100644
index 0000000..ef2cb32
--- /dev/null
+++ b/src/Network/WireGuard/Foreign/In6Addr.hsc
@@ -0,0 +1,90 @@
+--
+-- Copyright (c) 2002-2010, The University Court of the University of Glasgow.
+-- Copyright (c) 2007-2010, Johan Tibell
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are met:
+--
+-- - Redistributions of source code must retain the above copyright notice,
+-- this list of conditions and the following disclaimer.
+--
+-- - Redistributions in binary form must reproduce the above copyright notice,
+-- this list of conditions and the following disclaimer in the documentation
+-- and/or other materials provided with the distribution.
+--
+-- - Neither name of the University nor the names of its contributors may be
+-- used to endorse or promote products derived from this software without
+-- specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+-- GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+-- INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+-- FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+-- UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+-- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+-- OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+-- DAMAGE.
+--
+
+module Network.WireGuard.Foreign.In6Addr
+ ( In6Addr(..)
+ ) where
+
+import Foreign
+import Network.Socket.Internal
+
+#include "uapi.h"
+
+-- Extracted from network:Network/Socket/Types.hsc, with some modification.
+
+-- The peek32 and poke32 functions work around the fact that the RFCs
+-- don't require 32-bit-wide address fields to be present.  We can
+-- only portably rely on an 8-bit field, s6_addr.
+
+s6_addr_offset :: Int
+s6_addr_offset = (#offset struct in6_addr, s6_addr)
+
+peek32 :: Ptr a -> Int -> IO Word32
+peek32 p i0 = do
+    let i' = i0 * 4
+        peekByte n = peekByteOff p (s6_addr_offset + i' + n) :: IO Word8
+        a `sl` i = fromIntegral a `shiftL` i
+    a0 <- peekByte 0
+    a1 <- peekByte 1
+    a2 <- peekByte 2
+    a3 <- peekByte 3
+    return ((a0 `sl` 24) .|. (a1 `sl` 16) .|. (a2 `sl` 8) .|. (a3 `sl` 0))
+
+poke32 :: Ptr a -> Int -> Word32 -> IO ()
+poke32 p i0 a = do
+    let i' = i0 * 4
+        pokeByte n = pokeByteOff p (s6_addr_offset + i' + n)
+        x `sr` i = fromIntegral (x `shiftR` i) :: Word8
+    pokeByte 0 (a `sr` 24)
+    pokeByte 1 (a `sr` 16)
+    pokeByte 2 (a `sr`  8)
+    pokeByte 3 (a `sr`  0)
+
+-- | Private newtype proxy for the Storable instance. To avoid orphan instances.
+newtype In6Addr = In6Addr { fromIn6Addr :: HostAddress6 }
+
+instance Storable In6Addr where
+    sizeOf _    = #const sizeof(struct in6_addr)
+    alignment _ = #alignment struct in6_addr
+
+    peek p = do
+        a <- peek32 p 0
+        b <- peek32 p 1
+        c <- peek32 p 2
+        d <- peek32 p 3
+        return $ In6Addr (a, b, c, d)
+
+    poke p (In6Addr (a, b, c, d)) = do
+        poke32 p 0 a
+        poke32 p 1 b
+        poke32 p 2 c
+        poke32 p 3 d