diff --git a/patches/futhark-0.22.3.patch b/patches/futhark-0.22.4.patch
similarity index 98%
rename from patches/futhark-0.22.3.patch
rename to patches/futhark-0.22.4.patch
index 94571dfce08597aa1411eca7fb8cadb586464d42..61549342451dd519978121147f11c7263d60ff84 100644
--- a/patches/futhark-0.22.3.patch
+++ b/patches/futhark-0.22.4.patch
@@ -12,10 +12,10 @@ index f0cf5bc..bcddcc6 100644
              tell $ buildFGBody body
              pure body
 diff --git a/src/Futhark/IR/SOACS/Simplify.hs b/src/Futhark/IR/SOACS/Simplify.hs
-index b497fb0..706aa5f 100644
+index adcd8d6..528a2b2 100644
 --- a/src/Futhark/IR/SOACS/Simplify.hs
 +++ b/src/Futhark/IR/SOACS/Simplify.hs
-@@ -757,7 +757,7 @@ arrayOps = mconcat . map onStm . stmsToList . bodyStms
+@@ -759,7 +759,7 @@ arrayOps = mconcat . map onStm . stmsToList . bodyStms
        tell $ arrayOps $ lambdaBody lam
        pure lam
      walker =
@@ -24,7 +24,7 @@ index b497fb0..706aa5f 100644
          { walkOnBody = const $ modify . (<>) . arrayOps,
            walkOnOp = modify . (<>) . onOp
          }
-@@ -780,7 +780,7 @@ replaceArrayOps substs (Body _ stms res) =
+@@ -784,7 +784,7 @@ replaceArrayOps substs (Body _ stms res) =
            fromArrayOp op'
      onExp _ cs e = (cs, mapExp mapper e)
      mapper =
@@ -53,7 +53,7 @@ index b1cab74..0960106 100644
  instance Bitraversable TypeBase where
    bitraverse f g (Array t shape u) = Array t <$> f shape <*> g u
 diff --git a/src/Futhark/Optimise/CSE.hs b/src/Futhark/Optimise/CSE.hs
-index 397728a..b4a00ad 100644
+index 65dc1fd..699971d 100644
 --- a/src/Futhark/Optimise/CSE.hs
 +++ b/src/Futhark/Optimise/CSE.hs
 @@ -176,7 +176,7 @@ cseInLambda lam = do
@@ -197,7 +197,7 @@ index 56534e5..771e2ee 100644
            }
  
 diff --git a/src/Futhark/Optimise/Simplify/Rules.hs b/src/Futhark/Optimise/Simplify/Rules.hs
-index 8b3964a..6369b74 100644
+index 0bed9c5..c3fba24 100644
 --- a/src/Futhark/Optimise/Simplify/Rules.hs
 +++ b/src/Futhark/Optimise/Simplify/Rules.hs
 @@ -196,7 +196,7 @@ withAccTopDown vtable (Let pat aux (WithAcc inputs lam)) = Simplify . auxing aux
