cachix-api 1.13.0 → 1.14.0

raw patch · 20 files changed

+168/−49 lines, 20 filesdep +openapi3dep ~websocketsPVP ok

version bump matches the API change (PVP)

Dependencies added: openapi3

Dependency ranges changed: websockets

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• cachix-api.cabal +6/−2
• src/Cachix/API/WebSocket/Client.hs +26/−0
• src/Cachix/API/WebSocketSubprotocol.hs +2/−1
• src/Cachix/Types/BinaryCache.hs +9/−5
• src/Cachix/Types/ByteStringStreaming.hs +12/−5
• src/Cachix/Types/Deploy.hs +3/−2
• src/Cachix/Types/DeployResponse/V1.hs +8/−2
• src/Cachix/Types/DeployResponse/V2.hs +9/−3
• src/Cachix/Types/Deployment.hs +4/−3
• src/Cachix/Types/MultipartUpload.hs +7/−6
• src/Cachix/Types/NarFileName.hs +7/−3
• src/Cachix/Types/NarInfo.hs +5/−2
• src/Cachix/Types/NarInfoCreate.hs +3/−2
• src/Cachix/Types/NarInfoHash.hs +3/−2
• src/Cachix/Types/NixCacheInfo.hs +3/−2
• src/Cachix/Types/Permission.hs +3/−2
• src/Cachix/Types/PinCreate.hs +6/−5
• src/Cachix/Types/SigningKeyCreate.hs +3/−2
• test/WebSocketClientSpec.hs +43/−0

@@ -7,6 +7,12 @@  ## [Unreleased] +## [1.14.0] - 2026-11-05++### Added++- Add OpenAPI 3.0 schemas for API payloads, streaming responses, and URL parameters.+ ## [0.7.0] - 2022-01-12  - Support Cachix Deploy

@@ -1,6 +1,6 @@ cabal-version:   2.2 name:            cachix-api-version:         1.13.0+version:         1.14.0 synopsis:        Servant HTTP API specification for https://cachix.org homepage:        https://github.com/cachix/cachix#readme bug-reports:     https://github.com/cachix/cachix/issues@@ -72,6 +72,7 @@     Cachix.API.Deploy.V2     Cachix.API.Error     Cachix.API.Signing+    Cachix.API.WebSocket.Client     Cachix.API.WebSocketSubprotocol     Cachix.Types.BinaryCache     Cachix.Types.ByteStringStreaming@@ -104,6 +105,7 @@     , http-media     , jose     , nix-narinfo+    , openapi3     , protolude     , resourcet     , safe-exceptions@@ -115,7 +117,7 @@     , time     , unordered-containers     , uuid-    , websockets+    , websockets            >=0.13    if flag(ram)     build-depends:@@ -134,6 +136,7 @@   other-modules:     DeploySpec     Spec+    WebSocketClientSpec    hs-source-dirs:     test   build-depends:@@ -142,5 +145,6 @@     , cachix-api     , hspec     , protolude+    , websockets    build-tool-depends: hspec-discover:hspec-discover

@@ -0,0 +1,26 @@+-- | WebSocket clients with explicit HTTP handshake rejections.+module Cachix.API.WebSocket.Client+  ( HandshakeRejected (..),+    withHandshakeErrors,+  )+where++import qualified Network.WebSockets as WS+import Protolude++newtype HandshakeRejected = HandshakeRejected+  { rejectionResponse :: WS.ResponseHead+  }+  deriving (Show)++instance Exception HandshakeRejected++-- | Normalize HTTP handshake rejections thrown by the supplied action.+-- Invalid HTTP 101 upgrade responses retain their original exception.+withHandshakeErrors :: IO a -> IO a+withHandshakeErrors action = action `catch` handleHandshakeError+  where+    handleHandshakeError (WS.RequestRejected _ response) = throwIO $ HandshakeRejected response+    handleHandshakeError (WS.MalformedResponse response _)+      | WS.responseCode response /= 101 = throwIO $ HandshakeRejected response+    handleHandshakeError exception = throwIO exception

