cachix-api 1.0.1 → 1.1

raw patch · 4 files changed

+64/−21 lines, 4 filesdep +safe-exceptionsdep +stm-chansPVP ok

version bump matches the API change (PVP)

Dependencies added: safe-exceptions, stm-chans

API changes (from Hackage documentation)

Files

• cachix-api.cabal +4/−2
• src/Cachix/API.hs +1/−0
• src/Cachix/API/WebSocketSubprotocol.hs +40/−17
• src/Cachix/Types/BinaryCache.hs +19/−2

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               cachix-api-version:            1.0.1+version:            1.1 synopsis:           Servant HTTP API specification for https://cachix.org homepage:           https://github.com/cachix/cachix#readme bug-reports:        https://github.com/cachix/cachix/issues@@ -79,10 +79,12 @@     , nix-narinfo     , protolude     , resourcet+    , safe-exceptions     , servant               >=0.14.1     , servant-auth     , servant-auth-swagger     , servant-client+    , stm-chans     , string-conv     , swagger2     , text@@ -127,4 +129,4 @@     , transformers     , unordered-containers -  build-tool-depends: hspec-discover:hspec-discover -any+  build-tool-depends: hspec-discover:hspec-discover

@@ -102,6 +102,7 @@         :> "cache"         :> Capture "name" Text         :> "nar"+        :> QueryParam "compression" BinaryCache.CompressionMethod         :> StreamBody NoFraming XNixNar (ConduitT () ByteStringStreaming.ByteStringStreaming (ResourceT IO) ())         :> Post '[JSON] NoContent,     serveNarContent ::

@@ -1,10 +1,10 @@-{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DuplicateRecordFields #-}  module Cachix.API.WebSocketSubprotocol where  import qualified Control.Concurrent.Async as Async-import qualified Control.Concurrent.Chan as Chan+import qualified Control.Concurrent.STM.TMQueue as TMQueue+import qualified Control.Exception.Safe as Safe import qualified Data.Aeson as Aeson import Data.Time (UTCTime) import Data.UUID (UUID)@@ -51,27 +51,50 @@   deriving (Show, Eq, Generic, Aeson.FromJSON, Aeson.ToJSON)  parseMessage :: Aeson.FromJSON cmd => ByteString -> Either Text (Message cmd)-parseMessage body =-  case Aeson.eitherDecodeStrict' body of-    Left err -> Left $ toS err-    Right message -> Right message+parseMessage = first toS . Aeson.eitherDecodeStrict'  sendMessage :: Aeson.ToJSON cmd => WS.Connection -> Message cmd -> IO () sendMessage connection cmd =-  WS.sendTextData connection $ Aeson.encode cmd+  WS.sendTextData connection (Aeson.encode cmd) +-- | Receive and process messages in parallel.+--+-- Note: This will not rethrow the 'CloseRequest' exception!+-- -- TODO: use Async.replicateConcurrently-recieveDataConcurrently :: WS.Connection -> (ByteString -> IO ()) -> IO ()-recieveDataConcurrently connection m = do-  channel <- Chan.newChan-  Async.race_ (producer channel) (consumer channel)+receiveDataConcurrently :: WS.Connection -> (ByteString -> IO ()) -> IO ()+receiveDataConcurrently connection action =+  do+    queue <- atomically TMQueue.newTMQueue+    Async.withAsync (consumer queue) (producer queue)   where-    producer channel = forever $ do-      payload <- WS.receiveData connection-      Chan.writeChan channel payload-    consumer channel = forever $ do-      payload <- Chan.readChan channel-      m payload+    producer queue consumerThread =+      loop+        `finally` closeGracefully queue consumerThread+        `Safe.catch` closeRequest+      where+        loop = do+          payload <- WS.receiveData connection+          atomically $ TMQueue.writeTMQueue queue payload+          loop++    consumer queue = loop+      where+        loop = do+          payload <- atomically $ TMQueue.readTMQueue queue+          case payload of+            Nothing -> return ()+            Just msg -> action msg *> loop++    -- Close the queue and wait for the consumer finish processing messages.+    closeGracefully :: TMQueue.TMQueue a -> Async.Async () -> IO ()+    closeGracefully queue consumerThread = do+      atomically $ TMQueue.closeTMQueue queue+      Async.wait consumerThread++    closeRequest :: WS.ConnectionException -> IO ()+    closeRequest (WS.CloseRequest _ _) = return ()+    closeRequest e = throwIO e  data Log = Log   { line :: Text,

@@ -2,8 +2,9 @@  import Cachix.Types.Permission (Permission) import Data.Aeson (FromJSON, ToJSON)-import Data.Swagger (ToSchema)+import Data.Swagger (ToParamSchema (..), ToSchema) import Protolude+import Servant.API  data BinaryCache = BinaryCache   { name :: Text,@@ -11,6 +12,22 @@     isPublic :: Bool,     publicSigningKeys :: [Text],     githubUsername :: Text,-    permission :: Permission+    permission :: Permission,+    preferredCompressionMethod :: CompressionMethod   }   deriving (Show, Generic, FromJSON, ToJSON, ToSchema, NFData)++data CompressionMethod = XZ | ZSTD+  deriving (Show, Read, Generic, FromJSON, ToJSON, ToSchema, NFData)++instance FromHttpApiData CompressionMethod where+  parseUrlPiece "xz" = Right XZ+  parseUrlPiece "zst" = Right ZSTD+  parseUrlPiece compressionMethod = Left $ "Wrong compression method: " <> compressionMethod++instance ToHttpApiData CompressionMethod where+  toUrlPiece XZ = "xz"+  toUrlPiece ZSTD = "zst"++instance ToParamSchema CompressionMethod where+  toParamSchema _ = toParamSchema (Proxy :: Proxy Text)