{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}

module Cachix.API
  ( BinaryCacheAPI (..),
    API,
    CachixAuth,
  )
where

import qualified Cachix.Types.BinaryCache as BinaryCache
import qualified Cachix.Types.ByteStringStreaming as ByteStringStreaming
import Cachix.Types.ContentTypes
import qualified Cachix.Types.MultipartUpload as Multipart
import Cachix.Types.NarFileName (NarFileName (..))
import qualified Cachix.Types.NarInfo as NarInfo
import qualified Cachix.Types.NarInfoCreate as NarInfoCreate
import qualified Cachix.Types.NarInfoHash as NarInfoHash
import qualified Cachix.Types.NixCacheInfo as NixCacheInfo
import Cachix.Types.Servant (Get302, Head)
import Cachix.Types.Session (Session)
import qualified Cachix.Types.SigningKeyCreate as SigningKeyCreate
import Control.Monad.Trans.Resource
import Data.Conduit (ConduitT)
import Data.UUID (UUID)
import Protolude
import Servant.API hiding (BasicAuth)
import Servant.API.Generic
import Servant.Auth

type CachixAuth = Auth '[Cookie, JWT, BasicAuth] Session

-- Nix CLI + Cachix CLI
data BinaryCacheAPI route = BinaryCacheAPI
  { -- https://cache.nixos.org/nix-cache-info
    forall route.
BinaryCacheAPI route
-> route
   :- (CachixAuth
       :> ("cache"
           :> (Capture "name" Text
               :> ("nix-cache-info" :> Get '[XNixCacheInfo, JSON] NixCacheInfo))))
nixCacheInfo ::
      route
        :- CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> "nix-cache-info"
          :> Get '[XNixCacheInfo, JSON] NixCacheInfo.NixCacheInfo,
    -- Hydra: src/lib/Hydra/View/NARInfo.pm
    forall route.
BinaryCacheAPI route
-> route
   :- (CachixAuth
       :> ("cache"
           :> (Capture "name" Text
               :> (Capture "narinfohash" NarInfoHash
                   :> Get
                        '[XNixNarInfo, JSON]
                        (Headers '[Header "Cache-Control" Text] CachixNarInfo)))))
narinfo ::
      route
        :- CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> Capture "narinfohash" NarInfoHash.NarInfoHash
          :> Get '[XNixNarInfo, JSON] (Headers '[Header "Cache-Control" Text] NarInfo.CachixNarInfo),
    forall route.
BinaryCacheAPI route
-> route
   :- (CachixAuth
       :> ("cache"
           :> (Capture "name" Text
               :> (Capture "narinfohash" NarInfoHash :> Head))))
narinfoHead ::
      route
        :- CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> Capture "narinfohash" NarInfoHash.NarInfoHash
          :> Head,
    -- Hydra: src/lib/Hydra/View/NixNAR.pm
    forall route.
BinaryCacheAPI route
-> route
   :- (CachixAuth
       :> ("cache"
           :> (Capture "name" Text
               :> ("nar"
                   :> (Capture "nar" NarFileName :> Get302 '[XNixNar] '[])))))
nar ::
      route
        :- CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> "nar"
          :> Capture "nar" NarFileName
          :> Get302 '[XNixNar] '[],
    -- cachix specific
    forall route.
BinaryCacheAPI route
-> route
   :- (CachixAuth
       :> ("cache" :> (Capture "name" Text :> Get '[JSON] BinaryCache)))
getCache ::
      route
        :- CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> Get '[JSON] BinaryCache.BinaryCache,
    forall route.
BinaryCacheAPI route
-> route
   :- (CachixAuth
       :> ("cache"
           :> (Capture "name" Text
               :> ("narinfo"
                   :> (Summary
                         "Given a list of store hashes, return a list of those that are missing"
                       :> (ReqBody '[JSON] [Text] :> Post '[JSON] [Text]))))))
narinfoBulk ::
      route
        :- CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> "narinfo"
          :> Summary "Given a list of store hashes, return a list of those that are missing"
          :> ReqBody '[JSON] [Text]
          :> Post '[JSON] [Text],
    forall route.
BinaryCacheAPI route
-> route
   :- (CachixAuth
       :> ("cache"
           :> (Capture "name" Text
               :> ("narurl" :> (Capture "nar" NarFileName :> Get '[JSON] Text)))))
narURL ::
      route
        :- CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> "narurl"
          :> Capture "nar" NarFileName
          :> Get '[JSON] Text,
    forall route.
BinaryCacheAPI route
-> route
   :- (Summary "Upload a NAR directly to the Cachix Server"
       :> (Description
             "This is a legacy API for older Cachix clients. Prefer 'createNar' instead."
           :> (CachixAuth
               :> ("cache"
                   :> (Capture "name" Text
                       :> ("nar"
                           :> (QueryParam "compression" CompressionMethod
                               :> (StreamBody
                                     NoFraming
                                     XNixNar
                                     (ConduitT () ByteStringStreaming (ResourceT IO) ())
                                   :> Post '[JSON] NoContent))))))))
createAndUploadNar ::
      route
        :- Summary "Upload a NAR directly to the Cachix Server"
          :> Description "This is a legacy API for older Cachix clients. Prefer 'createNar' instead."
          :> CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> "nar"
          :> QueryParam "compression" BinaryCache.CompressionMethod
          :> StreamBody NoFraming XNixNar (ConduitT () ByteStringStreaming.ByteStringStreaming (ResourceT IO) ())
          :> Post '[JSON] NoContent,
    forall route.
BinaryCacheAPI route
-> route
   :- (Summary "Create an empty NAR and initiate a multipart upload"
       :> (CachixAuth
           :> ("cache"
               :> (Capture "name" Text
                   :> ("multipart-nar"
                       :> (QueryParam "compression" CompressionMethod
                           :> Post '[JSON] CreateMultipartUploadResponse))))))
createNar ::
      route
        :- Summary "Create an empty NAR and initiate a multipart upload"
          :> CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> "multipart-nar"
          :> QueryParam "compression" BinaryCache.CompressionMethod
          :> Post '[JSON] Multipart.CreateMultipartUploadResponse,
    forall route.
BinaryCacheAPI route
-> route
   :- (Summary
         "Retrieve a presigned URL to upload a part of a multipart NAR"
       :> (CachixAuth
           :> ("cache"
               :> (Capture "name" Text
                   :> ("multipart-nar"
                       :> (Capture "narUuid" UUID
                           :> (QueryParam' '[Required] "uploadId" Text
                               :> (QueryParam' '[Required] "partNumber" Int
                                   :> (ReqBody '[JSON] SigningData
                                       :> Post '[JSON] UploadPartResponse)))))))))
uploadNarPart ::
      route
        :- Summary "Retrieve a presigned URL to upload a part of a multipart NAR"
          :> CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> "multipart-nar"
          :> Capture "narUuid" UUID
          :> QueryParam' '[Required] "uploadId" Text
          :> QueryParam' '[Required] "partNumber" Int
          :> ReqBody '[JSON] Multipart.SigningData
          :> Post '[JSON] Multipart.UploadPartResponse,
    forall route.
BinaryCacheAPI route
-> route
   :- (Summary "Complete a multipart upload"
       :> (Description
             "Verify the etags for each part and create the narinfo"
           :> (CachixAuth
               :> ("cache"
                   :> (Capture "name" Text
                       :> ("multipart-nar"
                           :> (Capture "narUuid" UUID
                               :> ("complete"
                                   :> (QueryParam' '[Required] "uploadId" Text
                                       :> (ReqBody '[JSON] CompletedMultipartUpload
                                           :> Post '[JSON] NoContent))))))))))
completeNarUpload ::
      route
        :- Summary "Complete a multipart upload"
          :> Description "Verify the etags for each part and create the narinfo"
          :> CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> "multipart-nar"
          :> Capture "narUuid" UUID
          :> "complete"
          :> QueryParam' '[Required] "uploadId" Text
          :> ReqBody '[JSON] Multipart.CompletedMultipartUpload
          :> Post '[JSON] NoContent,
    forall route.
BinaryCacheAPI route
-> route
   :- (Summary "Abort a multipart upload"
       :> (CachixAuth
           :> ("cache"
               :> (Capture "name" Text
                   :> ("multipart-nar"
                       :> (Capture "narUuid" UUID
                           :> ("abort"
                               :> (QueryParam' '[Required] "uploadId" Text
                                   :> Post '[JSON] NoContent))))))))
abortMultipartUpload ::
      route
        :- Summary "Abort a multipart upload"
          :> CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> "multipart-nar"
          :> Capture "narUuid" UUID
          :> "abort"
          :> QueryParam' '[Required] "uploadId" Text
          :> Post '[JSON] NoContent,
    forall route.
BinaryCacheAPI route
-> route
   :- (CachixAuth
       :> ("cache"
           :> (Capture "name" Text
               :> (Capture "narinfohash" NarInfoHash
                   :> (ReqBody '[JSON] NarInfoCreate :> Post '[JSON] NoContent)))))
createNarinfo ::
      route
        :- CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> Capture "narinfohash" NarInfoHash.NarInfoHash
          :> ReqBody '[JSON] NarInfoCreate.NarInfoCreate
          :> Post '[JSON] NoContent,
    forall route.
BinaryCacheAPI route
-> route
   :- (CachixAuth
       :> ("cache"
           :> (Capture "name" Text
               :> ("serve"
                   :> (Capture "storehash" Text
                       :> (CaptureAll "filepath" Text
                           :> (Summary "Serve a file from a given store path"
                               :> Get
                                    '[XNixNar]
                                    (Headers
                                       '[Header "X-Content-Type-Options" Text,
                                         Header "Cache-Control" Text]
                                       LazyByteStringStreaming))))))))
serveNarContent ::
      route
        :- CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> "serve"
          :> Capture "storehash" Text
          :> CaptureAll "filepath" Text
          :> Summary "Serve a file from a given store path"
          :> Get '[XNixNar] (Headers '[Header "X-Content-Type-Options" Text, Header "Cache-Control" Text] ByteStringStreaming.LazyByteStringStreaming),
    forall route.
BinaryCacheAPI route
-> route
   :- (CachixAuth
       :> ("cache"
           :> (Capture "name" Text
               :> ("key"
                   :> (ReqBody '[JSON] SigningKeyCreate :> Post '[JSON] NoContent)))))
createKey ::
      route
        :- CachixAuth
          :> "cache"
          :> Capture "name" Text
          :> "key"
          :> ReqBody '[JSON] SigningKeyCreate.SigningKeyCreate
          :> Post '[JSON] NoContent
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall route x.
Rep (BinaryCacheAPI route) x -> BinaryCacheAPI route
forall route x.
BinaryCacheAPI route -> Rep (BinaryCacheAPI route) x
$cto :: forall route x.
Rep (BinaryCacheAPI route) x -> BinaryCacheAPI route
$cfrom :: forall route x.
BinaryCacheAPI route -> Rep (BinaryCacheAPI route) x
Generic)

type API = "api" :> "v1" :> ToServantApi BinaryCacheAPI