@@ -6,6 +6,7 @@ import qualified Control.Concurrent.STM.TMQueue as TMQueue import qualified Control.Exception.Safe as Safe import qualified Data.Aeson as Aeson+import qualified Data.OpenApi as OpenApi import Data.Time (UTCTime) import Data.UUID (UUID) import qualified Network.WebSockets as WS@@ -100,4 +101,4 @@   { line :: Text,     time :: UTCTime   }-  deriving (Generic, Show, Aeson.ToJSON, Aeson.FromJSON)+  deriving (Generic, Show, Aeson.ToJSON, Aeson.FromJSON, OpenApi.ToSchema)

@@ -2,7 +2,8 @@  import Cachix.Types.Permission (Permission) import Data.Aeson (FromJSON, ToJSON)-import Data.Swagger (ToParamSchema (..), ToSchema)+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Protolude import Servant.API import Text.Read@@ -18,10 +19,10 @@     permission :: Permission,     preferredCompressionMethod :: CompressionMethod   }-  deriving (Show, Generic, FromJSON, ToJSON, ToSchema, NFData)+  deriving (Show, Generic, FromJSON, ToJSON, Swagger.ToSchema, OpenApi.ToSchema, NFData)  data CompressionMethod = XZ | ZSTD-  deriving (Show, Eq, Generic, FromJSON, ToJSON, ToSchema, NFData)+  deriving (Show, Eq, Generic, FromJSON, ToJSON, Swagger.ToSchema, OpenApi.ToSchema, NFData)  instance Read CompressionMethod where   readsPrec _ value =@@ -40,5 +41,8 @@   toUrlPiece XZ = "xz"   toUrlPiece ZSTD = "zst" -instance ToParamSchema CompressionMethod where-  toParamSchema _ = toParamSchema (Proxy :: Proxy Text)+instance Swagger.ToParamSchema CompressionMethod where+  toParamSchema _ = Swagger.toParamSchema (Proxy :: Proxy Text)++instance OpenApi.ToParamSchema CompressionMethod where+  toParamSchema _ = OpenApi.toParamSchema (Proxy :: Proxy Text)

@@ -1,15 +1,22 @@ module Cachix.Types.ByteStringStreaming where  import qualified Data.ByteString.Lazy as LBS-import Data.Swagger (NamedSchema (..), ToSchema (..), binarySchema)+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Protolude  newtype ByteStringStreaming = ByteStringStreaming ByteString -instance ToSchema ByteStringStreaming where-  declareNamedSchema _ = pure $ NamedSchema (Just "ByteString") binarySchema+instance Swagger.ToSchema ByteStringStreaming where+  declareNamedSchema _ = pure $ Swagger.NamedSchema (Just "ByteString") Swagger.binarySchema  newtype LazyByteStringStreaming = LazyByteStringStreaming LBS.ByteString -instance ToSchema LazyByteStringStreaming where-  declareNamedSchema _ = pure $ NamedSchema (Just "lazyByteString") binarySchema+instance Swagger.ToSchema LazyByteStringStreaming where+  declareNamedSchema _ = pure $ Swagger.NamedSchema (Just "lazyByteString") Swagger.binarySchema++instance OpenApi.ToSchema ByteStringStreaming where+  declareNamedSchema _ = pure $ OpenApi.NamedSchema (Just "ByteString") OpenApi.binarySchema++instance OpenApi.ToSchema LazyByteStringStreaming where+  declareNamedSchema _ = pure $ OpenApi.NamedSchema (Just "lazyByteString") OpenApi.binarySchema

@@ -3,7 +3,8 @@ module Cachix.Types.Deploy where  import Data.HashMap.Strict-import Data.Swagger (ToSchema)+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Deriving.Aeson import Protolude @@ -11,5 +12,5 @@   { agents :: HashMap Text Text,     rollbackScript :: Maybe (HashMap Text Text)   }-  deriving (Show, Eq, Generic, FromJSON, ToSchema)+  deriving (Show, Eq, Generic, FromJSON, Swagger.ToSchema, OpenApi.ToSchema)   deriving (ToJSON) via CustomJSON '[OmitNothingFields] Deploy

