diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for cachix-api + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ +Copyright 2018 Domen Kožar + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +https://github.com/cachix/cachix/blob/master/README.md diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cachix-api.cabal b/cachix-api.cabal new file mode 100644 --- /dev/null +++ b/cachix-api.cabal @@ -0,0 +1,147 @@ +-- This file has been generated from package.yaml by hpack version 0.21.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: e8db970407465738fc6d366b754b2cf51d5a5e123461ea5b89db16236ecbd3ee + +name: cachix-api +version: 0.1.0.0 +description: Please see the README on Github at +homepage: https://github.com/githubuser/cachix-api#readme +bug-reports: https://github.com/githubuser/cachix-api/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: >= 1.10 + +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/githubuser/cachix-api + +library + exposed-modules: + Cachix.Api + Cachix.Api.Signing + Cachix.Api.Swagger + Cachix.Api.Types + Cachix.Types.ContentTypes + Cachix.Types.Servant + Cachix.Types.Session + other-modules: + Paths_cachix_api + hs-source-dirs: + src + default-extensions: OverloadedStrings + ghc-options: -Wall -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-name-shadowing -fwarn-incomplete-patterns + build-depends: + aeson + , amazonka + , base >=4.7 && <5 + , base16-bytestring + , bytestring + , conduit + , conduit-combinators + , cookie + , cryptonite + , http-api-data + , http-media + , lens + , memory + , servant + , servant-auth + , servant-auth-server + , servant-auth-swagger + , servant-generic + , servant-streaming + , servant-swagger + , servant-swagger-ui-core + , string-conv + , swagger2 + , text + , transformers + default-language: Haskell2010 + +executable cachix-gen-swagger + main-is: Main.hs + other-modules: + Paths_cachix_api + hs-source-dirs: + cachix-gen-swagger + default-extensions: OverloadedStrings + ghc-options: -Wall -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-name-shadowing -fwarn-incomplete-patterns -threaded -rtsopts -with-rtsopts=-N + build-depends: + aeson + , amazonka + , base >=4.7 && <5 + , base16-bytestring + , bytestring + , cachix-api + , conduit + , conduit-combinators + , cookie + , cryptonite + , http-api-data + , http-media + , lens + , memory + , servant + , servant-auth + , servant-auth-server + , servant-auth-swagger + , servant-generic + , servant-streaming + , servant-swagger + , servant-swagger-ui-core + , string-conv + , swagger2 + , text + , transformers + default-language: Haskell2010 + +test-suite cachix-api-test + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Spec + Paths_cachix_api + hs-source-dirs: + test + default-extensions: OverloadedStrings + ghc-options: -Wall -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-name-shadowing -fwarn-incomplete-patterns -threaded -rtsopts -with-rtsopts=-N + build-depends: + aeson + , amazonka + , base >=4.7 && <5 + , base16-bytestring + , bytestring + , cachix-api + , conduit + , conduit-combinators + , cookie + , cryptonite + , hspec + , http-api-data + , http-media + , lens + , memory + , protolude + , servant + , servant-auth + , servant-auth-server + , servant-auth-swagger + , servant-generic + , servant-streaming + , servant-swagger + , servant-swagger-ui-core + , string-conv + , swagger2 + , text + , transformers + default-language: Haskell2010 diff --git a/cachix-gen-swagger/Main.hs b/cachix-gen-swagger/Main.hs new file mode 100644 --- /dev/null +++ b/cachix-gen-swagger/Main.hs @@ -0,0 +1,8 @@ +module Main (main) where + +import Data.Aeson (encode) + +import Cachix.Api (swaggerDoc) + +main :: IO () +main = print $ encode swaggerDoc diff --git a/src/Cachix/Api.hs b/src/Cachix/Api.hs new file mode 100644 --- /dev/null +++ b/src/Cachix/Api.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeOperators #-} + +module Cachix.Api + ( api + , servantApi + , swaggerDoc + , CachixAPI(..) + , BinaryCacheAPI(..) + , CachixServantAPI + , module Cachix.Api.Types + , module Cachix.Types.ContentTypes + ) where + +import Control.Lens + +import Data.Proxy (Proxy(..)) +import Data.Swagger hiding (Header) +import Data.Text +import GHC.Generics (Generic) +import Network.AWS (AWS) +import Servant.API +import Servant.Auth +import Servant.Generic +import Servant.Streaming +import Servant.Swagger +import Servant.Swagger.UI.Core (SwaggerSchemaUI) +import Web.Cookie (SetCookie) + +import Cachix.Types.ContentTypes +import Cachix.Types.Servant (Get302, Post302, Head) +import Cachix.Types.Session (Session) +import Cachix.Api.Types +import Cachix.Api.Swagger () + + +type CachixAuth = Auth '[Cookie,JWT] Session + +data BinaryCacheAPI route = BinaryCacheAPI + { get :: route :- + Get '[JSON] BinaryCache + , create :: route :- + CachixAuth :> + ReqBody '[JSON] BinaryCacheCreate :> + Post '[JSON] NoContent + -- https://cache.nixos.org/nix-cache-info + , nixCacheInfo :: route :- + "nix-cache-info" :> + Get '[XNixCacheInfo, JSON] NixCacheInfo + -- Hydra: src/lib/Hydra/View/NixNAR.pm + , nar :: route :- + "nar" :> + Capture "nar" NarC :> + StreamResponseGet '[XNixNar, JSON] + , createNar :: route :- + "nar" :> + StreamBodyMonad '[XNixNar, JSON] AWS :> + Post '[JSON] NoContent + -- Hydra: src/lib/Hydra/View/NARInfo.pm + , narinfo :: route :- + Capture "narinfo" NarInfoC :> + Get '[XNixNarInfo, JSON] NarInfo + , narinfoHead :: route :- + Capture "narinfo" NarInfoC :> + Head + , createNarinfo :: route :- + Capture "narinfo" NarInfoC :> + ReqBody '[JSON] NarInfoCreate :> + Post '[JSON] NoContent + } 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] [BinaryCache] + , cache :: route :- + "cache" :> + Capture "name" Text :> + ToServant (BinaryCacheAPI AsApi) + } deriving Generic + +type CachixServantAPI = "api" :> "v1" :> ToServant (CachixAPI AsApi) + +servantApi :: Proxy CachixServantAPI +servantApi = Proxy + +type API = CachixServantAPI + :<|> "api" :> SwaggerSchemaUI "v1" "swagger.json" + +api :: Proxy API +api = Proxy + +swaggerDoc :: Swagger +swaggerDoc = toSwagger servantApi + & info.title .~ "cachix.org API" + & info.version .~ "1.0" + & info.description ?~ "TODO" diff --git a/src/Cachix/Api/Signing.hs b/src/Cachix/Api/Signing.hs new file mode 100644 --- /dev/null +++ b/src/Cachix/Api/Signing.hs @@ -0,0 +1,43 @@ +module Cachix.Api.Signing + ( fingerprint + , passthroughSizeSink + , passthroughHashSink + ) where + +import Crypto.Hash +import Control.Monad.IO.Class (MonadIO, liftIO) +import qualified Data.ByteArray as BA +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 qualified Data.Text as T +import Data.Text (Text) + + +-- perl/lib/Nix/Manifest.pm:fingerprintPath +-- TODO: Either Text ByteString: assert values +-- NB: references must be sorted +fingerprint :: Text -> Text -> Int -> [Text] -> ByteString +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 => Consumer ByteString m Int +sizeSink = CC.foldM (\p n -> return (p + BS.length n)) 0 + +hashSink :: MonadIO m => Consumer ByteString m (Context SHA256) +hashSink = CC.foldM (\p n -> return (hashUpdate p n)) hashInit + +passthroughSizeSink :: MonadIO m => IORef Int -> Conduit ByteString m ByteString +passthroughSizeSink ioref = passthroughSink sizeSink (liftIO . writeIORef ioref) + +passthroughHashSink :: MonadIO m => IORef Text -> Conduit ByteString m ByteString +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 diff --git a/src/Cachix/Api/Swagger.hs b/src/Cachix/Api/Swagger.hs new file mode 100644 --- /dev/null +++ b/src/Cachix/Api/Swagger.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Cachix.Api.Swagger + () where + +import Data.Swagger +import Data.Proxy +import Servant.API +import Servant.Swagger +import Servant.Streaming +import Servant.Auth.Swagger () +import Web.Cookie (SetCookie) + +import Cachix.Api.Types + + +instance ToSchema NixCacheInfo +instance ToSchema NarInfo +instance ToSchema NarInfoCreate + +instance ToSchema BinaryCache +instance ToSchema BinaryCacheCreate + +instance ToSchema User + +instance ToParamSchema NarC +instance ToParamSchema NarInfoC + + +-- TODO: https://github.com/haskell-servant/servant-auth/pull/42#issuecomment-381279499 +instance ToParamSchema SetCookie where + toParamSchema _ = mempty -- TODO: cookie instances for swagger + +-- https://github.com/plow-technologies/servant-streaming/blob/master/servant-streaming-docs/src/Servant/Streaming/Docs/Internal.hs +-- TODO: these should define the body/response content +instance (HasSwagger api) => HasSwagger (StreamBodyMonad contentTypes m :> api) where +--instance (HasSwagger api) => HasSwagger (StreamBody contentTypes :> api) where + toSwagger _ = toSwagger (Proxy :: Proxy api) + +instance HasSwagger (StreamResponseGet contentTypes) where + toSwagger _ = mempty -- TODO mkEndpointNoContent diff --git a/src/Cachix/Api/Types.hs b/src/Cachix/Api/Types.hs new file mode 100644 --- /dev/null +++ b/src/Cachix/Api/Types.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +module Cachix.Api.Types where + +import Data.Aeson (FromJSON, ToJSON) +import Data.ByteString (ByteString) +import Data.Monoid ((<>)) +import Data.Text (Text, takeEnd, dropEnd) +import GHC.Generics (Generic) +import Servant.API + + +data NixCacheInfo = NixCacheInfo + { storeDir :: Text + , wantMassQuery :: Integer + , priority :: Integer + } deriving (Generic, Show, FromJSON, ToJSON) + +-- 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 --base32" + , 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) + +-- | Client create type +data NarInfoCreate = NarInfoCreate + { cStoreHash :: Text -- ^ $storePrefix / $storeHash - $storeSuffix + , cStoreSuffix :: Text -- ^ $storePrefix / $storeHash - $storeSuffix + , cNarHash :: Text + , cNarSize :: Int + , cFileHash :: Text + , cFileSize :: Int + , cReferences :: [Text] + , cDeriver :: Text + , cSig :: Text + } deriving (Generic, Show, FromJSON, ToJSON) + +data BinaryCache = BinaryCache + { name :: Text + , uri :: Text + , publicSigningKeys :: [Text] + } deriving (Show, Generic, FromJSON, ToJSON) + +data BinaryCacheCreate = BinaryCacheCreate + { publicSigningKey :: Text + } deriving (Show, Generic, FromJSON, ToJSON) + +-- | checksum of nar.xz file +newtype NarC = NarC Text deriving Generic + +-- | Store path hash +newtype NarInfoC = NarInfoC Text deriving Generic + +instance FromHttpApiData NarC where + parseUrlPiece s = + if takeEnd 7 s == ".nar.xz" + then Right $ NarC s + else Left "" + +instance ToHttpApiData NarC where + toUrlPiece (NarC n) = n <> ".nar.xz" + +instance FromHttpApiData NarInfoC where + parseUrlPiece s = + if takeEnd 8 s == ".narinfo" + then Right $ NarInfoC (dropEnd 8 s) + else Left "" + +instance ToHttpApiData NarInfoC where + toUrlPiece (NarInfoC n) = n <> ".narinfo" + + +data BinaryCacheError = BinaryCacheError + { error :: Text + } deriving (Generic, FromJSON, ToJSON) + +data User = User + { fullname :: Text + , username :: Text + } deriving (Generic, FromJSON, ToJSON) diff --git a/src/Cachix/Types/ContentTypes.hs b/src/Cachix/Types/ContentTypes.hs new file mode 100644 --- /dev/null +++ b/src/Cachix/Types/ContentTypes.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +module Cachix.Types.ContentTypes ( + XNixNar, + XNixNarInfo, + XNixCacheInfo +) where + +import Data.Typeable (Typeable) +import qualified Network.HTTP.Media as M +import Servant.API + +import Cachix.Api.Types + +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" diff --git a/src/Cachix/Types/Servant.hs b/src/Cachix/Types/Servant.hs new file mode 100644 --- /dev/null +++ b/src/Cachix/Types/Servant.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +-- | Servant specific additions that could be upstreamed +module Cachix.Types.Servant + ( 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 +type Head = Verb 'HEAD 200 '[JSON] NoContent diff --git a/src/Cachix/Types/Session.hs b/src/Cachix/Types/Session.hs new file mode 100644 --- /dev/null +++ b/src/Cachix/Types/Session.hs @@ -0,0 +1,19 @@ +-- | Module for auth session storage +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +module Cachix.Types.Session + ( 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 + deriving (Eq, Show, Generic, FromJSON, ToJSON, FromJWT, ToJWT) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,13 @@ +module Main where + +import Protolude +import Test.Hspec.Runner +import Test.Hspec.Formatters +import qualified Spec + +main :: IO () +main = hspecWith config Spec.spec + where + config = defaultConfig + { configColorMode = ColorAlways + } diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}