content: {-# LANGUAGE DataKinds                  #-}
  {-# LANGUAGE DeriveFunctor              #-}
  {-# LANGUAGE DeriveGeneric              #-}
  {-# LANGUAGE DuplicateRecordFields      #-}
  {-# LANGUAGE FlexibleInstances          #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE OverloadedStrings          #-}
  {-# LANGUAGE PartialTypeSignatures      #-}
  {-# LANGUAGE StandaloneDeriving         #-}
  {-# LANGUAGE TypeOperators              #-}
  {-# LANGUAGE ViewPatterns               #-}
  {-# OPTIONS -fno-warn-orphans  #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Hocker.Types
  -- Copyright   :  (C) 2016 Awake Networks
  -- License     :  Apache-2.0
  -- Maintainer  :  Awake Networks <opensource@awakenetworks.com>
  -- Stability   :  stable
  ----------------------------------------------------------------------------
  
  module Hocker.Types where
  
  import           Control.Applicative
  import qualified Options.Applicative.Help.Pretty as Doc
  import           Control.Monad.Error.Class
  import qualified Control.Monad.Except       as Except
  import           Control.Monad.IO.Class
  import qualified Control.Monad.Reader       as Reader
  import           Control.Monad.Reader.Class
  import qualified Crypto.Hash                as Hash
  import qualified Data.ByteString.Lazy
  import           Data.Char                  (toUpper)
  import qualified Data.Text                  as Text
  import qualified Network.Wreq               as Wreq
  import           Network.Wreq.ErrorHandling
  import qualified Options.Applicative        as Options
  import           Options.Generic
  import           URI.ByteString
  
  import           Hocker.Types.Exceptions
  import           Hocker.Types.Hash                 ()
  import           Hocker.Types.ImageName
  import           Hocker.Types.ImageTag
  import           Hocker.Types.URI                  ()
  
  -- | Docker registry URI.
  type RegistryURI     = (URIRef Absolute)
  
  -- | Docker registry username.
  type Username        = Text
  
  -- | Docker registry user password.
  type Password        = Text
  
  -- | Docker image layer sha256 hash digest.
  type Layer           = Text
  
  -- | SHA256 hash digest with the hash algorithm identifier prefix,
  -- stripped
  type StrippedDigest  = Text
  
  -- | Docker image manifest JSON.
  type Manifest        = Data.ByteString.Lazy.ByteString
  
  -- | Docker image config JSON.
  type ImageConfigJSON = Data.ByteString.Lazy.ByteString
  
  -- | Wreq response type parameterized by the lazy bytestring type.
  type RspBS           = Wreq.Response Data.ByteString.Lazy.ByteString
  
  -- | A file extension.
  type Extension       = String
  
  -- | RepoName is the part before the forward slash in a docker image
  -- name, e.g: @library@ in @library/debian@
  type RepoNamePart    = Text
  
  -- | ImageName is the part after the forward slash in a docker image
  -- name, e.g: @library@ in @library/debian@
  type ImageNamePart   = Text
  
  -- | Docker image config JSON file's sha256 hash digest in Nix's
  -- base32 encoding.
  --
  -- NB: it's very important to realize there's a significant difference
  -- between Nix's base32 encoding and the standard base32 encoding!
  -- (i.e, they're not compatible).
  type ConfigDigest    = Base32Digest
  
  -- | Generic top-level optparse-generic CLI args data type and
  -- specification.
  --
  -- NOTE: `hocker-layer` does not use this data type because it
  -- requires an additional layer sha256 hash digest argument.
  data Options w = Options
      { -- | URI for the registry, optional
        registry    :: w ::: Maybe RegistryURI
        <?> "URI of registry, defaults to the Docker Hub registry"
      , credentials :: Maybe Credentials
        -- | Filesystem path to write output to
      , out         :: w ::: Maybe FilePath
        <?> "Write content to location"
        -- | Docker image name (includes the reponame, e.g: library/debian)
      , imageName   :: ImageName
        -- | Docker image tag
      , imageTag    :: ImageTag
      } deriving (Generic)
  
  instance ParseRecord (Options Wrapped)
  deriving instance Show (Options Unwrapped)
  
  -- | Hocker 'ExceptT' and 'ReaderT' transformer stack threading a
  -- 'HockerMeta' data type.
  newtype Hocker a = Hocker { unHocker :: Reader.ReaderT HockerMeta (Except.ExceptT HockerException IO) a }
    deriving
      ( Functor
      , Applicative
      , Monad
      , MonadIO
      , MonadReader HockerMeta
      , MonadError HockerException
      )
  
  runHocker :: Hocker a -> HockerMeta -> IO (Either HockerException a)
  runHocker (unHocker -> d) = Except.runExceptT . interceptHttpExc . Reader.runReaderT d
  
  -- | Red wagon record carrying around the environment as we fetch,
  -- transform, and assemble docker image artifacts.
  data HockerMeta = HockerMeta
      { dockerRegistry :: RegistryURI
      , auth           :: Maybe Wreq.Auth
      , imageName      :: ImageName
      , imageTag       :: ImageTag
      , out            :: Maybe FilePath
      , outDir         :: Maybe FilePath
      , imageLayer     :: Maybe (Hash.Digest Hash.SHA256)
      } deriving (Show)
  
  -- | Newtype base32 encoding of a hash digest.
  --
  -- Please note, this base32 encoding is unique to Nix and not
  -- compatible with other base32 encodings.
  newtype Base32Digest = Base32Digest Text
    deriving (Show, Read, Eq)
  
  -- | Newtype base16 encoding of a hash digest.
  --
  -- This encoding has no known idiosyncracies specific to Nix, it
  -- should be compatible with other tools and library's expectations.
  newtype Base16Digest = Base16Digest Text
    deriving (Show, Read, Eq)
  
  data Credentials = Basic Username Password | BearerToken Text | CredentialsFile FilePath
    deriving (Show)
  
  instance ParseField Credentials where
    readField = Options.readerError "Internal, fatal error: unexpected use of readField"
    parseField _help _long _short _value =
      (   (Basic <$> parseUsername <*> parsePassword)
      <|> (BearerToken <$> parseToken)
      <|> (CredentialsFile <$> parseCredentialFile)
      )
      where
        parseUsername = Text.pack <$>
          (Options.option Options.str $
           (  Options.metavar "BASIC USERNAME"
           <> Options.long    "username"
           <> Options.short   'u'
           <> Options.help    "Username part of a basic auth credential"
           )
          )
        parsePassword = Text.pack <$>
          (Options.option Options.str $
           (  Options.metavar "BASIC PASSWORD"
           <> Options.long    "password"
           <> Options.short   'p'
           <> Options.help    "Password part of a basic auth credential"
           )
          )
        parseToken = Text.pack <$>
          (Options.option Options.str $
           (  Options.metavar "BEARER TOKEN"
           <> Options.long    "token"
           <> Options.short   't'
           <> Options.helpDoc (Just $ Doc.vcat
              [ "Bearer token retrieved from a call to `docker login`"
              , "(mutually exclusive to --username and --password and --credentials-file)"
              ])
           )
          )
        parseCredentialFile = Options.option Options.str $
          (  Options.metavar "PATH"
          <> Options.long    "credentials-file"
          <> Options.short    'f'
          <> Options.helpDoc (Just $ Doc.vcat
              [ "Path to a file containing either:"
              , ""
              , "USERNAME=<username>"
              , "PASSWORD=<password>"
              , ""
              , "or"
              , ""
              , "BEARER_TOKEN=<token>"
              , ""
              , "(mutually exclusive to --username and --password and --token)"
              ])
          )
  
  instance ParseFields Credentials
  instance ParseRecord Credentials where
    parseRecord = fmap Options.Generic.getOnly parseRecord
  
  -- | @upperFirst@ uppercases the first letter of the string.
  upperFirst :: String -> String
  upperFirst []    = []
  upperFirst (h:t) = toUpper h : t
  