@@ -5,11 +5,17 @@     ToJSON,   ) import Data.HashMap.Strict-import Data.Swagger (ToSchema)+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Protolude  newtype DeployResponse = DeployResponse   { agents :: HashMap Text Text   }   deriving stock (Show, Generic)-  deriving anyclass (FromJSON, ToJSON, ToSchema, NFData)+  deriving anyclass (FromJSON, ToJSON, Swagger.ToSchema, NFData)++instance OpenApi.ToSchema DeployResponse where+  declareNamedSchema proxy = do+    OpenApi.NamedSchema _ responseSchema <- OpenApi.genericDeclareNamedSchema OpenApi.defaultSchemaOptions proxy+    pure $ OpenApi.NamedSchema (Just "DeployResponseV1") responseSchema

@@ -5,7 +5,8 @@     ToJSON,   ) import Data.HashMap.Strict-import Data.Swagger (ToSchema)+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Data.UUID (UUID) import Protolude @@ -14,10 +15,15 @@     url :: Text   }   deriving stock (Show, Generic)-  deriving anyclass (FromJSON, ToJSON, ToSchema, NFData)+  deriving anyclass (FromJSON, ToJSON, Swagger.ToSchema, OpenApi.ToSchema, NFData)  newtype DeployResponse = DeployResponse   { agents :: HashMap Text Details   }   deriving stock (Show, Generic)-  deriving anyclass (FromJSON, ToJSON, ToSchema, NFData)+  deriving anyclass (FromJSON, ToJSON, Swagger.ToSchema, NFData)++instance OpenApi.ToSchema DeployResponse where+  declareNamedSchema proxy = do+    OpenApi.NamedSchema _ responseSchema <- OpenApi.genericDeclareNamedSchema OpenApi.defaultSchemaOptions proxy+    pure $ OpenApi.NamedSchema (Just "DeployResponseV2") responseSchema

@@ -4,7 +4,8 @@   ( FromJSON,     ToJSON,   )-import Data.Swagger (ToSchema)+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Data.Time.Clock (UTCTime) import Data.UUID (UUID) import Protolude@@ -16,7 +17,7 @@   | Failed   | Succeeded   deriving stock (Eq, Generic, Show)-  deriving anyclass (FromJSON, ToJSON, ToSchema, NFData)+  deriving anyclass (FromJSON, ToJSON, Swagger.ToSchema, OpenApi.ToSchema, NFData)  data Deployment = Deployment   { id :: UUID,@@ -29,4 +30,4 @@     status :: Status   }   deriving stock (Show, Generic)-  deriving anyclass (FromJSON, ToJSON, ToSchema, NFData)+  deriving anyclass (FromJSON, ToJSON, Swagger.ToSchema, OpenApi.ToSchema, NFData)

@@ -2,7 +2,8 @@  import Cachix.Types.NarInfoCreate (NarInfoCreate) import Data.Aeson (FromJSON, ToJSON)-import Data.Swagger (ToSchema)+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Data.UUID (UUID) import Protolude @@ -11,18 +12,18 @@     uploadId :: Text   }   deriving stock (Generic, Eq, Show)-  deriving anyclass (ToJSON, FromJSON, ToSchema, NFData)+  deriving anyclass (ToJSON, FromJSON, Swagger.ToSchema, OpenApi.ToSchema, NFData)  -- | Any hashes or headers required to create the presigned URL. data SigningData = SigningData   { contentMD5 :: Text   }   deriving stock (Generic, Eq, Show)-  deriving anyclass (ToJSON, FromJSON, ToSchema, NFData)+  deriving anyclass (ToJSON, FromJSON, Swagger.ToSchema, OpenApi.ToSchema, NFData)  newtype UploadPartResponse = UploadPartResponse {uploadUrl :: Text}   deriving stock (Generic, Show)-  deriving anyclass (ToJSON, FromJSON, ToSchema, NFData)+  deriving anyclass (ToJSON, FromJSON, Swagger.ToSchema, OpenApi.ToSchema, NFData)  data CompletedPart = CompletedPart   { partNumber :: Int,@@ -30,7 +31,7 @@     eTag :: Text   }   deriving stock (Generic, Eq, Show)-  deriving anyclass (ToJSON, FromJSON, ToSchema, NFData)+  deriving anyclass (ToJSON, FromJSON, Swagger.ToSchema, OpenApi.ToSchema, NFData)  instance Ord CompletedPart where   p1 `compare` p2 = partNumber p1 `compare` partNumber p2@@ -44,4 +45,4 @@     narInfoCreate :: NarInfoCreate   }   deriving stock (Generic, Show)-  deriving anyclass (ToJSON, FromJSON, ToSchema)+  deriving anyclass (ToJSON, FromJSON, Swagger.ToSchema, OpenApi.ToSchema)

