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

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

import qualified Cachix.Types.BinaryCache as BinaryCache
import qualified Cachix.Types.ByteStringStreaming as ByteStringStreaming
import Cachix.Types.ContentTypes
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 (Head)
import Cachix.Types.Session (Session)
import qualified Cachix.Types.SigningKeyCreate as SigningKeyCreate
import Control.Monad.Trans.Resource
import Data.Conduit (ConduitT)
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
                       :> StreamGet
                            NoFraming
                            XNixNar
                            (ConduitT () ByteStringStreaming (ResourceT IO) ()))))))
nar ::
      route
        :- CachixAuth
        :> "cache"
        :> Capture "name" Text
        :> "nar"
        :> Capture "nar" NarFileName
        :> StreamGet NoFraming XNixNar (ConduitT () ByteStringStreaming.ByteStringStreaming (ResourceT IO) ()),
    -- 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
   :- (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
               :> ("nar"
                   :> (StreamBody
                         NoFraming
                         XNixNar
                         (ConduitT () ByteStringStreaming (ResourceT IO) ())
                       :> Post '[JSON] NoContent)))))
createNar ::
      route
        :- CachixAuth
        :> "cache"
        :> Capture "name" Text
        :> "nar"
        :> StreamBody NoFraming XNixNar (ConduitT () ByteStringStreaming.ByteStringStreaming (ResourceT IO) ())
        :> 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

api :: Proxy API
api :: Proxy API
api = forall {k} (t :: k). Proxy t
Proxy