content: {-# LANGUAGE ViewPatterns #-}
  
  -- | ABC has a non-conventional approach to separate compilation and
  -- linking: ABC resources are given deterministic, cryptographically
  -- unique names using secure hash of the bytecode, and ABC can invoke
  -- these resources by name to logically inline the bytecode. 
  -- 
  -- To support integration with content distribution networks, ABC 
  -- resources are encrypted. The decryption key is the secure hash of
  -- the bytecode. The full name includes both the decryption key and
  -- the secure hash of the cipher text to quickly look up the resource.
  -- 
  -- The full ABC invocation looks like:
  -- 
  --      {#SecureHashOfCiphertextSecureHashOfBytecode}
  --
  -- The hashes are encoded in ABC's base16 (cf. ABC.Base16), with no
  -- separator in order to get the tightest encoding possible. The
  -- full descriptor (including curly braces) is 99 characters but
  -- will compress to 53.
  --
  -- The hashes use independent parts of an SHA3-384 secure hash. The
  -- first third is 128 bits (16 bytes) for the lookup. The last two
  -- thirds is 256 bits, used to decrypt the resource. Systems should 
  -- accept the possibility of rare lookup collisions, and resolve via
  -- the secure bytecode hash. 
  -- 
  -- Pseudocode for resource construction:
  -- 
  --      given bytecode
  --      encryptionKey = secureHashBC(bytecode)
  --      cipherText = encrypt(compress(bytecode),encryptionKey)
  --      lookupKey = secureHashCT(cipherText)
  --      store(lookupKey,cipherText)
  --      resourceId = base16encode(append(lookupKey,encryptionKey))
  --      return resourceId
  -- 
  -- Pseudocode for resource acquisition:
  -- 
  --      given resourceId
  --      extract lookupKey, encryptionKey from resourceId
  --      cipherText = fetch(lookupKey)
  --      validate(lookupKey == secureHashCT(cipherText))
  --      bytecode = decompress(decrypt(cipherText),encryptionKey)
  --      validate(encryptionKey == secureHashBC(bytecode))
  --      validateABC(bytecode)
  --      return bytecode
  -- 
  -- Separate compilation is opportunistic. We expect reuse of names,
  -- so we can cache and compile the bytecode associated with a given
  -- resourceId.
  --
  -- Not all details are settled. Some relatively stable decisions:
  -- 
  --      secureHash CT,BC: are independent halves of SHA3-384
  --      AES encryption, CTR mode, nonce simple function of key
  --      two pass compression: base16 binaries, then everything 
  --      simple, deterministic, unambiguous compression algorithm
  -- 
  -- This module implements the standard resource model as far as it
  -- has been implemented, stubbing the elements that haven't been 
  -- decided yet.
  -- 
  module ABC.Resource 
      ( CipherText, ResourceToken
      , SaveMethod, LoadMethod
      , makeResource, loadResource
      , abcResourceToken
      -- miscellaneous
      , HashCT, HashBC
      , secureHashCT, secureHashBC, secureHashBC'
      , SecureHash, secureHash
      , encodeABC, decodeABC
      ) where
  
  import Control.Arrow ((>>>))
  import Control.Applicative
  import Data.Functor.Identity
  import qualified Data.List as L
  import Data.ByteString (ByteString)
  import Data.Maybe (mapMaybe)
  import qualified Data.ByteString as B
  import qualified Data.Byteable as B
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as T
  import qualified Text.Read as R
  import qualified Crypto.Hash as CH
  import ABC.Operators
  import qualified ABC.Base16 as B16
  import qualified ABC.Compress as ABCZ
  
  -- | HashCT and HashBC are byte strings
  --
  -- Concretely:
  --   HashCT is first 128 bits of SHA3-384 of the ciphertext.
  --   HashBC is last  256 bits of SHA3-384 of the bytecode (UTF-8 encoded)
  --
  -- Independent halves of SHA3-384 ensures independence of hash values
  -- without relying on quality of encryption or compression. The total
  -- 384 bits from HashCT and HashBC contribute to the unique identity
  -- of a ResourceToken.
  -- 
  type HashBC = ByteString
  type HashCT = ByteString
  
  -- | SecureHash is simply the full SHA3-384 value (48 octets)
  type SecureHash = ByteString
  
  -- | Cipher text in this case is compressed and encrypted bytecode.
  -- 
  -- At the moment, compression and encryption algorithms is not yet 
  -- decided, and this is simply identical to the bytecode. But that
  -- won't always hold.
  type CipherText = ByteString
  
  -- | A resource token is the text that goes between curly braces
  -- for invocation in ABC. I.e. in this case, it has the form:
  --      #secureHashOfCiphertext:secureHashOfBytecode
  -- with the secure hashes encoded in base64url.
  type ResourceToken = String
  
  -- | Store a ciphertext somewhere, to be later looked up by secure
  -- hash. The full secure hash is given here just to avoid local
  -- redundant computation. In some situations, it may be appropriate
  -- to validate the secure hash for security or integrity reasons.
  type SaveMethod m = SecureHash -> CipherText -> m ()
  
  -- | Load a ciphertext given HashCT, i.e. the first half of the full
  -- SHA3-384 SecureHash of the ciphertext. In the unlikely case of a
  -- 192-bit hash collision, or for some simple storage models, we may
  -- return multiple candidate texts. 
  type LoadMethod m = HashCT -> m [CipherText]
  
  -- | generate secure hash for a series of operations.
  -- (second half of SHA3-384 on UTF-8 encoding of ABC)
  secureHashBC :: [Op] -> HashBC
  secureHashBC = secureHashBC' . encodeABC
  
  -- | encode ABC as a UTF-8 bytestring
  encodeABC :: [Op] -> ByteString
  encodeABC = T.encodeUtf8 . T.pack . show
  
  -- | decode bytestring as ABC program (or fail returning Nothing)
  decodeABC :: ByteString -> Maybe [Op]
  decodeABC bcBytes = 
      case T.decodeUtf8' bcBytes of
          Left _ -> Nothing
          Right txt -> 
              let s = T.unpack txt in
              case R.reads s of
                  [(ops,"")] -> Just ops
                  _rl -> Nothing
  
  -- | generate secure hash for the bytecode from bytestring
  -- eqv. to `drop 16 . secureHash`
  secureHashBC' :: ByteString -> HashBC
  secureHashBC' = B.drop 16 . secureHash
  
  -- | secure hash for the ciphertext (used as lookup key)
  -- first half of SHA3-384, eqv. to `take 16 . secureHash`
  secureHashCT :: CipherText -> HashCT
  secureHashCT = B.take 16 . secureHash
  
  -- | generate a complete secure hash (SHA3-384, as 48 octets)
  secureHash :: ByteString -> SecureHash
  secureHash = sha3_384
  
  -- | given a storage method and an ABC subprogram, create the ABC 
  -- resource and return a deterministic, unique resource token. 
  --
  makeResource :: (Monad m) => (SaveMethod m) -> [Op] -> m ResourceToken
  makeResource fnSave bytecode = saveCode >> return rscTok where
      bcBytes = encodeABC bytecode
      hashBC = secureHashBC' bcBytes
      cipherText = encrypt hashBC (compress bcBytes)
      fullHashCT = secureHash cipherText
      saveCode = fnSave fullHashCT cipherText
      hashCT = B.take 16 fullHashCT
      rscTok = "#" ++ toBase16 (hashCT `B.append` hashBC)
  
  -- | purely compute the resource token without storing the resource
  abcResourceToken :: [Op] -> ResourceToken
  abcResourceToken = runIdentity . makeResource nullStore where
      nullStore _hashCT _cipherText = return ()
  
  -- | given a load method and a full resource token, obtain a single
  -- resource that should be cryptographically unique. Or `fail` if 
  -- no such resource can be loaded. Also performs a minimal, shallow
  -- validation that the hashes match and ABC parses.
  loadResource :: (Monad m) => (LoadMethod m) -> ResourceToken -> m [Op]
  loadResource fnLoad tok@(splitToken -> Just (hashCT,hashBC)) =
      fnLoad hashCT >>= \ lCandidate -> 
      let lMatchHashCT = L.filter ((== hashCT) . secureHashCT) lCandidate in
      let lbcBytes = L.nub $ mapMaybe (decompress . decrypt hashBC) lMatchHashCT in
      let lMatchHashBC = L.filter ((== hashBC) . secureHashBC') lbcBytes in
      let lOps = mapMaybe decodeABC lMatchHashBC in
      case lOps of
          [] -> fail ("ABC resource " ++ tok ++ " not found") -- e.g. network failure
          [ops] -> return ops
          _ -> fail ("ABC resource " ++ tok ++ " is ambiguous") -- secure hash collision!
  loadResource _ tok = fail $ "invalid resource token: " ++ tok
  
  -- extract two secure hashes from given resource token
  splitToken :: ResourceToken -> Maybe (HashCT, HashBC)
  splitToken ('#':rscid) =
      let (rct,rbc) = L.splitAt 32 rscid in
      case (fromBase16 rct, fromBase16 rbc) of
          (Just hct, Just hbc) ->
              -- ensure 192 bits for each hash
              let okSize = (16 == B.length hct) && (32 == B.length hbc) in
              if okSize then Just (hct,hbc) else Nothing
          _ -> Nothing
  splitToken _ = Nothing
      
  -- the type declaration selects the hash function (yuck)
  sha3_384 :: ByteString -> ByteString
  sha3_384 = B.toBytes . sha3_384'
  
  sha3_384' :: ByteString -> CH.Digest CH.SHA3_384
  sha3_384' = CH.hash
  
  toBase16 :: ByteString -> String
  toBase16 = B.unpack >>> B16.encode >>> fmap toChar where
      toChar = toEnum . fromIntegral
  
  fromBase16 :: String -> Maybe ByteString
  fromBase16 s = 
      let bs = (B.unpack . T.encodeUtf8 . T.pack) s in
      let (goodBytes,badBytes) = B16.decode bs in
      if null badBytes then Just (B.pack goodBytes)
                       else Nothing
  
  
  -- todo: implement encryption; for now, just appending the key and
  -- the content to simulate use of binary code under the hood.
  encrypt :: HashBC -> ByteString -> CipherText
  encrypt = B.append
  
  -- todo: implement decryption
  -- (note: might need to trim a little off the end of the final block)
  decrypt :: HashBC -> CipherText -> ByteString
  decrypt _key ct | B.isPrefixOf _key ct = B.drop (B.length _key) ct
  decrypt _ ct = ct
  
  -- todo: implement compression
  compress :: ByteString -> ByteString
  compress = B.unpack >>> ABCZ.compress >>> B.pack
  
  -- todo: implement decompression
  decompress :: ByteString -> Maybe ByteString
  decompress = pure . (B.unpack >>> ABCZ.decompress >>> B.pack)
  
  
  