@@ -3,7 +3,8 @@   ) where -import Data.Swagger (ToParamSchema (..))+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import qualified Data.Text as T import Protolude import Servant.API@@ -25,5 +26,8 @@ instance ToHttpApiData NarFileName where   toUrlPiece narfilename = contentHash narfilename <> ".nar." <> extension narfilename -instance ToParamSchema NarFileName where-  toParamSchema _ = toParamSchema (Proxy :: Proxy Text)+instance Swagger.ToParamSchema NarFileName where+  toParamSchema _ = Swagger.toParamSchema (Proxy :: Proxy Text)++instance OpenApi.ToParamSchema NarFileName where+  toParamSchema _ = OpenApi.toParamSchema (Proxy :: Proxy Text)

@@ -9,11 +9,14 @@ where  import Data.Aeson (FromJSON, ToJSON)-import Data.Swagger (ToSchema)+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Nix.NarInfo (NarInfo (..)) import Protolude -deriving instance ToSchema CachixNarInfo+deriving instance Swagger.ToSchema CachixNarInfo++deriving instance OpenApi.ToSchema CachixNarInfo  deriving instance ToJSON CachixNarInfo 

@@ -9,7 +9,8 @@   ( FromJSON,     ToJSON,   )-import Data.Swagger+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Protolude  -- TODO: get rid of c prefix@@ -28,7 +29,7 @@     cDeriver :: Text,     cSig :: Maybe Text   }-  deriving (Generic, Show, FromJSON, ToJSON, ToSchema)+  deriving (Generic, Show, FromJSON, ToJSON, Swagger.ToSchema, OpenApi.ToSchema)  data NarInfoInvalid   = NarSizeIsZero

@@ -3,14 +3,15 @@   ) where -import Data.Swagger (ToParamSchema, ToSchema)+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Data.Text (dropEnd, takeEnd) import Protolude import Servant.API  -- | Store path hash newtype NarInfoHash = NarInfoHash {unnarinfohash :: Text}-  deriving (Generic, ToSchema, ToParamSchema)+  deriving (Generic, Swagger.ToSchema, Swagger.ToParamSchema, OpenApi.ToSchema, OpenApi.ToParamSchema)  instance FromHttpApiData NarInfoHash where   parseUrlPiece s =

@@ -1,7 +1,8 @@ module Cachix.Types.NixCacheInfo where  import Data.Aeson (FromJSON, ToJSON)-import Data.Swagger (ToSchema)+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Protolude  data NixCacheInfo = NixCacheInfo@@ -9,4 +10,4 @@     wantMassQuery :: Integer,     priority :: Integer   }-  deriving (Generic, Show, FromJSON, ToJSON, ToSchema, NFData)+  deriving (Generic, Show, FromJSON, ToJSON, Swagger.ToSchema, OpenApi.ToSchema, NFData)

@@ -1,8 +1,9 @@ module Cachix.Types.Permission where  import Data.Aeson (FromJSON, ToJSON)-import Data.Swagger (ToSchema)+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Protolude  data Permission = Read | Write | Admin-  deriving (Generic, Show, FromJSON, ToJSON, ToSchema, NFData, Eq, Ord)+  deriving (Generic, Show, FromJSON, ToJSON, Swagger.ToSchema, OpenApi.ToSchema, NFData, Eq, Ord)

