diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,12 +7,17 @@ ## [Unreleased] +## [0.3.0] - 2019-09-03 + +- #216 Add bulk store path query +- #216 Provide plain and base16 passthrough sinks + ## [0.2.1] - 2019-07-05 # Added - #192 Add Secrets.SigningKey abstraction @robert -- #180 support servant 0.16 @domenkozar +- #180 Support servant 0.16 @domenkozar ## [0.2.0] - 2019-03-04 diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/cachix-api.cabal b/cachix-api.cabal --- a/cachix-api.cabal +++ b/cachix-api.cabal @@ -1,53 +1,61 @@ -cabal-version: 2.2 -name: cachix-api -version: 0.2.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 -author: Domen Kožar -maintainer: domen@enlambda.com -copyright: 2018 Domen Kožar -license: Apache-2.0 -license-file: LICENSE -build-type: Simple - +cabal-version: 2.2 +name: cachix-api +version: 0.3.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 +author: Domen Kožar +maintainer: domen@enlambda.com +copyright: 2018 Domen Kožar +license: Apache-2.0 +license-file: LICENSE +build-type: Simple extra-source-files: - CHANGELOG.md - README.md + CHANGELOG.md + README.md common defaults - default-extensions: OverloadedStrings DeriveGeneric DeriveAnyClass - ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-name-shadowing -fwarn-incomplete-patterns - default-language: Haskell2010 + default-extensions: + DeriveAnyClass + DeriveGeneric + OverloadedStrings + ghc-options: + -Wall -Wcompat -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wredundant-constraints -fwarn-tabs + -fwarn-unused-imports -fwarn-missing-signatures + -fwarn-name-shadowing -fwarn-incomplete-patterns + + default-language: Haskell2010 + source-repository head - type: git + type: git location: https://github.com/cachix/cachix library - import: defaults + import: defaults exposed-modules: - Cachix.Api - Cachix.Api.Error - Cachix.Api.Signing - Cachix.Api.Types - Cachix.Types.BinaryCacheAuthenticated - Cachix.Types.BinaryCacheCreate - Cachix.Types.ContentTypes - Cachix.Types.GitHubTeam - Cachix.Types.NarInfoCreate - Cachix.Types.Servant - Cachix.Types.Session - Cachix.Types.SigningKeyCreate - Cachix.Types.SwaggerOrphans - hs-source-dirs: - src + Cachix.Api + Cachix.Api.Error + Cachix.Api.Signing + Cachix.Api.Types + Cachix.Types.BinaryCacheAuthenticated + Cachix.Types.BinaryCacheCreate + Cachix.Types.ContentTypes + Cachix.Types.GitHubTeam + Cachix.Types.NarInfoCreate + Cachix.Types.Servant + Cachix.Types.Session + Cachix.Types.SigningKeyCreate + Cachix.Types.SwaggerOrphans + + hs-source-dirs: src build-depends: - aeson - , base >=4.7 && <5 + , aeson + , base >=4.7 && <5 , base16-bytestring , bytestring - , conduit >=1.3.0 + , conduit >=1.3.0 , cookie , cryptonite , deepseq @@ -57,11 +65,11 @@ , lens , memory , resourcet - , servant >=0.14.1 - , servant-client + , servant >=0.14.1 , servant-auth , servant-auth-server , servant-auth-swagger + , servant-client , servant-swagger , string-conv , swagger2 @@ -69,30 +77,27 @@ , transformers executable cachix-gen-swagger - import: defaults - main-is: Main.hs - hs-source-dirs: - cachix-gen-swagger + import: defaults + main-is: Main.hs + hs-source-dirs: cachix-gen-swagger build-depends: - aeson - , base >=4.7 && <5 + , aeson + , base >=4.7 && <5 , cachix-api test-suite cachix-api-test - import: defaults - type: exitcode-stdio-1.0 - main-is: Main.hs - other-modules: - Spec - hs-source-dirs: - test + import: defaults + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: Spec + hs-source-dirs: test build-depends: - aeson - , base >=4.7 && <5 + , aeson + , base >=4.7 && <5 , base16-bytestring , bytestring , cachix-api - , conduit >=1.3.0 + , conduit >=1.3.0 , cookie , cryptonite , hspec @@ -101,7 +106,7 @@ , lens , memory , protolude - , servant >=0.14.1 + , servant >=0.14.1 , servant-auth , servant-auth-server , servant-auth-swagger @@ -111,4 +116,5 @@ , swagger2 , text , transformers - build-tool-depends: hspec-discover:hspec-discover + + build-tool-depends: hspec-discover:hspec-discover -any diff --git a/cachix-gen-swagger/Main.hs b/cachix-gen-swagger/Main.hs --- a/cachix-gen-swagger/Main.hs +++ b/cachix-gen-swagger/Main.hs @@ -1,8 +1,7 @@ module Main (main) where -import Data.Aeson (encode) - import Cachix.Api (swaggerDoc) +import Data.Aeson (encode) main :: IO () main = print $ encode swaggerDoc diff --git a/src/Cachix/Api.hs b/src/Cachix/Api.hs --- a/src/Cachix/Api.hs +++ b/src/Cachix/Api.hs @@ -3,25 +3,36 @@ {-# LANGUAGE TypeOperators #-} module Cachix.Api - ( servantApi - , swaggerDoc - , CachixAPI(..) - , CachixServantAPI - , CachixAuth - , InstallAPI(..) - , GitHubAPI(..) - , BinaryCacheAPI(..) - , BinaryCacheStreamingAPI(..) - , BinaryCachStreamingServantAPI - , module Cachix.Api.Types - , module Cachix.Types.ContentTypes - ) where + ( servantApi, + swaggerDoc, + CachixAPI (..), + CachixServantAPI, + CachixAuth, + InstallAPI (..), + GitHubAPI (..), + BinaryCacheAPI (..), + BinaryCacheStreamingAPI (..), + BinaryCachStreamingServantAPI, + module Cachix.Api.Types, + module Cachix.Types.ContentTypes + ) +where +import Cachix.Api.Types +import qualified Cachix.Types.BinaryCacheAuthenticated as BinaryCacheAuthenticated +import qualified Cachix.Types.BinaryCacheCreate as BinaryCacheCreate +import Cachix.Types.ContentTypes +import qualified Cachix.Types.GitHubTeam as GitHubTeam +import qualified Cachix.Types.NarInfoCreate as NarInfoCreate +import Cachix.Types.Servant (Get302, Head, Post302) +import Cachix.Types.Session (Session) +import qualified Cachix.Types.SigningKeyCreate as SigningKeyCreate +import Cachix.Types.SwaggerOrphans () import Control.Lens import Control.Monad.Trans.Resource import Data.ByteString (ByteString) import Data.Conduit (ConduitT) -import Data.Proxy (Proxy(..)) +import Data.Proxy (Proxy (..)) import Data.Swagger hiding (Header) import Data.Text import GHC.Generics (Generic) @@ -30,145 +41,180 @@ import Servant.Auth import Servant.Auth.Swagger () import Servant.Swagger -import Web.Cookie (SetCookie) - -import Cachix.Types.ContentTypes -import Cachix.Types.Servant (Get302, Post302, Head) -import Cachix.Types.Session (Session) -import Cachix.Types.SwaggerOrphans () -import Cachix.Api.Types - -import qualified Cachix.Types.BinaryCacheCreate as BinaryCacheCreate -import qualified Cachix.Types.BinaryCacheAuthenticated as BinaryCacheAuthenticated -import qualified Cachix.Types.GitHubTeam as GitHubTeam -import qualified Cachix.Types.NarInfoCreate as NarInfoCreate -import qualified Cachix.Types.SigningKeyCreate as SigningKeyCreate - +import Web.Cookie (SetCookie) type CachixAuth = Auth '[Cookie, JWT, BasicAuth] Session -data BinaryCacheAPI route = BinaryCacheAPI - { get :: route :- - CachixAuth :> - Get '[JSON] BinaryCache - , create :: route :- - CachixAuth :> - ReqBody '[JSON] BinaryCacheCreate.BinaryCacheCreate :> - Post '[JSON] NoContent - -- https://cache.nixos.org/nix-cache-info - , nixCacheInfo :: route :- - CachixAuth :> - "nix-cache-info" :> - Get '[XNixCacheInfo, JSON] NixCacheInfo - -- Hydra: src/lib/Hydra/View/NARInfo.pm - , narinfo :: route :- - CachixAuth :> - Capture "narinfo" NarInfoC :> - Get '[XNixNarInfo, JSON] NarInfo - , narinfoHead :: route :- - CachixAuth :> - Capture "narinfo" NarInfoC :> - Head - , createNarinfo :: route :- - Capture "narinfo" NarInfoC :> - ReqBody '[JSON] NarInfoCreate.NarInfoCreate :> - Post '[JSON] NoContent - , createKey :: route :- - CachixAuth :> - "key" :> - ReqBody '[JSON] SigningKeyCreate.SigningKeyCreate :> - Post '[JSON] NoContent - } deriving Generic +data BinaryCacheAPI route + = BinaryCacheAPI + { get + :: route + :- CachixAuth + :> Get '[JSON] BinaryCache, + create + :: route + :- CachixAuth + :> ReqBody '[JSON] BinaryCacheCreate.BinaryCacheCreate + :> Post '[JSON] NoContent, + -- https://cache.nixos.org/nix-cache-info + nixCacheInfo + :: route + :- CachixAuth + :> "nix-cache-info" + :> Get '[XNixCacheInfo, JSON] NixCacheInfo, + -- Hydra: src/lib/Hydra/View/NARInfo.pm + narinfo + :: route + :- CachixAuth + :> Capture "narinfo" NarInfoC + :> Get '[XNixNarInfo, JSON] NarInfo, + narinfoHead + :: route + :- CachixAuth + :> Capture "narinfo" NarInfoC + :> Head, + narinfoBulk + :: route + :- CachixAuth + :> "narinfo" + :> Summary "Given a list of store hashes, return a list of those that are missing" + :> ReqBody '[JSON] [Text] + :> Post '[JSON] [Text], + createNarinfo + :: route + :- Capture "narinfo" NarInfoC + :> ReqBody '[JSON] NarInfoCreate.NarInfoCreate + :> Post '[JSON] NoContent, + createKey + :: route + :- CachixAuth + :> "key" + :> ReqBody '[JSON] SigningKeyCreate.SigningKeyCreate + :> Post '[JSON] NoContent + } + deriving (Generic) -- | Streaming endpoints -data BinaryCacheStreamingAPI route = BinaryCacheStreamingAPI - { -- Hydra: src/lib/Hydra/View/NixNAR.pm - nar :: route :- - CachixAuth :> - "nar" :> - Capture "nar" NarC :> - StreamGet NoFraming OctetStream (ConduitT () ByteString (ResourceT IO) ()) - , createNar :: route :- - "nar" :> - StreamBody NoFraming XNixNar (ConduitT () ByteString (ResourceT IO) ()) :> - Post '[JSON] NoContent - } deriving Generic +data BinaryCacheStreamingAPI route + = BinaryCacheStreamingAPI + { -- Hydra: src/lib/Hydra/View/NixNAR.pm + nar + :: route + :- CachixAuth + :> "nar" + :> Capture "nar" NarC + :> StreamGet NoFraming OctetStream (ConduitT () ByteString (ResourceT IO) ()), + createNar + :: route + :- "nar" + :> StreamBody NoFraming XNixNar (ConduitT () ByteString (ResourceT IO) ()) + :> Post '[JSON] NoContent + } + deriving (Generic) -data InstallAPI route = InstallAPI - { installGetLatest :: route :- - Summary "Redirects to a tarball containing nix expression to build the latest version of cachix cli" :> - Get302 '[JSON] '[] - , installGetVersion :: route :- - Summary "Redirects to a tarball containing nix expression to build given version of cachix cli" :> - Capture "version" Text :> - Get302 '[JSON] '[] - } deriving Generic +data InstallAPI route + = InstallAPI + { installGetLatest + :: route + :- Summary "Redirects to a tarball containing nix expression to build the latest version of cachix cli" + :> Get302 '[JSON] '[], + installGetVersion + :: route + :- Summary "Redirects to a tarball containing nix expression to build given version of cachix cli" + :> Capture "version" Text + :> Get302 '[JSON] '[] + } + deriving (Generic) -data GitHubAPI route = GitHubAPI - { githubOrganizations :: route :- - CachixAuth :> - "orgs" :> - Get '[JSON] [Text] - , githubTeams :: route :- - CachixAuth :> - "orgs" :> - Capture "org" Text :> - "teams" :> - Get '[JSON] [GitHubTeam.GitHubTeam] - } deriving Generic +data GitHubAPI route + = GitHubAPI + { githubOrganizations + :: route + :- CachixAuth + :> "orgs" + :> Get '[JSON] [Text], + githubTeams + :: route + :- CachixAuth + :> "orgs" + :> Capture "org" Text + :> "teams" + :> Get '[JSON] [GitHubTeam.GitHubTeam] + } + deriving (Generic) -data CachixAPI route = CachixAPI - { logout :: route :- - "logout" :> - CachixAuth :> - Post302 '[JSON] '[ Header "Set-Cookie" SetCookie - , Header "Set-Cookie" SetCookie - ] - , login :: route :- - "login" :> - Get302 '[JSON] '[] - , loginCallback :: route :- - "login" :> - "callback" :> - QueryParam "code" Text :> - QueryParam "state" Text :> - Get302 '[JSON] '[ Header "Set-Cookie" SetCookie - , Header "Set-Cookie" SetCookie - ] - , user :: route :- - CachixAuth :> - "user" :> - Get '[JSON] User - , createToken :: route :- - CachixAuth :> - "token" :> - Post '[JSON] Text - , caches :: route :- - CachixAuth :> - "cache" :> - Get '[JSON] [BinaryCacheAuthenticated.BinaryCacheAuthenticated] - , cache :: route :- - "cache" :> - Capture "name" Text :> - ToServantApi BinaryCacheAPI - , install :: route :- - "install" :> - ToServantApi InstallAPI - , github :: route :- - "github" :> - ToServantApi GitHubAPI - } deriving Generic +data CachixAPI route + = CachixAPI + { logout + :: route + :- "logout" + :> CachixAuth + :> Post302 '[JSON] + '[ Header "Set-Cookie" SetCookie, + Header "Set-Cookie" SetCookie + ], + login + :: route + :- "login" + :> Get302 '[JSON] '[], + loginCallback + :: route + :- "login" + :> "callback" + :> QueryParam "code" Text + :> QueryParam "state" Text + :> Get302 '[JSON] + '[ Header "Set-Cookie" SetCookie, + Header "Set-Cookie" SetCookie + ], + user + :: route + :- CachixAuth + :> "user" + :> Get '[JSON] User, + createToken + :: route + :- CachixAuth + :> "token" + :> Post '[JSON] Text, + caches + :: route + :- CachixAuth + :> "cache" + :> Get '[JSON] [BinaryCacheAuthenticated.BinaryCacheAuthenticated], + cache + :: route + :- "cache" + :> Capture "name" Text + :> ToServantApi BinaryCacheAPI, + install + :: route + :- "install" + :> ToServantApi InstallAPI, + github + :: route + :- "github" + :> ToServantApi GitHubAPI + } + deriving (Generic) type CachixServantAPI = "api" :> "v1" :> ToServantApi CachixAPI -type BinaryCachStreamingServantAPI = - "api" :> "v1" :> "cache" :> Capture "name" Text :> ToServantApi BinaryCacheStreamingAPI +type BinaryCachStreamingServantAPI + = "api" :> "v1" :> "cache" :> Capture "name" Text :> ToServantApi BinaryCacheStreamingAPI servantApi :: Proxy CachixServantAPI servantApi = Proxy swaggerDoc :: Swagger -swaggerDoc = toSwagger servantApi - & info.title .~ "cachix.org API" - & info.version .~ "1.0" - & info.description ?~ "TODO" +swaggerDoc = + toSwagger servantApi + & info + . title + .~ "cachix.org API" + & info + . version + .~ "1.0" + & info + . description + ?~ "TODO" diff --git a/src/Cachix/Api/Error.hs b/src/Cachix/Api/Error.hs --- a/src/Cachix/Api/Error.hs +++ b/src/Cachix/Api/Error.hs @@ -1,23 +1,26 @@ module Cachix.Api.Error - ( escalate - , escalateAs - ) where + ( escalate, + escalateAs + ) +where -import Control.Exception (Exception) -import Control.Monad.Catch ( MonadThrow(throwM) ) +import Control.Exception (Exception) +import Control.Monad.Catch (MonadThrow (throwM)) {- | Examples: > escalate . maybeToEither err404 | Note that exceptions gets handled by warp and logged (user sees just "Internal server") -} -escalateAs :: (Exception exc, MonadThrow m) - => (l -> exc) - -> Either l a - -> m a +escalateAs + :: (Exception exc, MonadThrow m) + => (l -> exc) + -> Either l a + -> m a escalateAs f = either (throwM . f) pure -escalate :: (Exception exc, MonadThrow m) - => Either exc a - -> m a +escalate + :: (Exception exc, MonadThrow m) + => Either exc a + -> m a escalate = escalateAs id diff --git a/src/Cachix/Api/Signing.hs b/src/Cachix/Api/Signing.hs --- a/src/Cachix/Api/Signing.hs +++ b/src/Cachix/Api/Signing.hs @@ -1,31 +1,33 @@ module Cachix.Api.Signing - ( fingerprint - , passthroughSizeSink - , passthroughHashSink - ) where + ( fingerprint, + passthroughSizeSink, + passthroughHashSinkB16, + passthroughHashSink + ) +where -import Crypto.Hash -import Control.Monad.IO.Class (MonadIO, liftIO) -import qualified Data.ByteArray as BA +import Control.Monad.IO.Class (MonadIO, liftIO) +import Crypto.Hash +import qualified Data.ByteArray as BA +import Data.ByteArray.Encoding (Base (..), convertToBase) import qualified Data.ByteString as BS -import Data.ByteString (ByteString) -import qualified Data.ByteString.Base16 as B16 -import Data.Conduit -import qualified Data.Conduit.Combinators as CC -import Data.IORef -import Data.String.Conv (toS) +import Data.ByteString (ByteString) +import Data.Conduit +import qualified Data.Conduit.Combinators as CC +import Data.IORef +import Data.String.Conv (toS) import qualified Data.Text as T -import Data.Text (Text) - +import Data.Text (Text) -- perl/lib/Nix/Manifest.pm:fingerprintPath -- NB: references must be sorted fingerprint :: Text -> Text -> Integer -> [Text] -> ByteString -fingerprint storePath narHash narSize references = toS $ T.intercalate ";" - ["1", storePath, narHash, T.pack (show narSize), T.intercalate "," references] +fingerprint storePath narHash narSize references = + toS + $ T.intercalate ";" + ["1", storePath, narHash, T.pack (show narSize), T.intercalate "," references] -- Useful sinks for streaming nars - sizeSink :: MonadIO m => ConduitT ByteString o m Integer sizeSink = CC.foldM (\p n -> return (p + fromIntegral (BS.length n))) 0 @@ -35,8 +37,11 @@ passthroughSizeSink :: MonadIO m => IORef Integer -> ConduitT ByteString ByteString m () passthroughSizeSink ioref = passthroughSink sizeSink (liftIO . writeIORef ioref) -passthroughHashSink :: MonadIO m => IORef Text -> ConduitT ByteString ByteString m () -passthroughHashSink ioref = passthroughSink hashSink (liftIO . writeIORef ioref . transf) - where - -- TODO: use cryptonite B16 to get rid of extra dep and simplify - transf = toS . B16.encode . BS.pack . BA.unpack . hashFinalize +passthroughHashSinkBase :: MonadIO m => (Digest SHA256 -> ByteString) -> IORef ByteString -> ConduitT ByteString ByteString m () +passthroughHashSinkBase f ioref = passthroughSink hashSink (liftIO . writeIORef ioref . f . hashFinalize) + +passthroughHashSink :: MonadIO m => IORef ByteString -> ConduitT ByteString ByteString m () +passthroughHashSink = passthroughHashSinkBase BA.convert + +passthroughHashSinkB16 :: MonadIO m => IORef ByteString -> ConduitT ByteString ByteString m () +passthroughHashSinkB16 = passthroughHashSinkBase (convertToBase Base16) diff --git a/src/Cachix/Api/Types.hs b/src/Cachix/Api/Types.hs --- a/src/Cachix/Api/Types.hs +++ b/src/Cachix/Api/Types.hs @@ -1,95 +1,107 @@ module Cachix.Api.Types where -import Data.Aeson (FromJSON, ToJSON) -import Data.Monoid ((<>)) -import Data.Swagger (ToSchema, ToParamSchema) -import Data.Text (Text, takeEnd, dropEnd) -import GHC.Generics (Generic) -import Control.DeepSeq (NFData) +import Control.DeepSeq (NFData) +import Data.Aeson (FromJSON, ToJSON) +import Data.Monoid ((<>)) +import Data.Swagger (ToParamSchema, ToSchema) +import Data.Text (Text, dropEnd, takeEnd) +import GHC.Generics (Generic) import Servant.API - -data NixCacheInfo = NixCacheInfo - { storeDir :: Text - , wantMassQuery :: Integer - , priority :: Integer - } deriving (Generic, Show, FromJSON, ToJSON, ToSchema) +data NixCacheInfo + = NixCacheInfo + { storeDir :: Text, + wantMassQuery :: Integer, + priority :: Integer + } + deriving (Generic, Show, FromJSON, ToJSON, ToSchema) -- narinfo url includes storePath hash and .narinfo suffix -data NarInfo = NarInfo - { storePath :: Text - -- ^ absolute path of the derivation in nix store - , url :: Text - -- ^ relative url (to current domain) to download nar file - , compression :: Text - -- ^ name of the compression algorithm, eg. xz - , fileHash :: Text - -- ^ sha256 hash of the compressed nar file - -- NOTE: to compute use "nix-hash --type sha256 --flat" - , fileSize :: Integer - -- ^ file size of compressed nar file - -- NOTE: du -b - , narHash :: Text - -- ^ sha256 hash of the decompressed nar file - -- NOTE: to compute use "nix-hash --type sha256 --flat --base32" - , narSize :: Integer - -- ^ file size of decompressed nar file - -- NOTE: du -b - , references :: [Text] - -- ^ immediate dependencies of the storePath - -- NOTE: nix-store -q --references - , deriver :: Text - -- ^ relative store path (to nix store root) of the deriver - -- NOTE: nix-store -q --deriver - , sig :: Text - -- ^ signature of fields: storePath, narHash, narSize, refs - } deriving (Generic, Show, FromJSON, ToJSON, ToSchema) - +data NarInfo + = NarInfo + { storePath :: Text, + -- ^ absolute path of the derivation in nix store + url :: Text, + -- ^ relative url (to current domain) to download nar file + compression :: Text, + -- ^ name of the compression algorithm, eg. xz + fileHash :: Text, + -- ^ sha256 hash of the compressed nar file + -- NOTE: to compute use "nix-hash --type sha256 --flat" + fileSize :: Integer, + -- ^ file size of compressed nar file + -- NOTE: du -b + narHash :: Text, + -- ^ sha256 hash of the decompressed nar file + -- NOTE: to compute use "nix-hash --type sha256 --flat --base32" + narSize :: Integer, + -- ^ file size of decompressed nar file + -- NOTE: du -b + references :: [Text], + -- ^ immediate dependencies of the storePath + -- NOTE: nix-store -q --references + deriver :: Text, + -- ^ relative store path (to nix store root) of the deriver + -- NOTE: nix-store -q --deriver + sig :: Text + -- ^ signature of fields: storePath, narHash, narSize, refs + } + deriving (Generic, Show, FromJSON, ToJSON, ToSchema) -data BinaryCache = BinaryCache - { name :: Text - , uri :: Text - , isPublic :: Bool - , publicSigningKeys :: [Text] - , githubUsername :: Text - } deriving (Show, Generic, FromJSON, ToJSON, ToSchema, NFData) +data BinaryCache + = BinaryCache + { name :: Text, + uri :: Text, + isPublic :: Bool, + publicSigningKeys :: [Text], + githubUsername :: Text + } + deriving (Show, Generic, FromJSON, ToJSON, ToSchema, NFData) -newtype BinaryCacheError = BinaryCacheError - { error :: Text - } deriving (Generic, FromJSON, ToJSON) +newtype BinaryCacheError + = BinaryCacheError + { error :: Text + } + deriving (Generic, FromJSON, ToJSON) -- | Hash of nar.xz file newtype NarC = NarC Text deriving (Generic, ToSchema, ToParamSchema) instance FromHttpApiData NarC where + parseUrlPiece s = if takeEnd 7 s == ".nar.xz" - then Right $ NarC (dropEnd 7 s) - else Left "" + then Right $ NarC (dropEnd 7 s) + else Left "" instance ToHttpApiData NarC where + toUrlPiece (NarC n) = n <> ".nar.xz" -- | Store path hash newtype NarInfoC = NarInfoC Text deriving (Generic, ToSchema, ToParamSchema) instance FromHttpApiData NarInfoC where + parseUrlPiece s = if takeEnd 8 s == ".narinfo" - then Right $ NarInfoC (dropEnd 8 s) - else Left "" + then Right $ NarInfoC (dropEnd 8 s) + else Left "" instance ToHttpApiData NarInfoC where + toUrlPiece (NarInfoC n) = n <> ".narinfo" -data User = User - { fullname :: Maybe Text - , username :: Text - , email :: Maybe Text - , hasOrgsAcccess :: Bool - , activeSubscription :: SubscriptionType - , subscriptionAccountId :: Maybe Text - } deriving (Generic, FromJSON, ToJSON, ToSchema) +data User + = User + { fullname :: Maybe Text, + username :: Text, + email :: Maybe Text, + hasOrgsAcccess :: Bool, + activeSubscription :: SubscriptionType, + subscriptionAccountId :: Maybe Text + } + deriving (Generic, FromJSON, ToJSON, ToSchema) data SubscriptionType = Community | Starter | Basic | Pro deriving (Generic, FromJSON, ToJSON, ToSchema, Show, Read) diff --git a/src/Cachix/Types/BinaryCacheAuthenticated.hs b/src/Cachix/Types/BinaryCacheAuthenticated.hs --- a/src/Cachix/Types/BinaryCacheAuthenticated.hs +++ b/src/Cachix/Types/BinaryCacheAuthenticated.hs @@ -1,20 +1,23 @@ module Cachix.Types.BinaryCacheAuthenticated - ( BinaryCacheAuthenticated(..) - ) where + ( BinaryCacheAuthenticated (..) + ) +where -import Data.Aeson ( FromJSON - , ToJSON - ) +import Data.Aeson + ( FromJSON, + ToJSON + ) import Data.Swagger -import Data.Text ( Text ) -import GHC.Generics ( Generic ) - +import Data.Text (Text) +import GHC.Generics (Generic) -- | Binary Cache response content when user is authenticated -data BinaryCacheAuthenticated = BinaryCacheAuthenticated - { name :: Text - , uri :: Text - , publicSigningKeys :: [Text] - , isPublic :: Bool - , totalFileSize :: Integer - } deriving (Show, Generic, FromJSON, ToJSON, ToSchema) +data BinaryCacheAuthenticated + = BinaryCacheAuthenticated + { name :: Text, + uri :: Text, + publicSigningKeys :: [Text], + isPublic :: Bool, + totalFileSize :: Integer + } + deriving (Show, Generic, FromJSON, ToJSON, ToSchema) diff --git a/src/Cachix/Types/BinaryCacheCreate.hs b/src/Cachix/Types/BinaryCacheCreate.hs --- a/src/Cachix/Types/BinaryCacheCreate.hs +++ b/src/Cachix/Types/BinaryCacheCreate.hs @@ -1,18 +1,21 @@ module Cachix.Types.BinaryCacheCreate - ( BinaryCacheCreate(..) - ) where - -import Data.Aeson ( FromJSON - , ToJSON - ) -import Data.Swagger -import Data.Text ( Text ) -import GHC.Generics ( Generic ) + ( BinaryCacheCreate (..) + ) +where +import Data.Aeson + ( FromJSON, + ToJSON + ) +import Data.Swagger +import Data.Text (Text) +import GHC.Generics (Generic) -data BinaryCacheCreate = BinaryCacheCreate - { publicSigningKey :: Maybe Text - , isPublic :: Bool - , githubOrganization :: Maybe Text - , githubTeamId :: Maybe Int - } deriving (Show, Generic, FromJSON, ToJSON, ToSchema) +data BinaryCacheCreate + = BinaryCacheCreate + { publicSigningKey :: Maybe Text, + isPublic :: Bool, + githubOrganization :: Maybe Text, + githubTeamId :: Maybe Int + } + deriving (Show, Generic, FromJSON, ToJSON, ToSchema) diff --git a/src/Cachix/Types/ContentTypes.hs b/src/Cachix/Types/ContentTypes.hs --- a/src/Cachix/Types/ContentTypes.hs +++ b/src/Cachix/Types/ContentTypes.hs @@ -1,39 +1,49 @@ {-# LANGUAGE MultiParamTypeClasses #-} -module Cachix.Types.ContentTypes ( - XNixNar, - XNixNarInfo, - XNixCacheInfo -) where -import Data.ByteString (ByteString) -import Data.ByteString.Lazy (fromStrict, toStrict) -import Data.Typeable (Typeable) -import qualified Network.HTTP.Media as M -import Servant.API +module Cachix.Types.ContentTypes + ( XNixNar, + XNixNarInfo, + XNixCacheInfo + ) +where import Cachix.Api.Types +import Data.ByteString (ByteString) +import Data.ByteString.Lazy (fromStrict, toStrict) +import Data.Typeable (Typeable) +import qualified Network.HTTP.Media as M +import Servant.API -data XNixNar deriving Typeable -data XNixNarInfo deriving Typeable -data XNixCacheInfo deriving Typeable +data XNixNar deriving (Typeable) +data XNixNarInfo deriving (Typeable) + +data XNixCacheInfo deriving (Typeable) + instance Accept XNixCacheInfo where + contentType _ = "application" M.// "octet-stream" instance Accept XNixNarInfo where + contentType _ = "text" M.// "x-nix-narinfo" instance Accept XNixNar where + contentType _ = "application" M.// "x-nix-nar" instance MimeUnrender XNixCacheInfo NixCacheInfo where + mimeUnrender _ _ = Left "TODO" instance MimeUnrender XNixNarInfo NarInfo where + mimeUnrender _ _ = Left "TODO" instance MimeRender XNixNar ByteString where + mimeRender _ = fromStrict instance MimeUnrender XNixNar ByteString where + mimeUnrender _ = Right . toStrict diff --git a/src/Cachix/Types/GitHubTeam.hs b/src/Cachix/Types/GitHubTeam.hs --- a/src/Cachix/Types/GitHubTeam.hs +++ b/src/Cachix/Types/GitHubTeam.hs @@ -1,16 +1,19 @@ module Cachix.Types.GitHubTeam - ( GitHubTeam(..) - ) where - -import Data.Aeson ( FromJSON - , ToJSON - ) -import Data.Swagger -import Data.Text ( Text ) -import GHC.Generics ( Generic ) + ( GitHubTeam (..) + ) +where +import Data.Aeson + ( FromJSON, + ToJSON + ) +import Data.Swagger +import Data.Text (Text) +import GHC.Generics (Generic) -data GitHubTeam = GitHubTeam - { id :: Int - , name :: Text - } deriving (Generic, FromJSON, ToJSON, ToSchema) +data GitHubTeam + = GitHubTeam + { id :: Int, + name :: Text + } + deriving (Generic, FromJSON, ToJSON, ToSchema) diff --git a/src/Cachix/Types/NarInfoCreate.hs b/src/Cachix/Types/NarInfoCreate.hs --- a/src/Cachix/Types/NarInfoCreate.hs +++ b/src/Cachix/Types/NarInfoCreate.hs @@ -1,37 +1,41 @@ module Cachix.Types.NarInfoCreate - ( NarInfoCreate(..) - , NarInfoInvalid - , isNarInfoCreateValid - ) where + ( NarInfoCreate (..), + NarInfoInvalid, + isNarInfoCreateValid + ) +where -import Control.Exception (Exception) -import Data.Aeson ( FromJSON - , ToJSON - ) -import Data.Swagger -import Data.Text ( Text ) -import GHC.Generics ( Generic ) +import Control.Exception (Exception) +import Data.Aeson + ( FromJSON, + ToJSON + ) +import Data.Swagger +import Data.Text (Text) +import GHC.Generics (Generic) -- TODO: get rid of c prefix -- | Client create type -data NarInfoCreate = NarInfoCreate - { cStoreHash :: Text -- ^ $storePrefix / $storeHash - $storeSuffix - , cStoreSuffix :: Text -- ^ $storePrefix / $storeHash - $storeSuffix - , cNarHash :: Text - , cNarSize :: Integer - , cFileHash :: Text - , cFileSize :: Integer - , cReferences :: [Text] - , cDeriver :: Text - , cSig :: Text - } deriving (Generic, Show, FromJSON, ToJSON, ToSchema) +data NarInfoCreate + = NarInfoCreate + { cStoreHash :: Text, -- ^ $storePrefix / $storeHash - $storeSuffix + cStoreSuffix :: Text, -- ^ $storePrefix / $storeHash - $storeSuffix + cNarHash :: Text, + cNarSize :: Integer, + cFileHash :: Text, + cFileSize :: Integer, + cReferences :: [Text], + cDeriver :: Text, + cSig :: Text + } + deriving (Generic, Show, FromJSON, ToJSON, ToSchema) -data NarInfoInvalid = - NarSizeIsZero +data NarInfoInvalid + = NarSizeIsZero deriving (Show, Exception) - isNarInfoCreateValid :: NarInfoCreate -> Either NarInfoInvalid () -isNarInfoCreateValid nic | cNarSize nic == 0 = Left NarSizeIsZero - | otherwise = Right () +isNarInfoCreateValid nic + | cNarSize nic == 0 = Left NarSizeIsZero + | otherwise = Right () diff --git a/src/Cachix/Types/Servant.hs b/src/Cachix/Types/Servant.hs --- a/src/Cachix/Types/Servant.hs +++ b/src/Cachix/Types/Servant.hs @@ -1,18 +1,21 @@ -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeOperators #-} + -- | Servant specific additions that could be upstreamed module Cachix.Types.Servant - ( Get302 - , Post302 - , Head - ) where + ( Get302, + Post302, + Head + ) +where import Data.Text (Text) import Servant.API -- Location header as per https://github.com/haskell-servant/servant/issues/117#issuecomment-381398666 type Get302 (cts :: [*]) (hs :: [*]) = Verb 'GET 302 cts (Headers (Header "Location" Text ': hs) NoContent) + type Post302 (cts :: [*]) (hs :: [*]) = Verb 'POST 302 cts (Headers (Header "Location" Text ': hs) NoContent) -- TODO: allow empty CT with HEAD diff --git a/src/Cachix/Types/Session.hs b/src/Cachix/Types/Session.hs --- a/src/Cachix/Types/Session.hs +++ b/src/Cachix/Types/Session.hs @@ -1,19 +1,20 @@ --- | Module for auth session storage {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} + +-- | Module for auth session storage module Cachix.Types.Session - ( Session(..) - , UserId - ) where + ( Session (..), + UserId + ) +where import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) -- TODO: move these two into Servant.Auth import Servant.Auth.Server (FromJWT, ToJWT) - type UserId = Integer -newtype Session = - Session UserId +newtype Session + = Session UserId deriving (Eq, Show, Generic, FromJSON, ToJSON, FromJWT, ToJWT) diff --git a/src/Cachix/Types/SigningKeyCreate.hs b/src/Cachix/Types/SigningKeyCreate.hs --- a/src/Cachix/Types/SigningKeyCreate.hs +++ b/src/Cachix/Types/SigningKeyCreate.hs @@ -1,15 +1,19 @@ module Cachix.Types.SigningKeyCreate - ( SigningKeyCreate(..) - ) where + ( SigningKeyCreate (..) + ) +where -import Data.Aeson ( FromJSON - , ToJSON - ) -import Data.Swagger -import Data.Text ( Text ) -import GHC.Generics ( Generic ) +import Data.Aeson + ( FromJSON, + ToJSON + ) +import Data.Swagger +import Data.Text (Text) +import GHC.Generics (Generic) -- | Conveys that a signing secret key was created, by sharing the public key. -newtype SigningKeyCreate = SigningKeyCreate - { publicKey :: Text - } deriving (Show, Generic, FromJSON, ToJSON, ToSchema) +newtype SigningKeyCreate + = SigningKeyCreate + { publicKey :: Text + } + deriving (Show, Generic, FromJSON, ToJSON, ToSchema) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,13 +1,14 @@ module Main where import Protolude -import Test.Hspec.Runner -import Test.Hspec.Formatters import qualified Spec +import Test.Hspec.Formatters +import Test.Hspec.Runner main :: IO () main = hspecWith config Spec.spec where - config = defaultConfig - { configColorMode = ColorAlways - } + config = + defaultConfig + { configColorMode = ColorAlways + }