diff --git a/patches/posix-api-0.3.5.0.patch b/patches/posix-api-0.3.5.0.patch
deleted file mode 100644
index 6c31d6d1b73750044f6595d05298e62924b9281e..0000000000000000000000000000000000000000
--- a/patches/posix-api-0.3.5.0.patch
+++ /dev/null
@@ -1,96 +0,0 @@
-diff --git a/posix-api.cabal b/posix-api.cabal
-index 2daa9d3..b48bfc8 100644
---- a/posix-api.cabal
-+++ b/posix-api.cabal
-@@ -73,7 +73,7 @@ extra-source-files:
- 
- flag assertions
-   manual: True
--  description: Extra run-time invariant checking 
-+  description: Extra run-time invariant checking
-   default: False
- 
- library
-@@ -111,6 +111,7 @@ library
-     , primitive-offset >= 0.2 && <0.3
-     , primitive-unlifted >= 0.1 && <0.2
-     , run-st >= 0.1.1 && <0.2
-+    , ghc-prim
-   hs-source-dirs: src
-   if flag(assertions)
-     hs-source-dirs: src-assertions
-diff --git a/src/Linux/Socket.hs b/src/Linux/Socket.hs
-index 1784486..90b28d7 100644
---- a/src/Linux/Socket.hs
-+++ b/src/Linux/Socket.hs
-@@ -5,6 +5,8 @@
- {-# language UnboxedTuples #-}
- {-# language UnliftedFFITypes #-}
- 
-+{-# options_ghc -Wno-dodgy-imports #-}
-+
- module Linux.Socket
-   ( -- * Functions
-     uninterruptibleReceiveMultipleMessageA
-@@ -55,7 +57,7 @@ import Data.Primitive.Unlifted.Array (MutableUnliftedArray(..),UnliftedArray)
- import Data.Word (Word8)
- import Foreign.C.Error (Errno,getErrno)
- import Foreign.C.Types (CInt(..),CSize(..),CUInt(..))
--import GHC.Exts (Ptr(..),RealWorld,MutableByteArray#,Addr#,MutableArrayArray#,Int(I#))
-+import GHC.Exts (Ptr(..),RealWorld,MutableByteArray#,Addr#,MutableArrayArray#(..),Int(I#))
- import GHC.Exts (shrinkMutableByteArray#,touch#,nullAddr#)
- import GHC.IO (IO(..))
- import Linux.Socket.Types (SocketFlags(..))
-diff --git a/src/Posix/Socket.hs b/src/Posix/Socket.hs
-index 973f763..c77c1da 100644
---- a/src/Posix/Socket.hs
-+++ b/src/Posix/Socket.hs
-@@ -1,4 +1,5 @@
- {-# language BangPatterns #-}
-+{-# language CPP #-}
- {-# language DataKinds #-}
- {-# language DuplicateRecordFields #-}
- {-# language GADTSyntax #-}
-@@ -11,6 +12,8 @@
- {-# language UnboxedTuples #-}
- {-# language UnliftedFFITypes #-}
- 
-+{-# options_ghc -Wno-dodgy-imports #-}
-+
- -- | Types and functions related to the POSIX sockets API.
- --   Unusual characteristics:
- --
-@@ -215,8 +218,13 @@ import Foreign.C.String (CString)
- import Foreign.C.Types (CInt(..),CSize(..))
- import Foreign.Ptr (nullPtr)
- import GHC.Exts (Ptr,RealWorld,ByteArray#,MutableByteArray#)
--import GHC.Exts (Addr#,TYPE,RuntimeRep(UnliftedRep))
--import GHC.Exts (ArrayArray#,MutableArrayArray#,Int(I#))
-+import GHC.Exts (Addr#,TYPE)
-+#if MIN_VERSION_ghc_prim(0,8,0)
-+import GHC.Types (UnliftedRep)
-+#else
-+import GHC.Exts (RuntimeRep(UnliftedRep))
-+#endif
-+import GHC.Exts (ArrayArray#(..),MutableArrayArray#(..),Int(I#))
- import GHC.Exts (shrinkMutableByteArray#,touch#)
- import Posix.Socket.Types (Family(..),Protocol(..),Type(..),SocketAddress(..))
- import Posix.Socket.Types (SocketAddressInternet(..))
-@@ -770,7 +778,7 @@ writeVector fd buffers = do
-   touchLifted newBufs
-   pure r
- 
--data UList (a :: TYPE 'UnliftedRep) where
-+data UList (a :: TYPE UnliftedRep) where
-   UNil :: UList a
-   UCons :: a -> UList a -> UList a
- 
-@@ -824,7 +832,7 @@ uninterruptibleSendMessageB ::
-   -> CSize -- ^ Length in bytes (payload A)
-   -> MessageFlags 'Send -- ^ Flags
-   -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
--uninterruptibleSendMessageB fd 
-+uninterruptibleSendMessageB fd
-   (MutableByteArrayOffset{array,offset}) lenB
-   (Addr addr) lenA flags =
-     c_unsafe_sendmsg_b fd (unMba array) offset lenB addr lenA flags
diff --git a/patches/posix-api-0.4.0.0.patch b/patches/posix-api-0.4.0.0.patch
new file mode 100644
index 0000000000000000000000000000000000000000..43486170d821280410ac9233cc9062c6ec631871
--- /dev/null
+++ b/patches/posix-api-0.4.0.0.patch
@@ -0,0 +1,31 @@
+diff --git a/src/Linux/Socket.hs b/src/Linux/Socket.hs
+index 1784486..6b3011c 100644
+--- a/src/Linux/Socket.hs
++++ b/src/Linux/Socket.hs
+@@ -55,7 +55,7 @@ import Data.Primitive.Unlifted.Array (MutableUnliftedArray(..),UnliftedArray)
+ import Data.Word (Word8)
+ import Foreign.C.Error (Errno,getErrno)
+ import Foreign.C.Types (CInt(..),CSize(..),CUInt(..))
+-import GHC.Exts (Ptr(..),RealWorld,MutableByteArray#,Addr#,MutableArrayArray#,Int(I#))
++import GHC.Exts (Ptr(..),RealWorld,MutableByteArray#,Addr#,MutableArrayArray#(..),Int(I#))
+ import GHC.Exts (shrinkMutableByteArray#,touch#,nullAddr#)
+ import GHC.IO (IO(..))
+ import Linux.Socket.Types (SocketFlags(..))
+@@ -115,7 +115,7 @@ foreign import ccall unsafe "HaskellPosix.h recvmmsg_sockaddr_discard"
+ --   (e.g. with @SOCK_NONBLOCK@):
+ --
+ --   > uninterruptibleSocket internet (applySocketFlags (closeOnExec <> nonblocking) stream) defaultProtocol
+---   
++--
+ applySocketFlags :: SocketFlags -> Type -> Type
+ applySocketFlags (SocketFlags s) (Type t) = Type (s .|. t)
+ 
+@@ -181,7 +181,7 @@ uninterruptibleReceiveMultipleMessageA !s !msgSize !msgCount !flags = do
+ -- * The message data of each message.
+ --
+ -- The @sockaddr@s bytearray and the unlifted array of messages are
+--- guaranteed to have the same number of elements. 
++-- guaranteed to have the same number of elements.
+ uninterruptibleReceiveMultipleMessageB ::
+      Fd -- ^ Socket
+   -> CInt -- ^ Expected @sockaddr@ size