@@ -1,15 +1,16 @@ module Cachix.Types.PinCreate where  import Data.Aeson (FromJSON, ToJSON)-import Data.Swagger (ToSchema (..), defaultSchemaOptions, genericDeclareNamedSchemaUnrestricted)+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Protolude  data Keep = Days Int | Revisions Int | Forever-  deriving (Show, Eq, Generic, ToJSON, FromJSON)+  deriving (Show, Eq, Generic, ToJSON, FromJSON, OpenApi.ToSchema)  -- to support Keep with data constructor with arguments-instance ToSchema Keep where-  declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions+instance Swagger.ToSchema Keep where+  declareNamedSchema = Swagger.genericDeclareNamedSchemaUnrestricted Swagger.defaultSchemaOptions  data PinCreate = PinCreate   { name :: Text,@@ -17,4 +18,4 @@     artifacts :: [Text],     keep :: Maybe Keep   }-  deriving (Show, Eq, Generic, ToJSON, FromJSON, ToSchema)+  deriving (Show, Eq, Generic, ToJSON, FromJSON, Swagger.ToSchema, OpenApi.ToSchema)

@@ -7,11 +7,12 @@   ( FromJSON,     ToJSON,   )-import Data.Swagger+import qualified Data.OpenApi as OpenApi+import qualified Data.Swagger as Swagger import Protolude  -- | Conveys that a signing secret key was created, by sharing the public key. newtype SigningKeyCreate = SigningKeyCreate   { publicKey :: Text   }-  deriving (Show, Generic, FromJSON, ToJSON, ToSchema)+  deriving (Show, Generic, FromJSON, ToJSON, Swagger.ToSchema, OpenApi.ToSchema)

@@ -0,0 +1,43 @@+module WebSocketClientSpec where++import Cachix.API.WebSocket.Client+import qualified Data.IORef as IORef+import qualified Network.WebSockets as WS+import qualified Network.WebSockets.Stream as Stream+import Protolude+import Test.Hspec++spec :: Spec+spec = describe "WebSocket handshake errors" $ do+  for_ [(400, "Bad Request"), (401, "Unauthorized")] $ \(status, message) ->+    it ("exposes HTTP " <> show status <> " rejections with their response headers") $ do+      let response = WS.ResponseHead status message [("WWW-Authenticate", "Bearer")]+          rawResponse = "HTTP/1.1 " <> encodeUtf8 (show status :: Text) <> " " <> message <> "\r\nWWW-Authenticate: Bearer\r\n\r\n"+      handshake rawResponse `shouldThrow` rejectsWith response++  it "preserves malformed HTTP 101 upgrade errors" $+    handshake "HTTP/1.1 101 Switching Protocols\r\nSec-WebSocket-Accept: invalid\r\n\r\n"+      `shouldThrow` \case+        WS.MalformedResponse actual _ -> WS.responseCode actual == 101+        _ -> False++  it "preserves failures without an HTTP response" $+    handshake ""+      `shouldThrow` \case+        WS.ParseException _ -> True+        _ -> False++rejectsWith :: WS.ResponseHead -> HandshakeRejected -> Bool+rejectsWith expected (HandshakeRejected actual) =+  WS.responseCode actual == WS.responseCode expected+    && WS.responseMessage actual == WS.responseMessage expected+    && WS.responseHeaders actual == WS.responseHeaders expected++-- Exercise the real client handshake parser without opening a socket.+handshake :: ByteString -> IO ()+handshake response = do+  input <- IORef.newIORef (Just response)+  bracket+    (Stream.makeStream (IORef.atomicModifyIORef' input (\chunk -> (Nothing, chunk))) (const $ pure ()))+    Stream.close+    (\stream -> withHandshakeErrors $ WS.runClientWithStream stream "localhost" "/ws" WS.defaultConnectionOptions [] (const $ pure ()))