{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -O0 #-}

-- TODO https://github.com/haskell-servant/servant/issues/986

module Cachix.Client.Servant
  ( isErr,
    cachixClient,
  )
where

import qualified Cachix.API
import Network.HTTP.Types (Status)
import Protolude
import Servant.API.Generic
import Servant.Auth.Client ()
import qualified Servant.Client
import Servant.Client.Generic (AsClientT)
import Servant.Client.Streaming
import Servant.Conduit ()


isErr :: ClientError -> Status -> Bool
isErr :: ClientError -> Status -> Bool
isErr (Servant.Client.FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
resp) Status
status
  | Response -> Status
forall a. ResponseF a -> Status
Servant.Client.responseStatusCode Response
resp Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status = Bool
True
isErr ClientError
_ Status
_ = Bool
False

cachixClient :: Cachix.API.BinaryCacheAPI (AsClientT ClientM)
cachixClient :: BinaryCacheAPI (AsClientT ClientM)
cachixClient = ToServant BinaryCacheAPI (AsClientT ClientM)
-> BinaryCacheAPI (AsClientT ClientM)
forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant (ToServant BinaryCacheAPI (AsClientT ClientM)
 -> BinaryCacheAPI (AsClientT ClientM))
-> ToServant BinaryCacheAPI (AsClientT ClientM)
-> BinaryCacheAPI (AsClientT ClientM)
forall a b. (a -> b) -> a -> b
$ Proxy
  ("api"
   :> ("v1"
       :> ((((CachixAuth
              :> ("cache"
                  :> (Capture "name" Text
                      :> ("nix-cache-info" :> Get '[XNixCacheInfo, JSON] NixCacheInfo))))
             :<|> (CachixAuth
                   :> ("cache"
                       :> (Capture "name" Text
                           :> (Capture "narinfohash" NarInfoHash
                               :> Get '[XNixNarInfo, JSON] CachixNarInfo)))))
            :<|> ((CachixAuth
                   :> ("cache"
                       :> (Capture "name" Text
                           :> (Capture "narinfohash" NarInfoHash :> Head))))
                  :<|> ((CachixAuth
                         :> ("cache"
                             :> (Capture "name" Text
                                 :> ("nar"
                                     :> (Capture "nar" NarFileName
                                         :> StreamGet
                                              NoFraming
                                              XNixNar
                                              (ConduitT
                                                 () ByteStringStreaming (ResourceT IO) ()))))))
                        :<|> (CachixAuth
                              :> ("cache"
                                  :> (Capture "name" Text :> Get '[JSON] BinaryCache))))))
           :<|> (((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]))))))
                  :<|> ((CachixAuth
                         :> ("cache"
                             :> (Capture "name" Text
                                 :> ("narurl" :> (Capture "nar" NarFileName :> Get '[JSON] Text)))))
                        :<|> (CachixAuth
                              :> ("cache"
                                  :> (Capture "name" Text
                                      :> (Capture "narinfohash" NarInfoHash
                                          :> (ReqBody '[JSON] NarInfoCreate
                                              :> Post '[JSON] NoContent)))))))
                 :<|> ((CachixAuth
                        :> ("cache"
                            :> (Capture "name" Text
                                :> ("nar"
                                    :> (StreamBody
                                          NoFraming
                                          XNixNar
                                          (ConduitT () ByteStringStreaming (ResourceT IO) ())
                                        :> Post '[JSON] NoContent)))))
                       :<|> ((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]
                                                              LazyByteStringStreaming))))))))
                             :<|> (CachixAuth
                                   :> ("cache"
                                       :> (Capture "name" Text
                                           :> ("key"
                                               :> (ReqBody '[JSON] SigningKeyCreate
                                                   :> Post '[JSON] NoContent)))))))))))
-> Client
     ClientM
     ("api"
      :> ("v1"
          :> ((((CachixAuth
                 :> ("cache"
                     :> (Capture "name" Text
                         :> ("nix-cache-info" :> Get '[XNixCacheInfo, JSON] NixCacheInfo))))
                :<|> (CachixAuth
                      :> ("cache"
                          :> (Capture "name" Text
                              :> (Capture "narinfohash" NarInfoHash
                                  :> Get '[XNixNarInfo, JSON] CachixNarInfo)))))
               :<|> ((CachixAuth
                      :> ("cache"
                          :> (Capture "name" Text
                              :> (Capture "narinfohash" NarInfoHash :> Head))))
                     :<|> ((CachixAuth
                            :> ("cache"
                                :> (Capture "name" Text
                                    :> ("nar"
                                        :> (Capture "nar" NarFileName
                                            :> StreamGet
                                                 NoFraming
                                                 XNixNar
                                                 (ConduitT
                                                    () ByteStringStreaming (ResourceT IO) ()))))))
                           :<|> (CachixAuth
                                 :> ("cache"
                                     :> (Capture "name" Text :> Get '[JSON] BinaryCache))))))
              :<|> (((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]))))))
                     :<|> ((CachixAuth
                            :> ("cache"
                                :> (Capture "name" Text
                                    :> ("narurl"
                                        :> (Capture "nar" NarFileName :> Get '[JSON] Text)))))
                           :<|> (CachixAuth
                                 :> ("cache"
                                     :> (Capture "name" Text
                                         :> (Capture "narinfohash" NarInfoHash
                                             :> (ReqBody '[JSON] NarInfoCreate
                                                 :> Post '[JSON] NoContent)))))))
                    :<|> ((CachixAuth
                           :> ("cache"
                               :> (Capture "name" Text
                                   :> ("nar"
                                       :> (StreamBody
                                             NoFraming
                                             XNixNar
                                             (ConduitT () ByteStringStreaming (ResourceT IO) ())
                                           :> Post '[JSON] NoContent)))))
                          :<|> ((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]
                                                                 LazyByteStringStreaming))))))))
                                :<|> (CachixAuth
                                      :> ("cache"
                                          :> (Capture "name" Text
                                              :> ("key"
                                                  :> (ReqBody '[JSON] SigningKeyCreate
                                                      :> Post '[JSON] NoContent)))))))))))
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client Proxy API
Proxy
  ("api"
   :> ("v1"
       :> ((((CachixAuth
              :> ("cache"
                  :> (Capture "name" Text
                      :> ("nix-cache-info" :> Get '[XNixCacheInfo, JSON] NixCacheInfo))))
             :<|> (CachixAuth
                   :> ("cache"
                       :> (Capture "name" Text
                           :> (Capture "narinfohash" NarInfoHash
                               :> Get '[XNixNarInfo, JSON] CachixNarInfo)))))
            :<|> ((CachixAuth
                   :> ("cache"
                       :> (Capture "name" Text
                           :> (Capture "narinfohash" NarInfoHash :> Head))))
                  :<|> ((CachixAuth
                         :> ("cache"
                             :> (Capture "name" Text
                                 :> ("nar"
                                     :> (Capture "nar" NarFileName
                                         :> StreamGet
                                              NoFraming
                                              XNixNar
                                              (ConduitT
                                                 () ByteStringStreaming (ResourceT IO) ()))))))
                        :<|> (CachixAuth
                              :> ("cache"
                                  :> (Capture "name" Text :> Get '[JSON] BinaryCache))))))
           :<|> (((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]))))))
                  :<|> ((CachixAuth
                         :> ("cache"
                             :> (Capture "name" Text
                                 :> ("narurl" :> (Capture "nar" NarFileName :> Get '[JSON] Text)))))
                        :<|> (CachixAuth
                              :> ("cache"
                                  :> (Capture "name" Text
                                      :> (Capture "narinfohash" NarInfoHash
                                          :> (ReqBody '[JSON] NarInfoCreate
                                              :> Post '[JSON] NoContent)))))))
                 :<|> ((CachixAuth
                        :> ("cache"
                            :> (Capture "name" Text
                                :> ("nar"
                                    :> (StreamBody
                                          NoFraming
                                          XNixNar
                                          (ConduitT () ByteStringStreaming (ResourceT IO) ())
                                        :> Post '[JSON] NoContent)))))
                       :<|> ((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]
                                                              LazyByteStringStreaming))))))))
                             :<|> (CachixAuth
                                   :> ("cache"
                                       :> (Capture "name" Text
                                           :> ("key"
                                               :> (ReqBody '[JSON] SigningKeyCreate
                                                   :> Post '[JSON] NoContent)))))))))))
Cachix.API.api